diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 9743c7fa3f..3f3f420575 100644 --- a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -130,6 +130,8 @@ module MOM_surface_forcing_gfdl logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover !! the answers from the end of 2018. Otherwise, use a simpler !! expression to calculate gustiness. + logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the + !! gustless wind friction velocity. logical :: check_no_land_fluxes !< Return warning if IOB flux over land is non-zero type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing @@ -247,7 +249,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. real :: rhoXcp ! Reference density times heat capacity times unit scaling - ! factors [J T s-1 Z-1 m-2 degC-1 ~> J m-3 degC-1] + ! factors [Q R degC-1 ~> J m-3 degC-1] real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. call cpu_clock_begin(id_clock_forcing) @@ -261,7 +263,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s - if (CS%restore_temp) rhoXcp = US%R_to_kg_m3*US%Z_to_m*US%s_to_T * CS%Rho0 * fluxes%C_p + if (CS%restore_temp) rhoXcp = CS%Rho0 * fluxes%C_p open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 @@ -274,8 +276,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! allocation and initialization if this is the first time that this ! flux type has been used. if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., press=.true., & + fix_accum_bug=CS%fix_ustar_gustless_bug) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) @@ -339,8 +341,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%dt_buoy_accum = US%s_to_T*valid_time if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 + fluxes%heat_added(:,:) = 0.0 + fluxes%salt_flux_added(:,:) = 0.0 endif do j=js,je ; do i=is,ie @@ -470,67 +472,75 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, endif if (associated(IOB%runoff_hflx)) then - fluxes%heat_content_lrunoff(i,j) = kg_m2_s_conversion * IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G) endif if (associated(IOB%calving_hflx)) then - fluxes%heat_content_frunoff(i,j) = kg_m2_s_conversion * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G) endif if (associated(IOB%lw_flux)) then - fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%LW(i,j) = US%W_m2_to_QRZ_T * IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux', G) endif if (associated(IOB%t_flux)) then - fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%sens(i,j) = -US%W_m2_to_QRZ_T* IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux', G) endif fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) - & + IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) - & + IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent(i,j) = fluxes%latent(i,j) - & + IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor endif fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) if (associated(IOB%sw_flux_vis_dir)) then - fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) + fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_vis_dir(i-i0,j-j0) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir', G) endif if (associated(IOB%sw_flux_vis_dif)) then - fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) + fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_vis_dif(i-i0,j-j0) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif', G) endif if (associated(IOB%sw_flux_nir_dir)) then - fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) + fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_nir_dir(i-i0,j-j0) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir', G) endif if (associated(IOB%sw_flux_nir_dif)) then - fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) + fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_nir_dif(i-i0,j-j0) if (CS%check_no_land_fluxes) & call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G) endif - 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) + if (CS%answers_2018) then + 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) + else + 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)) + endif enddo ; enddo @@ -1119,7 +1129,7 @@ subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) call data_override('OCN', 'hflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + US%W_m2_to_QRZ_T*temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) @@ -1493,6 +1503,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "If true, use the order of arithmetic and expressions that recover the answers "//& "from the end of 2018. Otherwise, use a simpler expression to calculate gustiness.", & default=default_2018_answers) + call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, & + "If true correct a bug in the time-averaging of the gustless wind friction velocity", & + default=.false.) ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 1f01845ae4..407a11a0c3 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -271,8 +271,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & diag_ptr=OS%diag, count_calls=.true.) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & - use_temp=use_temperature) - OS%fluxes%C_p = OS%C_p + C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -788,13 +787,13 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%area (isc:iec,jsc:jec), & Ocean_sfc%frazil (isc:iec,jsc:jec)) - Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model - Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models - Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models - Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models - Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav - Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model - Ocean_sfc%area = 0.0 + Ocean_sfc%t_surf(:,:) = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model + Ocean_sfc%s_surf(:,:) = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models + Ocean_sfc%u_surf(:,:) = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%v_surf(:,:) = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%sea_lev(:,:) = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav + Ocean_sfc%frazil(:,:) = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%area(:,:) = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics if (present(gas_fields_ocn)) then @@ -873,7 +872,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ enddo ; enddo endif - if (associated(sfc_state%frazil)) then + if (allocated(sfc_state%frazil)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0) enddo ; enddo @@ -1066,9 +1065,9 @@ subroutine ocean_model_data1D_get(OS, Ocean, name, value) select case(name) case('c_p') - value = OS%C_p + value = OS%C_p case default - call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name) end select end subroutine ocean_model_data1D_get diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index b2e26b0c66..4f7feb4e98 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -46,6 +46,8 @@ module MOM_surface_forcing !* The boundaries always run through q grid points (x). * !* * !********+*********+*********+*********+*********+*********+*********+** + +use MOM_constants, only : hlv, hlf use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE use MOM_diag_mediator, only : post_data, query_averaging_enabled @@ -89,72 +91,89 @@ module MOM_surface_forcing ! which may be used to drive MOM. All fluxes are positive into the ocean. type, public :: surface_forcing_CS ; private - logical :: use_temperature ! if true, temp & salinity used as state variables - logical :: restorebuoy ! if true, use restoring surface buoyancy forcing - logical :: adiabatic ! if true, no diapycnal mass fluxes or surface buoyancy forcing - logical :: variable_winds ! if true, wind stresses vary with time - logical :: variable_buoyforce ! if true, buoyancy forcing varies with time. - real :: south_lat ! southern latitude of the domain - real :: len_lat ! domain length in latitude - - real :: Rho0 ! Boussinesq reference density [R ~> kg m-3] - real :: G_Earth ! gravitational acceleration [L2 Z-1 T-2 ~> m s-2] - real :: Flux_const ! piston velocity for surface restoring [Z T-1 ~> m s-1] - - real :: gust_const ! constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] - logical :: read_gust_2d ! if true, use 2-dimensional gustiness supplied from a file - real, pointer :: gust(:,:) => NULL() ! spatially varying unresolved background gustiness [R L Z T-1 ~> Pa] - ! gust is used when read_gust_2d is true. - - real, pointer :: T_Restore(:,:) => NULL() ! temperature to damp (restore) the SST to [degC] - real, pointer :: S_Restore(:,:) => NULL() ! salinity to damp (restore) the SSS [ppt] - real, pointer :: Dens_Restore(:,:) => NULL() ! density to damp (restore) surface density [kg m-3] - - integer :: wind_last_lev_read = -1 ! The last time level read from the wind input files - integer :: buoy_last_lev_read = -1 ! The last time level read from buoyancy input files - - real :: gyres_taux_const, gyres_taux_sin_amp, gyres_taux_cos_amp, gyres_taux_n_pis - ! if WIND_CONFIG=='gyres' then use - ! = A, B, C and n respectively for - ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L) - - real :: T_north, T_south ! target temperatures at north and south used in - ! buoyancy_forcing_linear - real :: S_north, S_south ! target salinity at north and south used in - ! buoyancy_forcing_linear - - logical :: first_call_set_forcing = .true. - real :: wind_scale ! value by which wind-stresses are scaled (nondimensional) - character(len=8) :: wind_stagger - - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - type(diag_ctrl), pointer :: diag ! structure used to regulate timing of diagnostic output - - character(len=200) :: inputdir ! The directory where NetCDF input files are. - character(len=200) :: wind_config ! Indicator for wind forcing type (2gyre, USER, FILE..) - character(len=200) :: wind_file ! If wind_config is "file", file to use - character(len=200) :: buoy_config ! Indicator for buoyancy forcing type - character(len=200) :: longwavedown_file - character(len=200) :: longwaveup_file - character(len=200) :: evaporation_file - character(len=200) :: sensibleheat_file - character(len=200) :: shortwaveup_file - character(len=200) :: shortwavedown_file - character(len=200) :: snow_file - character(len=200) :: precip_file - character(len=200) :: freshdischarge_file - character(len=200) :: SSTrestore_file - character(len=200) :: salinityrestore_file - character(len=80) :: stress_x_var, stress_y_var - - ! Diagnostics handles - type(forcing_diags), public :: handles - - type(user_revise_forcing_CS), pointer :: urf_CS => NULL() - type(user_surface_forcing_CS), pointer :: user_forcing_CSp => NULL() -! type(MESO_surface_forcing_CS), pointer :: MESO_forcing_CSp => NULL() + logical :: use_temperature !< if true, temp & salinity used as state variables + logical :: restorebuoy !< if true, use restoring surface buoyancy forcing + logical :: adiabatic !< if true, no diapycnal mass fluxes or surface buoyancy forcing + logical :: variable_winds !< if true, wind stresses vary with time + logical :: variable_buoyforce !< if true, buoyancy forcing varies with time. + real :: south_lat !< southern latitude of the domain + real :: len_lat !< domain length in latitude + + real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] + real :: G_Earth !< gravitational acceleration [L2 Z-1 T-2 ~> m s-2] + real :: Flux_const !< piston velocity for surface restoring [Z T-1 ~> m s-1] + real :: latent_heat_fusion !< latent heat of fusion times [Q ~> J kg-1] + real :: latent_heat_vapor !< latent heat of vaporization [Q ~> J kg-1] + + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + logical :: read_gust_2d !< if true, use 2-dimensional gustiness supplied from a file + real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness [R L Z T-1 ~> Pa] + !< gust is used when read_gust_2d is true. + + real, pointer :: T_Restore(:,:) => NULL() !< temperature to damp (restore) the SST to [degC] + real, pointer :: S_Restore(:,:) => NULL() !< salinity to damp (restore) the SSS [ppt] + real, pointer :: Dens_Restore(:,:) => NULL() !< density to damp (restore) surface density [kg m-3] + + integer :: wind_last_lev_read = -1 !< The last time level read from the wind input files + integer :: buoy_last_lev_read = -1 !< The last time level read from buoyancy input files + + ! if WIND_CONFIG=='gyres' then use the following as = A, B, C and n respectively for + ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L) + real :: gyres_taux_const !< A constant wind stress [Pa]. + real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. + real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. + real :: gyres_taux_n_pis !< The number of sine lobes in the basin if if WIND_CONFIG=='gyres' + + real :: T_north !< target temperatures at north used in buoyancy_forcing_linear + real :: T_south !< target temperatures at south used in buoyancy_forcing_linear + real :: S_north !< target salinity at north used in buoyancy_forcing_linear + real :: S_south !< target salinity at south used in buoyancy_forcing_linear + + logical :: first_call_set_forcing = .true. !< True until after the first call to set_forcing + + real :: wind_scale !< value by which wind-stresses are scaled, ND. + character(len=8) :: wind_stagger !< A character indicating how the wind stress components + !! are staggered in WIND_FILE. Valid values are A or C for now. + + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< A pointer to the structure + !! that is used to orchestrate the calling of tracer packages + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure + + type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output + + character(len=200) :: inputdir !< directory where NetCDF input files are. + character(len=200) :: wind_config !< indicator for wind forcing type (2gyre, USER, FILE..) + character(len=200) :: wind_file !< if wind_config is "file", file to use + character(len=200) :: buoy_config !< indicator for buoyancy forcing type + + character(len=200) :: longwavedown_file = '' !< The file from which the downward longwave heat flux is read + character(len=200) :: shortwavedown_file = '' !< The file from which the downward shortwave heat flux is read + character(len=200) :: evaporation_file = '' !< The file from which the evaporation is read + character(len=200) :: sensibleheat_file = '' !< The file from which the sensible heat flux is read + character(len=200) :: latentheat_file = '' !< The file from which the latent heat flux is read + + character(len=200) :: precip_file = '' !< The file from which the rainfall is read + character(len=200) :: snow_file = '' !< The file from which the snowfall is read + character(len=200) :: freshdischarge_file = '' !< The file from which the runoff and calving are read + + character(len=200) :: longwaveup_file = '' !< The file from which the upward longwave heat flux is read + character(len=200) :: shortwaveup_file = '' !< The file from which the upward shorwave heat flux is read + + character(len=200) :: SSTrestore_file = '' !< The file from which to read the sea surface + !! temperature to restore toward + character(len=200) :: salinityrestore_file = '' !< The file from which to read the sea surface + !! salinity to restore toward + + character(len=80) :: stress_x_var = '' !< X-windstress variable name in the input file + character(len=80) :: stress_y_var = '' !< Y-windstress variable name in the input file + + type(forcing_diags), public :: handles !< A structure with diagnostics handles + + !>@{ Control structures for named forcing packages + type(user_revise_forcing_CS), pointer :: urf_CS => NULL() + type(user_surface_forcing_CS), pointer :: user_forcing_CSp => NULL() + ! type(MESO_surface_forcing_CS), pointer :: MESO_forcing_CSp => NULL() + !!@} end type surface_forcing_CS integer :: id_clock_forcing @@ -238,11 +257,11 @@ subroutine set_forcing(sfc_state, forcing, fluxes, day_start, day_interval, G, U if ((CS%variable_buoyforce .or. CS%first_call_set_forcing) .and. & (.not.CS%adiabatic)) then if (trim(CS%buoy_config) == "file") then - call buoyancy_forcing_from_files(sfc_state, fluxes, day_center, dt, G, CS) + call buoyancy_forcing_from_files(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "zero") then call buoyancy_forcing_zero(sfc_state, fluxes, day_center, dt, G, CS) elseif (trim(CS%buoy_config) == "linear") then - call buoyancy_forcing_linear(sfc_state, fluxes, day_center, dt, G, CS) + call buoyancy_forcing_linear(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "MESO") then call MOM_error(FATAL, "MESO forcing is not available with the ice-shelf"//& "version of MOM_surface_forcing.") @@ -590,7 +609,7 @@ end subroutine wind_forcing_from_file !> This subroutine specifies the current surface fluxes of buoyancy, temperature and fresh water !! by reading a file. It may also be modified to add surface fluxes of user provided tracers. -subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) +subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -598,10 +617,11 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a !! previous surface_forcing_init call - real :: rhoXcp ! mean density times the heat capacity [J m-3 degC-1]. + real :: rhoXcp ! mean density times the heat capacity [Q R degC-1 ~> J m-3 degC-1]. real :: Irho0 ! inverse Boussinesq reference density [m3 kg-1]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed @@ -661,28 +681,25 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) call MOM_read_data(trim(CS%inputdir)//trim(CS%longwavedown_file), "lwdn_sfc", & - fluxes%LW(:,:), G%Domain, timelevel=time_lev) + fluxes%LW(:,:), G%Domain, timelevel=time_lev, scale=US%W_m2_to_QRZ_T) call MOM_read_data(trim(CS%inputdir)//trim(CS%longwaveup_file), "lwup_sfc", & - temp(:,:), G%Domain, timelevel=time_lev) + temp(:,:), G%Domain, timelevel=time_lev, scale=US%W_m2_to_QRZ_T) do j=js,je ; do i=is,ie ; fluxes%LW(i,j) = fluxes%LW(i,j) - temp(i,j) ; enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%evaporation_file), "evap", & - temp(:,:), G%Domain, timelevel=time_lev) + fluxes%evap(:,:), G%Domain, timelevel=time_lev, scale=-US%kg_m3_to_R*US%m_to_Z*US%T_to_s) do j=js,je ; do i=is,ie - fluxes%latent(i,j) = -hlv*temp(i,j) - fluxes%evap(i,j) = -US%kg_m3_to_R*US%m_to_Z*US%T_to_s * temp(i,j) + fluxes%latent(i,j) = CS%latent_heat_vapor*fluxes%evap(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) - enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%sensibleheat_file), "shflx", & - temp(:,:), G%Domain, timelevel=time_lev) - do j=js,je ; do i=is,ie ; fluxes%sens(i,j) = -temp(i,j) ; enddo ; enddo + fluxes%sens(:,:), G%Domain, timelevel=time_lev, scale=-US%W_m2_to_QRZ_T) call MOM_read_data(trim(CS%inputdir)//trim(CS%shortwavedown_file), "swdn_sfc", & - fluxes%sw(:,:), G%Domain, timelevel=time_lev) + fluxes%sw(:,:), G%Domain, timelevel=time_lev, scale=US%W_m2_to_QRZ_T) call MOM_read_data(trim(CS%inputdir)//trim(CS%shortwaveup_file), "swup_sfc", & - temp(:,:), G%Domain, timelevel=time_lev) + temp(:,:), G%Domain, timelevel=time_lev, scale=US%W_m2_to_QRZ_T) do j=js,je ; do i=is,ie fluxes%sw(i,j) = fluxes%sw(i,j) - temp(i,j) enddo ; enddo @@ -731,11 +748,10 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) fluxes%sw(i,j) = fluxes%sw(i,j) * G%mask2dT(i,j) fluxes%latent(i,j) = fluxes%latent(i,j) * G%mask2dT(i,j) - fluxes%heat_content_lrunoff(i,j) = fluxes%C_p * & - fluxes%lrunoff(i,j)*sfc_state%SST(i,j) + fluxes%heat_content_lrunoff(i,j) = fluxes%C_p * fluxes%lrunoff(i,j)*sfc_state%SST(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent_evap_diag(i,j) * G%mask2dT(i,j) - fluxes%latent_fprec_diag(i,j) = -US%R_to_kg_m3*US%Z_to_m*US%s_to_T*fluxes%fprec(i,j)*hlf - fluxes%latent_frunoff_diag(i,j) = -US%R_to_kg_m3*US%Z_to_m*US%s_to_T*fluxes%frunoff(i,j)*hlf + fluxes%latent_fprec_diag(i,j) = -fluxes%fprec(i,j)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -fluxes%frunoff(i,j)*CS%latent_heat_fusion enddo ; enddo endif ! time_lev /= CS%buoy_last_lev_read @@ -744,13 +760,13 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) if (CS%use_temperature) then do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then - fluxes%heat_restore(i,j) = G%mask2dT(i,j) * & - ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * US%Z_to_m*US%s_to_T*CS%Flux_const) + fluxes%heat_added(i,j) = G%mask2dT(i,j) * & + ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const) fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & (CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j))) else - fluxes%heat_restore(i,j) = 0.0 + fluxes%heat_added(i,j) = 0.0 fluxes%vprec(i,j) = 0.0 endif enddo ; enddo @@ -825,7 +841,7 @@ end subroutine buoyancy_forcing_zero !> This subroutine specifies the current surface fluxes of buoyancy, temperature and fresh water. !! It may also be modified to add surface fluxes of user provided tracers. -subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) +subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure with pointers to thermodynamic forcing fields @@ -833,6 +849,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a !! previous surface_forcing_init call @@ -877,13 +894,13 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) T_restore = CS%T_south + (CS%T_north-CS%T_south)*y S_restore = CS%S_south + (CS%S_north-CS%S_south)*y if (G%mask2dT(i,j) > 0) then - fluxes%heat_restore(i,j) = G%mask2dT(i,j) * US%Z_to_m*US%s_to_T * & - ((T_Restore - sfc_state%SST(i,j)) * (((US%R_to_kg_m3*CS%Rho0) * fluxes%C_p) * CS%Flux_const)) + fluxes%heat_added(i,j) = G%mask2dT(i,j) * & + ((T_Restore - sfc_state%SST(i,j)) * ((CS%Rho0 * fluxes%C_p) * CS%Flux_const)) fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & (S_Restore - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + S_Restore)) else - fluxes%heat_restore(i,j) = 0.0 + fluxes%heat_added(i,j) = 0.0 fluxes%vprec(i,j) = 0.0 endif enddo ; enddo @@ -1086,14 +1103,17 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "If true, the buoyancy fluxes drive the model back "//& "toward some specified surface state with a rate "//& "given by FLUXCONST.", default= .false.) + call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & + "The latent heat of fusion.", default=hlf, & + units="J/kg", scale=US%J_kg_to_Q) + call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & + "The latent heat of fusion.", default=hlv, units="J/kg", scale=US%J_kg_to_Q) if (CS%restorebuoy) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", & - units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) - ! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 + units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, fail_if_missing=.true.) if (trim(CS%buoy_config) == "linear") then call get_param(param_file, mdl, "SST_NORTH", CS%T_north, & "With buoy_config linear, the sea surface temperature "//& diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 57accf2ef5..10417d4a1e 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -179,7 +179,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) real :: Salin_restore ! The salinity that is being restored toward [ppt] real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. - real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. + real :: rhoXcp ! The mean density times the heat capacity [Q R degC-1 ~> J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux [L2 T-3 R-1 ~> m5 s-3 kg-1]. @@ -227,7 +227,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of [W m-2] and are positive into the ocean. + ! Heat fluxes are in units of [Q R Z T-1 ~> W m-2] and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) fluxes%sens(i,j) = 0.0 * G%mask2dT(i,j) @@ -249,14 +249,14 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & "Temperature and salinity restoring used without modification." ) - rhoXcp = US%R_to_kg_m3*CS%Rho0 * fluxes%C_p + rhoXcp = CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie ! Set Temp_restore and Salin_restore to the temperature (in degC) and ! salinity (in ppt or PSU) that are being restored toward. Temp_restore = 0.0 Salin_restore = 0.0 - fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * US%Z_to_m*US%s_to_T*CS%Flux_const)) * & + fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * & (Temp_restore - sfc_state%SST(i,j)) fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & ((Salin_restore - sfc_state%SSS(i,j)) / (0.5 * (Salin_restore + sfc_state%SSS(i,j)))) @@ -332,9 +332,7 @@ subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", & - units="m day-1", scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) - ! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 + units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, fail_if_missing=.true.) endif end subroutine USER_surface_forcing_init diff --git a/config_src/mct_driver/mom_ocean_model_mct.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 index fb98a7b2bf..8b65f056cd 100644 --- a/config_src/mct_driver/mom_ocean_model_mct.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -279,8 +279,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i input_restart_file=input_restart_file, & diag_ptr=OS%diag, count_calls=.true.) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & - use_temp=use_temperature) - OS%fluxes%C_p = OS%C_p + C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -913,7 +912,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ enddo ; enddo endif - if (associated(sfc_state%frazil)) then + if (allocated(sfc_state%frazil)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0) enddo ; enddo diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index 981202eda8..1a0cdcb952 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -104,7 +104,7 @@ module MOM_surface_forcing_mct !! sea-ice viscosity becomes effective, in kg m-2, !! typically of order 1000 [kg m-2]. logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments - real :: Flux_const !< piston velocity for surface restoring [m/s] + real :: Flux_const !< piston velocity for surface restoring [Z T-1 ~> m s-1] logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux logical :: adjust_net_srestore_to_zero !< adjust srestore to zero (for both salt_flux or vprec) logical :: adjust_net_srestore_by_scaling !< adjust srestore w/o moving zero contour @@ -118,6 +118,8 @@ module MOM_surface_forcing_mct real :: max_delta_srestore !< maximum delta salinity used for restoring real :: max_delta_trestore !< maximum delta sst used for restoring real, pointer, dimension(:,:) :: basin_mask => NULL() !< mask for SSS restoring by basin + logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the + !! gustless wind friction velocity. type(diag_ctrl), pointer :: diag !< structure to regulate diagnostic output timing character(len=200) :: inputdir !< directory where NetCDF input files are character(len=200) :: salt_restore_file !< filename for salt restoring data @@ -244,7 +246,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, real :: kg_m2_s_conversion !< A combination of unit conversion factors for rescaling !! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. - real :: C_p !< heat capacity of seawater ( J/(K kg) ) + real :: C_p !< heat capacity of seawater [J kg-1 degC-1] real :: sign_for_net_FW_bug !< Should be +1. but an old bug can be recovered by using -1. call cpu_clock_begin(id_clock_forcing) @@ -258,7 +260,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s - C_p = fluxes%C_p + C_p = US%Q_to_J_kg*fluxes%C_p open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 @@ -276,8 +278,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! allocation and initialization if this is the first time that this ! flux type has been used. if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., & + press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) @@ -341,8 +343,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%dt_buoy_accum = US%s_to_T*valid_time if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 + fluxes%heat_added(:,:) = 0.0 + fluxes%salt_flux_added(:,:) = 0.0 endif do j=js,je ; do i=is,ie @@ -364,7 +366,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, do j=js,je ; do i=is,ie delta_sss = data_restore(i,j)- sfc_state%SSS(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) - fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*US%m_to_Z*US%T_to_s*CS%Flux_const)* & + fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! R Z T-1 ~> kg Salt m-2 s-1 enddo; enddo if (CS%adjust_net_srestore_to_zero) then @@ -386,7 +388,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, delta_sss = sfc_state%SSS(i,j) - data_restore(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j))* & - (US%m_to_Z*US%T_to_s * CS%Rho0*CS%Flux_const) * & + (CS%Rho0*CS%Flux_const) * & delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) endif enddo; enddo @@ -414,7 +416,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & - (US%R_to_kg_m3*CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 enddo; enddo endif @@ -457,61 +459,64 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) ! GMM, cime does not not have an equivalent for heat_content_lrunoff and - ! heat_content_frunoff. I am seeting these to zero for now. + ! heat_content_frunoff. I am setting these to zero for now. if (associated(fluxes%heat_content_lrunoff)) & fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j) if (associated(fluxes%heat_content_frunoff)) & fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = kg_m2_s_conversion * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) ! longwave radiation, sum up and down (W/m2) if (associated(IOB%lw_flux)) & - fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lw(i,j) = US%W_m2_to_QRZ_T * IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) ! sensible heat flux (W/m2) if (associated(IOB%t_flux)) & - fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%sens(i,j) = US%W_m2_to_QRZ_T * IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) ! sea ice and snow melt heat flux [W/m2] if (associated(IOB%seaice_melt_heat)) & - fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) + fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%seaice_melt_heat(i-i0,j-j0) ! water flux due to sea ice and snow melt [kg/m2/s] if (associated(IOB%seaice_melt)) & - fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * kg_m2_s_conversion * IOB%seaice_melt(i-i0,j-j0) + fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * kg_m2_s_conversion * IOB%seaice_melt(i-i0,j-j0) ! latent heat flux (W/m^2) fluxes%latent(i,j) = 0.0 ! contribution from frozen ppt if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) + & + IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif ! contribution from frozen runoff if (associated(fluxes%frunoff)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%rofi_flux(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) + & + IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif ! contribution from evaporation if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent(i,j) = fluxes%latent(i,j) + & + IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor endif fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) if (associated(IOB%sw_flux_vis_dir)) & - fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) + fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_vis_dir(i-i0,j-j0) if (associated(IOB%sw_flux_vis_dif)) & - fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) + fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_vis_dif(i-i0,j-j0) if (associated(IOB%sw_flux_nir_dir)) & - fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) + fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_nir_dir(i-i0,j-j0) if (associated(IOB%sw_flux_nir_dif)) & - fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) + fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_nir_dif(i-i0,j-j0) 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) @@ -898,7 +903,7 @@ subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) call data_override('OCN', 'hflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + US%W_m2_to_QRZ_T*temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) @@ -1127,7 +1132,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & + "velocity). Note the non-MKS units.", units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & "A file in which to find the surface salinity to use for restoring.", & @@ -1136,8 +1141,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The name of the surface salinity variable to read from "//& "SALT_RESTORE_FILE for restoring salinity.", & default="salt") -! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & "If true, the restoring of salinity is applied as a salt "//& @@ -1175,7 +1178,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & + "velocity). Note the non-MKS units.", units="m day-1", scale=US%m_to_Z*US%T_to_s / 86400.0, & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & "A file in which to find the surface temperature to use for restoring.", & @@ -1184,8 +1187,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The name of the surface temperature variable to read from "//& "SST_RESTORE_FILE for restoring sst.", & default="temp") - ! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & "The maximum sst difference used in restoring terms.", & @@ -1255,9 +1256,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1, & + call MOM_read_data(gust_file, 'gustiness', CS%gust, G%domain, timelevel=1, & scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif + call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, & + "If true correct a bug in the time-averaging of the gustless wind friction velocity", & + default=.false.) ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 240b576669..9c56018bd9 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -281,8 +281,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i input_restart_file=input_restart_file, & diag_ptr=OS%diag, count_calls=.true.) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & - use_temp=use_temperature) - OS%fluxes%C_p = OS%C_p + C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -908,7 +907,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ enddo ; enddo endif - if (associated(sfc_state%frazil)) then + if (allocated(sfc_state%frazil)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0) enddo ; enddo diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 270d4e9f4c..1a1e7b9f03 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -108,7 +108,7 @@ module MOM_surface_forcing_nuopc !! typically of order 1000 [kg m-2]. logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments - real :: Flux_const !< piston velocity for surface restoring [m/s] + real :: Flux_const !< piston velocity for surface restoring [Z T-1 ~> m s-1] logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux logical :: adjust_net_srestore_to_zero !< adjust srestore to zero (for both salt_flux or vprec) logical :: adjust_net_srestore_by_scaling !< adjust srestore w/o moving zero contour @@ -122,6 +122,8 @@ module MOM_surface_forcing_nuopc real :: max_delta_srestore !< maximum delta salinity used for restoring real :: max_delta_trestore !< maximum delta sst used for restoring real, pointer, dimension(:,:) :: basin_mask => NULL() !< mask for SSS restoring by basin + logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the + !! gustless wind friction velocity. type(diag_ctrl), pointer :: diag !< structure to regulate diagnostic output timing character(len=200) :: inputdir !< directory where NetCDF input files are @@ -249,7 +251,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, real :: kg_m2_s_conversion !< A combination of unit conversion factors for rescaling !! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. - real :: C_p !< heat capacity of seawater ( J/(K kg) ) + real :: C_p !< heat capacity of seawater [J kg-1 degC-1] real :: sign_for_net_FW_bug !< Should be +1. but an old bug can be recovered by using -1. call cpu_clock_begin(id_clock_forcing) @@ -263,7 +265,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s - C_p = fluxes%C_p + C_p = US%Q_to_J_kg*fluxes%C_p open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 @@ -281,8 +283,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! allocation and initialization if this is the first time that this ! flux type has been used. if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., & + press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) @@ -368,7 +370,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, do j=js,je ; do i=is,ie delta_sss = data_restore(i,j)- sfc_state%SSS(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) - fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*US%m_to_Z*US%T_to_s*CS%Flux_const)* & + fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 enddo ; enddo if (CS%adjust_net_srestore_to_zero) then @@ -390,7 +392,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, delta_sss = sfc_state%SSS(i,j) - data_restore(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j))* & - (US%m_to_Z*US%T_to_s * CS%Rho0*CS%Flux_const) * & + (CS%Rho0*CS%Flux_const) * & delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) endif enddo ; enddo @@ -418,7 +420,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & - (US%R_to_kg_m3*CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! Q R Z T-1 ~> W m-2 enddo ; enddo endif @@ -459,20 +461,20 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = kg_m2_s_conversion*IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%lw_flux)) & - fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lw(i,j) = US%W_m2_to_QRZ_T * IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%t_flux)) & - fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%sens(i,j) = US%W_m2_to_QRZ_T * IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! sea ice and snow melt heat flux [W/m2] + ! sea ice and snow melt heat flux [Q R Z T-1 ~> W/m2] if (associated(IOB%seaice_melt_heat)) & - fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) + fluxes%seaice_melt_heat(i,j) = US%W_m2_to_QRZ_T * G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) ! water flux due to sea ice and snow melt [kg/m2/s] if (associated(IOB%seaice_melt)) & @@ -480,30 +482,33 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) + & + IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) + & + IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent(i,j) = fluxes%latent(i,j) + & + IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor endif fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) if (associated(IOB%sw_flux_vis_dir)) & - fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) + fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_vis_dir(i-i0,j-j0) if (associated(IOB%sw_flux_vis_dif)) & - fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) + fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_vis_dif(i-i0,j-j0) if (associated(IOB%sw_flux_nir_dir)) & - fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) + fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_nir_dir(i-i0,j-j0) if (associated(IOB%sw_flux_nir_dif)) & - fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) + fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_nir_dif(i-i0,j-j0) 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) @@ -893,7 +898,7 @@ subroutine apply_flux_adjustments(G, US, CS, Time, fluxes) call data_override('OCN', 'hflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec - fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + US%W_m2_to_QRZ_T*temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) @@ -1121,7 +1126,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & + "velocity). Note the non-MKS units.", units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & "A file in which to find the surface salinity to use for restoring.", & @@ -1130,8 +1135,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The name of the surface salinity variable to read from "//& "SALT_RESTORE_FILE for restoring salinity.", & default="salt") -! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & "If true, the restoring of salinity is applied as a salt "//& @@ -1169,7 +1172,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes "//& "to the relative surface anomalies (akin to a piston "//& - "velocity). Note the non-MKS units.", units="m day-1", & + "velocity). Note the non-MKS units.", units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & "A file in which to find the surface temperature to use for restoring.", & @@ -1178,8 +1181,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The name of the surface temperature variable to read from "//& "SST_RESTORE_FILE for restoring sst.", & default="temp") - ! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & "The maximum sst difference used in restoring terms.", & @@ -1249,9 +1250,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1, & + call MOM_read_data(gust_file, 'gustiness', CS%gust, G%domain, timelevel=1, & scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif + call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, & + "If true correct a bug in the time-averaging of the gustless wind friction velocity", & + default=.false.) ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index cf59d577d8..ebe98a3293 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -35,10 +35,10 @@ module MESO_surface_forcing real, dimension(:,:), pointer :: & T_Restore(:,:) => NULL(), & !< The temperature to restore the SST toward [degC]. S_Restore(:,:) => NULL(), & !< The salinity to restore the sea surface salnity toward [ppt] - PmE(:,:) => NULL(), & !< The prescribed precip minus evap [m s-1]. - Solar(:,:) => NULL() !< The shortwave forcing into the ocean [W m-2]. + PmE(:,:) => NULL(), & !< The prescribed precip minus evap [Z T-1 ~> m s-1]. + Solar(:,:) => NULL() !< The shortwave forcing into the ocean [Q R Z T-1 ~> W m-2]. real, dimension(:,:), pointer :: Heat(:,:) => NULL() !< The prescribed longwave, latent and sensible - !! heat flux into the ocean [W m-2]. + !! heat flux into the ocean [Q R Z T-1 ~> W m-2]. character(len=200) :: inputdir !< The directory where NetCDF input files are. character(len=200) :: salinityrestore_file !< The file with the target sea surface salinity character(len=200) :: SSTrestore_file !< The file with the target sea surface temperature @@ -81,7 +81,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) real :: Salin_restore ! The salinity that is being restored toward [ppt] real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. - real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. + real :: rhoXcp ! The mean density times the heat capacity [Q R degC-1 ~> J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux [L2 T-3 R-1 ~> m5 s-3 kg-1]. @@ -127,11 +127,11 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) call MOM_read_data(trim(CS%inputdir)//trim(CS%salinityrestore_file), "SAL", & CS%S_Restore(:,:), G%Domain) call MOM_read_data(trim(CS%inputdir)//trim(CS%heating_file), "Heat", & - CS%Heat(:,:), G%Domain) + CS%Heat(:,:), G%Domain, scale=US%W_m2_to_QRZ_T) call MOM_read_data(trim(CS%inputdir)//trim(CS%PmE_file), "PmE", & - CS%PmE(:,:), G%Domain) + CS%PmE(:,:), G%Domain, scale=US%m_to_Z*US%T_to_s) call MOM_read_data(trim(CS%inputdir)//trim(CS%Solar_file), "NET_SOL", & - CS%Solar(:,:), G%Domain) + CS%Solar(:,:), G%Domain, scale=US%W_m2_to_QRZ_T) first_call = .false. endif @@ -142,16 +142,16 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) - fluxes%lprec(i,j) = US%m_to_Z*US%T_to_s * CS%PmE(i,j) * CS%Rho0 * G%mask2dT(i,j) + fluxes%lprec(i,j) = CS%PmE(i,j) * CS%Rho0 * G%mask2dT(i,j) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of [W m-2] and are positive into the ocean. - fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) - fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) - fluxes%sens(i,j) = CS%Heat(i,j) * G%mask2dT(i,j) - fluxes%sw(i,j) = CS%Solar(i,j) * G%mask2dT(i,j) + ! Heat fluxes are in units of [Q R Z T-1 ~> W m-2] and are positive into the ocean. + fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) + fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) + fluxes%sens(i,j) = CS%Heat(i,j) * G%mask2dT(i,j) + fluxes%sw(i,j) = CS%Solar(i,j) * G%mask2dT(i,j) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie @@ -169,13 +169,13 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! call MOM_error(FATAL, "MESO_buoyancy_surface_forcing: " // & ! "Temperature and salinity restoring used without modification." ) - rhoXcp = US%R_to_kg_m3*CS%Rho0 * fluxes%C_p + rhoXcp = CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie ! Set Temp_restore and Salin_restore to the temperature (in degC) and ! salinity (in ppt or PSU) that are being restored toward. if (G%mask2dT(i,j) > 0) then fluxes%heat_added(i,j) = G%mask2dT(i,j) * & - ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * US%Z_to_m*US%s_to_T*CS%Flux_const) + ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const) fluxes%vprec(i,j) = - (CS%Rho0 * CS%Flux_const) * & (CS%S_Restore(i,j) - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j))) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index cea90b5db4..dfdfeff8ef 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -318,7 +318,7 @@ program MOM_main tracer_flow_CSp=tracer_flow_CSp) endif - call get_MOM_state_elements(MOM_CSp, G=grid, GV=GV, US=US, C_p=fluxes%C_p) + call get_MOM_state_elements(MOM_CSp, G=grid, GV=GV, US=US, C_p_scaled=fluxes%C_p) Master_Time = Time call callTree_waypoint("done initialize_MOM") diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index a113d18871..5b49cdc662 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -83,8 +83,8 @@ module MOM_surface_forcing real :: Flux_const !< piston velocity for surface restoring [Z T-1 ~> m s-1] real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] real :: Flux_const_S !< piston velocity for surface salinity restoring [Z T-1 ~> m s-1] - real :: latent_heat_fusion !< latent heat of fusion times scaling factors [J T m-2 R-1 Z-1 s-1 ~> J kg-1] - real :: latent_heat_vapor !< latent heat of vaporization [J kg-1] + real :: latent_heat_fusion !< latent heat of fusion times [Q ~> J kg-1] + real :: latent_heat_vapor !< latent heat of vaporization [Q ~> J kg-1] real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" forcing real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" forcing @@ -109,6 +109,8 @@ module MOM_surface_forcing !! the answers from the end of 2018. Otherwise, use a form of the gyre !! wind stresses that are rotationally invariant and more likely to be !! the same between compilers. + logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the + !! gustless wind friction velocity. real :: T_north !< target temperatures at north used in buoyancy_forcing_linear real :: T_south !< target temperatures at south used in buoyancy_forcing_linear @@ -121,7 +123,7 @@ module MOM_surface_forcing logical :: dataOverrideIsInitialized = .false. !< If true, data override has been initialized real :: wind_scale !< value by which wind-stresses are scaled, ND. - real :: constantHeatForcing !< value used for sensible heat flux when buoy_config="const" + real :: constantHeatForcing !< value used for sensible heat flux when buoy_config="const" [Q R Z T-1 ~> W m-2] character(len=8) :: wind_stagger !< A character indicating how the wind stress components !! are staggered in WIND_FILE. Valid values are A or C for now. @@ -244,7 +246,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US ! Allocate memory for the mechanical and thermodyanmic forcing fields. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.) - call allocate_forcing_type(G, fluxes, ustar=.true.) + call allocate_forcing_type(G, fluxes, ustar=.true., fix_accum_bug=CS%fix_ustar_gustless_bug) if (trim(CS%buoy_config) /= "NONE") then if ( CS%use_temperature ) then call allocate_forcing_type(G, fluxes, water=.true., heat=.true., press=.true.) @@ -307,7 +309,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US elseif (trim(CS%buoy_config) == "zero") then call buoyancy_forcing_zero(sfc_state, fluxes, day_center, dt, G, CS) elseif (trim(CS%buoy_config) == "const") then - call buoyancy_forcing_const(sfc_state, fluxes, day_center, dt, G, CS) + call buoyancy_forcing_const(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "linear") then call buoyancy_forcing_linear(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "MESO") then @@ -774,7 +776,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. - real :: rhoXcp ! reference density times heat capacity [J m-3 degC-1] + real :: rhoXcp ! reference density times heat capacity [Q R degC-1 ~> J m-3 degC-1] integer :: time_lev_daily ! time levels to read for fields with daily cycle integer :: time_lev_monthly ! time levels to read for fields with monthly cycle @@ -788,7 +790,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s - if (CS%use_temperature) rhoXcp = US%R_to_kg_m3*CS%Rho0 * fluxes%C_p + if (CS%use_temperature) rhoXcp = CS%Rho0 * fluxes%C_p ! Read the buoyancy forcing file call get_time(day, seconds, days) @@ -820,11 +822,11 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) case (365) ; time_lev = time_lev_daily case default ; time_lev = 1 end select - call MOM_read_data(CS%longwave_file, CS%LW_var, fluxes%LW(:,:), & - G%Domain, timelevel=time_lev) + call MOM_read_data(CS%longwave_file, CS%LW_var, fluxes%lw(:,:), & + G%Domain, timelevel=time_lev, scale=US%W_m2_to_QRZ_T) if (CS%archaic_OMIP_file) then call MOM_read_data(CS%longwaveup_file, "lwup_sfc", temp(:,:), G%Domain, & - timelevel=time_lev) + timelevel=time_lev, scale=US%W_m2_to_QRZ_T) do j=js,je ; do i=is,ie ; fluxes%LW(i,j) = fluxes%LW(i,j) - temp(i,j) ; enddo ; enddo endif CS%LW_last_lev = time_lev @@ -836,11 +838,10 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) case default ; time_lev = 1 end select if (CS%archaic_OMIP_file) then - call MOM_read_data(CS%evaporation_file, CS%evap_var, temp(:,:), & - G%Domain, timelevel=time_lev) + call MOM_read_data(CS%evaporation_file, CS%evap_var, fluxes%evap(:,:), & + G%Domain, timelevel=time_lev, scale=-kg_m2_s_conversion) do j=js,je ; do i=is,ie - fluxes%latent(i,j) = -CS%latent_heat_vapor*temp(i,j) - fluxes%evap(i,j) = -kg_m2_s_conversion*temp(i,j) + fluxes%latent(i,j) = CS%latent_heat_vapor*fluxes%evap(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) enddo ; enddo else @@ -856,7 +857,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) end select if (.not.CS%archaic_OMIP_file) then call MOM_read_data(CS%latentheat_file, CS%latent_var, fluxes%latent(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, scale=US%W_m2_to_QRZ_T) do j=js,je ; do i=is,ie fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) enddo ; enddo @@ -869,12 +870,11 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) case default ; time_lev = 1 end select if (CS%archaic_OMIP_file) then - call MOM_read_data(CS%sensibleheat_file, CS%sens_var, temp(:,:), & - G%Domain, timelevel=time_lev) - do j=js,je ; do i=is,ie ; fluxes%sens(i,j) = -temp(i,j) ; enddo ; enddo + call MOM_read_data(CS%sensibleheat_file, CS%sens_var, fluxes%sens(:,:), & + G%Domain, timelevel=time_lev, scale=-US%W_m2_to_QRZ_T) else call MOM_read_data(CS%sensibleheat_file, CS%sens_var, fluxes%sens(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, scale=US%W_m2_to_QRZ_T) endif CS%sens_last_lev = time_lev @@ -883,11 +883,11 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) case (365) ; time_lev = time_lev_daily case default ; time_lev = 1 end select - call MOM_read_data(CS%shortwave_file, CS%SW_var, fluxes%sw(:,:), & - G%Domain, timelevel=time_lev) + call MOM_read_data(CS%shortwave_file, CS%SW_var, fluxes%sw(:,:), G%Domain, & + timelevel=time_lev, scale=US%W_m2_to_QRZ_T) if (CS%archaic_OMIP_file) then - call MOM_read_data(CS%shortwaveup_file, "swup_sfc", temp(:,:), & - G%Domain, timelevel=time_lev) + call MOM_read_data(CS%shortwaveup_file, "swup_sfc", temp(:,:), G%Domain, & + timelevel=time_lev, scale=US%W_m2_to_QRZ_T) do j=js,je ; do i=is,ie fluxes%sw(i,j) = fluxes%sw(i,j) - temp(i,j) enddo ; enddo @@ -968,7 +968,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) fluxes%fprec(i,j) = fluxes%fprec(i,j) * G%mask2dT(i,j) fluxes%lrunoff(i,j) = fluxes%lrunoff(i,j) * G%mask2dT(i,j) fluxes%frunoff(i,j) = fluxes%frunoff(i,j) * G%mask2dT(i,j) - fluxes%LW(i,j) = fluxes%LW(i,j) * G%mask2dT(i,j) + fluxes%lw(i,j) = fluxes%lw(i,j) * G%mask2dT(i,j) fluxes%sens(i,j) = fluxes%sens(i,j) * G%mask2dT(i,j) fluxes%sw(i,j) = fluxes%sw(i,j) * G%mask2dT(i,j) fluxes%latent(i,j) = fluxes%latent(i,j) * G%mask2dT(i,j) @@ -1053,7 +1053,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US ! anomalies [ppt]. real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1]. - real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. + real :: rhoXcp ! The mean density times the heat capacity [Q R degC-1 ~> J m-3 degC-1]. integer :: time_lev_daily ! The time levels to read for fields with integer :: time_lev_monthly ! daily and montly cycles. @@ -1081,19 +1081,22 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US js_in = G%jsc - G%jsd + 1 je_in = G%jec - G%jsd + 1 - call data_override('OCN', 'lw', fluxes%LW(:,:), day, & - is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + call data_override('OCN', 'lw', fluxes%lw(:,:), day, & + is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! scale=US%W_m2_to_QRZ_T + if (US%QRZ_T_to_W_m2 /= 1.0) then ; do j=js,je ; do i=is,ie + fluxes%lw(i,j) = fluxes%lw(i,j) * US%W_m2_to_QRZ_T + enddo ; enddo ; endif call data_override('OCN', 'evap', fluxes%evap(:,:), day, & is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! note the sign convention do j=js,je ; do i=is,ie - ! This is dangerous because it is not clear whether the data files have been read! - fluxes%evap(i,j) = -fluxes%evap(i,j) ! Normal convention is positive into the ocean - ! but evap is normally a positive quantity in the files + ! The normal convention is that fluxes%evap positive into the ocean + ! but evap is normally a positive quantity in the files + ! This conversion is dangerous because it is not clear whether the data files have been read! + fluxes%evap(i,j) = -kg_m2_s_conversion*fluxes%evap(i,j) fluxes%latent(i,j) = CS%latent_heat_vapor*fluxes%evap(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) - fluxes%evap(i,j) = kg_m2_s_conversion*fluxes%evap(i,j) enddo ; enddo call data_override('OCN', 'sens', fluxes%sens(:,:), day, & @@ -1101,12 +1104,15 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US ! note the sign convention do j=js,je ; do i=is,ie - fluxes%sens(i,j) = -fluxes%sens(i,j) ! Normal convention is positive into the ocean + fluxes%sens(i,j) = -US%W_m2_to_QRZ_T * fluxes%sens(i,j) ! Normal convention is positive into the ocean ! but sensible is normally a positive quantity in the files enddo ; enddo call data_override('OCN', 'sw', fluxes%sw(:,:), day, & - is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! scale=US%W_m2_to_QRZ_T + if (US%QRZ_T_to_W_m2 /= 1.0) then ; do j=js,je ; do i=is,ie + fluxes%sw(i,j) = fluxes%sw(i,j) * US%W_m2_to_QRZ_T + enddo ; enddo ; endif call data_override('OCN', 'snow', fluxes%fprec(:,:), day, & is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! scale=kg_m2_s_conversion @@ -1149,7 +1155,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US (0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j))) else fluxes%heat_added(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 endif enddo ; enddo else @@ -1182,7 +1188,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US fluxes%fprec(i,j) = fluxes%fprec(i,j) * G%mask2dT(i,j) fluxes%lrunoff(i,j) = fluxes%lrunoff(i,j) * G%mask2dT(i,j) fluxes%frunoff(i,j) = fluxes%frunoff(i,j) * G%mask2dT(i,j) - fluxes%LW(i,j) = fluxes%LW(i,j) * G%mask2dT(i,j) + fluxes%lw(i,j) = fluxes%lw(i,j) * G%mask2dT(i,j) fluxes%latent(i,j) = fluxes%latent(i,j) * G%mask2dT(i,j) fluxes%sens(i,j) = fluxes%sens(i,j) * G%mask2dT(i,j) fluxes%sw(i,j) = fluxes%sw(i,j) * G%mask2dT(i,j) @@ -1250,7 +1256,7 @@ end subroutine buoyancy_forcing_zero !> Sets up spatially and temporally constant surface heat fluxes. -subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, CS) +subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -1258,6 +1264,7 @@ subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -1340,14 +1347,14 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, US, CS) T_restore = CS%T_south + (CS%T_north-CS%T_south)*y S_restore = CS%S_south + (CS%S_north-CS%S_south)*y if (G%mask2dT(i,j) > 0) then - fluxes%heat_added(i,j) = G%mask2dT(i,j) * (US%R_to_kg_m3*US%Z_to_m*US%s_to_T) * & + fluxes%heat_added(i,j) = G%mask2dT(i,j) * & ((T_Restore - sfc_state%SST(i,j)) * ((CS%Rho0 * fluxes%C_p) * CS%Flux_const)) fluxes%vprec(i,j) = - (CS%Rho0*CS%Flux_const) * & (S_Restore - sfc_state%SSS(i,j)) / & (0.5*(sfc_state%SSS(i,j) + S_Restore)) else fluxes%heat_added(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 endif enddo ; enddo else @@ -1589,7 +1596,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "SENSIBLE_HEAT_FLUX", CS%constantHeatForcing, & "A constant heat forcing (positive into ocean) applied "//& "through the sensible heat flux field. ", & - units='W/m2', fail_if_missing=.true.) + units='W/m2', scale=US%W_m2_to_QRZ_T, fail_if_missing=.true.) endif call get_param(param_file, mdl, "WIND_CONFIG", CS%wind_config, & "The character string that indicates how wind forcing "//& @@ -1657,6 +1664,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C CS%south_lat = G%south_lat CS%len_lat = G%len_lat endif + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -1669,9 +1677,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "given by FLUXCONST.", default= .false.) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", default=hlf, & - units="J/kg", scale=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) + units="J/kg", scale=US%J_kg_to_Q) call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & - "The latent heat of fusion.", units="J/kg", default=hlv) + "The latent heat of fusion.", default=hlv, units="J/kg", scale=US%J_kg_to_Q) if (CS%restorebuoy) then ! These three variables use non-standard time units, but are rescaled as they are read. call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & @@ -1686,7 +1694,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "The constant that relates the restoring surface temperature "//& "flux to the relative surface anomaly (akin to a piston "//& "velocity). Note the non-MKS units.", & - units="m day-1", scale=1.0/86400.0, & ! scale=US%m_to_Z*US%T_to_s, + units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & default=flux_const_default) call get_param(param_file, mdl, "FLUXCONST_S", CS%Flux_const_S, & "The constant that relates the restoring surface salinity "//& @@ -1722,6 +1730,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", & units="Pa", default=0.02, scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) + call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, & + "If true correct a bug in the time-averaging of the gustless wind friction velocity", & + default=.false.) call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) @@ -1760,7 +1771,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C elseif (trim(CS%wind_config) == "SCM_CVmix_tests" .or. & trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_surface_forcing_init(Time, G, param_file, CS%SCM_CVmix_tests_CSp) - CS%SCM_CVmix_tests_CSp%Rho0 = US%R_to_kg_m3*CS%Rho0 !copy reference density for pass endif call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles) diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index caf862f097..97da89e69e 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -129,9 +129,8 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) real :: Temp_restore ! The temperature that is being restored toward [degC]. real :: Salin_restore ! The salinity that is being restored toward [ppt] real :: density_restore ! The potential density that is being restored - ! toward [kg m-3]. - real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. - real :: Rho0_mks ! The mean density in MKS units [kg m-3] + ! toward [R ~> kg m-3]. + real :: rhoXcp ! The mean density times the heat capacity [Q R degC-1 ~> J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. @@ -140,7 +139,6 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - Rho0_mks = CS%Rho0 * US%R_to_kg_m3 ! When modifying the code, comment out this error message. It is here ! so that the original (unmodified) version is not accidentally used. @@ -180,7 +178,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of W m-2 and are positive into the ocean. + ! Heat fluxes are in units of [Q R Z T-1 ~> W m-2] and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) fluxes%sens(i,j) = 0.0 * G%mask2dT(i,j) @@ -202,14 +200,14 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & "Temperature and salinity restoring used without modification." ) - rhoXcp = Rho0_mks * fluxes%C_p + rhoXcp = CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie ! Set Temp_restore and Salin_restore to the temperature (in degC) and ! salinity (in PSU or ppt) that are being restored toward. Temp_restore = 0.0 Salin_restore = 0.0 - fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * US%Z_to_m*US%s_to_T*CS%Flux_const)) * & + fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * & (Temp_restore - sfc_state%SST(i,j)) fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & ((Salin_restore - sfc_state%SSS(i,j)) / (0.5 * (Salin_restore + sfc_state%SSS(i,j)))) @@ -221,14 +219,14 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / Rho0_mks + buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. - density_restore = 1030.0 + density_restore = 1030.0*US%kg_m3_to_R fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & - (density_restore - sfc_state%sfc_density(i,j)) + (density_restore - US%kg_m3_to_R*sfc_state%sfc_density(i,j)) enddo ; enddo endif endif ! end RESTOREBUOY diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 18e2c2e5b8..fceec84cc9 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1079,8 +1079,8 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) haloshift=0, scale=GV%H_to_m*US%L_to_m**2) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) - if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, & - "Pre-advection frazil", G%HI, haloshift=0) + if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, & + scale=G%US%Q_to_J_kg*G%US%R_to_kg_m3*G%US%Z_to_m) if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%R_to_kg_m3*US%Z_to_m) ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US) @@ -1270,8 +1270,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) - if (associated(tv%frazil)) call hchksum(tv%frazil, & - "Post-diabatic frazil", G%HI, haloshift=0) + if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", G%HI, haloshift=0, & + scale=G%US%Q_to_J_kg*G%US%R_to_kg_m3*G%US%Z_to_m) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%R_to_kg_m3*US%Z_to_m) ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) @@ -1824,7 +1824,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "constant. This is only used if ENABLE_THERMODYNAMICS is "//& "true. The default value is from the TEOS-10 definition "//& "of conservative temperature.", units="J kg-1 K-1", & - default=3991.86795711963) + default=3991.86795711963, scale=US%J_kg_to_Q) endif if (use_EOS) call get_param(param_file, "MOM", "P_REF", CS%tv%P_Ref, & "The pressure that is used for calculating the coordinate "//& @@ -2008,11 +2008,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%tv%T_is_conT) then vd_T = var_desc(name="contemp", units="Celsius", longname="Conservative Temperature", & cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", & - conversion=CS%tv%C_p) + conversion=US%Q_to_J_kg*CS%tv%C_p) else vd_T = var_desc(name="temp", units="degC", longname="Potential Temperature", & cmor_field_name="thetao", cmor_longname="Sea Water Potential Temperature", & - conversion=CS%tv%C_p) + conversion=US%Q_to_J_kg*CS%tv%C_p) endif if (CS%tv%S_is_absS) then vd_S = var_desc(name="abssalt",units="g kg-1",longname="Absolute Salinity", & @@ -2026,7 +2026,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (advect_TS) then S_flux_units = get_tr_flux_units(GV, "psu") ! Could change to "kg m-2 s-1"? - conv2watt = GV%H_to_kg_m2 * CS%tv%C_p + conv2watt = GV%H_to_kg_m2 * US%Q_to_J_kg*CS%tv%C_p if (GV%Boussinesq) then conv2salt = GV%H_to_m ! Could change to GV%H_to_kg_m2 * 0.001? else @@ -2106,11 +2106,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! initialization routine for tv. if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state) if (use_temperature) then - allocate(CS%tv%TempxPmE(isd:ied,jsd:jed)) - CS%tv%TempxPmE(:,:) = 0.0 + allocate(CS%tv%TempxPmE(isd:ied,jsd:jed)) ; CS%tv%TempxPmE(:,:) = 0.0 if (use_geothermal) then - allocate(CS%tv%internal_heat(isd:ied,jsd:jed)) - CS%tv%internal_heat(:,:) = 0.0 + allocate(CS%tv%internal_heat(isd:ied,jsd:jed)) ; CS%tv%internal_heat(:,:) = 0.0 endif endif call callTree_waypoint("state variables allocated (initialize_MOM)") @@ -2745,7 +2743,7 @@ subroutine extract_surface_state(CS, sfc_state) real :: H_rescale !< A conversion factor from thickness units to the units used in the !! calculation of properties of the uppermost ocean [nondim] or [Z H-1 ~> 1 or m3 kg-1] ! After the ANSWERS_2018 flag has been obsoleted, H_rescale will be 1. - real :: delT(SZI_(CS%G)) !< T-T_freeze [degC] + real :: delT(SZI_(CS%G)) !< Depth integral of T-T_freeze [m degC] logical :: use_temperature !< If true, temp and saln used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg integer :: isd, ied, jsd, jed @@ -2766,9 +2764,9 @@ subroutine extract_surface_state(CS, sfc_state) if (.not.sfc_state%arrays_allocated) then ! Consider using a run-time flag to determine whether to do the vertical ! integrals, since the 3-d sums are not negligible in cost. - call allocate_surface_state(sfc_state, G, use_temperature, do_integrals=.true.) + call allocate_surface_state(sfc_state, G, use_temperature, do_integrals=.true., & + omit_frazil=.not.associated(CS%tv%frazil)) endif - sfc_state%frazil => CS%tv%frazil sfc_state%T_is_conT = CS%tv%T_is_conT sfc_state%S_is_absS = CS%tv%S_is_absS @@ -2776,6 +2774,10 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j) enddo ; enddo + if (allocated(sfc_state%frazil) .and. associated(CS%tv%frazil)) then ; do j=js,je ; do i=is,ie + sfc_state%frazil(i,j) = US%Q_to_J_kg*US%R_to_kg_m3*US%Z_to_m * CS%tv%frazil(i,j) + enddo ; enddo ; endif + ! copy Hml into sfc_state, so that caps can access it if (associated(CS%Hml)) then do j=js,je ; do i=is,ie @@ -2799,7 +2801,8 @@ subroutine extract_surface_state(CS, sfc_state) H_rescale = 1.0 ; if (CS%answers_2018) H_rescale = GV%H_to_Z depth_ml = CS%Hmix if (.not.CS%answers_2018) depth_ml = CS%Hmix*GV%Z_to_H - ! Determine the mean tracer properties of the uppermost depth_ml fluid. + ! Determine the mean tracer properties of the uppermost depth_ml fluid. + !$OMP parallel do default(shared) private(depth,dh) do j=js,je do i=is,ie @@ -2936,7 +2939,7 @@ subroutine extract_surface_state(CS, sfc_state) enddo do k=1,nz ; do i=is,ie - depth_ml = min(CS%HFrz,CS%visc%MLD(i,j)) + depth_ml = min(CS%HFrz, CS%visc%MLD(i,j)) if (depth(i) + h(i,j,k)*GV%H_to_m < depth_ml) then dh = h(i,j,k)*GV%H_to_m elseif (depth(i) < depth_ml) then @@ -2957,7 +2960,7 @@ subroutine extract_surface_state(CS, sfc_state) if (G%mask2dT(i,j)>0.) then ! instantaneous melt_potential [J m-2] - sfc_state%melt_potential(i,j) = CS%tv%C_p * US%R_to_kg_m3*GV%Rho0 * delT(i) + sfc_state%melt_potential(i,j) = US%Q_to_J_kg*US%R_to_kg_m3 * CS%tv%C_p * GV%Rho0 * delT(i) endif enddo enddo ! end of j loop @@ -2979,7 +2982,7 @@ subroutine extract_surface_state(CS, sfc_state) if (allocated(sfc_state%internal_heat) .and. associated(CS%tv%internal_heat)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - sfc_state%internal_heat(i,j) = CS%tv%internal_heat(i,j) + sfc_state%internal_heat(i,j) = US%R_to_kg_m3*US%Z_to_m*CS%tv%internal_heat(i,j) enddo ; enddo endif if (allocated(sfc_state%taux_shelf) .and. associated(CS%visc%taux_shelf)) then @@ -3123,21 +3126,21 @@ end function MOM_state_is_synchronized !> This subroutine offers access to values or pointers to other types from within !! the MOM_control_struct, allowing the MOM_control_struct to be opaque. -subroutine get_MOM_state_elements(CS, G, GV, US, C_p, use_temp) - type(MOM_control_struct), pointer :: CS !< MOM control structure - type(ocean_grid_type), & - optional, pointer :: G !< structure containing metrics and grid info - type(verticalGrid_type), & - optional, pointer :: GV !< structure containing vertical grid info - type(unit_scale_type), & - optional, pointer :: US !< A dimensional unit scaling type - real, optional, intent(out) :: C_p !< The heat capacity - logical, optional, intent(out) :: use_temp !< Indicates whether temperature is a state variable +subroutine get_MOM_state_elements(CS, G, GV, US, C_p, C_p_scaled, use_temp) + type(MOM_control_struct), pointer :: CS !< MOM control structure + type(ocean_grid_type), optional, pointer :: G !< structure containing metrics and grid info + type(verticalGrid_type), optional, pointer :: GV !< structure containing vertical grid info + type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type + real, optional, intent(out) :: C_p !< The heat capacity [J kg degC-1] + real, optional, intent(out) :: C_p_scaled !< The heat capacity in scaled + !! units [Q degC-1 ~> J kg degC-1] + logical, optional, intent(out) :: use_temp !< True if temperature is a state variable if (present(G)) G => CS%G if (present(GV)) GV => CS%GV if (present(US)) US => CS%US - if (present(C_p)) C_p = CS%tv%C_p + if (present(C_p)) C_p = CS%US%Q_to_J_kg * CS%tv%C_p + if (present(C_p_scaled)) C_p_scaled = CS%tv%C_p if (present(use_temp)) use_temp = associated(CS%tv%T) end subroutine get_MOM_state_elements @@ -3152,7 +3155,7 @@ subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only) if (present(mass)) & mass = global_mass_integral(CS%h, CS%G, CS%GV, on_PE_only=on_PE_only) if (present(heat)) & - heat = CS%tv%C_p * global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%T, on_PE_only=on_PE_only) + heat = CS%US%Q_to_J_kg*CS%tv%C_p * global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%T, on_PE_only=on_PE_only) if (present(salt)) & salt = 1.0e-3 * global_mass_integral(CS%h, CS%G, CS%GV, CS%tv%S, on_PE_only=on_PE_only) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 659ca478ed..d0df64c015 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -129,11 +129,12 @@ subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke hs=1; if (present(haloshift)) hs=haloshift - if (associated(tv%T)) call hchksum(tv%T, mesg//" T",G%HI,haloshift=hs) - if (associated(tv%S)) call hchksum(tv%S, mesg//" S",G%HI,haloshift=hs) - if (associated(tv%frazil)) call hchksum(tv%frazil, mesg//" frazil",G%HI,haloshift=hs) + if (associated(tv%T)) call hchksum(tv%T, mesg//" T", G%HI, haloshift=hs) + if (associated(tv%S)) call hchksum(tv%S, mesg//" S", G%HI, haloshift=hs) + if (associated(tv%frazil)) call hchksum(tv%frazil, mesg//" frazil", G%HI, haloshift=hs, & + scale=G%US%Q_to_J_kg*G%US%R_to_kg_m3*G%US%Z_to_m) if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" salt deficit",G%HI,haloshift=hs, scale=US%R_to_kg_m3*US%Z_to_m) + call hchksum(tv%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, scale=US%R_to_kg_m3*US%Z_to_m) end subroutine MOM_thermo_chksum @@ -163,7 +164,7 @@ subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) if (allocated(sfc%u) .and. allocated(sfc%v)) & call uvchksum(mesg//" SSU", sfc%u, sfc%v, G%HI, haloshift=hs, symmetric=sym) ! if (allocated(sfc%salt_deficit)) call hchksum(sfc%salt_deficit, mesg//" salt deficit",G%HI,haloshift=hs) - if (associated(sfc%frazil)) call hchksum(sfc%frazil, mesg//" frazil",G%HI,haloshift=hs) + if (allocated(sfc%frazil)) call hchksum(sfc%frazil, mesg//" frazil", G%HI, haloshift=hs) end subroutine MOM_surface_chksum diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index b361cd7a82..f91f0bcd46 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -1448,7 +1448,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, US, LB, vol_CFL, & local_open_BC = .false. if (present(OBC)) then ; if (associated(OBC)) then - local_open_BC = OBC%open_u_BCs_exist_globally + local_open_BC = OBC%open_v_BCs_exist_globally endif ; endif if (local_open_BC) then do n = 1, OBC%number_of_segments diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 3dd3af8fbf..510ef58aa5 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -59,27 +59,27 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & buoy => NULL() !< buoyancy flux [L2 T-3 ~> m2 s-3] - ! radiative heat fluxes into the ocean [W m-2] + ! radiative heat fluxes into the ocean [Q R Z T-1 ~> W m-2] real, pointer, dimension(:,:) :: & - sw => NULL(), & !< shortwave [W m-2] - sw_vis_dir => NULL(), & !< visible, direct shortwave [W m-2] - sw_vis_dif => NULL(), & !< visible, diffuse shortwave [W m-2] - sw_nir_dir => NULL(), & !< near-IR, direct shortwave [W m-2] - sw_nir_dif => NULL(), & !< near-IR, diffuse shortwave [W m-2] - lw => NULL() !< longwave [W m-2] (typically negative) - - ! turbulent heat fluxes into the ocean [W m-2] + sw => NULL(), & !< shortwave [Q R Z T-1 ~> W m-2] + sw_vis_dir => NULL(), & !< visible, direct shortwave [Q R Z T-1 ~> W m-2] + sw_vis_dif => NULL(), & !< visible, diffuse shortwave [Q R Z T-1 ~> W m-2] + sw_nir_dir => NULL(), & !< near-IR, direct shortwave [Q R Z T-1 ~> W m-2] + sw_nir_dif => NULL(), & !< near-IR, diffuse shortwave [Q R Z T-1 ~> W m-2] + lw => NULL() !< longwave [Q R Z T-1 ~> W m-2] (typically negative) + + ! turbulent heat fluxes into the ocean [Q R Z T-1 ~> W m-2] real, pointer, dimension(:,:) :: & - latent => NULL(), & !< latent [W m-2] (typically < 0) - sens => NULL(), & !< sensible [W m-2] (typically negative) - seaice_melt_heat => NULL(), & !< sea ice and snow melt or formation [W m-2] (typically negative) - heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments [W m-2] + latent => NULL(), & !< latent [Q R Z T-1 ~> W m-2] (typically < 0) + sens => NULL(), & !< sensible [Q R Z T-1 ~> W m-2] (typically negative) + seaice_melt_heat => NULL(), & !< sea ice and snow melt or formation [Q R Z T-1 ~> W m-2] (typically negative) + heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments [Q R Z T-1 ~> W m-2] ! components of latent heat fluxes used for diagnostic purposes real, pointer, dimension(:,:) :: & - latent_evap_diag => NULL(), & !< latent [W m-2] from evaporating liquid water (typically < 0) - latent_fprec_diag => NULL(), & !< latent [W m-2] from melting fprec (typically < 0) - latent_frunoff_diag => NULL() !< latent [W m-2] from melting frunoff (calving) (typically < 0) + latent_evap_diag => NULL(), & !< latent [Q R Z T-1 ~> W m-2] from evaporating liquid water (typically < 0) + latent_fprec_diag => NULL(), & !< latent [Q R Z T-1 ~> W m-2] from melting fprec (typically < 0) + latent_frunoff_diag => NULL() !< latent [Q R Z T-1 ~> W m-2] from melting frunoff (calving) (typically < 0) ! water mass fluxes into the ocean [kg m-2 s-1]; these fluxes impact the ocean mass real, pointer, dimension(:,:) :: & @@ -96,16 +96,16 @@ module MOM_forcing_type ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & - heat_content_cond => NULL(), & !< heat content associated with condensating water [J kg-1 R Z T-1 ~> W m-2] - heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip [J kg-1 R Z T-1 ~> W m-2] + heat_content_cond => NULL(), & !< heat content associated with condensating 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 [J kg-1 R Z T-1 ~> W m-2] - heat_content_fprec => NULL(), & !< heat content associated with frozen precip [J kg-1 R Z T-1 ~> W m-2] - heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip [J kg-1 R Z T-1 ~> W m-2] - heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff [J kg-1 R Z T-1 ~> W m-2] - heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff [J kg-1 R Z T-1 ~> W m-2] - heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean [J kg-1 R Z T-1 ~> W m-2] - heat_content_massin => NULL() !< heat content associated with mass entering ocean [J kg-1 R Z T-1 ~> W m-2] + !! 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] + heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff [Q R Z T-1 ~> W m-2] + heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean [Q R Z T-1 ~> W m-2] + heat_content_massin => NULL() !< heat content associated with mass entering ocean [Q R Z T-1 ~> W m-2] ! salt mass flux (contributes to ocean mass only if non-Bouss ) real, pointer, dimension(:,:) :: & @@ -164,7 +164,8 @@ module MOM_forcing_type real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes !! should be applied [T ~> s]. If negative, this forcing !! type variable has not yet been inialized. - + logical :: gustless_accum_bug = .true. !< If true, use an incorrect expression in the time + !! average of the gustless wind stress. real :: C_p !< heat capacity of seawater [J kg-1 degC-1]. !! C_p is is the same value as in thermovar_ptrs_type. @@ -338,7 +339,7 @@ module MOM_forcing_type !! for optimization purposes. The 2d (i,j) wrapper is the next subroutine below. !! This routine multiplies fluxes by dt, so that the result is an accumulation of fluxes !! over a time step. -subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & +subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, & h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, & aggregate_FW, nonpenSW, netmassInOut_rate, net_Heat_Rate, & @@ -352,7 +353,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & type(optics_type), pointer :: optics !< pointer to optics integer, intent(in) :: nsw !< number of bands of penetrating SW integer, intent(in) :: j !< j-index to work on - real, intent(in) :: dt_in_T !< The time step for these fluxes [T ~> s] + real, intent(in) :: dt !< The time step for these fluxes [T ~> s] real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content @@ -414,12 +415,9 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & real :: Ih_limit ! inverse depth at which surface fluxes start to be limited ! or 0 for no limiting [H-1 ~> m-1 or m2 kg-1] real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth - real :: W_m2_to_H_T ! converts W/m^2 to H degC T-1 [degC H T-1 W-2 m2 ~> degC m3 J-1 or degC kg J-1] - real :: RZ_T_to_W_m2_degC ! Converts mass fluxes to heat fluxes per degree temperature - ! change [W m-2 degC-1 T R-1 Z-1 ~> J kg degC] - real :: I_Cp ! 1.0 / C_p [kg decC J-1] - real :: RZcp_to_H ! Unit convsersion factors divided by the heat capacity - ! [kg degC H R-1 Z-1 J-1 ~> degC m3 J-1 or kg degC J-1] + real :: I_Cp ! 1.0 / C_p [degC Q-1 ~> kg degC J-1] + 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 character(len=200) :: mesg integer :: is, ie, nz, i, k, n @@ -441,11 +439,8 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & !}BGR Ih_limit = 0.0 ; if (FluxRescaleDepth > 0.0) Ih_limit = 1.0 / FluxRescaleDepth - RZ_T_to_W_m2_degC = fluxes%C_p*US%R_to_kg_m3*US%Z_to_m*US%s_to_T I_Cp = 1.0 / fluxes%C_p - W_m2_to_H_T = 1.0 / (US%s_to_T * GV%H_to_kg_m2 * fluxes%C_p) - - RZcP_to_H = 1.0 / (GV%H_to_RZ * fluxes%C_p) + I_Cp_Hconvert = 1.0 / (GV%H_to_RZ * fluxes%C_p) is = G%isc ; ie = G%iec ; nz = G%ke @@ -484,8 +479,8 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,k) ; enddo ; enddo if (nsw >= 1) then - call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd) !, penSW_scale=W_m2_to_H_T*dt_in_T - if (do_PSWBR) call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd_rate) !, penSW_scale=W_m2_to_H_T + call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd) + if (do_PSWBR) call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd_rate) endif do i=is,ie @@ -496,8 +491,8 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & ! (H=m for Bouss, H=kg/m2 for non-Bouss) Pen_sw_tot(i) = 0.0 if (nsw >= 1) then - do n=1,nsw - Pen_SW_bnd(n,i) = W_m2_to_H_T*scale*dt_in_T * max(0.0, Pen_SW_bnd(n,i)) + do n=1,nsw + Pen_SW_bnd(n,i) = I_Cp_Hconvert*scale*dt * max(0.0, Pen_SW_bnd(n,i)) Pen_sw_tot(i) = Pen_sw_tot(i) + Pen_SW_bnd(n,i) enddo else @@ -508,7 +503,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & pen_sw_tot_rate(i) = 0.0 if (nsw >= 1) then do n=1,nsw - Pen_SW_bnd_rate(n,i) = W_m2_to_H_T*scale * max(0.0, Pen_SW_bnd_rate(n,i)) + Pen_SW_bnd_rate(n,i) = I_Cp_Hconvert*scale * max(0.0, Pen_SW_bnd_rate(n,i)) pen_sw_tot_rate(i) = pen_sw_tot_rate(i) + pen_sw_bnd_rate(n,i) enddo else @@ -517,7 +512,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & endif ! net volume/mass of liquid and solid passing through surface boundary fluxes - netMassInOut(i) = dt_in_T * (scale * & + netMassInOut(i) = dt * (scale * & (((((( fluxes%lprec(i,j) & + fluxes%fprec(i,j) ) & + fluxes%evap(i,j) ) & @@ -543,7 +538,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & ! is added to the ocean, which may still need to be coded. Not that the units ! of netMassInOut are still kg_m2, so no conversion to H should occur yet. if (.not.GV%Boussinesq .and. associated(fluxes%salt_flux)) then - netMassInOut(i) = netMassInOut(i) + dt_in_T * (scale * fluxes%salt_flux(i,j)) + netMassInOut(i) = netMassInOut(i) + dt * (scale * fluxes%salt_flux(i,j)) if (do_NMIOr) netMassInOut_rate(i) = netMassInOut_rate(i) + & (scale * fluxes%salt_flux(i,j)) endif @@ -569,7 +564,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & ! in which case heat_content_vprec is computed in MOM_diabatic_driver.F90. if (fluxes%vprec(i,j) < 0.0) netMassOut(i) = netMassOut(i) + fluxes%vprec(i,j) - netMassOut(i) = dt_in_T * scale * netMassOut(i) + netMassOut(i) = dt * scale * netMassOut(i) ! convert to H units (Bouss=meter or non-Bouss=kg/m^2) netMassInOut(i) = GV%RZ_to_H * netMassInOut(i) @@ -581,40 +576,40 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & ! CIME provides heat flux from snow&ice melt (seaice_melt_heat), so this is added below if (associated(fluxes%seaice_melt_heat)) then - net_heat(i) = scale * dt_in_T * W_m2_to_H_T * & - ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & + net_heat(i) = scale * dt * I_Cp_Hconvert * & + ( fluxes%sw(i,j) + (((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) + & fluxes%seaice_melt_heat(i,j)) ) !Repeats above code w/ dt=1. for legacy reason - if (do_NHR) net_heat_rate(i) = scale * W_m2_to_H_T * & - ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & + if (do_NHR) net_heat_rate(i) = scale * I_Cp_Hconvert * & + ( fluxes%sw(i,j) + (((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) + & fluxes%seaice_melt_heat(i,j))) else - net_heat(i) = scale * dt_in_T * W_m2_to_H_T * & - ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) + net_heat(i) = scale * dt * I_Cp_Hconvert * & + ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) !Repeats above code w/ dt=1. for legacy reason - if (do_NHR) net_heat_rate(i) = scale * W_m2_to_H_T * & - ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) + if (do_NHR) net_heat_rate(i) = scale * I_Cp_Hconvert * & + ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) endif ! Add heat flux from surface damping (restoring) (K * H) or flux adjustments. if (associated(fluxes%heat_added)) then - net_heat(i) = net_heat(i) + (scale * (dt_in_T * W_m2_to_H_T)) * fluxes%heat_added(i,j) - if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale * (W_m2_to_H_T)) * fluxes%heat_added(i,j) + net_heat(i) = net_heat(i) + (scale * (dt * I_Cp_Hconvert)) * fluxes%heat_added(i,j) + if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale * I_Cp_Hconvert) * fluxes%heat_added(i,j) endif ! Add explicit heat flux for runoff (which is part of the ice-ocean boundary ! flux type). Runoff is otherwise added with a temperature of SST. if (useRiverHeatContent) then ! remove lrunoff*SST here, to counteract its addition elsewhere - net_heat(i) = (net_heat(i) + (scale*(dt_in_T * RZcP_to_H)) * fluxes%heat_content_lrunoff(i,j)) - & - (GV%RZ_to_H * (scale * dt_in_T)) * fluxes%lrunoff(i,j) * T(i,1) + net_heat(i) = (net_heat(i) + (scale*(dt * I_Cp_Hconvert)) * fluxes%heat_content_lrunoff(i,j)) - & + (GV%RZ_to_H * (scale * dt)) * fluxes%lrunoff(i,j) * T(i,1) !BGR-Jul 5, 2017{ !Intentionally neglect the following contribution to rate for legacy reasons. - !if (do_NHR) net_heat_rate(i) = (net_heat_rate(i) + (scale*RZcP_to_H) * fluxes%heat_content_lrunoff(i,j)) - & + !if (do_NHR) net_heat_rate(i) = (net_heat_rate(i) + (scale*I_Cp_Hconvert) * fluxes%heat_content_lrunoff(i,j)) - & ! (GV%RZ_to_H * (scale)) * fluxes%lrunoff(i,j) * T(i,1) !}BGR if (calculate_diags .and. associated(tv%TempxPmE)) then - tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt_in_T) * & + tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & (I_Cp*fluxes%heat_content_lrunoff(i,j) - fluxes%lrunoff(i,j)*T(i,1)) endif endif @@ -623,15 +618,15 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & ! flux type). Calving is otherwise added with a temperature of SST. if (useCalvingHeatContent) then ! remove frunoff*SST here, to counteract its addition elsewhere - net_heat(i) = net_heat(i) + (scale*(dt_in_T * RZcP_to_H)) * fluxes%heat_content_frunoff(i,j) - & - (GV%RZ_to_H * (scale * dt_in_T)) * fluxes%frunoff(i,j) * T(i,1) + net_heat(i) = net_heat(i) + (scale*(dt * I_Cp_Hconvert)) * fluxes%heat_content_frunoff(i,j) - & + (GV%RZ_to_H * (scale * dt)) * fluxes%frunoff(i,j) * T(i,1) !BGR-Jul 5, 2017{ !Intentionally neglect the following contribution to rate for legacy reasons. -! if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale*RZcP_to_H) * fluxes%heat_content_frunoff(i,j) - & +! if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale*I_Cp_Hconvert) * fluxes%heat_content_frunoff(i,j) - & ! (GV%RZ_to_H * scale) * fluxes%frunoff(i,j) * T(i,1) !}BGR if (calculate_diags .and. associated(tv%TempxPmE)) then - tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt_in_T) * & + tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & (I_Cp*fluxes%heat_content_frunoff(i,j) - fluxes%frunoff(i,j)*T(i,1)) endif endif @@ -646,19 +641,19 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & ! When evap, lprec, or vprec > 0, then we know their heat content here ! via settings from inside of the appropriate config_src driver files. ! if (associated(fluxes%heat_content_lprec)) then -! net_heat(i) = net_heat(i) + scale * dt_in_T * RZcP_to_H * & +! net_heat(i) = net_heat(i) + scale * dt * I_Cp_Hconvert * & ! (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_cond(i,j) + fluxes%heat_content_vprec(i,j)))))) ! endif if (fluxes%num_msg < fluxes%max_msg) then - if (Pen_SW_tot(i) > 1.000001 * W_m2_to_H_T*scale*dt_in_T*fluxes%sw(i,j)) 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 write(mesg,'("Penetrating shortwave of ",1pe17.10, & &" exceeds total shortwave of ",1pe17.10,& &" at ",1pg11.4,"E, "1pg11.4,"N.")') & - Pen_SW_tot(i),W_m2_to_H_T*scale*dt_in_T * fluxes%sw(i,j),& + Pen_SW_tot(i), I_Cp_Hconvert*scale*dt * fluxes%sw(i,j), & G%geoLonT(i,j),G%geoLatT(i,j) call MOM_error(WARNING,mesg) endif @@ -672,7 +667,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & ! diagnose non-downwelling SW if (present(nonPenSW)) then - nonPenSW(i) = scale * dt_in_T * W_m2_to_H_T * fluxes%sw(i,j) - Pen_SW_tot(i) + nonPenSW(i) = scale * dt * I_Cp_Hconvert * fluxes%sw(i,j) - Pen_SW_tot(i) endif ! Salt fluxes @@ -682,7 +677,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & ! Boussinesq: (ppt * m) ! non-Bouss: (g/m^2) if (associated(fluxes%salt_flux)) then - Net_salt(i) = (scale * dt_in_T * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H + Net_salt(i) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H !Repeat above code for 'rate' term if (do_NSR) Net_salt_rate(i) = (scale * 1. * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H endif @@ -701,10 +696,10 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & if (associated(fluxes%heat_content_massin)) then if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" - fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt_in_T + fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt else ! net is "out" fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & - T(i,1) * GV%H_to_RZ / dt_in_T + T(i,1) * GV%H_to_RZ / dt endif else fluxes%heat_content_massin(i,j) = 0. @@ -716,10 +711,10 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & if (associated(fluxes%heat_content_massout)) then if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" - fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt_in_T + fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_RZ / dt else ! net is "out" - fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & - T(i,1) * GV%H_to_RZ / dt_in_T + fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + T(i,1) * GV%H_to_RZ / dt endif else fluxes%heat_content_massout(i,j) = 0.0 @@ -810,7 +805,7 @@ end subroutine extractFluxes1d !> 2d wrapper for 1d extract fluxes from surface fluxes type. !! This subroutine extracts fluxes from the surface fluxes type. It multiplies the !! fluxes by dt, so that the result is an accumulation of the fluxes over a time step. -subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleDepth, & +subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt, FluxRescaleDepth, & useRiverHeatContent, useCalvingHeatContent, h, T, & netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & aggregate_FW) @@ -821,7 +816,7 @@ subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleD type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. type(optics_type), pointer :: optics !< pointer to optics integer, intent(in) :: nsw !< number of bands of penetrating SW - real, intent(in) :: dt_in_T !< The time step for these fluxes [T ~> s] + real, intent(in) :: dt !< The time step for these fluxes [T ~> s] real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content @@ -856,12 +851,12 @@ subroutine extractFluxes2d(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleD logical, intent(in) :: aggregate_FW !< For determining how to aggregate the forcing. integer :: j -!$OMP parallel do default(none) shared(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleDepth, & +!$OMP parallel do default(none) shared(G, GV, US, fluxes, optics, nsw, dt, FluxRescaleDepth, & !$OMP useRiverHeatContent, useCalvingHeatContent, & !$OMP h,T,netMassInOut,netMassOut,Net_heat,Net_salt,Pen_SW_bnd,tv, & !$OMP aggregate_FW) do j=G%jsc, G%jec - call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, & + call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent,& h(:,j,:), T(:,j,:), netMassInOut(:,j), netMassOut(:,j), & net_heat(:,j), net_salt(:,j), pen_SW_bnd(:,:,j), tv, aggregate_FW) @@ -1026,31 +1021,34 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. if (associated(fluxes%ustar)) & - call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) + call hchksum(fluxes%ustar, mesg//" fluxes%ustar", G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%buoy)) & - call hchksum(fluxes%buoy, mesg//" fluxes%buoy ",G%HI, haloshift=hshift, scale=US%L_to_m**2*US%s_to_T**3) + call hchksum(fluxes%buoy, mesg//" fluxes%buoy ", G%HI, haloshift=hshift, scale=US%L_to_m**2*US%s_to_T**3) if (associated(fluxes%sw)) & - call hchksum(fluxes%sw, mesg//" fluxes%sw",G%HI,haloshift=hshift) + call hchksum(fluxes%sw, mesg//" fluxes%sw",G%HI, haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%sw_vis_dir)) & - call hchksum(fluxes%sw_vis_dir, mesg//" fluxes%sw_vis_dir",G%HI,haloshift=hshift) + call hchksum(fluxes%sw_vis_dir, mesg//" fluxes%sw_vis_dir", G%HI, haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%sw_vis_dif)) & - call hchksum(fluxes%sw_vis_dif, mesg//" fluxes%sw_vis_dif",G%HI,haloshift=hshift) + call hchksum(fluxes%sw_vis_dif, mesg//" fluxes%sw_vis_dif", G%HI, haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%sw_nir_dir)) & - call hchksum(fluxes%sw_nir_dir, mesg//" fluxes%sw_nir_dir",G%HI,haloshift=hshift) + call hchksum(fluxes%sw_nir_dir, mesg//" fluxes%sw_nir_dir", G%HI, haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%sw_nir_dif)) & - call hchksum(fluxes%sw_nir_dif, mesg//" fluxes%sw_nir_dif",G%HI,haloshift=hshift) + call hchksum(fluxes%sw_nir_dif, mesg//" fluxes%sw_nir_dif", G%HI, haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%lw)) & - call hchksum(fluxes%lw, mesg//" fluxes%lw",G%HI,haloshift=hshift) + call hchksum(fluxes%lw, mesg//" fluxes%lw", G%HI, haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%latent)) & - call hchksum(fluxes%latent, mesg//" fluxes%latent",G%HI,haloshift=hshift) + call hchksum(fluxes%latent, mesg//" fluxes%latent", G%HI, haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%latent_evap_diag)) & - call hchksum(fluxes%latent_evap_diag, mesg//" fluxes%latent_evap_diag",G%HI,haloshift=hshift) + call hchksum(fluxes%latent_evap_diag, mesg//" fluxes%latent_evap_diag", G%HI, & + haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%latent_fprec_diag)) & - call hchksum(fluxes%latent_fprec_diag, mesg//" fluxes%latent_fprec_diag",G%HI,haloshift=hshift) + call hchksum(fluxes%latent_fprec_diag, mesg//" fluxes%latent_fprec_diag", G%HI, & + haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%latent_frunoff_diag)) & - call hchksum(fluxes%latent_frunoff_diag, mesg//" fluxes%latent_frunoff_diag",G%HI,haloshift=hshift) + call hchksum(fluxes%latent_frunoff_diag, mesg//" fluxes%latent_frunoff_diag", G%HI, & + haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%sens)) & - call hchksum(fluxes%sens, mesg//" fluxes%sens",G%HI,haloshift=hshift) + call hchksum(fluxes%sens, mesg//" fluxes%sens",G%HI,haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%evap)) & call hchksum(fluxes%evap, mesg//" fluxes%evap",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%lprec)) & @@ -1062,7 +1060,8 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) if (associated(fluxes%seaice_melt)) & call hchksum(fluxes%seaice_melt, mesg//" fluxes%seaice_melt",G%HI,haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%seaice_melt_heat)) & - call hchksum(fluxes%seaice_melt_heat, mesg//" fluxes%seaice_melt_heat",G%HI,haloshift=hshift) + call hchksum(fluxes%seaice_melt_heat, mesg//" fluxes%seaice_melt_heat", G%HI, & + haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%p_surf)) & call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf",G%HI,haloshift=hshift) if (associated(fluxes%salt_flux)) & @@ -1081,22 +1080,22 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) haloshift=hshift, scale=RZ_T_conversion) if (associated(fluxes%heat_content_frunoff)) & call hchksum(fluxes%heat_content_frunoff, mesg//" fluxes%heat_content_frunoff", G%HI, & - haloshift=hshift, scale=RZ_T_conversion) + haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%heat_content_lprec)) & call hchksum(fluxes%heat_content_lprec, mesg//" fluxes%heat_content_lprec", G%HI, & - haloshift=hshift, scale=RZ_T_conversion) + haloshift=hshift, scale=US%QRZ_T_to_W_m2) if (associated(fluxes%heat_content_fprec)) & call hchksum(fluxes%heat_content_fprec, mesg//" fluxes%heat_content_fprec", G%HI, & - haloshift=hshift, scale=RZ_T_conversion) + 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=RZ_T_conversion) + 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=RZ_T_conversion) + 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=RZ_T_conversion) + haloshift=hshift, scale=US%QRZ_T_to_W_m2) end subroutine MOM_forcing_chksum !> Write out chksums for the driving mechanical forces. @@ -1464,91 +1463,91 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_heat_content_frunoff = register_diag_field('ocean_model', 'heat_content_frunoff', & diag%axesT1, Time, 'Heat content (relative to 0C) of solid runoff into ocean', & - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & + 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='temperature_flux_due_to_solid_runoff_expressed_as_heat_flux_into_sea_water') handles%id_heat_content_lrunoff = register_diag_field('ocean_model', 'heat_content_lrunoff', & diag%axesT1, Time, 'Heat content (relative to 0C) of liquid runoff into ocean', & - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & + 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water') handles%id_hfrunoffds = register_diag_field('ocean_model', 'hfrunoffds', & diag%axesT1, Time, 'Heat content (relative to 0C) of liquid+solid runoff into ocean', & - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & + 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water') handles%id_heat_content_lprec = register_diag_field('ocean_model', 'heat_content_lprec', & diag%axesT1,Time,'Heat content (relative to 0degC) of liquid precip entering ocean', & - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) + 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_heat_content_fprec = register_diag_field('ocean_model', 'heat_content_fprec',& diag%axesT1,Time,'Heat content (relative to 0degC) of frozen prec entering ocean',& - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) + '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%R_to_kg_m3*US%Z_to_m*US%s_to_T) + '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%R_to_kg_m3*US%Z_to_m*US%s_to_T) + 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_heat_content_cond = register_diag_field('ocean_model', 'heat_content_cond', & diag%axesT1,Time,'Heat content (relative to 0degC) of water condensing into ocean',& - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) + '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%R_to_kg_m3*US%Z_to_m*US%s_to_T, & + 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water',& cmor_long_name='Heat Content (relative to 0degC) of Liquid + Frozen Precipitation') handles%id_heat_content_surfwater = register_diag_field('ocean_model', 'heat_content_surfwater',& diag%axesT1, Time, & 'Heat content (relative to 0degC) of net water crossing ocean surface (frozen+liquid)', & - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) + 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_heat_content_massout = register_diag_field('ocean_model', 'heat_content_massout', & diag%axesT1, Time,'Heat content (relative to 0degC) of net mass leaving ocean ocean via evap and ice form',& - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & + 'W m-2', conversion=US%QRZ_T_to_W_m2, & cmor_field_name='hfevapds', & cmor_standard_name='temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water', & cmor_long_name='Heat Content (relative to 0degC) of Water Leaving Ocean via Evaporation and Ice Formation') handles%id_heat_content_massin = register_diag_field('ocean_model', 'heat_content_massin', & diag%axesT1, Time,'Heat content (relative to 0degC) of net mass entering ocean ocean',& - 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) + 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_net_heat_coupler = register_diag_field('ocean_model', 'net_heat_coupler', & diag%axesT1,Time,'Surface ocean heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',& - 'W m-2') + 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface',diag%axesT1, Time, & 'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat or '// & - 'flux adjustments',& - 'W m-2',& + 'flux adjustments', & + 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='surface_downward_heat_flux_in_sea_water', cmor_field_name='hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water', & cmor_long_name='Surface ocean heat flux from SW+LW+latent+sensible+masstransfer+frazil+seaice_melt_heat') handles%id_sw = register_diag_field('ocean_model', 'SW', diag%axesT1, Time, & - 'Shortwave radiation flux into ocean', 'W m-2', & + 'Shortwave radiation flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='net_downward_shortwave_flux_at_sea_water_surface', & cmor_field_name='rsntds', & cmor_standard_name='net_downward_shortwave_flux_at_sea_water_surface', & cmor_long_name='Net Downward Shortwave Radiation at Sea Water Surface') handles%id_sw_vis = register_diag_field('ocean_model', 'sw_vis', diag%axesT1, Time, & 'Shortwave radiation direct and diffuse flux into the ocean in the visible band', & - 'W m-2') + 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_sw_nir = register_diag_field('ocean_model', 'sw_nir', diag%axesT1, Time, & 'Shortwave radiation direct and diffuse flux into the ocean in the near-infrared band', & - 'W m-2') + 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_LwLatSens = register_diag_field('ocean_model', 'LwLatSens', diag%axesT1, Time, & - 'Combined longwave, latent, and sensible heating at ocean surface', 'W m-2') + 'Combined longwave, latent, and sensible heating at ocean surface', 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_lw = register_diag_field('ocean_model', 'LW', diag%axesT1, Time, & - 'Longwave radiation flux into ocean', 'W m-2', & + 'Longwave radiation flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='surface_net_downward_longwave_flux', & cmor_field_name='rlntds', & cmor_standard_name='surface_net_downward_longwave_flux', & @@ -1556,41 +1555,41 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_lat = register_diag_field('ocean_model', 'latent', diag%axesT1, Time, & 'Latent heat flux into ocean due to fusion and evaporation (negative means ocean heat loss)', & - 'W m-2', cmor_field_name='hflso', & + 'W m-2', conversion=US%QRZ_T_to_W_m2, cmor_field_name='hflso', & cmor_standard_name='surface_downward_latent_heat_flux', & cmor_long_name='Surface Downward Latent Heat Flux due to Evap + Melt Snow/Ice') handles%id_lat_evap = register_diag_field('ocean_model', 'latent_evap', diag%axesT1, Time, & - 'Latent heat flux into ocean due to evaporation/condensation', 'W m-2') + 'Latent heat flux into ocean due to evaporation/condensation', 'W m-2', conversion=US%QRZ_T_to_W_m2) handles%id_lat_fprec = register_diag_field('ocean_model', 'latent_fprec_diag', diag%axesT1, Time,& - 'Latent heat flux into ocean due to melting of frozen precipitation', 'W m-2', & + 'Latent heat flux into ocean due to melting of frozen precipitation', 'W m-2', conversion=US%QRZ_T_to_W_m2, & cmor_field_name='hfsnthermds', & cmor_standard_name='heat_flux_into_sea_water_due_to_snow_thermodynamics', & cmor_long_name='Latent Heat to Melt Frozen Precipitation') handles%id_lat_frunoff = register_diag_field('ocean_model', 'latent_frunoff', diag%axesT1, Time, & - 'Latent heat flux into ocean due to melting of icebergs', 'W m-2', & + 'Latent heat flux into ocean due to melting of icebergs', 'W m-2', conversion=US%QRZ_T_to_W_m2, & cmor_field_name='hfibthermds', & cmor_standard_name='heat_flux_into_sea_water_due_to_iceberg_thermodynamics', & cmor_long_name='Latent Heat to Melt Frozen Runoff/Iceberg') - handles%id_sens = register_diag_field('ocean_model', 'sensible', diag%axesT1, Time,& - 'Sensible heat flux into ocean', 'W m-2', & + handles%id_sens = register_diag_field('ocean_model', 'sensible', diag%axesT1, Time, & + 'Sensible heat flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='surface_downward_sensible_heat_flux', & cmor_field_name='hfsso', & cmor_standard_name='surface_downward_sensible_heat_flux', & cmor_long_name='Surface Downward Sensible Heat Flux') handles%id_seaice_melt_heat = register_diag_field('ocean_model', 'seaice_melt_heat', diag%axesT1, Time,& - 'Heat flux into ocean due to snow and sea ice melt/freeze', 'W m-2', & + 'Heat flux into ocean due to snow and sea ice melt/freeze', 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='snow_ice_melt_heat_flux', & !GMM TODO cmor_field_name='hfsso', & cmor_standard_name='snow_ice_melt_heat_flux', & cmor_long_name='Heat flux into ocean from snow and sea ice melt') handles%id_heat_added = register_diag_field('ocean_model', 'heat_added', diag%axesT1, Time, & - 'Flux Adjustment or restoring surface heat flux into ocean', 'W m-2') + 'Flux Adjustment or restoring surface heat flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2) !=============================================================== @@ -1948,9 +1947,11 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) ! Average the water, heat, and salt fluxes, and ustar. do j=js,je ; do i=is,ie -!### Replace the expression for ustar_gustless with this one... -! fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j) - fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j) + if (fluxes%gustless_accum_bug) then + fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j) + else + fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j) + endif fluxes%evap(i,j) = wt1*fluxes%evap(i,j) + wt2*flux_tmp%evap(i,j) fluxes%lprec(i,j) = wt1*fluxes%lprec(i,j) + wt2*flux_tmp%lprec(i,j) @@ -2114,9 +2115,12 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) G%mask2dCv(i,J) * forces%tauy(i,J)**2) / & (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - fluxes%ustar_gustless(i,j) = sqrt(US%L_to_Z * sqrt(taux2 + tauy2) / Rho0) -!### For efficiency this could be changed to: -! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) + if (fluxes%gustless_accum_bug) then + ! This change is just for computational efficiency, but it is wrapped with another change. + fluxes%ustar_gustless(i,j) = sqrt(US%L_to_Z * sqrt(taux2 + tauy2) / Rho0) + else + fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) + endif enddo ; enddo endif @@ -2256,7 +2260,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles call cpu_clock_begin(handles%id_clock_forcing) - C_p = fluxes%C_p + C_p = US%Q_to_J_kg*fluxes%C_p RZ_T_conversion = US%R_to_kg_m3*US%Z_to_m*US%s_to_T I_dt = 1.0 / (US%T_to_s*fluxes%dt_buoy_accum) ppt2mks = 1e-3 @@ -2444,63 +2448,63 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles if ((handles%id_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) & call post_data(handles%id_heat_content_lrunoff, fluxes%heat_content_lrunoff, diag) if ((handles%id_total_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) then - total_transport = global_area_integral(fluxes%heat_content_lrunoff, G, scale=RZ_T_conversion) + total_transport = global_area_integral(fluxes%heat_content_lrunoff, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_content_lrunoff, total_transport, diag) endif if ((handles%id_heat_content_frunoff > 0) .and. associated(fluxes%heat_content_frunoff)) & call post_data(handles%id_heat_content_frunoff, fluxes%heat_content_frunoff, diag) if ((handles%id_total_heat_content_frunoff > 0) .and. associated(fluxes%heat_content_frunoff)) then - total_transport = global_area_integral(fluxes%heat_content_frunoff, G, scale=RZ_T_conversion) + total_transport = global_area_integral(fluxes%heat_content_frunoff, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_content_frunoff, total_transport, diag) endif if ((handles%id_heat_content_lprec > 0) .and. associated(fluxes%heat_content_lprec)) & call post_data(handles%id_heat_content_lprec, fluxes%heat_content_lprec, diag) if ((handles%id_total_heat_content_lprec > 0) .and. associated(fluxes%heat_content_lprec)) then - total_transport = global_area_integral(fluxes%heat_content_lprec, G, scale=RZ_T_conversion) + total_transport = global_area_integral(fluxes%heat_content_lprec, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_content_lprec, total_transport, diag) endif if ((handles%id_heat_content_fprec > 0) .and. associated(fluxes%heat_content_fprec)) & call post_data(handles%id_heat_content_fprec, fluxes%heat_content_fprec, diag) if ((handles%id_total_heat_content_fprec > 0) .and. associated(fluxes%heat_content_fprec)) then - total_transport = global_area_integral(fluxes%heat_content_fprec, G, scale=RZ_T_conversion) + total_transport = global_area_integral(fluxes%heat_content_fprec, G, scale=US%QRZ_T_to_W_m2) 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=RZ_T_conversion) + 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 - total_transport = global_area_integral(fluxes%heat_content_vprec, G, scale=RZ_T_conversion) + total_transport = global_area_integral(fluxes%heat_content_vprec, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_content_vprec, total_transport, diag) endif if ((handles%id_heat_content_cond > 0) .and. associated(fluxes%heat_content_cond)) & call post_data(handles%id_heat_content_cond, fluxes%heat_content_cond, diag) if ((handles%id_total_heat_content_cond > 0) .and. associated(fluxes%heat_content_cond)) then - total_transport = global_area_integral(fluxes%heat_content_cond, G, scale=RZ_T_conversion) + total_transport = global_area_integral(fluxes%heat_content_cond, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_content_cond, 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 - total_transport = global_area_integral(fluxes%heat_content_massout,G, scale=RZ_T_conversion) + total_transport = global_area_integral(fluxes%heat_content_massout,G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_content_massout, total_transport, diag) endif if ((handles%id_heat_content_massin > 0) .and. associated(fluxes%heat_content_massin)) & call post_data(handles%id_heat_content_massin, fluxes%heat_content_massin, diag) if ((handles%id_total_heat_content_massin > 0) .and. associated(fluxes%heat_content_massin)) then - total_transport = global_area_integral(fluxes%heat_content_massin, G, scale=RZ_T_conversion) + total_transport = global_area_integral(fluxes%heat_content_massin, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_content_massin, total_transport, diag) endif @@ -2508,19 +2512,19 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles handles%id_net_heat_coupler_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) + if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%lw(i,j) if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) - if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) + if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%sw(i,j) if (associated(fluxes%seaice_melt_heat)) res(i,j) = res(i,j) + fluxes%seaice_melt_heat(i,j) enddo ; enddo if (handles%id_net_heat_coupler > 0) call post_data(handles%id_net_heat_coupler, res, diag) if (handles%id_total_net_heat_coupler > 0) then - total_transport = global_area_integral(res,G) + total_transport = global_area_integral(res, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_net_heat_coupler, total_transport, diag) endif if (handles%id_net_heat_coupler_ga > 0) then - ave_flux = global_area_mean(res,G) + ave_flux = global_area_mean(res, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_net_heat_coupler_ga, ave_flux, diag) endif endif @@ -2529,42 +2533,42 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles handles%id_net_heat_surface_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) - if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) - if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) - if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) - if (associated(fluxes%seaice_melt_heat)) res(i,j) = res(i,j) + fluxes%seaice_melt_heat(i,j) - if (associated(sfc_state%frazil)) res(i,j) = res(i,j) + sfc_state%frazil(i,j) * I_dt + if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%lw(i,j) + if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) + if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) + if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%sw(i,j) + if (associated(fluxes%seaice_melt_heat)) res(i,j) = res(i,j) + fluxes%seaice_melt_heat(i,j) + if (allocated(sfc_state%frazil)) res(i,j) = res(i,j) + US%W_m2_to_QRZ_T*sfc_state%frazil(i,j) * I_dt !if (associated(sfc_state%TempXpme)) then - ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt + ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * US%Q_to_J_kg*fluxes%C_p * I_dt !else if (associated(fluxes%heat_content_lrunoff)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_lrunoff(i,j) + res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) if (associated(fluxes%heat_content_frunoff)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_frunoff(i,j) + res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) if (associated(fluxes%heat_content_lprec)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_lprec(i,j) + res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) if (associated(fluxes%heat_content_fprec)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_fprec(i,j) + res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) if (associated(fluxes%heat_content_icemelt)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_icemelt(i,j) + res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) if (associated(fluxes%heat_content_vprec)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_vprec(i,j) + res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) if (associated(fluxes%heat_content_cond)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_cond(i,j) + res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) if (associated(fluxes%heat_content_massout)) & - res(i,j) = res(i,j) + RZ_T_conversion*fluxes%heat_content_massout(i,j) + res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) !endif if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) enddo ; enddo if (handles%id_net_heat_surface > 0) call post_data(handles%id_net_heat_surface, res, diag) if (handles%id_total_net_heat_surface > 0) then - total_transport = global_area_integral(res, G) + total_transport = global_area_integral(res, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_net_heat_surface, total_transport, diag) endif if (handles%id_net_heat_surface_ga > 0) then - ave_flux = global_area_mean(res, G) + ave_flux = global_area_mean(res, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_net_heat_surface_ga, ave_flux, diag) endif endif @@ -2573,7 +2577,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles do j=js,je ; do i=is,ie res(i,j) = 0.0 ! if (associated(sfc_state%TempXpme)) then - ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt + ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * US%Q_to_J_kg*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) @@ -2587,7 +2591,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles enddo ; enddo if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag) if (handles%id_total_heat_content_surfwater > 0) then - total_transport = global_area_integral(res, G, scale=RZ_T_conversion) + total_transport = global_area_integral(res, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_content_surfwater, total_transport, diag) endif endif @@ -2626,16 +2630,16 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles do j=js,je ; do i=is,ie res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) enddo ; enddo - total_transport = global_area_integral(res,G) + total_transport = global_area_integral(res, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_LwLatSens, total_transport, diag) endif if ((handles%id_LwLatSens_ga > 0) .and. associated(fluxes%lw) .and. & associated(fluxes%latent) .and. associated(fluxes%sens)) then do j=js,je ; do i=is,ie - res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + res(i,j) = ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) enddo ; enddo - ave_flux = global_area_mean(res,G) + ave_flux = global_area_mean(res, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_LwLatSens_ga, ave_flux, diag) endif @@ -2651,11 +2655,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles call post_data(handles%id_sw_nir, fluxes%sw_nir_dir+fluxes%sw_nir_dif, diag) endif if ((handles%id_total_sw > 0) .and. associated(fluxes%sw)) then - total_transport = global_area_integral(fluxes%sw,G) + total_transport = global_area_integral(fluxes%sw, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_sw, total_transport, diag) endif if ((handles%id_sw_ga > 0) .and. associated(fluxes%sw)) then - ave_flux = global_area_mean(fluxes%sw,G) + ave_flux = global_area_mean(fluxes%sw, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_sw_ga, ave_flux, diag) endif @@ -2663,11 +2667,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles call post_data(handles%id_lw, fluxes%lw, diag) endif if ((handles%id_total_lw > 0) .and. associated(fluxes%lw)) then - total_transport = global_area_integral(fluxes%lw,G) + total_transport = global_area_integral(fluxes%lw, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_lw, total_transport, diag) endif if ((handles%id_lw_ga > 0) .and. associated(fluxes%lw)) then - ave_flux = global_area_mean(fluxes%lw,G) + ave_flux = global_area_mean(fluxes%lw, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_lw_ga, ave_flux, diag) endif @@ -2675,11 +2679,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles call post_data(handles%id_lat, fluxes%latent, diag) endif if ((handles%id_total_lat > 0) .and. associated(fluxes%latent)) then - total_transport = global_area_integral(fluxes%latent,G) + total_transport = global_area_integral(fluxes%latent, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_lat, total_transport, diag) endif if ((handles%id_lat_ga > 0) .and. associated(fluxes%latent)) then - ave_flux = global_area_mean(fluxes%latent,G) + ave_flux = global_area_mean(fluxes%latent, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_lat_ga, ave_flux, diag) endif @@ -2687,7 +2691,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles call post_data(handles%id_lat_evap, fluxes%latent_evap_diag, diag) endif if ((handles%id_total_lat_evap > 0) .and. associated(fluxes%latent_evap_diag)) then - total_transport = global_area_integral(fluxes%latent_evap_diag,G) + total_transport = global_area_integral(fluxes%latent_evap_diag, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_lat_evap, total_transport, diag) endif @@ -2695,7 +2699,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles call post_data(handles%id_lat_fprec, fluxes%latent_fprec_diag, diag) endif if ((handles%id_total_lat_fprec > 0) .and. associated(fluxes%latent_fprec_diag)) then - total_transport = global_area_integral(fluxes%latent_fprec_diag,G) + total_transport = global_area_integral(fluxes%latent_fprec_diag, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_lat_fprec, total_transport, diag) endif @@ -2703,7 +2707,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles call post_data(handles%id_lat_frunoff, fluxes%latent_frunoff_diag, diag) endif if (handles%id_total_lat_frunoff > 0 .and. associated(fluxes%latent_frunoff_diag)) then - total_transport = global_area_integral(fluxes%latent_frunoff_diag,G) + total_transport = global_area_integral(fluxes%latent_frunoff_diag, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_lat_frunoff, total_transport, diag) endif @@ -2716,16 +2720,16 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles endif if ((handles%id_total_seaice_melt_heat > 0) .and. associated(fluxes%seaice_melt_heat)) then - total_transport = global_area_integral(fluxes%seaice_melt_heat,G) + total_transport = global_area_integral(fluxes%seaice_melt_heat, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_seaice_melt_heat, total_transport, diag) endif if ((handles%id_total_sens > 0) .and. associated(fluxes%sens)) then - total_transport = global_area_integral(fluxes%sens,G) + total_transport = global_area_integral(fluxes%sens, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_sens, total_transport, diag) endif if ((handles%id_sens_ga > 0) .and. associated(fluxes%sens)) then - ave_flux = global_area_mean(fluxes%sens,G) + ave_flux = global_area_mean(fluxes%sens, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_sens_ga, ave_flux, diag) endif @@ -2734,7 +2738,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles endif if ((handles%id_total_heat_added > 0) .and. associated(fluxes%heat_added)) then - total_transport = global_area_integral(fluxes%heat_added,G) + total_transport = global_area_integral(fluxes%heat_added, G, scale=US%QRZ_T_to_W_m2) call post_data(handles%id_total_heat_added, total_transport, diag) endif @@ -2807,7 +2811,7 @@ end subroutine forcing_diagnostics !> Conditionally allocate fields within the forcing type -subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, iceberg, salt) +subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, iceberg, salt, fix_accum_bug) 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 @@ -2817,6 +2821,8 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic logical, optional, intent(in) :: shelf !< If present and true, allocate fluxes for ice-shelf logical, optional, intent(in) :: iceberg !< If present and true, allocate fluxes for icebergs logical, optional, intent(in) :: salt !< If present and true, allocate salt fluxes + logical, optional, intent(in) :: fix_accum_bug !< If present and true, avoid using a bug in + !! accumulation of ustar_gustless ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -2872,6 +2878,8 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic call myAlloc(fluxes%area_berg,isd,ied,jsd,jed, iceberg) call myAlloc(fluxes%mass_berg,isd,ied,jsd,jed, iceberg) + if (present(fix_accum_bug)) fluxes%gustless_accum_bug = .not.fix_accum_bug + end subroutine allocate_forcing_type !> Conditionally allocate fields within the mechanical forcing type diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2fdfad4b59..d4debfccea 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1960,8 +1960,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(dhdt*dhdx, cff_new*rx_max) ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) if (gamma_u < 1.0) then rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new @@ -2102,8 +2102,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdy = segment%grad_tan(j+1,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(dhdt*dhdx, cff_new*rx_max) ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) rx_tang_obl(I,j,k) = rx_new ry_tang_obl(i,J,k) = ry_new @@ -2205,8 +2205,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(dhdt*dhdx, cff_new*rx_max) ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) if (gamma_u < 1.0) then rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new @@ -2347,8 +2347,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdy = segment%grad_tan(j+1,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(dhdt*dhdx, cff_new*rx_max) ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) rx_tang_obl(I,j,k) = rx_new ry_tang_obl(i,J,k) = ry_new @@ -2449,8 +2449,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(dhdt*dhdy, cff_new*ry_max) rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) if (gamma_u < 1.0) then rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new @@ -2591,8 +2591,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdx = segment%grad_tan(i+1,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(dhdt*dhdy, cff_new*ry_max) rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) rx_tang_obl(I,j,k) = rx_new ry_tang_obl(i,J,k) = ry_new @@ -2694,8 +2694,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(dhdt*dhdy, cff_new*ry_max) rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) if (gamma_u < 1.0) then rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new @@ -2836,8 +2836,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdx = segment%grad_tan(i+1,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(dhdt*dhdy, cff_new*ry_max) rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) rx_tang_obl(I,j,k) = rx_new ry_tang_obl(i,J,k) = ry_new diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 5dfa91fee2..93fffb3c51 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -40,11 +40,13 @@ module MOM_variables SST, & !< The sea surface temperature [degC]. SSS, & !< The sea surface salinity [ppt ~> psu or gSalt/kg]. sfc_density, & !< The mixed layer density [kg m-3]. - Hml, & !< The mixed layer depth [m]. - u, & !< The mixed layer zonal velocity [m s-1]. - v, & !< The mixed layer meridional velocity [m s-1]. - sea_lev, & !< The sea level [m]. If a reduced surface gravity is - !! used, that is compensated for in sea_lev. + Hml, & !< The mixed layer depth [m]. + u, & !< The mixed layer zonal velocity [m s-1]. + v, & !< The mixed layer meridional velocity [m s-1]. + sea_lev, & !< The sea level [m]. If a reduced surface gravity is + !! used, that is compensated for in sea_lev. + frazil, & !< The energy needed to heat the ocean column to the freezing point during + !! the call to step_MOM [J m-2]. melt_potential, & !< Instantaneous amount of heat that can be used to melt sea ice [J m-2]. !! This is computed w.r.t. surface freezing temperature. ocean_mass, & !< The total mass of the ocean [kg m-2]. @@ -62,9 +64,6 @@ module MOM_variables !! conservative temperature in [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable SSS is actually the !! absolute salinity in [g/kg]. - real, pointer, dimension(:,:) :: frazil => NULL() - !< The energy needed to heat the ocean column to the freezing point during the call - !! to step_MOM [J m-2]. type(coupler_2d_bc_type) :: tr_fields !< A structure that may contain an !! array of named fields describing tracer-related quantities. !### NOTE: ALL OF THE ARRAYS IN TR_FIELDS USE THE COUPLER'S INDEXING CONVENTION AND HAVE NO @@ -84,7 +83,7 @@ module MOM_variables real :: P_Ref !< The coordinate-density reference pressure [Pa]. !! This is the pressure used to calculate Rml from !! T and S when eqn_of_state is associated. - real :: C_p !< The heat capacity of seawater [J degC-1 kg-1]. + real :: C_p !< The heat capacity of seawater [Q degC-1 ~> J degC-1 kg-1]. !! When conservative temperature is used, this is !! constant and exactly 3991.86795711963 J degC-1 kg-1. logical :: T_is_conT = .false. !< If true, the temperature variable tv%T is @@ -97,7 +96,7 @@ module MOM_variables real, dimension(:,:), pointer :: frazil => NULL() !< The energy needed to heat the ocean column to the !! freezing point since calculate_surface_state was2 - !! last called [J m-2]. + !! last called [Q Z R ~> J m-2]. real, dimension(:,:), pointer :: salt_deficit => NULL() !< The salt needed to maintain the ocean column !! at a minimum salinity of MIN_SALINITY since the last time @@ -111,7 +110,7 @@ module MOM_variables real, dimension(:,:), pointer :: internal_heat => NULL() !< Any internal or geothermal heat sources that !! have been applied to the ocean since the last call to - !! calculate_surface_state [degC kg m-2]. + !! calculate_surface_state [degC R Z ~> degC kg m-2]. end type thermo_var_ptrs !> Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90. @@ -225,7 +224,7 @@ module MOM_variables real, pointer, dimension(:,:) :: nkml_visc_v => NULL() !< The number of layers in the viscous surface mixed layer at v-points [nondim]. real, pointer, dimension(:,:) :: & - MLD => NULL() !< Instantaneous active mixing layer depth [H ~> m or kg m-2]. + MLD => NULL() !< Instantaneous active mixing layer depth in unscaled MKS units [m]. real, pointer, dimension(:,:,:) :: & Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z T-1 ~> m s-1]. Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1]. @@ -293,7 +292,7 @@ module MOM_variables !> Allocates the fields for the surface (return) properties of !! the ocean model. Unused fields are unallocated. subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & - gas_fields_ocn, use_meltpot, use_iceshelves) + gas_fields_ocn, use_meltpot, use_iceshelves, omit_frazil) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. @@ -308,9 +307,11 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & logical, optional, intent(in) :: use_meltpot !< If true, allocate the space for melt potential logical, optional, intent(in) :: use_iceshelves !< If true, allocate the space for the stresses !! under ice shelves. + logical, optional, intent(in) :: omit_frazil !< If present and false, do not allocate the space to + !! pass frazil fluxes to the coupler ! local variables - logical :: use_temp, alloc_integ, use_melt_potential, alloc_iceshelves + logical :: use_temp, alloc_integ, use_melt_potential, alloc_iceshelves, alloc_frazil integer :: is, ie, js, je, isd, ied, jsd, jed integer :: isdB, iedB, jsdB, jedB @@ -322,6 +323,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & alloc_integ = .true. ; if (present(do_integrals)) alloc_integ = do_integrals use_melt_potential = .false. ; if (present(use_meltpot)) use_melt_potential = use_meltpot alloc_iceshelves = .false. ; if (present(use_iceshelves)) alloc_iceshelves = use_iceshelves + alloc_frazil = .true. ; if (present(omit_frazil)) alloc_frazil = .not.omit_frazil if (sfc_state%arrays_allocated) return @@ -331,6 +333,9 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & else allocate(sfc_state%sfc_density(isd:ied,jsd:jed)) ; sfc_state%sfc_density(:,:) = 0.0 endif + if (use_temp .and. alloc_frazil) then + allocate(sfc_state%frazil(isd:ied,jsd:jed)) ; sfc_state%frazil(:,:) = 0.0 + endif allocate(sfc_state%sea_lev(isd:ied,jsd:jed)) ; sfc_state%sea_lev(:,:) = 0.0 allocate(sfc_state%Hml(isd:ied,jsd:jed)) ; sfc_state%Hml(:,:) = 0.0 allocate(sfc_state%u(IsdB:IedB,jsd:jed)) ; sfc_state%u(:,:) = 0.0 @@ -461,7 +466,7 @@ subroutine MOM_thermovar_chksum(mesg, tv, G) if (associated(tv%S)) & call hchksum(tv%S, mesg//" tv%S", G%HI) if (associated(tv%frazil)) & - call hchksum(tv%frazil, mesg//" tv%frazil", G%HI) + call hchksum(tv%frazil, mesg//" tv%frazil", G%HI, scale=G%US%Q_to_J_kg*G%US%R_to_kg_m3*G%US%Z_to_m) if (associated(tv%salt_deficit)) & call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=G%US%R_to_kg_m3*G%US%Z_to_m) if (associated(tv%TempxPmE)) & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 4caabf94a6..17996d785a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1291,7 +1291,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv ! Use TEOS-10 function calls convert T&S diagnostics from conservative temp ! to potential temperature. do j=js,je ; do i=is,ie - work_2d(i,j) = gsw_pt_from_ct(sfc_state%SSS(i,j),sfc_state%SST(i,j)) + work_2d(i,j) = gsw_pt_from_ct(sfc_state%SSS(i,j), sfc_state%SST(i,j)) enddo ; enddo if (IDs%id_sst > 0) call post_data(IDs%id_sst, work_2d, diag, mask=G%mask2dT) else @@ -1793,7 +1793,8 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) endif if (associated(tv%frazil)) then IDs%id_fraz = register_diag_field('ocean_model', 'frazil', diag%axesT1, Time, & - 'Heat from frazil formation', 'W m-2', conversion=US%s_to_T, cmor_field_name='hfsifrazil', & + 'Heat from frazil formation', 'W m-2', conversion=US%QRZ_T_to_W_m2, & + cmor_field_name='hfsifrazil', & cmor_standard_name='heat_flux_into_sea_water_due_to_frazil_ice_formation', & cmor_long_name='Heat Flux into Sea Water due to Frazil Ice Formation') endif @@ -1801,12 +1802,13 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) IDs%id_salt_deficit = register_diag_field('ocean_model', 'salt_deficit', diag%axesT1, Time, & 'Salt sink in ocean due to ice flux', & - 'psu m-2 s-1', conversion=G%US%R_to_kg_m3*G%US%Z_to_m*US%s_to_T) + 'psu m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) IDs%id_Heat_PmE = register_diag_field('ocean_model', 'Heat_PmE', diag%axesT1, Time, & 'Heat flux into ocean from mass flux into ocean', & - 'W m-2', conversion=G%US%R_to_kg_m3*G%US%Z_to_m*US%s_to_T) + 'W m-2', conversion=US%QRZ_T_to_W_m2) IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time,& - 'Heat flux into ocean from geothermal or other internal sources', 'W m-2', conversion=US%s_to_T) + 'Heat flux into ocean from geothermal or other internal sources', & + 'W m-2', conversion=US%QRZ_T_to_W_m2) end subroutine register_surface_diags @@ -2022,11 +2024,12 @@ subroutine write_static_fields(G, GV, US, tv, diag) use_temperature = associated(tv%T) if (use_temperature) then - id = register_static_field('ocean_model','C_p', diag%axesNull, & - 'heat capacity of sea water', 'J kg-1 K-1', cmor_field_name='cpocean', & - cmor_standard_name='specific_heat_capacity_of_sea_water', & - cmor_long_name='specific_heat_capacity_of_sea_water') - if (id > 0) call post_data(id, tv%C_p, diag, .true.) + id = register_static_field('ocean_model','C_p', diag%axesNull, & + 'heat capacity of sea water', 'J kg-1 K-1', conversion=US%Q_to_J_kg, & + cmor_field_name='cpocean', & + cmor_standard_name='specific_heat_capacity_of_sea_water', & + cmor_long_name='specific_heat_capacity_of_sea_water') + if (id > 0) call post_data(id, tv%C_p, diag, .true.) endif end subroutine write_static_fields diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 6affbab231..6a0334e3ac 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -52,9 +52,9 @@ module MOM_sum_output !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. type :: Depth_List - real :: depth !< A depth [m]. - real :: area !< The cross-sectional area of the ocean at that depth [m2]. - real :: vol_below !< The ocean volume below that depth [m3]. + real :: depth !< A depth [Z ~> m]. + real :: area !< The cross-sectional area of the ocean at that depth [L2 ~> m2]. + real :: vol_below !< The ocean volume below that depth [Z m2 ~> m3]. end type Depth_List !> The control structure for the MOM_sum_output module @@ -324,7 +324,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces [Z ~> m]. - real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT [m2]. + real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT [L2 ~> m2]. real :: KE(SZK_(G)) ! The total kinetic energy of a layer [J]. real :: PE(SZK_(G)+1)! The available potential energy of an interface [J]. real :: KE_tot ! The total kinetic energy [J]. @@ -336,8 +336,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ ! all layers [J] (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by ! the total mass of the ocean [m2 s-2]. - real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer [Z m2 ~> m3]. - real :: volbelow ! The volume of all layers beneath an interface [Z m2 ~> m3]. + real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer [Z L2 ~> m3]. + real :: volbelow ! The volume of all layers beneath an interface [Z L2 ~> m3]. real :: mass_lay(SZK_(G)) ! The mass of fluid in a layer [kg]. real :: mass_tot ! The total mass of the ocean [kg]. real :: vol_tot ! The total ocean volume [m3]. @@ -386,9 +386,11 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ PE_pt ! The potential energy at each point [J]. real, dimension(SZI_(G),SZJ_(G)) :: & Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. - real :: H_to_kg_m2 ! Local copy of a unit conversion factor. + real :: HL2_to_kg ! A conversion factor form a thickness-volume to mass [kg H-1 L-2 ~> kg m-3 or 1] real :: KE_scale_factor ! The combination of unit rescaling factors in the kinetic energy - ! calculation [kg T2 L-2 s-2 H-1 ~> kg m-3 or nondim] + ! calculation [kg T2 H-1 L-2 s-2 ~> kg m-3 or nondim] + real :: PE_scale_factor ! The combination of unit rescaling factors in the potential energy + ! calculation [kg T2 R-1 Z-1 L-2 s-2 ~> nondim] integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. integer :: i, j, k, is, ie, js, je, ns, nz, m, Isq, Ieq, Jsq, Jeq @@ -479,19 +481,20 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - H_to_kg_m2 = GV%H_to_kg_m2 + + HL2_to_kg = GV%H_to_kg_m2*US%L_to_m**2 if (.not.associated(CS)) call MOM_error(FATAL, & "write_energy: Module must be initialized before it is used.") do j=js,je ; do i=is,ie - areaTm(i,j) = G%mask2dT(i,j)*US%L_to_m**2*G%areaT(i,j) + areaTm(i,j) = G%mask2dT(i,j)*G%areaT(i,j) enddo ; enddo if (GV%Boussinesq) then tmp1(:,:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = h(i,j,k) * (H_to_kg_m2*areaTm(i,j)) + tmp1(i,j,k) = h(i,j,k) * (HL2_to_kg*areaTm(i,j)) enddo ; enddo ; enddo ! This block avoids using the points beyond an open boundary condition @@ -523,27 +526,27 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - do k=1,nz ; vol_lay(k) = (GV%H_to_Z/H_to_kg_m2)*mass_lay(k) ; enddo + do k=1,nz ; vol_lay(k) = (US%m_to_L**2*GV%H_to_Z/GV%H_to_kg_m2)*mass_lay(k) ; enddo else tmp1(:,:,:) = 0.0 if (CS%do_APE_calc) then do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = H_to_kg_m2 * h(i,j,k) * areaTm(i,j) + tmp1(i,j,k) = HL2_to_kg * h(i,j,k) * areaTm(i,j) enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) call find_eta(h, tv, G, GV, US, eta) do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = US%Z_to_m*(eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) + tmp1(i,j,k) = US%Z_to_m*US%L_to_m**2*(eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo vol_tot = reproducing_sum(tmp1, sums=vol_lay) - do k=1,nz ; vol_lay(k) = US%m_to_Z * vol_lay(k) ; enddo + do k=1,nz ; vol_lay(k) = US%m_to_Z*US%m_to_L**2 * vol_lay(k) ; enddo else do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = H_to_kg_m2 * h(i,j,k) * areaTm(i,j) + tmp1(i,j,k) = HL2_to_kg * h(i,j,k) * areaTm(i,j) enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - do k=1,nz ; vol_lay(k) = US%m_to_Z * (mass_lay(k) / (US%R_to_kg_m3*GV%Rho0)) ; enddo + do k=1,nz ; vol_lay(k) = US%m_to_Z*US%m_to_L**2*US%kg_m3_to_R * (mass_lay(k) / GV%Rho0) ; enddo endif endif ! Boussinesq @@ -654,10 +657,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ enddo Z_0APE(nz+1) = CS%DL(2)%depth - ! Calculate the Available Potential Energy integrated over each - ! interface. With a nonlinear equation of state or with a bulk - ! mixed layer this calculation is only approximate. With an ALE model - ! this does not make sense. + ! Calculate the Available Potential Energy integrated over each interface. With a nonlinear + ! equation of state or with a bulk mixed layer this calculation is only approximate. + ! With an ALE model this does not make sense and should be revisited. + PE_scale_factor = US%Z_to_m*US%L_to_m**2*US%L_T_to_m_s**2*US%R_to_kg_m3 PE_pt(:,:,:) = 0.0 if (GV%Boussinesq) then do j=js,je ; do i=is,ie @@ -667,7 +670,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) hbot = Z_0APE(K) - G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(US%R_to_kg_m3*GV%Rho0*GV%g_prime(K)) * & + PE_pt(i,j,K) = (0.5 * PE_scale_factor * areaTm(i,j)) * (GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -676,7 +679,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do k=nz,1,-1 hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(Z_0APE(K) - G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(US%R_to_kg_m3*GV%Rho0*GV%g_prime(K))) * & + PE_pt(i,j,K) = (0.5 * PE_scale_factor * areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -690,7 +693,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif ! Calculate the Kinetic Energy integrated over each layer. - KE_scale_factor = GV%H_to_kg_m2*US%L_T_to_m_s**2 + KE_scale_factor = HL2_to_kg*US%L_T_to_m_s**2 tmp1(:,:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (0.25 * KE_scale_factor * (areaTm(i,j) * h(i,j,k))) * & @@ -705,9 +708,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ Temp_int(:,:) = 0.0 ; Salt_int(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie Salt_int(i,j) = Salt_int(i,j) + tv%S(i,j,k) * & - (h(i,j,k)*(H_to_kg_m2 * areaTm(i,j))) - Temp_int(i,j) = Temp_int(i,j) + (tv%C_p * tv%T(i,j,k)) * & - (h(i,j,k)*(H_to_kg_m2 * areaTm(i,j))) + (h(i,j,k)*(HL2_to_kg * areaTm(i,j))) + Temp_int(i,j) = Temp_int(i,j) + (US%Q_to_J_kg*tv%C_p * tv%T(i,j,k)) * & + (h(i,j,k)*(HL2_to_kg * areaTm(i,j))) enddo ; enddo ; enddo Salt = reproducing_sum(Salt_int, EFP_sum=salt_EFP) Heat = reproducing_sum(Temp_int, EFP_sum=heat_EFP) @@ -778,7 +781,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ if (CS%use_temperature) then salin = Salt / mass_tot ; salin_anom = Salt_anom / mass_tot ! salin_chg = Salt_chg / mass_tot - temp = heat / (mass_tot*tv%C_p) ; temp_anom = Heat_anom / (mass_tot*tv%C_p) + temp = heat / (mass_tot*US%Q_to_J_kg*tv%C_p) ; temp_anom = Heat_anom / (mass_tot*US%Q_to_J_kg*tv%C_p) endif En_mass = toten / mass_tot @@ -962,8 +965,8 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) ! over a time step and summed over space [ppt kg]. real :: heat_input ! The total heat added by boundary fluxes, integrated ! over a time step and summed over space [J]. - real :: C_p ! The heat capacity of seawater [J degC-1 kg-1]. real :: RZL2_to_kg ! A combination of scaling factors for mass [kg R-1 Z-1 L-2 ~> 1] + real :: QRZL2_to_J ! A combination of scaling factors for heat [J Q-1 R-1 Z-1 L-2 ~> 1] type(EFP_type) :: & FW_in_EFP, & ! Extended fixed point version of FW_input [kg] @@ -974,8 +977,9 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - C_p = fluxes%C_p + RZL2_to_kg = US%L_to_m**2*US%R_to_kg_m3*US%Z_to_m + QRZL2_to_J = RZL2_to_kg*US%Q_to_J_kg FW_in(:,:) = 0.0 ; FW_input = 0.0 if (associated(fluxes%evap)) then @@ -1000,18 +1004,19 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) if (CS%use_temperature) then if (associated(fluxes%sw)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*US%T_to_s*US%L_to_m**2*G%areaT(i,j) * (fluxes%sw(i,j) + & + heat_in(i,j) = heat_in(i,j) + dt * QRZL2_to_J * G%areaT(i,j) * (fluxes%sw(i,j) + & (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif if (associated(fluxes%seaice_melt_heat)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*US%T_to_s*US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) + heat_in(i,j) = heat_in(i,j) + dt * QRZL2_to_J * G%areaT(i,j) * & + fluxes%seaice_melt_heat(i,j) enddo ; enddo ; endif ! smg: new code ! include heat content from water transport across ocean surface ! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) + dt*RZL2_to_kg*G%areaT(i,j) * & +! heat_in(i,j) = heat_in(i,j) + dt * QRZL2_to_J * G%areaT(i,j) * & ! (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_cond(i,j) + (fluxes%heat_content_vprec(i,j) & @@ -1021,27 +1026,25 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) ! smg: old code if (associated(tv%TempxPmE)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * RZL2_to_kg*G%areaT(i,j)) * tv%TempxPmE(i,j) + heat_in(i,j) = heat_in(i,j) + (fluxes%C_p * QRZL2_to_J*G%areaT(i,j)) * tv%TempxPmE(i,j) enddo ; enddo elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * sfc_state%SST(i,j)) * FW_in(i,j) + heat_in(i,j) = heat_in(i,j) + (US%Q_to_J_kg*fluxes%C_p * sfc_state%SST(i,j)) * FW_in(i,j) enddo ; enddo endif - ! The following heat sources may or may not be used. if (associated(tv%internal_heat)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * US%L_to_m**2*G%areaT(i,j)) * & - tv%internal_heat(i,j) + heat_in(i,j) = heat_in(i,j) + (fluxes%C_p * QRZL2_to_J*G%areaT(i,j)) * tv%internal_heat(i,j) enddo ; enddo endif if (associated(tv%frazil)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + US%L_to_m**2*G%areaT(i,j) * tv%frazil(i,j) + heat_in(i,j) = heat_in(i,j) + QRZL2_to_J * G%areaT(i,j) * tv%frazil(i,j) enddo ; enddo ; endif if (associated(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*US%T_to_s*US%L_to_m**2*G%areaT(i,j)*fluxes%heat_added(i,j) + heat_in(i,j) = heat_in(i,j) + QRZL2_to_J * dt*G%areaT(i,j) * fluxes%heat_added(i,j) enddo ; enddo ; endif ! if (associated(sfc_state%sw_lost)) then ; do j=js,je ; do i=is,ie ! heat_in(i,j) = heat_in(i,j) - US%L_to_m**2*G%areaT(i,j) * sfc_state%sw_lost(i,j) @@ -1112,13 +1115,13 @@ subroutine create_depth_list(G, CS) ! Local variables real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: & Dlist, & !< The global list of bottom depths [Z ~> m]. - AreaList !< The global list of cell areas [m2]. + AreaList !< The global list of cell areas [L2 ~> m2]. integer, dimension(G%Domain%niglobal*G%Domain%njglobal+1) :: & indx2 !< The position of an element in the original unsorted list. real :: Dnow !< The depth now being considered for sorting [Z ~> m]. real :: Dprev !< The most recent depth that was considered [Z ~> m]. - real :: vol !< The running sum of open volume below a deptn [Z m2 ~> m3]. - real :: area !< The open area at the current depth [m2]. + real :: vol !< The running sum of open volume below a deptn [Z L2 ~> m3]. + real :: area !< The open area at the current depth [L2 ~> m2]. real :: D_list_prev !< The most recent depth added to the list [Z ~> m]. logical :: add_to_list !< This depth should be included as an entry on the list. @@ -1139,7 +1142,7 @@ subroutine create_depth_list(G, CS) list_pos = (j_global-1)*G%Domain%niglobal + i_global Dlist(list_pos) = G%bathyT(i,j) - Arealist(list_pos) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) + Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo ! These sums reproduce across PEs because the arrays are only nonzero on one PE. @@ -1307,12 +1310,12 @@ subroutine write_depth_list(G, US, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" depth "//trim(NF90_STRERROR(status))) - do k=1,list_size ; tmp(k) = CS%DL(k)%area ; enddo + do k=1,list_size ; tmp(k) = US%L_to_m**2*CS%DL(k)%area ; enddo status = NF90_PUT_VAR(ncid, Aid, tmp) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" area "//trim(NF90_STRERROR(status))) - do k=1,list_size ; tmp(k) = US%Z_to_m*CS%DL(k)%vol_below ; enddo + do k=1,list_size ; tmp(k) = US%Z_to_m*US%L_to_m**2*CS%DL(k)%vol_below ; enddo status = NF90_PUT_VAR(ncid, Vid, tmp) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) @@ -1447,7 +1450,7 @@ subroutine read_depth_list(G, US, CS, filename) " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) - do k=1,list_size ; CS%DL(k)%area = tmp(k) ; enddo + do k=1,list_size ; CS%DL(k)%area = US%m_to_L**2*tmp(k) ; enddo var_name = "vol_below" var_msg = trim(var_name)//" in "//trim(filename) @@ -1460,7 +1463,7 @@ subroutine read_depth_list(G, US, CS, filename) " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) - do k=1,list_size ; CS%DL(k)%vol_below = US%m_to_Z*tmp(k) ; enddo + do k=1,list_size ; CS%DL(k)%vol_below = US%m_to_Z*US%m_to_L**2*tmp(k) ; enddo status = NF90_CLOSE(ncid) if (status /= NF90_NOERR) call MOM_error(WARNING, mdl// & diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index fe7f95fc79..63d89276a0 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -20,6 +20,8 @@ module MOM_unit_scaling real :: T_to_s !< A constant that translates the units of time to seconds. real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed. real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density. + real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram. + real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy. ! These are useful combinations of the fundamental scale conversion factors above. real :: Z_to_L !< Convert vertical distances to lateral lengths @@ -29,12 +31,15 @@ module MOM_unit_scaling real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2. real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1. real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1. + real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1. + real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2. ! These are used for changing scaling across restarts. real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. real :: m_to_L_restart = 0.0 !< A copy of the m_to_L that is used in restart files. real :: s_to_T_restart = 0.0 !< A copy of the s_to_T that is used in restart files. real :: kg_m3_to_R_restart = 0.0 !< A copy of the kg_m3_to_R that is used in restart files. + real :: J_kg_to_Q_restart = 0.0 !< A copy of the J_kg_to_Q that is used in restart files. end type unit_scale_type contains @@ -47,8 +52,8 @@ subroutine unit_scaling_init( param_file, US ) ! This routine initializes a unit_scale_type structure (US). ! Local variables - integer :: Z_power, L_power, T_power, R_power - real :: Z_rescale_factor, L_rescale_factor, T_rescale_factor, R_rescale_factor + integer :: Z_power, L_power, T_power, R_power, Q_power + real :: Z_rescale_factor, L_rescale_factor, T_rescale_factor, R_rescale_factor, Q_rescale_factor ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = "MOM_unit_scaling" @@ -76,6 +81,10 @@ subroutine unit_scaling_init( param_file, US ) "An integer power of 2 that is used to rescale the model's "//& "intenal units of density. Valid values range from -300 to 300.", & units="nondim", default=0, debuggingParam=.true.) + call get_param(param_file, mdl, "Q_RESCALE_POWER", Q_power, & + "An integer power of 2 that is used to rescale the model's "//& + "intenal units of heat content. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) if (abs(Z_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") if (abs(L_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& @@ -84,6 +93,8 @@ subroutine unit_scaling_init( param_file, US ) "T_RESCALE_POWER is outside of the valid range of -300 to 300.") if (abs(R_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "R_RESCALE_POWER is outside of the valid range of -300 to 300.") + if (abs(Q_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& + "Q_RESCALE_POWER is outside of the valid range of -300 to 300.") Z_rescale_factor = 1.0 if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power @@ -105,6 +116,11 @@ subroutine unit_scaling_init( param_file, US ) US%R_to_kg_m3 = 1.0 * R_rescale_factor US%kg_m3_to_R = 1.0 / R_rescale_factor + Q_Rescale_factor = 1.0 + if (Q_power /= 0) Q_Rescale_factor = 2.0**Q_power + US%Q_to_J_kg = 1.0 * Q_Rescale_factor + US%J_kg_to_Q = 1.0 / Q_Rescale_factor + ! These are useful combinations of the fundamental scale conversion factors set above. US%Z_to_L = US%Z_to_m * US%m_to_L US%L_to_Z = US%L_to_m * US%m_to_Z @@ -114,6 +130,8 @@ subroutine unit_scaling_init( param_file, US ) ! It does not look like US%m_s2_to_L_T2 would be used, so it does not exist. US%Z2_T_to_m2_s = US%Z_to_m**2 * US%s_to_T US%m2_s_to_Z2_T = US%m_to_Z**2 * US%T_to_s + US%W_m2_to_QRZ_T = US%J_kg_to_Q * US%kg_m3_to_R * US%m_to_Z * US%T_to_s + US%QRZ_T_to_W_m2 = US%Q_to_J_kg * US%R_to_kg_m3 * US%Z_to_m * US%s_to_T end subroutine unit_scaling_init @@ -126,6 +144,7 @@ subroutine fix_restart_unit_scaling(US) US%m_to_L_restart = US%m_to_L US%s_to_T_restart = US%s_to_T US%kg_m3_to_R_restart = US%kg_m3_to_R + US%J_kg_to_Q_restart = US%J_kg_to_Q end subroutine fix_restart_unit_scaling diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index d82910df81..50282a319b 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -975,7 +975,7 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) endif if (associated(fluxes%sens)) & - fluxes%sens(i,j) = -frac_area*ISS%tflux_ocn(i,j)*CS%flux_factor + fluxes%sens(i,j) = -frac_area*ISS%tflux_ocn(i,j)*US%W_m2_to_QRZ_T*CS%flux_factor if (associated(fluxes%salt_flux)) & fluxes%salt_flux(i,j) = frac_area * ISS%salt_flux(i,j)*CS%flux_factor endif ; enddo ; enddo @@ -1059,9 +1059,9 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) ! Note the following is hard coded for ISOMIP if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then fluxes%vprec(i,j) = -mean_melt_flux * CS%density_ice/1000. ! evap is negative - fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! W /m^2 ! Rescale fluxes%vprec to the proper units. fluxes%vprec(i,j) = US%kg_m3_to_R*US%m_to_Z*US%T_to_s * fluxes%vprec(i,j) + fluxes%sens(i,j) = fluxes%vprec(i,j) * US%J_kg_to_Q*CS%Cp * CS%T0 ! [ Q R Z T-1 ~> W /m^2 ] fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3 ! kg (salt)/(m^2 s) endif enddo ; enddo diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 4042681803..533fb5d9ec 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -158,11 +158,10 @@ subroutine iceberg_fluxes(G, US, fluxes, use_ice_shelf, sfc_state, & ! form of surface layer evaporation [R Z T-1 ~> kg m-2 s-1]. Update lprec in the ! control structure for diagnostic purposes. - if (associated(sfc_state%frazil)) then + if (allocated(sfc_state%frazil)) then fraz = US%kg_m3_to_R*US%m_to_Z*sfc_state%frazil(i,j) * I_dt_LHF - if (associated(fluxes%evap)) & - fluxes%evap(i,j) = fluxes%evap(i,j) - fraz - ! fluxes%lprec(i,j) = fluxes%lprec(i,j) - fraz + if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz + ! if (associated(fluxes%lprec)) fluxes%lprec(i,j) = fluxes%lprec(i,j) - fraz sfc_state%frazil(i,j) = 0.0 endif diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index fe1ae86ee6..923b2b4899 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1,3 +1,4 @@ + !> Provides functions for some diabatic processes such as fraxil, brine rejection, !! tendency due to surface flux divergence. module MOM_diabatic_aux @@ -81,11 +82,11 @@ module MOM_diabatic_aux real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to !! avoid grounding [H T-1 ~> m s-1] real, allocatable, dimension(:,:,:) :: penSW_diag !< Heating in a layer from convergence of - !! penetrative SW [W m-2] + !! penetrative SW [Q R Z T-1 ~> W m-2] real, allocatable, dimension(:,:,:) :: penSWflux_diag !< Penetrative SW flux at base of grid - !! layer [W m-2] + !! layer [Q R Z T-1 ~> W m-2] real, allocatable, dimension(:,:) :: nonpenSW_diag !< Non-downwelling SW radiation at ocean - !! surface [W m-2] + !! surface [Q R Z T-1 ~> W m-2] end type diabatic_aux_CS @@ -98,14 +99,15 @@ module MOM_diabatic_aux !> Frazil formation keeps the temperature above the freezing point. !! This subroutine warms any water that is colder than the (currently !! surface) freezing point up to the freezing point and accumulates -!! the required heat (in J m-2) in tv%frazil. -subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) +!! the required heat (in [Q R Z ~> J m-2]) in tv%frazil. +subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) 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_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any available !! thermodynamic fields. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init. real, dimension(SZI_(G),SZJ_(G)), & @@ -114,12 +116,12 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) ! Local variables real, dimension(SZI_(G)) :: & - fraz_col, & ! The accumulated heat requirement due to frazil [J]. + fraz_col, & ! The accumulated heat requirement due to frazil [Q R Z ~> J m-2]. T_freeze, & ! The freezing potential temperature at the current salinity [degC]. ps ! pressure real, dimension(SZI_(G),SZK_(G)) :: & pressure ! The pressure at the middle of each layer [Pa]. - real :: hc ! A layer's heat capacity [J m-2 degC-1]. + real :: hc ! A layer's heat capacity [Q R Z degC-1 ~> J m-2 degC-1]. logical :: T_fr_set ! True if the freezing point has been calculated for a ! row of points. integer :: i, j, k, is, ie, js, je, nz @@ -167,9 +169,9 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) if (tv%T(i,j,1) > T_freeze(i)) then ! If frazil had previously been formed, but the surface temperature is now ! above freezing, cool the surface layer with the frazil heat deficit. - hc = (tv%C_p*GV%H_to_kg_m2) * h(i,j,1) + hc = (tv%C_p*GV%H_to_RZ) * h(i,j,1) if (tv%frazil(i,j) - hc * (tv%T(i,j,1) - T_freeze(i)) <= 0.0) then - tv%T(i,j,1) = tv%T(i,j,1) - tv%frazil(i,j)/hc + tv%T(i,j,1) = tv%T(i,j,1) - tv%frazil(i,j) / hc tv%frazil(i,j) = 0.0 else tv%frazil(i,j) = tv%frazil(i,j) - hc * (tv%T(i,j,1) - T_freeze(i)) @@ -190,7 +192,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) T_fr_set = .true. endif - hc = (tv%C_p*GV%H_to_kg_m2) * h(i,j,k) + hc = (tv%C_p*GV%H_to_RZ) * h(i,j,k) if (h(i,j,k) <= 10.0*GV%Angstrom_H) then ! Very thin layers should not be cooled by the frazil flux. if (tv%T(i,j,k) < T_freeze(i)) then @@ -199,7 +201,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) endif else if (fraz_col(i) + hc * (T_freeze(i) - tv%T(i,j,k)) <= 0.0) then - tv%T(i,j,k) = tv%T(i,j,k) - fraz_col(i)/hc + tv%T(i,j,k) = tv%T(i,j,k) - fraz_col(i) / hc fraz_col(i) = 0.0 else fraz_col(i) = fraz_col(i) + hc * (T_freeze(i) - tv%T(i,j,k)) @@ -653,16 +655,18 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) end subroutine find_uv_at_h -subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp, tracer_flow_CSp) +subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity_CSp, tracer_flow_CSp) type(optics_type), pointer :: optics !< An optics structure that has will contain !! information about shortwave fluxes and absorption. type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs 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(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux type(opacity_CS), pointer :: opacity_CSp !< The control structure for the opacity module. - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure of the tracer modules. + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure + !! organizing the tracer modules. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] @@ -690,7 +694,7 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp, tracer_flow if (CS%id_chl > 0) call post_data(CS%id_chl, chl_2d, CS%diag) call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp, chl_2d=chl_2d) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp, chl_2d=chl_2d) else if (.not.associated(tracer_flow_CSp)) call MOM_error(FATAL, & "The tracer flow control structure must be associated when the model sets "//& @@ -700,11 +704,11 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp, tracer_flow if (CS%id_chl > 0) call post_data(CS%id_chl, chl_3d(:,:,1), CS%diag) call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp, chl_3d=chl_3d) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp, chl_3d=chl_3d) endif else call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp) + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, US, opacity_CSp) endif end subroutine set_pen_shortwave @@ -1301,13 +1305,13 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t tv%T(i,j,k) = T2d(i,k) enddo ; enddo - ! Diagnose heating [W m-2] applied to a grid cell from SW penetration + ! Diagnose heating [Q R Z T-1 ~> W m-2] applied to a grid cell from SW penetration ! Also diagnose the penetrative SW heat flux at base of layer. if (CS%id_penSW_diag > 0 .or. CS%id_penSWflux_diag > 0) then ! convergence of SW into a layer do k=1,nz ; do i=is,ie - CS%penSW_diag(i,j,k) = (T2d(i,k)-CS%penSW_diag(i,j,k))*h(i,j,k) * US%s_to_T*Idt * tv%C_p * GV%H_to_kg_m2 + CS%penSW_diag(i,j,k) = (T2d(i,k)-CS%penSW_diag(i,j,k))*h(i,j,k) * Idt * tv%C_p * GV%H_to_RZ enddo ; enddo ! Perform a cumulative sum upwards from bottom to @@ -1327,7 +1331,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Fill CS%nonpenSW_diag if (CS%id_nonpenSW_diag > 0) then do i=is,ie - CS%nonpenSW_diag(i,j) = nonpenSW(i) + CS%nonpenSW_diag(i,j) = nonpenSW(i) * Idt * tv%C_p * GV%H_to_RZ enddo endif @@ -1493,30 +1497,29 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori ! diagnostic for heating of a grid cell from convergence of SW heat into the cell CS%id_penSW_diag = register_diag_field('ocean_model', 'rsdoabsorb', & diag%axesTL, Time, 'Convergence of Penetrative Shortwave Flux in Sea Water Layer',& - 'W m-2', standard_name='net_rate_of_absorption_of_shortwave_energy_in_ocean_layer',v_extensive=.true.) + 'W m-2', conversion=US%QRZ_T_to_W_m2, & + standard_name='net_rate_of_absorption_of_shortwave_energy_in_ocean_layer', v_extensive=.true.) ! diagnostic for penetrative SW heat flux at top interface of tracer cell (nz+1 interfaces) ! k=1 gives penetrative SW at surface; SW(k=nz+1)=0 (no penetration through rock). CS%id_penSWflux_diag = register_diag_field('ocean_model', 'rsdo', & diag%axesTi, Time, 'Downwelling Shortwave Flux in Sea Water at Grid Cell Upper Interface',& - 'W m-2', standard_name='downwelling_shortwave_flux_in_sea_water') + 'W m-2', conversion=US%QRZ_T_to_W_m2, standard_name='downwelling_shortwave_flux_in_sea_water') ! need both arrays for the SW diagnostics (one for flux, one for convergence) if (CS%id_penSW_diag>0 .or. CS%id_penSWflux_diag>0) then - allocate(CS%penSW_diag(isd:ied,jsd:jed,nz)) - CS%penSW_diag(:,:,:) = 0.0 - allocate(CS%penSWflux_diag(isd:ied,jsd:jed,nz+1)) - CS%penSWflux_diag(:,:,:) = 0.0 + allocate(CS%penSW_diag(isd:ied,jsd:jed,nz)) ; CS%penSW_diag(:,:,:) = 0.0 + allocate(CS%penSWflux_diag(isd:ied,jsd:jed,nz+1)) ; CS%penSWflux_diag(:,:,:) = 0.0 endif ! diagnostic for non-downwelling SW radiation (i.e., SW absorbed at ocean surface) CS%id_nonpenSW_diag = register_diag_field('ocean_model', 'nonpenSW', & diag%axesT1, Time, & 'Non-downwelling SW radiation (i.e., SW absorbed in ocean surface with LW,SENS,LAT)',& - 'W m-2', standard_name='nondownwelling_shortwave_flux_in_sea_water') + 'W m-2', conversion=US%QRZ_T_to_W_m2, & + standard_name='nondownwelling_shortwave_flux_in_sea_water') if (CS%id_nonpenSW_diag > 0) then - allocate(CS%nonpenSW_diag(isd:ied,jsd:jed)) - CS%nonpenSW_diag(:,:) = 0.0 + allocate(CS%nonpenSW_diag(isd:ied,jsd:jed)) ; CS%nonpenSW_diag(:,:) = 0.0 endif endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f65a0e8eae..787482d0e2 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -337,14 +337,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) + call make_frazil(h, tv, G, GV, US, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) + call make_frazil(h, tv, G, GV, US, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) endif if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, US, CS) if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) endif call disable_averaging(CS%diag) @@ -398,13 +398,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + call make_frazil(h, tv, G, GV, US, CS%diabatic_aux_CSp, fluxes%p_surf_full) else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + call make_frazil(h, tv, G, GV, US, CS%diabatic_aux_CSp) endif if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, US, CS) if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) endif @@ -581,7 +581,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) @@ -714,7 +714,7 @@ 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, & - US%T_to_s*dt, tv%T, tv%C_p) + US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & US%T_to_s*dt, tv%S) call cpu_clock_end(id_clock_kpp) @@ -898,7 +898,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards if (CS%boundary_forcing_tendency_diag) then - call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, US, CS) if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) endif ! Boundary fluxes may have changed T, S, and h @@ -992,7 +992,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will (not?) have changed ! In either case, tendencies should be posted on hold if (CS%diabatic_diff_tendency_diag) then - call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, US, CS) if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) endif else @@ -1022,7 +1022,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! In ALE-mode, layer thicknesses do not change. Therefore, we can use h below if (CS%diabatic_diff_tendency_diag) & - call diagnose_diabatic_diff_tendency(tv, h, temp_diag, saln_diag, dt, G, GV, CS) + call diagnose_diabatic_diff_tendency(tv, h, temp_diag, saln_diag, dt, G, GV, US, CS) endif call cpu_clock_end(id_clock_tridiag) @@ -1366,7 +1366,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) @@ -1479,7 +1479,7 @@ 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, & - US%T_to_s*dt, tv%T, tv%C_p) + US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & US%T_to_s*dt, tv%S) call cpu_clock_end(id_clock_kpp) @@ -1616,7 +1616,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards if (CS%boundary_forcing_tendency_diag) then - call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, US, CS) if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) endif ! Boundary fluxes may have changed T, S, and h @@ -1705,7 +1705,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! In ALE-mode, layer thicknesses do not change. Therefore, we can use h below if (CS%diabatic_diff_tendency_diag) then - call diagnose_diabatic_diff_tendency(tv, h, temp_diag, saln_diag, dt, G, GV, CS) + call diagnose_diabatic_diff_tendency(tv, h, temp_diag, saln_diag, dt, G, GV, US, CS) endif call cpu_clock_end(id_clock_tridiag) @@ -2057,7 +2057,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) if (CS%bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) @@ -2240,7 +2240,7 @@ 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, & - US%T_to_s*dt, tv%T, tv%C_p) + US%T_to_s*dt, tv%T, US%Q_to_J_kg*tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & US%T_to_s*dt, tv%S) call cpu_clock_end(id_clock_kpp) @@ -2531,7 +2531,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Note: hold here refers to the thicknesses from before the dual-entraintment when using ! the bulk mixed layer scheme, so tendencies should be posted on hold. if (CS%diabatic_diff_tendency_diag) then - call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, US, CS) if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h=hold) endif @@ -2909,7 +2909,7 @@ end subroutine adiabatic !> This routine diagnoses tendencies from application of diabatic diffusion !! using ALE algorithm. Note that layer thickness is not altered by !! diabatic diffusion. -subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, CS) +subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields @@ -2917,6 +2917,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to diabatic physics real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to diabatic physics [ppt] real, intent(in) :: dt !< time step [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure ! Local variables @@ -2944,7 +2945,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, ! heat tendency if (CS%id_diabatic_diff_heat_tend > 0 .or. CS%id_diabatic_diff_heat_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * tv%C_p * work_3d(i,j,k) + work_3d(i,j,k) = h(i,j,k)*GV%H_to_RZ * tv%C_p * work_3d(i,j,k) enddo ; enddo ; enddo if (CS%id_diabatic_diff_heat_tend > 0) then call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag, alt_h=h) @@ -2976,7 +2977,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, ! salt tendency if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * ppt2mks * work_3d(i,j,k) + work_3d(i,j,k) = h(i,j,k)*GV%H_to_RZ * ppt2mks * work_3d(i,j,k) enddo ; enddo ; enddo if (CS%id_diabatic_diff_salt_tend > 0) then call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h=h) @@ -3001,7 +3002,7 @@ end subroutine diagnose_diabatic_diff_tendency !! Other fluxes contribute 3d in cases when the layers vanish or are very thin, !! in which case we distribute the flux into k > 1 layers. subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, & - dt, G, GV, CS) + dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields @@ -3014,6 +3015,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_old !< thickness prior to boundary flux application [H ~> m or kg m-2] real, intent(in) :: dt !< time step [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure ! Local variables @@ -3047,7 +3049,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, ! heat tendency if (CS%id_boundary_forcing_heat_tend > 0 .or. CS%id_boundary_forcing_heat_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) + work_3d(i,j,k) = GV%H_to_RZ * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) enddo ; enddo ; enddo if (CS%id_boundary_forcing_heat_tend > 0) then call post_data(CS%id_boundary_forcing_heat_tend, work_3d, CS%diag, alt_h = h_old) @@ -3074,7 +3076,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, ! salt tendency if (CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) + work_3d(i,j,k) = GV%H_to_RZ * ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) enddo ; enddo ; enddo if (CS%id_boundary_forcing_salt_tend > 0) then call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag, alt_h = h_old) @@ -3097,14 +3099,15 @@ end subroutine diagnose_boundary_forcing_tendency !! This routine is called twice from within subroutine diabatic; at start and at !! end of the diabatic processes. The impacts from frazil are generally a function !! of depth. Hence, when checking heat budget, be sure to remove HFSIFRAZIL from HFDS in k=1. -subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) +subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(diabatic_CS), pointer :: CS !< module control structure type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to frazil formation [degC] real, intent(in) :: dt !< time step [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(diabatic_CS), pointer :: CS !< module control structure real, dimension(SZI_(G),SZJ_(G)) :: work_2d real :: Idt ! The inverse of the timestep [T-1 ~> s-1] @@ -3124,7 +3127,7 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) ! heat tendency if (CS%id_frazil_heat_tend > 0 .or. CS%id_frazil_heat_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie - CS%frazil_heat_diag(i,j,k) = GV%H_to_kg_m2 * tv%C_p * h(i,j,k) * Idt * (tv%T(i,j,k)-temp_old(i,j,k)) + CS%frazil_heat_diag(i,j,k) = GV%H_to_RZ * tv%C_p * h(i,j,k) * Idt * (tv%T(i,j,k)-temp_old(i,j,k)) enddo ; enddo ; enddo if (CS%id_frazil_heat_tend > 0) call post_data(CS%id_frazil_heat_tend, CS%frazil_heat_diag(:,:,:), CS%diag) @@ -3534,7 +3537,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_diabatic_diff_heat_tend = register_diag_field('ocean_model', & 'diabatic_heat_tendency', diag%axesTL, Time, & 'Diabatic diffusion heat tendency', & - 'W m-2', conversion=US%s_to_T, cmor_field_name='opottempdiff', & + 'W m-2', conversion=US%QRZ_T_to_W_m2, cmor_field_name='opottempdiff', & cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'// & 'due_to_parameterized_dianeutral_mixing', & cmor_long_name='Tendency of sea water potential temperature expressed as heat content '// & @@ -3547,7 +3550,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_diabatic_diff_salt_tend = register_diag_field('ocean_model', & 'diabatic_salt_tendency', diag%axesTL, Time, & 'Diabatic diffusion of salt tendency', & - 'kg m-2 s-1', conversion=US%s_to_T, cmor_field_name='osaltdiff', & + 'kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, cmor_field_name='osaltdiff', & cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & 'due_to_parameterized_dianeutral_mixing', & cmor_long_name='Tendency of sea water salinity expressed as salt content '// & @@ -3561,7 +3564,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_diabatic_diff_heat_tend_2d = register_diag_field('ocean_model', & 'diabatic_heat_tendency_2d', diag%axesT1, Time, & 'Depth integrated diabatic diffusion heat tendency', & - 'W m-2', conversion=US%s_to_T, cmor_field_name='opottempdiff_2d', & + 'W m-2', conversion=US%QRZ_T_to_W_m2, cmor_field_name='opottempdiff_2d', & cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'//& 'due_to_parameterized_dianeutral_mixing_depth_integrated', & cmor_long_name='Tendency of sea water potential temperature expressed as heat content '//& @@ -3574,7 +3577,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_diabatic_diff_salt_tend_2d = register_diag_field('ocean_model', & 'diabatic_salt_tendency_2d', diag%axesT1, Time, & 'Depth integrated diabatic diffusion salt tendency', & - 'kg m-2 s-1', conversion=US%s_to_T, cmor_field_name='osaltdiff_2d', & + 'kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, cmor_field_name='osaltdiff_2d', & cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & 'due_to_parameterized_dianeutral_mixing_depth_integrated', & cmor_long_name='Tendency of sea water salinity expressed as salt content '// & @@ -3613,15 +3616,15 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_boundary_forcing_heat_tend = register_diag_field('ocean_model',& 'boundary_forcing_heat_tendency', diag%axesTL, Time, & - 'Boundary forcing heat tendency', 'W m-2', conversion=US%s_to_T, & - v_extensive = .true.) + 'Boundary forcing heat tendency', & + 'W m-2', conversion=US%QRZ_T_to_W_m2, v_extensive = .true.) if (CS%id_boundary_forcing_heat_tend > 0) then CS%boundary_forcing_tendency_diag = .true. endif CS%id_boundary_forcing_salt_tend = register_diag_field('ocean_model',& 'boundary_forcing_salt_tendency', diag%axesTL, Time, & - 'Boundary forcing salt tendency', 'kg m-2 s-1', conversion=US%s_to_T, & + 'Boundary forcing salt tendency', 'kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T, & v_extensive = .true.) if (CS%id_boundary_forcing_salt_tend > 0) then CS%boundary_forcing_tendency_diag = .true. @@ -3630,7 +3633,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! This diagnostic should equal to surface heat flux if all is working well. CS%id_boundary_forcing_heat_tend_2d = register_diag_field('ocean_model',& 'boundary_forcing_heat_tendency_2d', diag%axesT1, Time, & - 'Depth integrated boundary forcing of ocean heat', 'W m-2', conversion=US%s_to_T) + 'Depth integrated boundary forcing of ocean heat', & + 'W m-2', conversion=US%QRZ_T_to_W_m2) if (CS%id_boundary_forcing_heat_tend_2d > 0) then CS%boundary_forcing_tendency_diag = .true. endif @@ -3638,7 +3642,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! This diagnostic should equal to surface salt flux if all is working well. CS%id_boundary_forcing_salt_tend_2d = register_diag_field('ocean_model',& 'boundary_forcing_salt_tendency_2d', diag%axesT1, Time, & - 'Depth integrated boundary forcing of ocean salt','kg m-2 s-1', conversion=US%s_to_T) + 'Depth integrated boundary forcing of ocean salt', & + 'kg m-2 s-1', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T) if (CS%id_boundary_forcing_salt_tend_2d > 0) then CS%boundary_forcing_tendency_diag = .true. endif @@ -3660,7 +3665,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! diagnostic for tendency of heat due to frazil CS%id_frazil_heat_tend = register_diag_field('ocean_model',& 'frazil_heat_tendency', diag%axesTL, Time, & - 'Heat tendency due to frazil formation', 'W m-2', conversion=US%s_to_T, v_extensive=.true.) + 'Heat tendency due to frazil formation', & + 'W m-2', conversion=US%QRZ_T_to_W_m2, v_extensive=.true.) if (CS%id_frazil_heat_tend > 0) then CS%frazil_tendency_diag = .true. endif @@ -3668,7 +3674,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! if all is working propertly, this diagnostic should equal to hfsifrazil CS%id_frazil_heat_tend_2d = register_diag_field('ocean_model',& 'frazil_heat_tendency_2d', diag%axesT1, Time, & - 'Depth integrated heat tendency due to frazil formation', 'W m-2', conversion=US%s_to_T) + 'Depth integrated heat tendency due to frazil formation', & + 'W m-2', conversion=US%QRZ_T_to_W_m2) if (CS%id_frazil_heat_tend_2d > 0) then CS%frazil_tendency_diag = .true. endif diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index d7985d1f1b..76aa99ccc6 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -190,7 +190,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real :: h_avail ! The thickness that is available for entrainment [H ~> m or kg m-2]. real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account. real :: Rho_cor ! The depth-integrated potential density anomaly that - ! needs to be corrected for [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! needs to be corrected for [H R ~> kg m-2 or kg2 m-5]. real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2]. real :: h1 ! The layer thickness after entrainment through the ! interface below is taken into account [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index f11cd374bf..2e2c87fcd5 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -104,7 +104,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) real :: I_h ! inverse thickness [H-1 ~> m-1 or m2 kg-1] real :: dTemp ! temperature increase in a layer [degC] real :: Irho_cp ! inverse of heat capacity per unit layer volume - ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] + ! [degC H Q-1 R-1 Z-1 ~> degC m3 J-1 or degC kg J-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_old ! Temperature of each layer ! before any heat is added, @@ -132,7 +132,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) if (.not.CS%apply_geothermal) return nkmb = GV%nk_rho_varies - Irho_cp = 1.0 / (GV%H_to_kg_m2 * tv%C_p) + Irho_cp = 1.0 / (GV%H_to_RZ * tv%C_p) Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref @@ -337,7 +337,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) ! Calculate heat tendency due to addition and transfer of internal heat if (CS%id_internal_heat_heat_tendency > 0) then - work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old(i,j,k)) + work_3d(i,j,k) = ((GV%H_to_RZ*tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old(i,j,k)) endif endif ; enddo @@ -345,7 +345,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) enddo ! k-loop if (associated(tv%internal_heat)) then ; do i=is,ie - tv%internal_heat(i,j) = tv%internal_heat(i,j) + GV%H_to_kg_m2 * & + tv%internal_heat(i,j) = tv%internal_heat(i,j) + GV%H_to_RZ * & (G%mask2dT(i,j) * (CS%geo_heat(i,j) * (dt*Irho_cp)) - heat_rem(i)) enddo ; endif enddo ! j-loop @@ -368,7 +368,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, US, CS, halo) endif ! do i=is,ie ; do j=js,je -! resid(i,j) = tv%internal_heat(i,j) - resid(i,j) - GV%H_to_kg_m2 * & +! resid(i,j) = tv%internal_heat(i,j) - resid(i,j) - GV%H_to_RZ * & ! (G%mask2dT(i,j) * (CS%geo_heat(i,j) * (dt*Irho_cp))) ! enddo ; enddo @@ -391,8 +391,8 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS) character(len=48) :: thickness_units ! Local variables character(len=200) :: inputdir, geo_file, filename, geotherm_var - real :: scale ! A constant heat flux or dimensionally rescaled scaling factor - ! [J m-2 T-1 ~> W m-2] or [s T-1 ~> 1] + real :: geo_scale ! A constant heat flux or dimensionally rescaled geothermal flux scaling factor + ! [Q R Z T-1 ~> W m-2] or [Q R Z m2 s J-1 T-1 ~> 1] integer :: i, j, isd, ied, jsd, jed, id isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -407,12 +407,12 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS) ! write parameters to the model log. call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "GEOTHERMAL_SCALE", scale, & + call get_param(param_file, mdl, "GEOTHERMAL_SCALE", geo_scale, & "The constant geothermal heat flux, a rescaling "//& "factor for the heat flux read from GEOTHERMAL_FILE, or "//& "0 to disable the geothermal heating.", & - units="W m-2 or various", default=0.0, scale=US%T_to_s) - CS%apply_geothermal = .not.(scale == 0.0) + units="W m-2 or various", default=0.0, scale=US%W_m2_to_QRZ_T) + CS%apply_geothermal = .not.(geo_scale == 0.0) if (.not.CS%apply_geothermal) return call safe_alloc_ptr(CS%geo_heat, isd, ied, jsd, jed) ; CS%geo_heat(:,:) = 0.0 @@ -441,11 +441,11 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS) "GEOTHERMAL_FILE.", default="geo_heat") call MOM_read_data(filename, trim(geotherm_var), CS%geo_heat, G%Domain) do j=jsd,jed ; do i=isd,ied - CS%geo_heat(i,j) = (G%mask2dT(i,j) * scale) * CS%geo_heat(i,j) + CS%geo_heat(i,j) = (G%mask2dT(i,j) * geo_scale) * CS%geo_heat(i,j) enddo ; enddo else do j=jsd,jed ; do i=isd,ied - CS%geo_heat(i,j) = G%mask2dT(i,j) * scale + CS%geo_heat(i,j) = G%mask2dT(i,j) * geo_scale enddo ; enddo endif call pass_var(CS%geo_heat, G%domain) @@ -454,7 +454,7 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS) ! post the static geothermal heating field id = register_static_field('ocean_model', 'geo_heat', diag%axesT1, & - 'Geothermal heat flux into ocean', 'W m-2', conversion=US%s_to_T, & + 'Geothermal heat flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2, & cmor_field_name='hfgeou', cmor_units='W m-2', & cmor_standard_name='upward_geothermal_heat_flux_at_sea_floor', & cmor_long_name='Upward geothermal heat flux at sea floor', & @@ -465,7 +465,7 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS) CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & 'internal_heat_heat_tendency', diag%axesTL, Time, & 'Heat tendency (in 3D) due to internal (geothermal) sources', & - 'W m-2', conversion=US%s_to_T, v_extensive=.true.) + 'W m-2', conversion=US%QRZ_T_to_W_m2, v_extensive=.true.) CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & 'internal_heat_temp_tendency', diag%axesTL, Time, & 'Temperature tendency (in 3D) due to internal (geothermal) sources', & diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 18b01223ff..5ebeed6af6 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -28,8 +28,8 @@ module MOM_opacity real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] !! The number of radiation bands is most rapidly varying (first) index. - real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface - !! in each of the nbands bands that penetrates beyond the surface. + real, pointer, dimension(:,:,:) :: sw_pen_band => NULL() !< shortwave radiation [Q R Z T-1 ~> W m-2] + !! at the surface in each of the nbands bands that penetrates beyond the surface. !! The most rapidly varying dimension is the band. real, pointer, dimension(:) :: & @@ -89,20 +89,20 @@ module MOM_opacity !> This sets the opacity of sea water based based on one of several different schemes. subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & - G, GV, CS, chl_2d, chl_3d) + G, GV, US, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. - real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [Q R Z T-1 ~> W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [Q R Z T-1 ~> W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [Q R Z T-1 ~> W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [Q R Z T-1 ~> W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [Q R Z T-1 ~> W m-2] 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(opacity_CS), pointer :: CS !< The control structure earlier set up by - !! opacity_init. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(opacity_CS), pointer :: CS !< The control structure earlier set up by opacity_init. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions[mg m-3] + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] @@ -115,7 +115,7 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation - ! summed across all bands [W m-2]. + ! summed across all bands [Q R Z T-1 ~> W m-2]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "set_opacity: "// & @@ -124,7 +124,7 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ if (present(chl_2d) .or. present(chl_3d)) then ! The optical properties are based on cholophyll concentrations. call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & - G, GV, CS, chl_2d, chl_3d) + G, GV, US, CS, chl_2d, chl_3d) else ! Use sw e-folding scale set by MOM_input if (optics%nbands <= 1) then ; Inv_nbands = 1.0 else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif @@ -218,16 +218,17 @@ end subroutine set_opacity !> This sets the "blue" band opacity based on chloophyll A concencentrations !! The red portion is lumped into the net heating at the surface. subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & - G, GV, CS, chl_2d, chl_3d) + G, GV, US, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. - real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [Q R Z T-1 ~> W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [Q R Z T-1 ~> W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [Q R Z T-1 ~> W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [Q R Z T-1 ~> W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [Q R Z T-1 ~> W m-2] 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 type(opacity_CS), pointer :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] @@ -240,11 +241,11 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir real :: Inv_nbands_nir ! The inverse of the number of bands of penetrating ! near-infrafed radiation. real :: SW_pen_tot ! The sum across the bands of the penetrating - ! shortwave radiation [W m-2]. + ! shortwave radiation [Q R Z T-1 ~> W m-2]. real :: SW_vis_tot ! The sum across the visible bands of shortwave - ! radiation [W m-2]. + ! radiation [Q R Z T-1 ~> W m-2]. real :: SW_nir_tot ! The sum across the near infrared bands of shortwave - ! radiation [W m-2]. + ! radiation [Q R Z T-1 ~> W m-2]. type(time_type) :: day character(len=128) :: mesg integer :: i, j, k, n, is, ie, js, je, nz, nbands @@ -321,13 +322,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir endif ! Band 1 is Manizza blue. - optics%sw_pen_band(1,i,j) = CS%blue_frac*SW_vis_tot + optics%sw_pen_band(1,i,j) = CS%blue_frac*sw_vis_tot ! Band 2 (if used) is Manizza red. if (nbands > 1) & - optics%sw_pen_band(2,i,j) = (1.0-CS%blue_frac)*SW_vis_tot + optics%sw_pen_band(2,i,j) = (1.0-CS%blue_frac)*sw_vis_tot ! All remaining bands are NIR, for lack of something better to do. do n=3,nbands - optics%sw_pen_band(n,i,j) = Inv_nbands_nir * SW_nir_tot + optics%sw_pen_band(n,i,j) = Inv_nbands_nir * sw_nir_tot enddo enddo ; enddo case (MOREL_88) @@ -335,15 +336,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir do j=js,je ; do i=is,ie SW_pen_tot = 0.0 if (G%mask2dT(i,j) > 0.5) then ; if (multiband_vis_input) then - SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * & - (sw_vis_dir(i,j) + sw_vis_dif(i,j)) + SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * (sw_vis_dir(i,j) + sw_vis_dif(i,j)) else - SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * & - 0.5*sw_total(i,j) + SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * 0.5*sw_total(i,j) endif ; endif do n=1,nbands - optics%sw_pen_band(n,i,j) = Inv_nbands*SW_pen_tot + optics%sw_pen_band(n,i,j) = Inv_nbands*sw_pen_tot enddo enddo ; enddo case default @@ -444,19 +443,19 @@ function opacity_manizza(chl_data) !> This subroutine returns a 2-d slice at constant j of fields from an optics_type, with the potential !! for rescaling these fields. subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_top, penSW_scale) - type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities - !! and shortwave fluxes. - integer, intent(in) :: j !< j-index to extract - 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(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer, intent(in) :: j !< j-index to extract + 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(max(optics%nbands,1),SZI_(G),SZK_(GV)), & - optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer - real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. + optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer + real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. real, dimension(max(optics%nbands,1),SZI_(G)), & - optional, intent(out) :: penSW_top !< The shortwave radiation [W m-2] at the surface - !! in each of the nbands bands that penetrates - !! beyond the surface skin layer. - real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux. + optional, intent(out) :: penSW_top !< The shortwave radiation [Q R Z T-1 ~> W m-2] + !! at the surface in each of the nbands bands + !! that penetrates beyond the surface skin layer. + real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux. ! Local variables real :: scale_opacity, scale_penSW ! Rescaling factors @@ -474,7 +473,7 @@ subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_ if (present(penSW_top)) then ; do k=1,nz ; do i=is,ie do n=1,optics%nbands - penSW_top(n,i) = scale_penSW * optics%SW_pen_band(n,i,j) + penSW_top(n,i) = scale_penSW * optics%sw_pen_band(n,i,j) enddo enddo ; enddo ; endif @@ -721,7 +720,6 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l endif enddo ; enddo ! i & k loops - ! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return ! Unless modified, there is no temperature change due to fluxes from the bottom. @@ -1102,9 +1100,9 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) allocate(CS%id_opacity(optics%nbands)) ; CS%id_opacity(:) = -1 CS%id_sw_pen = register_diag_field('ocean_model', 'SW_pen', diag%axesT1, Time, & - 'Penetrating shortwave radiation flux into ocean', 'W m-2') + 'Penetrating shortwave radiation flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2) CS%id_sw_vis_pen = register_diag_field('ocean_model', 'SW_vis_pen', diag%axesT1, Time, & - 'Visible penetrating shortwave radiation flux into ocean', 'W m-2') + 'Visible penetrating shortwave radiation flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2) do n=1,optics%nbands write(bandnum,'(i3)') n shortname = 'opac_'//trim(adjustl(bandnum)) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 3cd81de052..cae084f120 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -492,12 +492,19 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! !Calculate tendencies (i.e., field changes at dt) from the sources / sinks ! - - call generic_tracer_source(tv%T,tv%S,rho_dzt,dzt,Hml,G%isd,G%jsd,1,dt,& - G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & - optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & - internal_heat=tv%internal_heat, & - frunoff=G%US%R_to_kg_m3*G%US%Z_to_m*G%US%s_to_T*fluxes%frunoff(:,:), sosga=sosga) + if ((G%US%L_to_m == 1.0) .and. (G%US%R_to_kg_m3*G%US%Z_to_m == 1.0) .and. (G%US%s_to_T == 1.0)) then + ! Avoid unnecessary copies when no unit conversion is needed. + call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, Hml, G%isd, G%jsd, 1, dt, & + G%areaT, get_diag_time_end(CS%diag), & + optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & + internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) + else + call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, Hml, G%isd, G%jsd, 1, dt, & + G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & + optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & + internal_heat=G%US%R_to_kg_m3*G%US%Z_to_m*tv%internal_heat(:,:), & + frunoff=G%US%R_to_kg_m3*G%US%Z_to_m*G%US%s_to_T*fluxes%frunoff(:,:), sosga=sosga) + endif ! This uses applyTracerBoundaryFluxesInOut to handle the change in tracer due to freshwater fluxes ! usually in ALE mode diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 0900598589..21db2cfff4 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -733,15 +733,15 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! Need to double check, but set_opacity seems to only need the sum of the diffuse and ! direct fluxes in the visible and near-infrared bands. For convenience, we store the ! sum of the direct and diffuse fluxes in the 'dir' field and set the 'dif' fields to zero - call MOM_read_data(mean_file,'sw_vis',fluxes%sw_vis_dir, G%Domain, & - timelevel=ridx_sum) - call MOM_read_data(mean_file,'sw_nir',fluxes%sw_nir_dir, G%Domain, & - timelevel=ridx_sum) + call MOM_read_data(mean_file,'sw_vis', fluxes%sw_vis_dir, G%Domain, & + timelevel=ridx_sum, scale=G%US%W_m2_to_QRZ_T) + call MOM_read_data(mean_file,'sw_nir', fluxes%sw_nir_dir, G%Domain, & + timelevel=ridx_sum, scale=G%US%W_m2_to_QRZ_T) fluxes%sw_vis_dir(:,:) = fluxes%sw_vis_dir(:,:)*0.5 - fluxes%sw_vis_dif(:,:) = fluxes%sw_vis_dir + fluxes%sw_vis_dif(:,:) = fluxes%sw_vis_dir(:,:) fluxes%sw_nir_dir(:,:) = fluxes%sw_nir_dir(:,:)*0.5 - fluxes%sw_nir_dif(:,:) = fluxes%sw_nir_dir - fluxes%sw = fluxes%sw_vis_dir + fluxes%sw_vis_dif + fluxes%sw_nir_dir + fluxes%sw_nir_dif + fluxes%sw_nir_dif(:,:) = fluxes%sw_nir_dir(:,:) + fluxes%sw = (fluxes%sw_vis_dir + fluxes%sw_vis_dif) + (fluxes%sw_nir_dir + fluxes%sw_nir_dif) do j=js,je ; do i=is,ie if (G%mask2dT(i,j)<1.0) then fluxes%sw(i,j) = 0.0 diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 7da25d6841..3dd5a9ab2b 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -663,7 +663,8 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: sw, sw_vis, sw_nir !< Save old value of shortwave radiation + real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & + sw, sw_vis, sw_nir !< Save old values of shortwave radiation [Q R Z T-1 ~> W m-2] real :: hval integer :: i,j,k integer :: is, ie, js, je, nz @@ -728,7 +729,8 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%US, CS%diabatic_aux_CSp, & + CS%opacity_CSp, CS%tracer_flow_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 5a176cd3f9..716745093c 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -489,11 +489,15 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) #ifdef _USE_GENERIC_TRACER - if (CS%use_MOM_generic_tracer) & + 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 "//& + "[QRZT]_RESCALE_POWER parameters to 0.") call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & G, GV, CS%MOM_generic_tracer_CSp, tv, optics, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) + endif #endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & @@ -541,9 +545,13 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, call OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%OCMIP2_CFC_CSp) #ifdef _USE_GENERIC_TRACER - if (CS%use_MOM_generic_tracer) & + 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 "//& + "[QRZT]_RESCALE_POWER parameters to 0.") call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & G, GV, CS%MOM_generic_tracer_CSp, tv, optics) + endif #endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 6283f07490..ec7f907fd1 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -67,7 +67,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) real :: density_restore ! The potential density that is being restored ! toward [R ~> kg m-3]. real :: rhoXcp ! Reference density times heat capacity times unit scaling - ! factors [J T s-1 Z-1 m-2 degC-1 ~> J m-3 degC-1] + ! factors [Q R degC-1 ~> J m-3 degC-1] real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux [L2 T-3 R-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je @@ -106,7 +106,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of [W m-2] and are positive into the ocean. + ! Heat fluxes are in units of [Q R Z T-1 ~> W m-2] and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) fluxes%sens(i,j) = 0.0 * G%mask2dT(i,j) @@ -128,7 +128,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & "Temperature and salinity restoring used without modification." ) - rhoXcp = US%R_to_kg_m3*US%Z_to_m*US%s_to_T * CS%Rho0 * fluxes%C_p + rhoXcp = CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie ! Set Temp_restore and Salin_restore to the temperature (in degC) and ! salinity (in ppt) that are being restored toward. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index c211341493..6eade35bad 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -258,6 +258,18 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = (val2 * (val1 * cff * cosa / & (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) + if (segment%nudged) then + do k=1,nz + segment%nudged_normal_vel(I,j,k) = (val2 * (val1 * cff * cosa / & + (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) + enddo + elseif (segment%specified) then + do k=1,nz + segment%normal_vel(I,j,k) = (val2 * (val1 * cff * cosa / & + (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) + segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * h(i+1,j,k) * G%dyCu(I,j) + enddo + endif else ! Not rotated yet segment%eta(I,j) = 0.0 @@ -284,21 +296,13 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - if (CS%answers_2018) then - ! Problem: val2 & cff could be functions of space, but are not set in this loop. - if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = (val2 * (val1 * cff * sina / & - (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) )) - enddo ; endif - else - cff =sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) - val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) - if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = (val1 * val2 * cff * sina) / & - ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) - - enddo ; endif - endif + cff =sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = (val1 * val2 * cff * sina) / & + ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) + + enddo ; endif enddo ; enddo endif else @@ -315,6 +319,18 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val1 * cff * sina / & (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j)))) * val2 + if (segment%nudged) then + do k=1,nz + segment%nudged_normal_vel(I,j,k) = US%L_T_to_m_s * (val1 * cff * sina / & + (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j)))) * val2 + enddo + elseif (segment%specified) then + do k=1,nz + segment%normal_vel(I,j,k) = US%L_T_to_m_s * (val1 * cff * sina / & + (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j)))) * val2 + segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * h(i,j+1,k) * G%dxCv(i,J) + enddo + endif else ! Not rotated yet segment%eta(i,J) = 0.0 @@ -339,20 +355,12 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - if (CS%answers_2018) then - ! Problem: val2 & cff could be functions of space, but are not set in this loop. - if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = (val2 * (val1 * cff * sina / & - (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))))) - enddo ; endif - else - cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) - val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) - if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = ((val1 * val2 * cff * sina) / & - ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) )) - enddo ; endif - endif + cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = ((val1 * val2 * cff * sina) / & + ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) )) + enddo ; endif enddo ; enddo endif endif diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 960abd49ca..be12f75c38 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -38,10 +38,10 @@ module SCM_CVMix_tests logical :: UseDiurnalSW !< True to use diurnal sw radiation real :: tau_x !< (Constant) Wind stress, X [Pa] real :: tau_y !< (Constant) Wind stress, Y [Pa] - real :: surf_HF !< (Constant) Heat flux [m degC s-1] - real :: surf_evap !< (Constant) Evaporation rate [m s-1] - real :: Max_sw !< maximum of diurnal sw radiation [m degC s-1] - real,public :: Rho0 !< reference density copied for easy passing [kg m-3] + real :: surf_HF !< (Constant) Heat flux [degC Z T-1 ~> m degC s-1] + real :: surf_evap !< (Constant) Evaporation rate [Z T-1 ~> m s-1] + real :: Max_sw !< maximum of diurnal sw radiation [degC Z T-1 ~> degC m s-1] + real :: Rho0 !< reference density [R ~> kg m-3] end type ! This include declares and sets the variable "version". @@ -177,20 +177,26 @@ subroutine SCM_CVMix_tests_surface_forcing_init(Time, G, param_file, CS) call get_param(param_file, mdl, "SCM_HEAT_FLUX", & CS%surf_HF, "Constant surface heat flux "// & "used in the SCM CVMix test surface forcing.", & - units='m K/s', fail_if_missing=.true.) + units='m K/s', scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) endif if (CS%UseEvaporation) then call get_param(param_file, mdl, "SCM_EVAPORATION", & CS%surf_evap, "Constant surface evaporation "// & "used in the SCM CVMix test surface forcing.", & - units='m/s', fail_if_missing=.true.) + units='m/s', scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) endif if (CS%UseDiurnalSW) then call get_param(param_file, mdl, "SCM_DIURNAL_SW_MAX", & CS%Max_sw, "Maximum diurnal sw radiation "// & "used in the SCM CVMix test surface forcing.", & - units='m K/s', fail_if_missing=.true.) + units='m K/s', scale=US%m_to_Z*US%T_to_s, fail_if_missing=.true.) endif + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) end subroutine SCM_CVMix_tests_surface_forcing_init @@ -221,7 +227,7 @@ subroutine SCM_CVMix_tests_wind_forcing(state, forces, day, G, US, CS) mag_tau = sqrt(CS%tau_x*CS%tau_x + CS%tau_y*CS%tau_y) if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt( US%L_to_Z * mag_tau / (US%kg_m3_to_R*CS%Rho0) ) + forces%ustar(i,j) = sqrt( US%L_to_Z * mag_tau / (CS%Rho0) ) enddo ; enddo ; endif end subroutine SCM_CVMix_tests_wind_forcing @@ -262,18 +268,16 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(state, fluxes, day, G, US, CS) ! Note CVMix test inputs give evaporation in [m s-1] ! This therefore must be converted to mass flux in [R Z T-1 ~> kg m-2 s-1] ! by multiplying by density and some unit conversion factors. - fluxes%evap(i,J) = CS%surf_evap * US%kg_m3_to_R*US%m_to_Z*US%T_to_s * CS%Rho0 + fluxes%evap(i,J) = CS%surf_evap * CS%Rho0 enddo ; enddo endif if (CS%UseDiurnalSW) then do J=Jsq,Jeq ; do i=is,ie - ! Note CVMix test inputs give max sw rad in [m K/s] - ! therefore must convert to W/m2 by multiplying - ! by Rho0*Cp + ! Note CVMix test inputs give max sw rad in [m degC/s] + ! therefore must convert to W/m2 by multiplying by Rho0*Cp ! Note diurnal cycle peaks at Noon. - fluxes%sw(i,J) = CS%Max_sw * max(0.0,cos(2*PI* & - (time_type_to_real(DAY)/86400.-0.5))) * CS%RHO0 * fluxes%C_p + fluxes%sw(i,J) = CS%Max_sw * max(0.0, cos(2*PI*(time_type_to_real(DAY)/86400.0 - 0.5))) * CS%RHO0 * fluxes%C_p enddo ; enddo endif diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 2d19cce6dd..63f8009235 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -105,7 +105,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of [W m-2] and are positive into the ocean. + ! Heat fluxes are in units of [Q R Z T-1 ~> W m-2] and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) fluxes%sens(i,j) = 0.0 * G%mask2dT(i,j)