diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 19a0ddbf86..51d3e0c7b7 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -50,107 +50,106 @@ module MOM_surface_forcing public ice_ocn_bnd_type_chksum public forcing_save_restart - -! surface_forcing_CS is a structure containing pointers to the forcing fields -! which may be used to drive MOM. All fluxes are positive downward. +!> surface_forcing_CS is a structure containing pointers to the forcing fields +!! which may be used to drive MOM. All fluxes are positive downward. type, public :: surface_forcing_CS ; private - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integer values - ! from MOM_domains) to indicate the staggering of - ! the winds that are being provided in calls to - ! update_ocean_model. - logical :: use_temperature ! If true, temp and saln used as state variables + integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integer values + !! from MOM_domains) to indicate the staggering of + !! the winds that are being provided in calls to + !! update_ocean_model. + logical :: use_temperature !< If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim). - real :: Rho0 ! Boussinesq reference density (kg/m^3) - real :: area_surf = -1.0 ! total ocean surface area (m^2) - real :: latent_heat_fusion ! latent heat of fusion (J/kg) - real :: latent_heat_vapor ! latent heat of vaporization (J/kg) - - real :: max_p_surf ! maximum surface pressure that can be - ! exerted by the atmosphere and floating sea-ice, - ! in Pa. This is needed because the FMS coupling - ! structure does not limit the water that can be - ! frozen out of the ocean and the ice-ocean heat - ! fluxes are treated explicitly. - logical :: use_limited_P_SSH ! If true, return the sea surface height with - ! the correction for the atmospheric (and sea-ice) - ! pressure limited by max_p_surf instead of the - ! full atmospheric pressure. The default is true. - - real :: gust_const ! constant unresolved background gustiness for ustar (Pa) - logical :: read_gust_2d ! If true, use a 2-dimensional gustiness supplied - ! from an input file. + real :: Rho0 !< Boussinesq reference density (kg/m^3) + real :: area_surf = -1.0 !< Total ocean surface area (m^2) + real :: latent_heat_fusion !< Latent heat of fusion (J/kg) + real :: latent_heat_vapor !< Latent heat of vaporization (J/kg) + + real :: max_p_surf !< The maximum surface pressure that can be + !! exerted by the atmosphere and floating sea-ice, + !! in Pa. This is needed because the FMS coupling + !! structure does not limit the water that can be + !! frozen out of the ocean and the ice-ocean heat + !! fluxes are treated explicitly. + logical :: use_limited_P_SSH !< If true, return the sea surface height with + !! the correction for the atmospheric (and sea-ice) + !! pressure limited by max_p_surf instead of the + !! full atmospheric pressure. The default is true. + logical :: approx_net_mass_src !< If true, use the net mass sources from the ice-ocean boundary + !! type without any further adjustments to drive the ocean dynamics. + !! The actual net mass source may differ due to corrections. + + real :: gust_const !< Constant unresolved background gustiness for ustar (Pa) + logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied from an input file. + real, pointer, dimension(:,:) :: & + TKE_tidal => NULL() !< Turbulent kinetic energy introduced to the bottom boundary layer + !! by drag on the tidal flows, in W m-2. + real, pointer, dimension(:,:) :: & + gust => NULL() !< A spatially varying unresolved background gustiness that + !! contributes to ustar (Pa). gust is used when read_gust_2d is true. real, pointer, dimension(:,:) :: & - TKE_tidal => NULL(), & ! turbulent kinetic energy introduced to the - ! bottom boundary layer by drag on the tidal flows, - ! in W m-2. - gust => NULL(), & ! spatially varying unresolved background - ! gustiness that contributes to ustar (Pa). - ! gust is used when read_gust_2d is true. - ustar_tidal => NULL() ! tidal contribution to the bottom friction velocity (m/s) - real :: cd_tides ! drag coefficient that applies to the tides (nondimensional) - real :: utide ! constant tidal velocity to use if read_tideamp - ! is false, in m s-1. - logical :: read_tideamp ! If true, spatially varying tidal amplitude read from a file. - - logical :: rigid_sea_ice ! If true, sea-ice exerts a rigidity that acts - ! to damp surface deflections (especially surface - ! gravity waves). The default is false. - real :: Kv_sea_ice ! viscosity in sea-ice that resists sheared vertical motions (m^2/s) - real :: density_sea_ice ! typical density of sea-ice (kg/m^3). The value is - ! only used to convert the ice pressure into - ! appropriate units for use with Kv_sea_ice. - real :: rigid_sea_ice_mass ! A mass per unit area of sea-ice beyond which - ! 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) - 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 - logical :: adjust_net_fresh_water_to_zero ! adjust net surface fresh-water (w/ restoring) to zero - logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW - logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour - logical :: mask_srestore_under_ice ! If true, use an ice mask defined by frazil - ! criteria for salinity restoring. - real :: ice_salt_concentration ! salt concentration for sea ice (kg/kg) - logical :: mask_srestore_marginal_seas ! if true, then mask SSS restoring in marginal seas - 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 - - 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 - character(len=30) :: salt_restore_var_name ! name of surface salinity in salt_restore_file - logical :: mask_srestore ! if true, apply a 2-dimensional mask to the surface - ! salinity restoring fluxes. The masking file should be - ! in inputdir/salt_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: srestore_mask => NULL() ! mask for SSS restoring - character(len=200) :: temp_restore_file ! filename for sst restoring data - character(len=30) :: temp_restore_var_name ! name of surface temperature in temp_restore_file - logical :: mask_trestore ! if true, apply a 2-dimensional mask to the surface - ! temperature restoring fluxes. The masking file should be - ! in inputdir/temp_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: trestore_mask => NULL() ! mask for SST restoring - integer :: id_srestore = -1 ! id number for time_interp_external. - integer :: id_trestore = -1 ! id number for time_interp_external. - - ! Diagnostics handles - type(forcing_diags), public :: handles + ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity (m/s) + real :: cd_tides !< Drag coefficient that applies to the tides (nondimensional) + real :: utide !< Constant tidal velocity to use if read_tideamp is false, in m s-1. + logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. + + logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts to damp surface + !! deflections (especially surface gravity waves). The default is false. + real :: Kv_sea_ice !< Viscosity in sea-ice that resists sheared vertical motions (m^2/s) + real :: density_sea_ice !< Typical density of sea-ice (kg/m^3). The value is only used to convert + !! the ice pressure into appropriate units for use with Kv_sea_ice. + real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which 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 + + logical :: restore_salt !< If true, the coupled MOM driver adds a term to restore surface + !! salinity to a specified value. + logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea + !! surface temperature to a specified value. + real :: Flux_const !< Piston velocity for surface restoring (m/s) + 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 + logical :: adjust_net_fresh_water_to_zero !< Adjust net surface fresh-water (with restoring) to zero + logical :: use_net_FW_adjustment_sign_bug !< Use the wrong sign when adjusting net FW + logical :: adjust_net_fresh_water_by_scaling !< Adjust net surface fresh-water w/o moving zero contour + logical :: mask_srestore_under_ice !< If true, use an ice mask defined by frazil criteria + !! for salinity restoring. + real :: ice_salt_concentration !< Salt concentration for sea ice (kg/kg) + logical :: mask_srestore_marginal_seas !< If true, then mask SSS restoring in marginal seas + 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 surface salinity restoring by basin + + type(diag_ctrl), pointer :: diag => NULL() !< 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 + character(len=30) :: salt_restore_var_name !< Name of surface salinity in salt_restore_file + logical :: mask_srestore !< If true, apply a 2-dimensional mask to the surface + !! salinity restoring fluxes. The masking file should be + !! in inputdir/salt_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring + character(len=200) :: temp_restore_file !< Filename for sst restoring data + character(len=30) :: temp_restore_var_name !< Name of surface temperature in temp_restore_file + logical :: mask_trestore !< If true, apply a 2-dimensional mask to the surface + !! temperature restoring fluxes. The masking file should be + !! in inputdir/temp_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: trestore_mask => NULL() !< Mask for SST restoring + integer :: id_srestore = -1 !< An id number for time_interp_external. + integer :: id_trestore = -1 !< An id number for time_interp_external. + + type(forcing_diags), public :: handles !< Diagnostics handles !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - type(user_revise_forcing_CS), pointer :: urf_CS => NULL() + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure + type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< A control structure for user forcing revisions end type surface_forcing_CS -! ice_ocean_boundary_type is a structure corresponding to forcing, but with -! the elements, units, and conventions that exactly conform to the use for -! MOM-based coupled models. +!> ice_ocean_boundary_type is a structure corresponding to forcing, but with the elements, units, +!! and conventions that exactly conform to the use for MOM6-based coupled models. type, public :: ice_ocean_boundary_type real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) @@ -166,6 +165,7 @@ module MOM_surface_forcing real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s) real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s) real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s) + real, pointer, dimension(:,:) :: stress_mag =>NULL() !< The time-mean magnitude of the stress on the ocean (Pa) real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s) real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2) real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) @@ -178,25 +178,23 @@ module MOM_surface_forcing !! ice-shelves, expressed as a coefficient !! for divergence damping, as determined !! outside of the ocean model in (m3/s) - integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT - type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of - !! named fields used for passive tracer fluxes. - integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of - !! wind stresses. This flag may be set by the - !! flux-exchange code, based on what the sea-ice - !! model is providing. Otherwise, the value from - !! the surface_forcing_CS is used. + integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT + type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of named fields + !! used for passive tracer fluxes. + integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of wind stresses. + !! This flag may be set by the flux-exchange code, based on what + !! the sea-ice model is providing. Otherwise, the value from + !! the surface_forcing_CS is used. end type ice_ocean_boundary_type -integer :: id_clock_forcing +integer :: id_clock_forcing !< A CPU time clock contains !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! thermodynamic forcing type, including changes of units, sign conventions, !! and putting the fields into arrays with MOM-standard halos. -subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & - sfc_state, restore_salt, restore_temp) +subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_state) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -211,9 +209,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the !! surface state of the ocean. - logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value. - logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. - real, dimension(SZI_(G),SZJ_(G)) :: & data_restore, & ! The surface value toward which to restore (g/kg or degC) @@ -233,10 +228,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd - logical :: restore_salinity ! local copy of the argument restore_salt, if it - ! is present, or false (no restoring) otherwise. - logical :: restore_sst ! local copy of the argument restore_temp, if it - ! is present, or false (no restoring) otherwise. real :: delta_sss ! temporary storage for sss diff from restoring value real :: delta_sst ! temporary storage for sst diff from restoring value @@ -263,11 +254,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%netFWGlobalAdj = 0.0 fluxes%netFWGlobalScl = 0.0 - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - ! allocation and initialization if this is the first time that this ! flux type has been used. if (fluxes%dt_buoy_accum < 0) then @@ -304,7 +290,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo ; enddo - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + if (CS%restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) fluxes%dt_buoy_accum = 0.0 endif ! endif for allocation and initialization @@ -323,7 +309,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & ! ocean model, rather than using haloless arrays, in which case the last line ! would be: ( (/isd,is,ie,ied/), (/jsd,js,je,jed/)) - if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:)=0.0 fluxes%salt_flux_added(:,:)=0.0 @@ -343,7 +328,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo ! Salinity restoring logic - if (restore_salinity) then + if (CS%restore_salt) then call time_interp_external(CS%id_srestore,Time,data_restore) ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) open_ocn_mask(:,:) = 1.0 @@ -396,7 +381,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & endif ! SST restoring logic - if (restore_sst) then + if (CS%restore_temp) then call time_interp_external(CS%id_trestore,Time,data_restore) do j=js,je ; do i=is,ie delta_sst = data_restore(i,j)- sfc_state%SST(i,j) @@ -544,6 +529,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & endif + ! Set the wind stresses and ustar. + if (associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar, & + gustless_ustar=fluxes%ustar_gustless) + elseif (associated(fluxes%ustar)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar) + elseif (associated(fluxes%ustar_gustless)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, gustless_ustar=fluxes%ustar_gustless) + endif + if (coupler_type_initialized(fluxes%tr_fluxes) .and. & coupler_type_initialized(IOB%fluxes)) & call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes) @@ -563,7 +558,7 @@ end subroutine convert_IOB_to_fluxes !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! mechanical forcing type, including changes of units, sign conventions, !! and putting the fields into arrays with MOM-standard halos. -subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forcing, reset_avg) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -574,27 +569,24 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. + real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the + !! current value of ustar as a weighted running + !! average, in s, or if 0 do not average ustar. + !! Missing is equivalent to 0. + logical, optional, intent(in) :: reset_avg !< If true, reset the time average. - - real, dimension(SZIB_(G),SZJB_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) - tauy_at_q ! Meridional wind stresses at q points (Pa) - + ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h ! Meridional wind stresses at h points (Pa) + rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) + net_mass_src, & ! A temporary of net mass sources, in kg m-2 s-1. + ustar_tmp ! A temporary array of ustar values, in m s-1. - real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) - real :: Irho0 ! inverse of the mean density in (m^3/kg) - real :: taux2, tauy2 ! squared wind stresses (Pa^2) - real :: tau_mag ! magnitude of the wind stress (Pa) real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice ! mass of sea ice at a face (kg/m^2) real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) + real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND. - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -610,8 +602,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 i0 = is - isc_bnd ; j0 = js - jsc_bnd - Irho0 = 1.0/CS%Rho0 - ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. if (.not.forces%initialized) then @@ -637,6 +627,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) if ( (associated(IOB%area_berg) .and. (.not. associated(forces%area_berg))) .or. & (associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) & call allocate_mech_forcing(G, forces, iceberg=.true.) + if (associated(IOB%ice_rigidity)) then rigidity_at_h(:,:) = 0.0 call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -647,6 +638,23 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 + ! Set the weights for forcing fields that use running time averages. + if (present(reset_avg)) then ; if (reset_avg) forces%dt_force_accum = 0.0 ; endif + wt1 = 0.0 ; wt2 = 1.0 + if (present(dt_forcing)) then + if ((forces%dt_force_accum > 0.0) .and. (dt_forcing > 0.0)) then + wt1 = forces%dt_force_accum / (forces%dt_force_accum + dt_forcing) + wt2 = 1.0 - wt1 + endif + if (dt_forcing > 0.0) then + forces%dt_force_accum = max(forces%dt_force_accum, 0.0) + dt_forcing + else + forces%dt_force_accum = 0.0 ! Reset the averaging time interval. + endif + else + forces%dt_force_accum = 0.0 ! Reset the averaging time interval. + endif + ! applied surface pressure from atmosphere and cryosphere if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then @@ -668,136 +676,62 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) endif forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. - wind_stagger = CS%wind_stagger - if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & - (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger - if (wind_stagger == BGRID_NE) then - ! This is necessary to fill in the halo points. - taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - if (associated(IOB%area_berg)) & - forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%mass_berg)) & - forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%ice_rigidity)) & - rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) - - if (wind_stagger == BGRID_NE) then - if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - elseif (wind_stagger == AGRID) then - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - endif - - enddo ; enddo - - ! surface momentum stress related fields as function of staggering - if (wind_stagger == BGRID_NE) then - if (G%symmetric) & - call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) - call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo - - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - + ! Set the wind stresses and ustar. + if (wt1 <= 0.0) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + ustar=forces%ustar, tau_halo=1) + else + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + ustar=ustar_tmp, tau_halo=1) do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo ; enddo - - elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & - stagger=AGRID, halo=1) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j) enddo ; enddo + endif - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo ; enddo + ! Find the net mass source in the input forcing without other adjustments. + if (CS%approx_net_mass_src .and. associated(forces%net_mass_src)) then + net_mass_src(:,:) = 0.0 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + if (associated(IOB%lprec)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%lprec(i-i0,j-j0) + if (associated(IOB%fprec)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%fprec(i-i0,j-j0) + if (associated(IOB%runoff)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%runoff(i-i0,j-j0) + if (associated(IOB%calving)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%calving(i-i0,j-j0) + if (associated(IOB%q_flux)) & + net_mass_src(i,j) = net_mass_src(i,j) - IOB%q_flux(i-i0,j-j0) + endif ; enddo ; enddo + if (wt1 <= 0.0) then + do j=js,je ; do i=is,ie + forces%net_mass_src(i,j) = wt2*net_mass_src(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + forces%net_mass_src(i,j) = wt1*forces%net_mass_src(i,j) + wt2*net_mass_src(i,j) + enddo ; enddo + endif + forces%net_mass_src_set = .true. + else + forces%net_mass_src_set = .false. + endif - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo ; enddo + ! Obtain optional ice-berg related fluxes from the IOB type: + if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie + forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + enddo ; enddo ; endif - else ! C-grid wind stresses. - if (G%symmetric) & - call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) - call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) + if (associated(IOB%mass_berg)) then ; do j=js,je ; do i=is,ie + forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + enddo ; enddo ; endif + ! Obtain sea ice related dynamic fields + if (associated(IOB%ice_rigidity)) then do j=js,je ; do i=is,ie - taux2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif + rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) enddo ; enddo - - endif ! endif for wind related fields - - ! sea ice related dynamic fields - if (associated(IOB%ice_rigidity)) then call pass_var(rigidity_at_h, G%Domain, halo=1) do I=is-1,ie ; do j=js,je forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & @@ -844,6 +778,226 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces + +!> This subroutine extracts the wind stresses and related fields like ustar from an +!! Ice_ocean_boundary_type into optional argument arrays, including changes of units, sign +!! conventions, and putting the fields into arrays with MOM-standard sized halos. +subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, & + gustless_ustar, tau_halo) + type(ice_ocean_boundary_type), & + target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive + !! the ocean in a coupled model + integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. + type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the + !! salinity to the right time, when it is being restored. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(inout) :: taux !< The zonal wind stresses on a C-grid, in Pa. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid, in Pa. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(inout) :: ustar !< The surface friction velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(out) :: gustless_ustar !< The surface friction velocity without + !! any contributions from gustiness, in m s-1. + integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses (in Pa) at h points + real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses (in Pa) at h points + real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses (in Pa) at u points + real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses (in Pa) at v points + real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses (in Pa) at q points + real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses (in Pa) at q points + + real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) + real :: Irho0 ! inverse of the mean density in (m^3/kg) + real :: taux2, tauy2 ! squared wind stresses (Pa^2) + real :: tau_mag ! magnitude of the wind stress (Pa) + + logical :: do_ustar, do_gustless + integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) + integer :: i, j, is, ie, js, je, ish, ieh, jsh, jeh, Isqh, Ieqh, Jsqh, Jeqh, i0, j0, halo + + halo = 0 ; if (present(tau_halo)) halo = tau_halo + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + ish = G%isc-halo ; ieh = G%iec+halo ; jsh = G%jsc-halo ; jeh = G%jec+halo + Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo + i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) + + Irho0 = 1.0/CS%Rho0 + + do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) + + wind_stagger = CS%wind_stagger + if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & + (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + + if (associated(IOB%u_flux).neqv.associated(IOB%v_flux)) call MOM_error(FATAL,"extract_IOB_stresses: "//& + "associated(IOB%u_flux) /= associated(IOB%v_flux !!!") + if (present(taux).neqv.present(tauy)) call MOM_error(FATAL,"extract_IOB_stresses: "//& + "present(taux) /= present(tauy) !!!") + + ! Set surface momentum stress related fields as a function of staggering. + if (present(taux) .or. present(tauy) .or. & + ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then + + if (wind_stagger == BGRID_NE) then + taux_in_B(:,:) = 0.0 ; tauy_in_B(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do J=js,je ; do I=is,ie + taux_in_B(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_B(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif + + if (G%symmetric) call fill_symmetric_edges(taux_in_B, tauy_in_B, G%Domain, stagger=BGRID_NE) + call pass_vector(taux_in_B, tauy_in_B, G%Domain, stagger=BGRID_NE, halo=max(1,halo)) + + if (present(taux).and.present(tauy)) then + do j=jsh,jeh ; do I=Isqh,Ieqh + taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + taux(I,j) = (G%mask2dBu(I,J)*taux_in_B(I,J) + G%mask2dBu(I,J-1)*taux_in_B(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo + do J=Jsqh,Jeqh ; do i=ish,ieh + tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + tauy(i,J) = (G%mask2dBu(I,J)*tauy_in_B(I,J) + G%mask2dBu(I-1,J)*tauy_in_B(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo + endif + elseif (wind_stagger == AGRID) then + taux_in_A(:,:) = 0.0 ; tauy_in_A(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do j=js,je ; do i=is,ie + taux_in_A(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_A(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif + + if (halo == 0) then + call pass_vector(taux_in_A, tauy_in_A, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) + else + call pass_vector(taux_in_A, tauy_in_A, G%Domain, stagger=AGRID, halo=max(1,halo)) + endif + + if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh + taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + taux(I,j) = (G%mask2dT(i,j)*taux_in_A(i,j) + G%mask2dT(i+1,j)*taux_in_A(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo ; enddo ; endif + + if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh + tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + tauy(i,J) = (G%mask2dT(i,j)*tauy_in_A(i,j) + G%mask2dT(i,J+1)*tauy_in_A(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo ; enddo ; endif + + else ! C-grid wind stresses. + taux_in_C(:,:) = 0.0 ; tauy_in_C(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do j=js,je ; do i=is,ie + taux_in_C(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_C(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif + + if (G%symmetric) call fill_symmetric_edges(taux_in_C, tauy_in_C, G%Domain) + call pass_vector(taux_in_C, tauy_in_C, G%Domain, halo=max(1,halo)) + + if (present(taux).and.present(tauy)) then + do j=jsh,jeh ; do I=Isqh,Ieqh + taux(I,j) = G%mask2dCu(I,j)*taux_in_C(I,j) + enddo ; enddo + do J=Jsqh,Jeqh ; do i=ish,ieh + tauy(i,J) = G%mask2dCv(i,J)*tauy_in_C(i,J) + enddo ; enddo + endif + endif ! endif for extracting wind stress fields with various staggerings + endif + + if (do_ustar .or. do_gustless) then + ! Set surface friction velocity directly or as a function of staggering. + ! ustar is required for the bulk mixed layer formulation and other turbulent mixing + ! parametizations. The background gustiness (for example with a relatively small value + ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds. + if (associated(IOB%stress_mag)) then + if (do_ustar) then ; do j=js,je ; do i=is,ie + gustiness = CS%gust_const + !### SIMPLIFY THE TREATMENT OF GUSTINESS! + if (CS%read_gust_2d) then + if ((wind_stagger == CGRID_NE) .or. & + ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & + ((wind_stagger == BGRID_NE) .and. & + (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & + gustiness = CS%gust(i,j) + endif + ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) +!### Change to: +! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + elseif (wind_stagger == BGRID_NE) then + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in_B(I,J)**2 + tauy_in_B(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_in_B(I-1,J-1)**2 + tauy_in_B(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_in_B(I,J-1)**2 + tauy_in_B(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_in_B(I-1,J)**2 + tauy_in_B(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + enddo ; enddo + elseif (wind_stagger == AGRID) then + do j=js,je ; do i=is,ie + tau_mag = G%mask2dT(i,j) * sqrt(taux_in_A(i,j)**2 + tauy_in_A(i,j)**2) + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + enddo ; enddo + else ! C-grid wind stresses. + do j=js,je ; do i=is,ie + taux2 = 0.0 ; tauy2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + & + G%mask2dCu(I,j)*taux_in_C(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + & + G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tau_mag = sqrt(taux2 + tauy2) + + gustiness = CS%gust_const + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + enddo ; enddo + endif ! endif for wind friction velocity fields + endif + +end subroutine extract_IOB_stresses + + !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -968,7 +1122,7 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart !> Initialize the surface forcing, including setting parameters and allocating permanent memory. -subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) +subroutine surface_forcing_init(Time, G, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -976,10 +1130,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res !! diagnostic output type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - logical, optional, intent(in) :: restore_salt !< If present and true surface salinity - !! restoring will be applied in this model. - logical, optional, intent(in) :: restore_temp !< If present and true surface temperature - !! restoring will be applied in this model. ! Local variables real :: utide ! The RMS tidal velocity, in m s-1. @@ -1038,11 +1188,19 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "the ice-ocean heat fluxes are treated explicitly. No \n"//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) + call get_param(param_file, mdl, "RESTORE_SALINITY", CS%restore_salt, & + "If true, the coupled driver will add a globally-balanced \n"//& + "fresh-water flux that drives sea-surface salinity \n"//& + "toward specified values.", default=.false.) + call get_param(param_file, mdl, "RESTORE_TEMPERATURE", CS%restore_temp, & + "If true, the coupled driver will add a \n"//& + "heat flux that drives sea-surface temperauture \n"//& + "toward specified values.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & "If true, adjusts the salinity restoring seen to zero\n"//& "whether restoring is via a salt flux or virtual precip.",& - default=restore_salt) + default=CS%restore_salt) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & CS%adjust_net_srestore_by_scaling, & "If true, adjustments to salt restoring to achieve zero net are\n"//& @@ -1072,6 +1230,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "correction for the atmospheric (and sea-ice) pressure \n"//& "limited by max_p_surf instead of the full atmospheric \n"//& "pressure.", default=.true.) + call get_param(param_file, mdl, "APPROX_NET_MASS_SRC", CS%approx_net_mass_src, & + "If true, use the net mass sources from the ice-ocean \n"//& + "boundary type without any further adjustments to drive \n"//& + "the ocean dynamics. The actual net mass source may differ \n"//& + "due to internal corrections.", default=.false.) call get_param(param_file, mdl, "WIND_STAGGER", stagger, & "A case-insensitive character string to indicate the \n"//& @@ -1087,7 +1250,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "coupler. This is used for testing and should be =1.0 for any\n"//& "production runs.", default=1.0) - if (restore_salt) then + if (CS%restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& @@ -1135,7 +1298,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "a mask for SSS restoring.", default=.false.) endif - if (restore_temp) then + if (CS%restore_temp) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& @@ -1250,11 +1413,10 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & "If true, allows flux adjustments to specified via the \n"//& "data_table using the component name 'OCN'.", default=.false.) - if (CS%allow_flux_adjustments) then - call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) - endif - if (present(restore_salt)) then ; if (restore_salt) then + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) + + if (CS%restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) call safe_alloc_ptr(CS%srestore_mask,isd,ied,jsd,jed); CS%srestore_mask(:,:) = 1.0 @@ -1262,9 +1424,9 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res flnam = trim(CS%inputdir) // 'salt_restore_mask.nc' call MOM_read_data(flnam,'mask', CS%srestore_mask, G%domain, timelevel=1) endif - endif ; endif + endif - if (present(restore_temp)) then ; if (restore_temp) then + if (CS%restore_temp) then temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file) CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) call safe_alloc_ptr(CS%trestore_mask,isd,ied,jsd,jed); CS%trestore_mask(:,:) = 1.0 @@ -1272,7 +1434,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res flnam = trim(CS%inputdir) // 'temp_restore_mask.nc' call MOM_read_data(flnam, 'mask', CS%trestore_mask, G%domain, timelevel=1) endif - endif ; endif + endif ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 595848e948..4e89945678 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -20,14 +20,12 @@ module ocean_model_mod use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use MOM_forcing_type, only : allocate_forcing_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields -use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing -use MOM_forcing_type, only : set_derived_forcing_fields +use MOM_forcing_type, only : forcing, mech_forcing, allocate_forcing_type +use MOM_forcing_type, only : fluxes_accumulate, get_net_mass_forcing +use MOM_forcing_type, only : copy_back_forcing_fields use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags use MOM_get_input, only : Get_MOM_Input, directories use MOM_grid, only : ocean_grid_type @@ -39,10 +37,10 @@ module ocean_model_mod use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing, only : forcing_save_restart -use MOM_time_manager, only : time_type, get_time, set_time, operator(>) -use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) -use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) -use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real +use MOM_time_manager, only : time_type, operator(>), operator(+), operator(-) +use MOM_time_manager, only : operator(*), operator(/), operator(/=) +use MOM_time_manager, only : operator(<=), operator(>=), operator(<) +use MOM_time_manager, only : real_to_time, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_variables, only : surface @@ -138,6 +136,8 @@ module ocean_model_mod ! This type is private, and can therefore vary between different ocean models. logical :: is_ocean_PE = .false. !< True if this is an ocean PE. type(time_type) :: Time !< The ocean model's time and master clock. + type(time_type) :: Time_dyn !< The ocean model's time for the dynamics. Time and Time_dyn + !! should be the same after a full time step. integer :: Restart_control !< An integer that is bit-tested to determine whether !! incremental restart files are saved and whether they !! have a time stamped name. +1 (bit 0) for generic @@ -145,16 +145,13 @@ module ocean_model_mod !! restart file is saved at the end of a run segment !! unless Restart_control is negative. - integer :: nstep = 0 !< The number of calls to update_ocean. + integer :: nstep = 0 !< The number of calls to update_ocean that update the dynamics. + integer :: nstep_thermo = 0 !< The number of calls to update_ocean that update the thermodynamics. logical :: use_ice_shelf !< If true, the ice shelf model is enabled. logical :: use_waves !< If true use wave coupling. logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the !! ocean dynamics and forcing fluxes. - logical :: restore_salinity !< If true, the coupled MOM driver adds a term to - !! restore salinity to a specified value. - logical :: restore_temp !< If true, the coupled MOM driver adds a term to - !! restore sst to a specified value. real :: press_to_z !< A conversion factor between pressure and ocean !! depth in m, usually 1/(rho_0*g), in m Pa-1. real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. @@ -249,11 +246,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. - character(len=48) :: stagger - integer :: secs, days + character(len=48) :: stagger ! A string indicating the staggering locations for the + ! surface velocities returned to the coupler. type(param_file_type) :: param_file !< A structure to parse for run-time parameters - logical :: use_temperature - type(time_type) :: dt_geometric, dt_savedays, dt_from_base + logical :: use_temperature ! If true, temperature and salinity are state variables. call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then @@ -266,7 +262,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) OS%is_ocean_pe = Ocean_sfc%is_ocean_pe if (.not.OS%is_ocean_pe) return - OS%Time = Time_in + OS%Time = Time_in ; OS%Time_dyn = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & diag_ptr=OS%diag, count_calls=.true.) @@ -320,14 +316,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) else ; call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & trim(stagger)//" is invalid.") ; endif - call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & - "If true, the coupled driver will add a globally-balanced \n"//& - "fresh-water flux that drives sea-surface salinity \n"//& - "toward specified values.", default=.false.) - call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & - "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperauture \n"//& - "toward specified values.", default=.false.) call get_param(param_file, mdl, "RHO_0", Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& @@ -364,7 +352,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & - OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) + OS%forcing_CSp) if (OS%use_ice_shelf) then call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & @@ -408,8 +396,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) - if (is_root_pe()) & - write(*,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + call MOM_mesg('==== Completed MOM6 Coupled Initialization ====', 2) call callTree_leave("ocean_model_init(") end subroutine ocean_model_init @@ -419,23 +406,22 @@ end subroutine ocean_model_init !! time time_start_update) for a time interval of Ocean_coupling_time_step, !! returning the publicly visible ocean surface properties in Ocean_sfc and !! storing the new ocean properties in Ocean_state. -subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & - time_start_update, Ocean_coupling_time_step, & - update_dyn, update_thermo, Ocn_fluxes_used) +subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_update, & + Ocean_coupling_time_step, update_dyn, update_thermo, & + Ocn_fluxes_used, start_cycle, end_cycle, cycle_length) type(ice_ocean_boundary_type), & - intent(in) :: Ice_ocean_boundary !< A structure containing the - !! various forcing fields coming from the ice. + intent(in) :: Ice_ocean_boundary !< A structure containing the various + !! forcing fields coming from the ice and atmosphere. type(ocean_state_type), & - pointer :: OS !< A pointer to a private structure containing - !! the internal ocean state. + pointer :: OS !< A pointer to a private structure containing the + !! internal ocean state. type(ocean_public_type), & - intent(inout) :: Ocean_sfc !< A structure containing all the - !! publicly visible ocean surface fields after - !! a coupling time step. The data in this type is - !! intent out. + intent(inout) :: Ocean_sfc !< A structure containing all the publicly visible + !! ocean surface fields after a coupling time step. + !! The data in this type is intent out. type(time_type), intent(in) :: time_start_update !< The time at the beginning of the update step. - type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over - !! which to advance the ocean. + type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over which to + !! advance the ocean. logical, optional, intent(in) :: update_dyn !< If present and false, do not do updates !! due to the ocean dynamics. logical, optional, intent(in) :: update_thermo !< If present and false, do not do updates @@ -443,39 +429,38 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & logical, optional, intent(in) :: Ocn_fluxes_used !< If present, this indicates whether the !! cumulative thermodynamic fluxes from the ocean, !! like frazil, have been used and should be reset. + logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be + !! treated as the first call to step_MOM in a + !! time-stepping cycle; missing is like true. + logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be + !! treated as the last call to step_MOM in a + !! time-stepping cycle; missing is like true. + real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle, in s. + ! Local variables - type(time_type) :: Master_time ! This allows step_MOM to temporarily change - ! the time that is seen by internal modules. - type(time_type) :: Time1 ! The value of the ocean model's time at the - ! start of a call to step_MOM. - integer :: index_bnds(4) ! The computational domain index bounds in the - ! ice-ocean boundary type. - real :: weight ! Flux accumulation weight - real :: dt_coupling ! The coupling time step in seconds. - integer :: nts ! The number of baroclinic dynamics time steps - ! within dt_coupling. - real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) - real :: dt_dyn ! The dynamics time step in sec. - real :: dtdia ! The diabatic time step in sec. - real :: t_elapsed_seg ! The elapsed time in this update segment, in s. - integer :: n, n_max, n_last_thermo - type(time_type) :: Time2 ! A temporary time. - logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans - ! multiple dynamic timesteps. - logical :: do_dyn ! If true, step the ocean dynamics and transport. - logical :: do_thermo ! If true, step the ocean thermodynamics. - logical :: step_thermo ! If true, take a thermodynamic step. - integer :: secs, days + type(time_type) :: Time_seg_start ! Stores the ocean model time at the start of this call to allow + ! step_MOM to temporarily change the time as seen by internal modules. + type(time_type) :: Time1 ! The value of the ocean model's time at the start of a call to step_MOM. + integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocean boundary type. + real :: weight ! Flux accumulation weight of the current fluxes. + real :: dt_coupling ! The coupling time step in seconds. + real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) + real :: dt_dyn ! The dynamics time step in sec. + real :: dtdia ! The diabatic time step in sec. + real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + integer :: n ! The internal iteration counter. + integer :: nts ! The number of baroclinic dynamics time steps in a thermodynamic step. + integer :: n_max ! The number of calls to step_MOM dynamics in this call to update_ocean_model. + integer :: n_last_thermo ! The iteration number the last time thermodynamics were updated. + logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans multiple dynamic timesteps. + logical :: do_dyn ! If true, step the ocean dynamics and transport. + logical :: do_thermo ! If true, step the ocean thermodynamics. + logical :: step_thermo ! If true, take a thermodynamic step. integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") - call get_time(Ocean_coupling_time_step, secs, days) - dt_coupling = 86400.0*real(days) + real(secs) + dt_coupling = time_type_to_real(Ocean_coupling_time_step) - if (time_start_update /= OS%Time) then - call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& - "agree with time_start_update argument.") - endif if (.not.associated(OS)) then call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & "ocean_state_type structure. ocean_model_init must be "// & @@ -486,113 +471,111 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo + if (do_thermo .and. (time_start_update /= OS%Time)) & + call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& + "agree with time_start_update argument.") + if (do_dyn .and. (time_start_update /= OS%Time_dyn)) & + call MOM_error(WARNING, "update_ocean_model: internal dynamics clock does not "//& + "agree with time_start_update argument.") + + if (.not.(do_dyn .or. do_thermo)) call MOM_error(FATAL, & + "update_ocean_model called without updating either dynamics or thermodynamics.") + if (do_dyn .and. do_thermo .and. (OS%Time /= OS%Time_dyn)) call MOM_error(FATAL, & + "update_ocean_model called to update both dynamics and thermodynamics with inconsistent clocks.") + ! This is benign but not necessary if ocean_model_init_sfc was called or if ! OS%sfc_state%tr_fields was spawned in ocean_model_init. Consider removing it. is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - ! Translate Ice_ocean_boundary into fluxes. + ! Translate Ice_ocean_boundary into fluxes and forces. call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), & index_bnds(3), index_bnds(4)) - weight = 1.0 - - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp) + if (do_dyn) then + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, & + OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used) + if (OS%use_ice_shelf) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + if (OS%icebergs_alter_ocean) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + endif - if (OS%fluxes%fluxes_used) then - if (do_thermo) & + if (do_thermo) then + if (OS%fluxes%fluxes_used) then call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, & - OS%restore_salinity, OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state) - ! Add ice shelf fluxes - if (OS%use_ice_shelf) then - if (do_thermo) & + ! Add ice shelf fluxes + if (OS%use_ice_shelf) & call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) - if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) - endif - if (OS%icebergs_alter_ocean) then - if (do_dyn) & - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - if (do_thermo) & + if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - endif - - ! Fields that exist in both the forcing and mech_forcing types must be copied. - call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid, skip_pres=.true.) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) #ifdef _USE_GENERIC_TRACER - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? - call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) ! Here weight=1, so just store the current fluxes + call disable_averaging(OS%diag) #endif - ! Indicate that there are new unused fluxes. - OS%fluxes%fluxes_used = .false. - OS%fluxes%dt_buoy_accum = dt_coupling - else - OS%flux_tmp%C_p = OS%fluxes%C_p - if (do_thermo) & + ! Indicate that there are new unused fluxes. + OS%fluxes%fluxes_used = .false. + OS%fluxes%dt_buoy_accum = dt_coupling + else + ! The previous fluxes have not been used yet, so translate the input fluxes + ! into a temporary type and then accumulate them in about 20 lines. + OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state) - if (OS%use_ice_shelf) then - if (do_thermo) & + if (OS%use_ice_shelf) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) - if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) - endif - if (OS%icebergs_alter_ocean) then - if (do_dyn) & - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - if (do_thermo) & + if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - endif - - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) - ! Some of the fields that exist in both the forcing and mech_forcing types - ! (e.g., ustar) are time-averages must be copied back to the forces type. - call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) #ifdef _USE_GENERIC_TRACER - call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average + ! Incorporate the current tracer fluxes into the running averages + call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) #endif + endif endif - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) - call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) - if (OS%use_waves) then + ! The net mass forcing is not currently used in the MOM6 dynamics solvers, so this is may be unnecessary. + if (do_dyn .and. associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) & + call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) + + if (OS%use_waves .and. do_thermo) then + ! For now, the waves are only updated on the thermodynamics steps, because that is where + ! the wave intensities are actually used to drive mixing. At some point, the wave updates + ! might also need to become a part of the ocean dynamics, according to B. Reichl. call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) endif - if (OS%nstep==0) then + if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif - call disable_averaging(OS%diag) - Master_time = OS%Time ; Time1 = OS%Time + Time_seg_start = OS%Time ; if (do_dyn) Time_seg_start = OS%Time_dyn + Time1 = Time_seg_start - if (OS%offline_tracer_mode) then + if (OS%offline_tracer_mode .and. do_thermo) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & - Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & + Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & + start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & reset_therm=Ocn_fluxes_used) - !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) - elseif (OS%single_step_call) then call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) dt_dyn = dt_coupling / real(n_max) - thermo_does_span_coupling = (OS%thermo_spans_coupling .and. & - (OS%dt_therm > 1.5*dt_coupling)) + thermo_does_span_coupling = (OS%thermo_spans_coupling .and. (OS%dt_therm > 1.5*dt_coupling)) if (thermo_does_span_coupling) then dt_therm = dt_coupling * floor(OS%dt_therm / dt_coupling + 0.001) @@ -602,7 +585,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & n_last_thermo = 0 endif - Time2 = Time1 ; t_elapsed_seg = 0.0 + Time1 = Time_seg_start ; t_elapsed_seg = 0.0 do n=1,n_max if (OS%diabatic_first) then if (thermo_does_span_coupling) call MOM_error(FATAL, & @@ -610,16 +593,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") if (modulo(n-1,nts)==0) then dtdia = dt_dyn*min(nts,n_max-(n-1)) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) endif - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_dyn, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) @@ -634,28 +617,32 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif if (step_thermo) then - ! Back up Time2 to the start of the thermodynamic segment. - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + ! Back up Time1 to the start of the thermodynamic segment. + Time1 = Time1 - real_to_time(dtdia - dt_dyn) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time1 = Time_seg_start + real_to_time(t_elapsed_seg) enddo endif - OS%Time = Master_time + Ocean_coupling_time_step - OS%nstep = OS%nstep + 1 + if (do_dyn) OS%Time_dyn = Time_seg_start + Ocean_coupling_time_step + if (do_dyn) OS%nstep = OS%nstep + 1 + OS%Time = Time_seg_start ! Reset the clock to compensate for shared pointers. + if (do_thermo) OS%Time = OS%Time + Ocean_coupling_time_step + if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1 - call enable_averaging(dt_coupling, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, & - OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) + if (do_dyn) then + call enable_averaging(dt_coupling, OS%Time_dyn, OS%diag) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%diag) + endif - if (OS%fluxes%fluxes_used) then + if (OS%fluxes%fluxes_used .and. do_thermo) then call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & OS%grid, OS%diag, OS%forcing_CSp%handles) @@ -666,7 +653,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) - call coupler_type_send_data(Ocean_sfc%fields, OS%Time) + Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn + call coupler_type_send_data(Ocean_sfc%fields, Time1) call callTree_leave("update_ocean_model()") end subroutine update_ocean_model diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 3eac851778..4714194f40 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -559,8 +559,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%nstep = OS%nstep + 1 call enable_averaging(time_step, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & - OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 1145ab346c..f427122382 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -251,6 +251,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & real :: delta_sst ! temporary storage for sst diff from restoring value real :: C_p ! heat capacity of seawater ( J/(K kg) ) + 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) @@ -470,15 +471,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! salt flux ! more salt restoring logic if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux(i,j)) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*(-IOB%salt_flux(i-i0,j-j0)) enddo; enddo ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then + sign_for_net_FW_bug = 1. + if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%meltw(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & @@ -1058,6 +1061,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res CS%adjust_net_fresh_water_to_zero, & "If true, adjusts the net fresh-water forcing seen \n"//& "by the ocean (including restoring) to zero.", default=.false.) + if (CS%adjust_net_fresh_water_to_zero) & + call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & + CS%use_net_FW_adjustment_sign_bug, & + "If true, use the wrong sign for the adjustment to\n"//& + "the net fresh-water.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & "If true, adjustments to net fresh water to achieve zero net are\n"//& diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index d58400b270..92fe04bbdf 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -88,8 +88,8 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! surface pressure ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) - ! salt flux - ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) + ! salt flux (minus sign needed here -GMM) + ice_ocean_boundary%salt_flux(i,j) = -x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) ! 1) visible, direct shortwave (W/m2) ! 2) visible, diffuse shortwave (W/m2) diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index eaa11da6c1..68852f89d9 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -12,14 +12,14 @@ module MESO_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, MOM_read_data, slasher -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface implicit none ; private -public MESO_wind_forcing, MESO_buoyancy_forcing, MESO_surface_forcing_init +public MESO_buoyancy_forcing, MESO_surface_forcing_init !> This control structure is used to store parameters associated with the MESO forcing. type, public :: MESO_surface_forcing_CS ; private @@ -52,71 +52,6 @@ module MESO_surface_forcing contains -!### This subroutine sets zero surface wind stresses, but it is not even -!### used by the MESO experimeents. This subroutine can be deleted. -RWH -subroutine MESO_wind_forcing(sfc_state, forces, day, G, CS) - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< The time of the fluxes - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a previous - !! call to MESO_surface_forcing_init - -! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. -! These are the stresses in the direction of the model grid (i.e. the same -! direction as the u- and v- velocities.) They are both in Pa. -! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer. -! -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day - Time of the fluxes. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to MESO_surface_forcing_init - - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - - ! When modifying the code, comment out this error message. It is here - ! so that the original (unmodified) version is not accidentally used. - call MOM_error(FATAL, "MESO_wind_surface_forcing: " // & - "User forcing routine called without modification." ) - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - - ! Allocate the forcing arrays, if necessary. - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) - - ! Set the surface wind stresses, in units of Pa. A positive taux - ! accelerates the ocean to the (pseudo-)east. - - ! The i-loop extends to is-1 so that taux can be used later in the - ! calculation of ustar - otherwise the lower bound would be Isq. - do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = G%mask2dCu(I,j) * 0.0 ! Change this to the desired expression. - enddo ; enddo - do J=js-1,Jeq ; do i=is,ie - forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 ! Change this to the desired expression. - enddo ; enddo - - ! Set the surface friction velocity, in units of m s-1. ustar - ! is always positive. - if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & - sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) - enddo ; enddo ; endif - -end subroutine MESO_wind_forcing - !> This subroutine sets up the MESO buoyancy forcing, which uses control-theory style !! specification restorative buoyancy fluxes at large scales. subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) @@ -130,10 +65,6 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by !! a previous call to MESO_surface_forcing_init -! This subroutine specifies the current surface fluxes of buoyancy or -! temperature and fresh water. It may also be modified to add -! surface fluxes of user provided tracers. - ! When temperature is used, there are long list of fluxes that need to be ! set - essentially the same as for a full coupled model, but most of these ! can be simply set to zero. The net fresh water flux should probably be @@ -144,17 +75,6 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to MESO_surface_forcing_init - real :: Temp_restore ! The temperature that is being restored toward, in C. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored @@ -293,14 +213,6 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MESO_surface_forcing" ! This module's name. @@ -383,9 +295,6 @@ end subroutine MESO_surface_forcing_init !! it is probably a good idea to read the forcing from input files !! using "file" for WIND_CONFIG and BUOY_CONFIG. !! -!! MESO_wind_forcing should set the surface wind stresses (taux and -!! tauy) perhaps along with the surface friction velocity (ustar). -!! !! MESO_buoyancy forcing is used to set the surface buoyancy !! forcing, which may include a number of fresh water flux fields !! (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 61c3f4a509..4933f29182 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -48,7 +48,8 @@ program MOM_main use MOM_string_functions,only : uppercase use MOM_surface_forcing, only : set_forcing, forcing_save_restart use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS - use MOM_time_manager, only : time_type, set_date, set_time, get_date, time_type_to_real + use MOM_time_manager, only : time_type, set_date, get_date + use MOM_time_manager, only : real_to_time, time_type_to_real use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(>), operator(<), operator(>=) use MOM_time_manager, only : increment_date, set_calendar_type, month_name @@ -137,7 +138,7 @@ program MOM_main real :: dt_dyn, dtdia, t_elapsed_seg integer :: n, n_max, nts, n_last_thermo logical :: diabatic_first, single_step_call - type(time_type) :: Time2 + type(time_type) :: Time2, time_chg integer :: Restart_control ! An integer that is bit-tested to determine whether ! incremental restart files are saved and whether they @@ -290,7 +291,7 @@ program MOM_main Start_time = set_date(date_init(1),date_init(2), date_init(3), & date_init(4),date_init(5),date_init(6)) else - Start_time = set_time(0,days=0) + Start_time = real_to_time(0.0) endif call time_interp_external_init @@ -356,7 +357,7 @@ program MOM_main endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) - Time_step_ocean = set_time(int(floor(dt_forcing+0.5))) + Time_step_ocean = real_to_time(dt_forcing) elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) @@ -415,7 +416,7 @@ program MOM_main call get_param(param_file, mod_name, "RESTINT", restint, & "The interval between saves of the restart file in units \n"//& "of TIMEUNIT. Use 0 (the default) to not save \n"//& - "incremental restart files at all.", default=set_time(0), & + "incremental restart files at all.", default=real_to_time(0.0), & timeunit=Time_unit) call get_param(param_file, mod_name, "WRITE_CPU_STEPS", cpu_steps, & "The number of coupled timesteps between writing the cpu \n"//& @@ -454,7 +455,7 @@ program MOM_main if (((.not.BTEST(Restart_control,1)) .and. (.not.BTEST(Restart_control,0))) & .or. (Restart_control < 0)) permit_incr_restart = .false. - if (restint > set_time(0)) then + if (restint > real_to_time(0.0)) then ! restart_time is the next integral multiple of restint. restart_time = Start_time + restint * & (1 + ((Time + Time_step_ocean) - Start_time) / restint) @@ -532,7 +533,7 @@ program MOM_main dtdia = dt_dyn*(n - n_last_thermo) ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + Time2 = Time2 - real_to_time(dtdia - dt_dyn) call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) @@ -541,7 +542,7 @@ program MOM_main endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + real_to_time(t_elapsed_seg) enddo endif @@ -549,17 +550,17 @@ program MOM_main ! This is here to enable fractional-second time steps. elapsed_time = elapsed_time + dt_forcing if (elapsed_time > 2e9) then - ! This is here to ensure that the conversion from a real to an integer - ! can be accurately represented in long runs (longer than ~63 years). - ! It will also ensure that elapsed time does not lose resolution of order - ! the timetype's resolution, provided that the timestep and tick are - ! larger than 10-5 seconds. If a clock with a finer resolution is used, - ! a smaller value would be required. - segment_start_time = segment_start_time + set_time(int(floor(elapsed_time))) - elapsed_time = elapsed_time - floor(elapsed_time) + ! This is here to ensure that the conversion from a real to an integer can be accurately + ! represented in long runs (longer than ~63 years). It will also ensure that elapsed time + ! does not lose resolution of order the timetype's resolution, provided that the timestep and + ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller + ! value would be required. + time_chg = real_to_time(elapsed_time) + segment_start_time = segment_start_time + time_chg + elapsed_time = elapsed_time - time_type_to_real(time_chg) endif if (elapsed_time_master) then - Master_Time = segment_start_time + set_time(int(floor(elapsed_time+0.5))) + Master_Time = segment_start_time + real_to_time(elapsed_time) else Master_Time = Master_Time + Time_step_ocean endif @@ -570,8 +571,7 @@ program MOM_main endif ; endif call enable_averaging(dt_forcing, Time, diag) - call mech_forcing_diags(forces, fluxes, dt_forcing, grid, diag, & - surface_forcing_CSp%handles) + call mech_forcing_diags(forces, dt_forcing, grid, diag, surface_forcing_CSp%handles) call disable_averaging(diag) if (.not. offline_tracer_mode) then diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 351b149830..a3a9a12204 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -32,11 +32,11 @@ module MOM_surface_forcing use MOM_io, only : EAST_FACE, NORTH_FACE, num_timelevels use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS use MOM_restart, only : restart_init_end, save_restart, restore_state -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, set_time +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface -use MESO_surface_forcing, only : MESO_wind_forcing, MESO_buoyancy_forcing +use MESO_surface_forcing, only : MESO_buoyancy_forcing use MESO_surface_forcing, only : MESO_surface_forcing_init, MESO_surface_forcing_CS use Neverland_surface_forcing, only : Neverland_wind_forcing, Neverland_buoyancy_forcing use Neverland_surface_forcing, only : Neverland_surface_forcing_init, Neverland_surface_forcing_CS @@ -226,7 +226,6 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS ! Local variables real :: dt ! length of time in seconds over which fluxes applied type(time_type) :: day_center ! central time of the fluxes. - integer :: intdt integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -234,8 +233,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call callTree_enter("set_forcing, MOM_surface_forcing.F90") day_center = day_start + day_interval/2 - call get_time(day_interval, intdt) - dt = real(intdt) + dt = time_type_to_real(day_interval) if (CS%first_call_set_forcing) then ! Allocate memory for the mechanical and thermodyanmic forcing fields. @@ -275,8 +273,6 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call wind_forcing_const(sfc_state, forces, 0., 0., day_center, G, CS) elseif (trim(CS%wind_config) == "const") then call wind_forcing_const(sfc_state, forces, CS%tau_x0, CS%tau_y0, day_center, G, CS) - elseif (trim(CS%wind_config) == "MESO") then - call MESO_wind_forcing(sfc_state, forces, day_center, G, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then @@ -369,13 +365,10 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS) ! Local variables real :: mag_tau integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_const, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB !set steady surface wind stresses, in units of Pa. mag_tau = sqrt( tau_x0**2 + tau_y0**2) @@ -414,13 +407,10 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) ! Local variables real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_2gyre, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB !set the steady surface wind stresses, in units of Pa. PI = 4.0*atan(1.0) @@ -450,13 +440,10 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) ! Local variables real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_1gyre, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! set the steady surface wind stresses, in units of Pa. PI = 4.0*atan(1.0) @@ -484,25 +471,22 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) ! Local variables real :: PI, y integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_gyres, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! steady surface wind stresses (Pa) PI = 4.0*atan(1.0) - do j=jsd,jed ; do I=is-1,IedB + do j=js-1,je+1 ; do I=is-1,Ieq y = (G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat forces%taux(I,j) = CS%gyres_taux_const + & ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) enddo ; enddo - do J=js-1,JedB ; do i=isd,ied + do J=js-1,Jeq ; do i=is-1,ie+1 forces%tauy(i,J) = 0.0 enddo ; enddo @@ -535,16 +519,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) integer :: time_lev ! The time level that is used for a field. integer :: days, seconds integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB logical :: read_Ustar call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - call get_time(day,seconds,days) + call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) if (time_lev_daily < 31) then ; time_lev_monthly = 0 @@ -774,7 +755,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) Irho0 = 1.0/CS%Rho0 ! Read the buoyancy forcing file - call get_time(day,seconds,days) + call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 65a5ca1339..326b807293 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -12,7 +12,7 @@ module Neverland_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_variables, only : surface implicit none ; private @@ -48,15 +48,15 @@ module Neverland_surface_forcing !! Neverland forcing configuration. subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. + !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< Time used for determining the fluxes. - type(ocean_grid_type), intent(inout) :: G !< Grid structure. - type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. - ! Local variable + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. + + ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: x, y real :: PI real :: tau_max, off @@ -110,26 +110,26 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) end subroutine Neverland_wind_forcing !> Returns the value of a cosine-bell function evaluated at x/L - real function cosbell(x,L) +real function cosbell(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI !< 3.1415926... calculated as 4*atan(1) + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) - PI = 4.0*atan(1.0) - cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) - end function cosbell + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) +end function cosbell !> Returns the value of a sin-spike function evaluated at x/L - real function spike(x,L) +real function spike(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI !< 3.1415926... calculated as 4*atan(1) + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) - PI = 4.0*atan(1.0) - spike = (1 - sin(PI*MIN(ABS(x/L),0.5))) - end function spike + PI = 4.0*atan(1.0) + spike = (1 - sin(PI*MIN(ABS(x/L),0.5))) +end function spike !> Surface fluxes of buoyancy for the Neverland configurations. @@ -218,7 +218,7 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" ! Local variables - character(len=40) :: mod = "Neverland_surface_forcing" ! This module's name. + character(len=40) :: mdl = "Neverland_surface_forcing" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "Neverland_surface_forcing_init called with an associated "// & @@ -229,31 +229,31 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) -! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & ! "The background gustiness in the winds.", units="Pa", & ! default=0.02) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then - call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & diff --git a/config_src/solo_driver/atmos_ocean_fluxes.F90 b/config_src/solo_driver/atmos_ocean_fluxes.F90 index 5494954398..4a4ddf6da3 100644 --- a/config_src/solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/solo_driver/atmos_ocean_fluxes.F90 @@ -13,7 +13,7 @@ module atmos_ocean_fluxes_mod !> This subroutine duplicates an interface used by the FMS coupler, but only !! returns a value of -1. None of the arguments are used for anything. function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, & - param, flag, ice_restart_file, ocean_restart_file, & + param, flag, mol_wt, ice_restart_file, ocean_restart_file, & units, caller, verbosity) result (coupler_index) character(len=*), intent(in) :: name !< An unused argument @@ -22,6 +22,7 @@ function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, integer, optional, intent(in) :: atm_tr_index !< An unused argument real, dimension(:), optional, intent(in) :: param !< An unused argument logical, dimension(:), optional, intent(in) :: flag !< An unused argument + real, optional, intent(in) :: mol_wt !< An unused argument character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument character(len=*), optional, intent(in) :: units !< An unused argument diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index e0136abf0f..7a27c75e18 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -12,7 +12,7 @@ module user_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface @@ -49,30 +49,15 @@ module user_surface_forcing !! direction as the u- and v- velocities.) They are both in Pa. subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. + !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init -! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. -! These are the stresses in the direction of the model grid (i.e. the same -! direction as the u- and v- velocities.) They are both in Pa. -! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer. -! -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day - Time of the fluxes. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init - + ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB ! When modifying the code, comment out this error message. It is here ! so that the original (unmodified) version is not accidentally used. @@ -81,8 +66,6 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) @@ -138,22 +121,12 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init - + ! Local variables real :: Temp_restore ! The temperature that is being restored toward, in C. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored ! toward, in kg m-3. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. + real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. @@ -266,14 +239,6 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to !! the control structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "user_surface_forcing" ! This module's name. diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index a71dfb557c..192b278a09 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -329,7 +329,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta_preale) + call find_eta(h, tv, G, GV, eta_preale, eta_to_m=1.0) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif @@ -760,14 +760,12 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, nz = GV%ke ppt2mks = 0.001 - if (associated(Reg)) then - ntr = Reg%ntr - else - ntr = 0 - endif + ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr if (present(dt)) then Idt = 1.0/dt + work_conc(:,:,:) = 0.0 + work_cont(:,:,:) = 0.0 endif ! Remap tracer @@ -801,22 +799,23 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif ; enddo ; enddo ! tendency diagnostics. - if (Tr%id_remap_conc > 0) then - call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag) - endif - if (Tr%id_remap_cont > 0) then - call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) - endif - if (Tr%id_remap_cont_2d > 0) then - do j = G%jsc,G%jec ; do i = G%isc,G%iec - work_2d(i,j) = 0.0 - do k = 1,GV%ke - work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) - enddo - enddo ; enddo - call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag) + if (present(dt)) then + if (Tr%id_remap_conc > 0) then + call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag) + endif + if (Tr%id_remap_cont > 0) then + call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) + endif + if (Tr%id_remap_cont_2d > 0) then + do j = G%jsc,G%jec ; do i = G%isc,G%iec + work_2d(i,j) = 0.0 + do k = 1,GV%ke + work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) + enddo + enddo ; enddo + call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag) + endif endif - enddo ! m=1,ntr endif ! endif for ntr > 0 @@ -866,7 +865,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif if (CS_ALE%id_vert_remap_h > 0) call post_data(CS_ALE%id_vert_remap_h, h_old, CS_ALE%diag) - if (CS_ALE%id_vert_remap_h_tendency > 0) then + if ((CS_ALE%id_vert_remap_h_tendency > 0) .and. present(dt)) then do k = 1, nz ; do j = G%jsc,G%jec ; do i = G%isc,G%iec work_cont(i,j,k) = (h_new(i,j,k) - h_old(i,j,k))*Idt enddo ; enddo ; enddo @@ -1226,7 +1225,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) integer :: i, j, k do j = G%jsd,G%jed ; do i = G%isd,G%ied - h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j) ) + h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%Zd_to_m*G%bathyT(i,j) ) enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 9f756346bf..1e7da482a3 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -164,12 +164,12 @@ module MOM_regridding contains !> Initialization and configures a regridding control structure based on customizable run-time parameters -subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, param_prefix, param_suffix) +subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, param_prefix, param_suffix) type(regridding_CS), intent(inout) :: CS !< Regridding control structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, intent(in) :: max_depth !< The maximum depth of the ocean, in m. type(param_file_type), intent(in) :: param_file !< Parameter file - character(len=*), intent(in) :: mod !< Name of calling module. + character(len=*), intent(in) :: mdl !< Name of calling module. character(len=*), intent(in) :: coord_mode !< Coordinate mode character(len=*), intent(in) :: param_prefix !< String to prefix to parameter names. !! If empty, causes main model parameters to be used. @@ -199,12 +199,12 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, 250., 375., 500., 500., 500., 500., 500., 500., & 500., 500., 500., 500., 500., 500., 500., 500. /) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) main_parameters=.false. if (len_trim(param_prefix)==0) main_parameters=.true. - if (main_parameters .and. len_trim(param_suffix)>0) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (main_parameters .and. len_trim(param_suffix)>0) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Suffix provided without prefix for parameter names!') CS%nk = 0 @@ -213,7 +213,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (main_parameters) then ! Read coordinate units parameter (main model = REGRIDDING_COORDINATE_UNITS) - call get_param(param_file, mod, "REGRIDDING_COORDINATE_UNITS", coord_units, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_UNITS", coord_units, & "Units of the regridding coordinuate.",& default=coordinateUnits(coord_mode)) else @@ -228,7 +228,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, param_name = trim(param_prefix)//"_INTERP_SCHEME_"//trim(param_suffix) string2 = 'PPM_H4' ! Default for diagnostics endif - call get_param(param_file, mod, "INTERPOLATION_SCHEME", string, & + call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, & "This sets the interpolation scheme to use to\n"//& "determine the new grid. These parameters are\n"//& "only relevant when REGRIDDING_COORDINATE_MODE is\n"//& @@ -239,7 +239,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "BOUNDARY_EXTRAPOLATION", tmpLogical, & + call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", tmpLogical, & "When defined, a proper high-order reconstruction\n"//& "scheme is used within boundary cells rather\n"//& "than PCM. E.g., if PPM is used for remapping, a\n"//& @@ -261,7 +261,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, string2 = 'UNIFORM' if (max_depth>3000.) string2='WOA09' ! For convenience endif - call get_param(param_file, mod, param_name, string, & + call get_param(param_file, mdl, param_name, string, & "Determines how to specify the coordinate\n"//& "resolution. Valid options are:\n"//& " PARAM - use the vector-parameter "//trim(coord_res_param)//"\n"//& @@ -291,7 +291,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ke = extract_integer(string(9:len_trim(string)),'',1) tmpReal = extract_real(string(9:len_trim(string)),',',2,missing_value=max_depth) else - call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Unable to interpret "'//trim(string)//'".') endif allocate(dz(ke)) @@ -302,13 +302,13 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)), & GV%Rlay(ke)+0.5*(GV%Rlay(ke)-GV%Rlay(ke-1)) ) endif - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=trim(coord_units)) elseif (trim(string)=='PARAM') then ! Read coordinate resolution (main model = ALE_RESOLUTION) ke = GV%ke ! Use model nk by default allocate(dz(ke)) - call get_param(param_file, mod, coord_res_param, dz, & + call get_param(param_file, mdl, coord_res_param, dz, & trim(message), units=trim(coord_units), fail_if_missing=.true.) elseif (index(trim(string),'FILE:')==1) then ! FILE:filename,var_name is assumed to be reading level thickness variables @@ -320,7 +320,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(6:)), 2) ) @@ -328,12 +328,12 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (field_exists(fileName,'dz')) then; varName = 'dz' elseif (field_exists(fileName,'dsigma')) then; varName = 'dsigma' elseif (field_exists(fileName,'ztest')) then; varName = 'ztest' - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Coordinate variable not specified and none could be guessed.") endif endif ! This check fails when the variable is a dimension variable! -AJA - !if (.not. field_exists(fileName,trim(varName))) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + !if (.not. field_exists(fileName,trim(varName))) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & ! "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (CS%regridding_scheme == REGRIDDING_SIGMA) then expected_units = 'nondim' @@ -345,7 +345,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (index(trim(varName),'interfaces=')==1) then varName=trim(varName(12:)) call check_grid_def(filename, varName, expected_units, message, ierr) - if (ierr) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "//& + if (ierr) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "//& "Unsupported format in grid definition '"//trim(filename)//"'. Error message "//trim(message)) call field_size(trim(fileName), trim(varName), nzf) ke = nzf(1)-1 @@ -367,15 +367,15 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, call MOM_read_data(trim(fileName), trim(varName), dz) endif if (main_parameters .and. ke/=GV%ke) then - call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Mismatch in number of model levels and "'//trim(string)//'".') endif - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) elseif (index(trim(string),'FNC1:')==1) then ke = GV%ke; allocate(dz(ke)) call dz_function1( trim(string(6:)), dz ) - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) elseif (index(trim(string),'RFNC1:')==1) then ! Function used for set target interface densities @@ -386,24 +386,24 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, allocate(rho_target(ke+1)) fileName = trim( extractWord(trim(string(8:)), 1) ) if (fileName(1:1)/='.' .and. filename(1:1)/='/') fileName = trim(inputdir) // trim( fileName ) - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(8:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") call MOM_read_data(trim(fileName), trim(varName), rho_target) varName = trim( extractWord(trim(string(8:)), 3) ) if (varName(1:5) == 'FNC1:') then ! Use FNC1 to calculate dz call dz_function1( trim(string((index(trim(string),'FNC1:')+5):)), dz ) else ! Read dz from file - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") call MOM_read_data(trim(fileName), trim(varName), dz) endif if (main_parameters) then - call log_param(param_file, mod, "!"//coord_res_param, dz, & + call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) - call log_param(param_file, mod, "!TARGET_DENSITIES", rho_target, & + call log_param(param_file, mdl, "!TARGET_DENSITIES", rho_target, & 'HYBRID target densities for itnerfaces', units=coordinateUnits(coord_mode)) endif elseif (index(trim(string),'WOA09')==1) then @@ -414,16 +414,16 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, tmpReal = tmpReal + woa09_dz(ke) enddo elseif (index(trim(string),'WOA09:')==1) then - if (len_trim(string)==6) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (len_trim(string)==6) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Expected string of form "WOA09:N" but got "'//trim(string)//'".') ke = extract_integer(string(7:len_trim(string)),'',1) endif - if (ke>40 .or. ke<1) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (ke>40 .or. ke<1) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'For "WOA05:N" N must 0 0. ) then dz(ke) = dz(ke) + ( max_depth - tmpReal ) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_DEPTH was too shallow to adjust bottom layer of DZ!"//trim(string)) endif endif @@ -466,7 +466,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! \todo This line looks like it would overwrite the target densities set just above? elseif (coordinateMode(coord_mode) == REGRIDDING_RHO) then call set_target_densities_from_GV(GV, CS) - call log_param(param_file, mod, "!TARGET_DENSITIES", CS%target_density, & + call log_param(param_file, mdl, "!TARGET_DENSITIES", CS%target_density, & 'RHO target densities for interfaces', units=coordinateUnits(coord_mode)) endif @@ -474,7 +474,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, call initCoord(CS, coord_mode) if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & + call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & "When interpolating potential density profiles we can add\n"//& "some artificial compressibility solely to make homogenous\n"//& "regions appear stratified.", default=0.) @@ -482,7 +482,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters) then - call get_param(param_file, mod, "MIN_THICKNESS", tmpReal, & + call get_param(param_file, mdl, "MIN_THICKNESS", tmpReal, & "When regridding, this is the minimum layer\n"//& "thickness allowed.", units="m",& default=regriddingDefaultMinThickness ) @@ -493,21 +493,21 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (coordinateMode(coord_mode) == REGRIDDING_SLIGHT) then ! Set SLight-specific regridding parameters. - call get_param(param_file, mod, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & + call get_param(param_file, mdl, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & "The nominal thickness of fixed thickness near-surface\n"//& "layers with the SLight coordinate.", units="m", default=1.0) - call get_param(param_file, mod, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & + call get_param(param_file, mdl, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & "The number of fixed-depth surface layers with the SLight\n"//& "coordinate.", units="nondimensional", default=2) - call get_param(param_file, mod, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & + call get_param(param_file, mdl, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & "The thickness of the surface region over which to average\n"//& "when calculating the density to use to define the interior\n"//& "with the SLight coordinate.", units="m", default=1.0) - call get_param(param_file, mod, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & + call get_param(param_file, mdl, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & "The number of layers to offset the surface density when\n"//& "defining where the interior ocean starts with SLight.", & units="nondimensional", default=2.0) - call get_param(param_file, mod, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & + call get_param(param_file, mdl, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & "If true, identify regions above the reference pressure\n"//& "where the reference pressure systematically underestimates\n"//& "the stratification and use this in the definition of the\n"//& @@ -518,11 +518,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, nlay_ML_to_interior=nlay_sfc_int, fix_haloclines=fix_haloclines) if (fix_haloclines) then ! Set additional parameters related to SLIGHT_FIX_HALOCLINES. - call get_param(param_file, mod, "HALOCLINE_FILTER_LENGTH", filt_len, & + call get_param(param_file, mdl, "HALOCLINE_FILTER_LENGTH", filt_len, & "A length scale over which to smooth the temperature and\n"//& "salinity before identifying erroneously unstable haloclines.", & units="m", default=2.0) - call get_param(param_file, mod, "HALOCLINE_STRAT_TOL", strat_tol, & + call get_param(param_file, mdl, "HALOCLINE_STRAT_TOL", strat_tol, & "A tolerance for the ratio of the stratification of the\n"//& "apparent coordinate stratification to the actual value\n"//& "that is used to identify erroneously unstable haloclines.\n"//& @@ -535,20 +535,20 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then - call get_param(param_file, mod, "ADAPT_TIME_RATIO", adaptTimeRatio, & + call get_param(param_file, mdl, "ADAPT_TIME_RATIO", adaptTimeRatio, & "Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) !### Should the units be "nondim"? - call get_param(param_file, mod, "ADAPT_ZOOM_DEPTH", adaptZoom, & + call get_param(param_file, mdl, "ADAPT_ZOOM_DEPTH", adaptZoom, & "Depth of near-surface zooming region.", units="m", default=200.0) - call get_param(param_file, mod, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & + call get_param(param_file, mdl, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & "Coefficient of near-surface zooming diffusivity.", & units="nondim", default=0.2) - call get_param(param_file, mod, "ADAPT_BUOY_COEFF", adaptBuoyCoeff, & + call get_param(param_file, mdl, "ADAPT_BUOY_COEFF", adaptBuoyCoeff, & "Coefficient of buoyancy diffusivity.", & units="nondim", default=0.8) - call get_param(param_file, mod, "ADAPT_ALPHA", adaptAlpha, & + call get_param(param_file, mdl, "ADAPT_ALPHA", adaptAlpha, & "Scaling on optimization tendency.", & units="nondim", default=1.0) - call get_param(param_file, mod, "ADAPT_DO_MIN_DEPTH", tmpLogical, & + call get_param(param_file, mdl, "ADAPT_DO_MIN_DEPTH", tmpLogical, & "If true, make a HyCOM-like mixed layer by preventing interfaces\n"//& "from being shallower than the depths specified by the regridding coordinate.", & default=.false.) @@ -559,7 +559,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "MAXIMUM_INT_DEPTH_CONFIG", string, & + call get_param(param_file, mdl, "MAXIMUM_INT_DEPTH_CONFIG", string, & "Determines how to specify the maximum interface depths.\n"//& "Valid options are:\n"//& " NONE - there are no maximum interface depths\n"//& @@ -575,7 +575,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if ( trim(string) == "NONE") then ! Do nothing. elseif ( trim(string) == "PARAM") then - call get_param(param_file, mod, "MAXIMUM_INTERFACE_DEPTHS", z_max, & + call get_param(param_file, mdl, "MAXIMUM_INTERFACE_DEPTHS", z_max, & trim(message), units="m", fail_if_missing=.true.) call set_regrid_max_depths(CS, z_max, GV%m_to_H) elseif (index(trim(string),'FILE:')==1) then @@ -586,18 +586,18 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") do_sum = .false. varName = trim( extractWord(trim(string(6:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (len_trim(varName)==0) then if (field_exists(fileName,'z_max')) then; varName = 'z_max' elseif (field_exists(fileName,'dz')) then; varName = 'dz' ; do_sum = .true. elseif (field_exists(fileName,'dz_max')) then; varName = 'dz_max' ; do_sum = .true. - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_INT_DEPTHS variable not specified and none could be guessed.") endif endif @@ -607,7 +607,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, else call MOM_read_data(trim(fileName), trim(varName), z_max) endif - call log_param(param_file, mod, "!MAXIMUM_INT_DEPTHS", z_max, & + call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_depths(CS, z_max, GV%m_to_H) elseif (index(trim(string),'FNC1:')==1) then @@ -617,11 +617,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, do k=1,nz_fixed_sfc ; dz_max(k) = dz_fixed_sfc ; enddo endif z_max(1) = 0.0 ; do K=1,ke ; z_max(K+1) = z_max(K) + dz_max(K) ; enddo - call log_param(param_file, mod, "!MAXIMUM_INT_DEPTHS", z_max, & + call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_depths(CS, z_max, GV%m_to_H) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Unrecognized MAXIMUM_INT_DEPTH_CONFIG "//trim(string)) endif deallocate(z_max) @@ -629,7 +629,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Optionally specify maximum thicknesses for each layer, enforced by moving ! the interface below a layer downward. - call get_param(param_file, mod, "MAX_LAYER_THICKNESS_CONFIG", string, & + call get_param(param_file, mdl, "MAX_LAYER_THICKNESS_CONFIG", string, & "Determines how to specify the maximum layer thicknesses.\n"//& "Valid options are:\n"//& " NONE - there are no maximum layer thicknesses\n"//& @@ -644,7 +644,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if ( trim(string) == "NONE") then ! Do nothing. elseif ( trim(string) == "PARAM") then - call get_param(param_file, mod, "MAX_LAYER_THICKNESS", h_max, & + call get_param(param_file, mdl, "MAX_LAYER_THICKNESS", h_max, & trim(message), units="m", fail_if_missing=.true.) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) elseif (index(trim(string),'FILE:')==1) then @@ -655,30 +655,30 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(6:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (len_trim(varName)==0) then if (field_exists(fileName,'h_max')) then; varName = 'h_max' elseif (field_exists(fileName,'dz_max')) then; varName = 'dz_max' - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_INT_DEPTHS variable not specified and none could be guessed.") endif endif call MOM_read_data(trim(fileName), trim(varName), h_max) - call log_param(param_file, mod, "!MAX_LAYER_THICKNESS", h_max, & + call log_param(param_file, mdl, "!MAX_LAYER_THICKNESS", h_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) elseif (index(trim(string),'FNC1:')==1) then call dz_function1( trim(string(6:)), h_max ) - call log_param(param_file, mod, "!MAX_LAYER_THICKNESS", h_max, & + call log_param(param_file, mdl, "!MAX_LAYER_THICKNESS", h_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Unrecognized MAX_LAYER_THICKNESS_CONFIG "//trim(string)) endif deallocate(h_max) @@ -904,7 +904,7 @@ subroutine check_remapping_grid( G, GV, h, dzInterface, msg ) !$OMP parallel do default(shared) do j = G%jsc-1,G%jec+1 do i = G%isc-1,G%iec+1 - if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) + if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%Zd_to_m*G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) enddo enddo @@ -1147,7 +1147,7 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) endif ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column thickness totalThickness = 0.0 @@ -1236,7 +1236,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) endif ! The rest of the model defines grids integrating up from the bottom - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column height totalThickness = 0.0 @@ -1340,7 +1340,7 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, & @@ -1445,7 +1445,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K = 1, GV%ke @@ -1576,7 +1576,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz z_col(K+1) = z_col(K) + h(i, j, k) ! Work in units of h (m or Pa) @@ -1677,7 +1677,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) ! Arguments type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original ayer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses, in H real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H real, intent(inout) :: h_new !< New layer thicknesses, in H type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -1697,14 +1697,14 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) nz = GV%ke - max_depth = G%max_depth - min_thickness = CS%min_thickness + max_depth = G%max_depth*GV%Z_to_H + min_thickness = CS%min_thickness !### May need *GV%m_to_H ? do j = G%jsc-1,G%jec+1 do i = G%isc-1,G%iec+1 ! Local depth - local_depth = G%bathyT(i,j)*GV%m_to_H + local_depth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column height total_height = 0.0 @@ -1998,7 +1998,7 @@ subroutine set_regrid_max_depths( CS, max_depths, units_to_H ) if (.not.allocated(CS%max_interface_depths)) allocate(CS%max_interface_depths(1:CS%nk+1)) - val_to_H = 1.0 ; if (present( units_to_H)) val_to_H = units_to_H + val_to_H = 1.0 ; if (present(units_to_H)) val_to_H = units_to_H if (max_depths(CS%nk+1) < max_depths(1)) val_to_H = -1.0*val_to_H ! Check for sign reversals in the depths. diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 5b17c3b57c..91ba50fab7 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -126,7 +126,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) zNext(nz+1) = zInt(i,j,nz+1) ! local depth for scaling diffusivity - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ! initialize del2sigma to zero del2sigma(:) = 0. diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f6bf668b73..1a590bb5b8 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -40,7 +40,7 @@ module MOM use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS use MOM_spatial_means, only : global_mass_integral -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, real_to_time, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_time_manager, only : operator(>=), increment_date use MOM_unit_tests, only : unit_tests @@ -72,10 +72,11 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid +use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze use MOM_fixed_initialization, only : MOM_initialize_fixed -use MOM_grid, only : ocean_grid_type, set_first_direction -use MOM_grid, only : MOM_grid_init, MOM_grid_end +use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end +use MOM_grid, only : set_first_direction, rescale_grid_bathymetry use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init @@ -113,6 +114,7 @@ module MOM use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd +use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units use MOM_wave_interface, only : wave_parameters_CS, waves_end use MOM_wave_interface, only : Update_Stokes_Drift @@ -272,7 +274,7 @@ module MOM ! These elements are used to control the calculation and error checking of the surface state real :: Hmix !< Diagnostic mixed layer thickness over which to - !! average surface tracer properties (in meter) when + !! average surface tracer properties (in depth units, Z) when !! bulk mixed layer is not used, or a negative value !! if a bulk mixed layer is being used. real :: HFrz !< If HFrz > 0, melt potential will be computed. @@ -280,7 +282,7 @@ module MOM !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. real :: Hmix_UV !< Depth scale over which to average surface flow to - !! feedback to the coupler/driver (m) when + !! feedback to the coupler/driver (in depth units, Z) when !! bulk mixed layer is not used, or a negative value !! if a bulk mixed layer is being used. logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values. @@ -559,7 +561,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo if (associated(CS%VarMix)) then - call enable_averaging(cycle_time, Time_start+set_time(int(cycle_time)), & + call enable_averaging(cycle_time, Time_start + real_to_time(cycle_time), & CS%diag) call calc_resoln_function(h, CS%tv, G, GV, CS%VarMix) call disable_averaging(CS%diag) @@ -585,7 +587,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom - call enable_averaging(time_interval, Time_start + set_time(int(floor(time_interval+0.5))), CS%diag) + call enable_averaging(time_interval, Time_start + real_to_time(time_interval), CS%diag) call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) call disable_averaging(CS%diag) endif @@ -607,9 +609,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do n=1,n_max rel_time = rel_time + dt ! The relative time at the end of the step. ! Set the universally visible time to the middle of the time step. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) ! Set the local time to the end of the time step. - Time_local = Time_start + set_time(int(floor(rel_time+0.5))) + Time_local = Time_start + real_to_time(rel_time) if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) @@ -636,10 +638,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (dtdia > dt) then ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they begin at the same time. - CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + CS%Time = CS%Time + real_to_time(0.5*(dtdia-dt)) ! The end-time of the diagnostic interval needs to be set ahead if there ! are multiple dynamic time steps worth of thermodynamics applied here. - end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5))) + end_time_thermo = Time_local + real_to_time(dtdia-dt) endif ! Apply diabatic forcing, do mixing, and regrid. @@ -652,7 +654,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" if (do_dyn) then @@ -734,7 +736,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they end at the same time. - if (dtdia > dt) CS%Time = CS%Time - set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & @@ -743,7 +745,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_thermo = 0.0 if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) endif if (do_dyn) then @@ -751,7 +753,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, GV%g_Earth, G, GV, ssh, CS%eta_av_bc) + call find_eta(h, CS%tv, G, GV, ssh, CS%eta_av_bc, eta_to_m=1.0) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -777,7 +779,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_diag = 0.0 call cpu_clock_begin(id_clock_Z_diag) - if (Time_local + set_time(int(0.5*dt_therm)) > CS%Z_diag_time) then + if (Time_local + real_to_time(0.5*dt_therm) > CS%Z_diag_time) then call enable_averaging(real(time_type_to_real(CS%Z_diag_interval)), & CS%Z_diag_time, CS%diag) !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? @@ -855,7 +857,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (MOM_state_is_synchronized(CS)) & call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, CS%sum_output_CSp, CS%tracer_flow_CSp, & - dt_forcing=set_time(int(floor(time_interval+0.5))) ) + dt_forcing=real_to_time(time_interval) ) call cpu_clock_end(id_clock_other) @@ -915,7 +917,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - call enable_averaging(dt_thermo, Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag) + call enable_averaging(dt_thermo, Time_local+real_to_time(dt_thermo-dt), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) @@ -934,7 +936,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then call enable_averaging(bbl_time_int, & - Time_local + set_time(int(bbl_time_int-dt+0.5)), CS%diag) + Time_local + real_to_time(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, & @@ -1574,7 +1576,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt, conv2salt, H_convert + real :: conv2watt, conv2salt character(len=48) :: flux_units, S_flux_units type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables. @@ -1753,12 +1755,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth \n"//& "over which to average to find surface properties like \n"//& "SST and SSS or density (but not surface velocities).", & - units="m", default=1.0) + units="m", default=1.0) !, scale=GV%m_to_Z) call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", CS%Hmix_UV, & "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth\n"//& "over which to average to find surface flow properties,\n"//& "SSU, SSV. A non-positive value indicates no averaging.", & - units="m", default=0.) + units="m", default=0.) !, scale=GV%m_to_Z) endif call get_param(param_file, "MOM", "HFREEZE", CS%HFrz, & "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& @@ -1950,7 +1952,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV ) GV => CS%GV -! dG%g_Earth = GV%g_Earth +! dG%g_Earth = (GV%g_Earth*GV%m_to_Z) + !### These should be merged with the get_param calls, but must follow verticalGridInit. + if (.not.bulkmixedlayer) then + CS%Hmix = CS%Hmix * GV%m_to_Z + CS%Hmix_UV = CS%Hmix_UV * GV%m_to_Z + endif ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. dG%symmetric) & @@ -1964,6 +1971,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Allocate initialize time-invariant MOM variables. call MOM_initialize_fixed(dG, CS%OBC, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") + ! This could replace a later call to rescale_grid_bathymetry. + if (dG%Zd_to_m /= GV%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, GV%Z_to_m) + if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, CS%OBC) call tracer_registry_init(param_file, CS%tracer_Reg) @@ -1974,7 +1984,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & IsdB = dG%IsdB ; IedB = dG%IedB ; JsdB = dG%JsdB ; JedB = dG%JedB ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0 ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0 - ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom + ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom_H ALLOC_(CS%uh(IsdB:IedB,jsd:jed,nz)) ; CS%uh(:,:,:) = 0.0 ALLOC_(CS%vh(isd:ied,JsdB:JedB,nz)) ; CS%vh(:,:,:) = 0.0 if (use_temperature) then @@ -2005,10 +2015,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & conv2watt = GV%H_to_kg_m2 * CS%tv%C_p if (GV%Boussinesq) then conv2salt = GV%H_to_m ! Could change to GV%H_to_kg_m2 * 0.001? - H_convert = GV%H_to_m else conv2salt = GV%H_to_kg_m2 - H_convert = GV%H_to_kg_m2 endif call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & @@ -2124,11 +2132,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Initialize dynamically evolving fields, perhaps from restart files. call cpu_clock_begin(id_clock_MOM_init) call MOM_initialize_coord(GV, param_file, write_geom_files, & - dirs%output_directory, CS%tv, dG%max_depth) + dirs%output_directory, CS%tv, dG%max_depth*dG%Zd_to_m) call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)") if (CS%use_ALE_algorithm) then - call ALE_init(param_file, GV, dG%max_depth, CS%ALE_CSp) + call ALE_init(param_file, GV, dG%max_depth*dG%Zd_to_m, CS%ALE_CSp) call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif @@ -2140,14 +2148,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G) call destroy_dyn_horgrid(dG) + ! This could replace an earlier call to rescale_dyn_horgrid_bathymetry just after MOM_initialize_fixed. + ! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m) + ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. - if (CS%debug .or. G%symmetric) & + if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) + else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? - G%ke = GV%ke ; G%g_Earth = GV%g_Earth + G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, param_file, & dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2173,9 +2185,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call MOM_grid_end(G) ; deallocate(G) G => CS%G - if (CS%debug .or. CS%G%symmetric) & + if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) - G%ke = GV%ke ; G%g_Earth = GV%g_Earth + else ; CS%G%Domain_aux => CS%G%Domain ;endif + G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z) endif @@ -2284,8 +2297,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) - call VarMix_init(Time, G, param_file, diag, CS%VarMix) - call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, CS%OBC) + call VarMix_init(Time, G, GV, param_file, diag, CS%VarMix) + call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -2294,7 +2307,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) if (CS%dtbt_reset_period > 0.0) then - CS%dtbt_reset_interval = set_time(int(floor(CS%dtbt_reset_period))) + CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * & ((Time - Time_init) / CS%dtbt_reset_interval) @@ -2320,7 +2333,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call thickness_diffuse_init(Time, G, GV, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, param_file, diag, & - CS%mixedlayer_restrat_CSp) + CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%mixedlayer_restrat) then if (.not.(bulkmixedlayer .or. CS%use_ALE_algorithm)) & call MOM_error(FATAL, "MOM: MIXEDLAYER_RESTRAT true requires a boundary layer scheme.") @@ -2333,11 +2346,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) - CS%Z_diag_interval = set_time(int((CS%dt_therm) * & - max(1,floor(0.01 + Z_diag_int/(CS%dt_therm))))) + CS%Z_diag_interval = real_to_time(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) call MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS%diag_to_Z_CSp) CS%Z_diag_time = Start_time + CS%Z_diag_interval * (1 + & - ((Time + set_time(int(CS%dt_therm))) - Start_time) / CS%Z_diag_interval) + ((Time + real_to_time(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) @@ -2428,9 +2440,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc, eta) + call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta, eta_to_m=1.0) else - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc) + call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta_to_m=1.0) endif endif if (CS%split) deallocate(eta) @@ -2445,17 +2457,19 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & .not.((dirs%input_filename(1:1) == 'r') .and. & (LEN_TRIM(dirs%input_filename) == 1)) - if (CS%ensemble_ocean) then - call init_oda(Time, G, GV, CS%odaCS) + call init_oda(Time, G, GV, CS%odaCS) endif + !### This could perhaps go here instead of in finish_MOM_initialization? + ! call fix_restart_scaling(GV) + call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) end subroutine initialize_MOM -!> Finishe initializing MOM and writes out the initial conditions. +!> Finishes initializing MOM and writes out the initial conditions. subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(time_type), intent(in) :: Time !< model time, used in this routine type(directories), intent(in) :: dirs !< structure with directory paths @@ -2467,7 +2481,6 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(verticalGrid_type), pointer :: GV => NULL() type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() real, allocatable :: z_interface(:,:,:) ! Interface heights (meter) - real, allocatable :: eta(:,:) ! Interface heights (meter) type(vardesc) :: vd call cpu_clock_begin(id_clock_init) @@ -2476,12 +2489,15 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) ! Pointers for convenience G => CS%G ; GV => CS%GV + !### Move to initialize_MOM? + call fix_restart_scaling(GV) + ! Write initial conditions if (CS%write_IC) then allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1)) - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, z_interface) + call find_eta(CS%h, CS%tv, G, GV, z_interface, eta_to_m=1.0) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') @@ -2614,10 +2630,16 @@ subroutine set_restart_fields(GV, param_file, CS, restart_CSp) call get_param(param_file, '', "ICE_SHELF", use_ice_shelf, default=.false., & do_not_log=.true.) if (use_ice_shelf .and. associated(CS%Hml)) then - call register_restart_field(CS%Hml, "hML", .false., restart_CSp, & - "Mixed layer thickness", "meter") + call register_restart_field(CS%Hml, "hML", .false., restart_CSp, & + "Mixed layer thickness", "meter") endif + ! Register scalar unit conversion factors. + call register_restart_field(GV%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & + "Height unit conversion factor", "Z meter-1") + call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & + "Thickness unit conversion factor", "Z meter-1") + end subroutine set_restart_fields !> Apply a correction to the sea surface height to compensate @@ -2650,7 +2672,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) else Rho_conv=GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * GV%g_Earth) + IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*GV%m_to_Z)) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; endif @@ -2675,14 +2697,15 @@ subroutine extract_surface_state(CS, sfc_state) u => NULL(), & !< u : zonal velocity component (m/s) v => NULL(), & !< v : meridional velocity component (m/s) h => NULL() !< h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - real :: depth(SZI_(CS%G)) !< distance from the surface (meter) - real :: depth_ml !< depth over which to average to - !< determine mixed layer properties (meter) - real :: dh !< thickness of a layer within mixed layer (meter) - real :: mass !< mass per unit area of a layer (kg/m2) - real :: T_freeze !< freezing temperature (oC) - real :: delT(SZI_(CS%G)) !< T-T_freeze (oC) - logical :: use_temperature !< If true, temp and saln used as state variables. + real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units (Z) + real :: depth_ml !< Depth over which to average to determine mixed + !! layer properties (Z) + real :: dh !< Thickness of a layer within the mixed layer (Z) + real :: mass !< Mass per unit area of a layer (kg/m2) + real :: bathy_m !< The depth of bathymetry in m (not Z), used for error checking. + real :: T_freeze !< freezing temperature (oC) + real :: delT(SZI_(CS%G)) !< T-T_freeze (oC) + logical :: use_temperature !< If true, temp and saln used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors integer :: isd, ied, jsd, jed integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB @@ -2736,7 +2759,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo else ! (CS%Hmix >= 0.0) - + !### This calculation should work in thickness (H) units instead of Z, but that + !### would change answers at roundoff in non-Boussinesq cases. depth_ml = CS%Hmix ! Determine the mean tracer properties of the uppermost depth_ml fluid. !$OMP parallel do default(shared) private(depth,dh) @@ -2751,8 +2775,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo do k=1,nz ; do i=is,ie - if (depth(i) + h(i,j,k)*GV%H_to_m < depth_ml) then - dh = h(i,j,k)*GV%H_to_m + if (depth(i) + h(i,j,k)*GV%H_to_Z < depth_ml) then + dh = h(i,j,k)*GV%H_to_Z elseif (depth(i) < depth_ml) then dh = depth_ml - depth(i) else @@ -2768,19 +2792,23 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do i=is,ie - if (depth(i) < GV%H_subroundoff*GV%H_to_m) & - depth(i) = GV%H_subroundoff*GV%H_to_m + if (depth(i) < GV%H_subroundoff*GV%H_to_Z) & + depth(i) = GV%H_subroundoff*GV%H_to_Z if (use_temperature) then sfc_state%SST(i,j) = sfc_state%SST(i,j) / depth(i) sfc_state%SSS(i,j) = sfc_state%SSS(i,j) / depth(i) else sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i) endif + !### Verify that this is no longer needed. + ! sfc_state%Hml(i,j) = GV%Z_to_m * depth(i) enddo enddo ! end of j loop ! Determine the mean velocities in the uppermost depth_ml fluid. if (CS%Hmix_UV>0.) then + !### This calculation should work in thickness (H) units instead of Z, but that + !### would change answers at roundoff in non-Boussinesq cases. depth_ml = CS%Hmix_UV !$OMP parallel do default(shared) private(depth,dh,hv) do J=jscB,jecB @@ -2789,7 +2817,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%v(i,J) = 0.0 enddo do k=1,nz ; do i=is,ie - hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%H_to_m + hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%H_to_Z if (depth(i) + hv < depth_ml) then dh = hv elseif (depth(i) < depth_ml) then @@ -2802,8 +2830,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do i=is,ie - if (depth(i) < GV%H_subroundoff*GV%H_to_m) & - depth(i) = GV%H_subroundoff*GV%H_to_m + if (depth(i) < GV%H_subroundoff*GV%H_to_Z) & + depth(i) = GV%H_subroundoff*GV%H_to_Z sfc_state%v(i,J) = sfc_state%v(i,J) / depth(i) enddo enddo ! end of j loop @@ -2815,7 +2843,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%u(I,j) = 0.0 enddo do k=1,nz ; do I=iscB,iecB - hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_m + hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_Z if (depth(i) + hu < depth_ml) then dh = hu elseif (depth(I) < depth_ml) then @@ -2828,8 +2856,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do I=iscB,iecB - if (depth(I) < GV%H_subroundoff*GV%H_to_m) & - depth(I) = GV%H_subroundoff*GV%H_to_m + if (depth(I) < GV%H_subroundoff*GV%H_to_Z) & + depth(I) = GV%H_subroundoff*GV%H_to_Z sfc_state%u(I,j) = sfc_state%u(I,j) / depth(I) enddo enddo ! end of j loop @@ -2941,10 +2969,11 @@ subroutine extract_surface_state(CS, sfc_state) numberOfErrors=0 ! count number of errors do j=js,je; do i=is,ie if (G%mask2dT(i,j)>0.) then - localError = sfc_state%sea_lev(i,j)<=-G%bathyT(i,j) & + bathy_m = G%Zd_to_m*G%bathyT(i,j) + localError = sfc_state%sea_lev(i,j)<=-bathy_m & .or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j)+G%bathyT(i,j) < CS%bad_vol_col_thick + .or. sfc_state%sea_lev(i,j) + bathy_m < CS%bad_vol_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & @@ -2957,7 +2986,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) @@ -2965,7 +2994,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) endif diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 7bff7a68b7..948901ac63 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -222,7 +222,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke h_neglect = GV%H_subroundoff - h_tiny = GV%Angstrom ! Perhaps this should be set to h_neglect instead. + h_tiny = GV%Angstrom_H ! Perhaps this should be set to h_neglect instead. !$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h) do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2 diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index d1a2a41a38..ebefd38bcf 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -16,7 +16,7 @@ module MOM_PressureForce use MOM_PressureForce_Mont, only : PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss use MOM_PressureForce_Mont, only : PressureForce_Mont_init, PressureForce_Mont_end use MOM_PressureForce_Mont, only : PressureForce_Mont_CS -use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS +use MOM_tidal_forcing, only : tidal_forcing_CS use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_ALE, only: ALE_CS diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index c68ac56305..4f295600cd 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -96,11 +96,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! enable the use of a reduced gravity form of the equations, ! in m2 s-2. dp_star, & ! Layer thickness after compensation for compressibility, in Pa. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! Bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. - geopot_bot, & ! Bottom geopotential relative to time-mean sea level, + ! astronomical sources and self-attraction and loading, in Z. + geopot_bot ! Bottom geopotential relative to time-mean sea level, ! including any tidal contributions, in units of m2 s-2. - SSH ! Sea surface height anomalies, in m. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer, in kg m-3. @@ -116,7 +116,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! barotropic and baroclinic pieces. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: I_gEarth + real :: I_gEarth ! The inverse of g_Earth, in s2 Z m-2 real :: dalpha real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer, in kg m-3. @@ -143,36 +143,30 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, I_gEarth = 1.0 / GV%g_Earth dp_neglect = GV%H_to_Pa * GV%H_subroundoff -!$OMP parallel default(none) shared(nz,alpha_Lay,GV,dalpha_int) -!$OMP do do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo -!$OMP do do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo -!$OMP end parallel -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,p,p_atm,GV,h,use_p_atm) if (use_p_atm) then -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = p_atm(i,j) ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = 0.0 ; enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa * h(i,j,k) enddo ; enddo ; enddo -!$OMP end parallel if (present(eta)) then Pa_to_H = 1.0 / GV%H_to_Pa if (use_p_atm) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,eta,p,p_atm,Pa_to_H) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = (p(i,j,nz+1) - p_atm(i,j))*Pa_to_H ! eta has the same units as h. enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,eta,p,Pa_to_H) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = p(i,j,nz+1)*Pa_to_H ! eta has the same units as h. enddo ; enddo @@ -182,37 +176,34 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, if (CS%tides) then ! Determine the sea surface height anomalies, to enable the calculation ! of self-attraction and loading. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,SSH,G,GV,use_EOS,tv,p,dz_geo, & -!$OMP I_gEarth,h,alpha_Lay) -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = -G%bathyT(i,j) enddo ; enddo if (use_EOS) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), & 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1) enddo -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz; do i=Isq,Ieq+1 SSH(i,j) = SSH(i,j) + I_gEarth * dz_geo(i,j,k) enddo ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 - SSH(i,j) = SSH(i,j) + GV%H_to_kg_m2*h(i,j,k)*alpha_Lay(k) + SSH(i,j) = SSH(i,j) + (GV%m_to_Z*GV%H_to_kg_m2)*h(i,j,k)*alpha_Lay(k) enddo ; enddo ; enddo endif -!$OMP end parallel - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV,e_tidal) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) enddo ; enddo @@ -229,8 +220,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, tv_tmp%T => T_tmp ; tv_tmp%S => S_tmp tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,nkmb,tv_tmp,tv,p_ref,GV) & -!$OMP private(Rho_cv_BL) + !$OMP parallel do default(shared) private(Rho_cv_BL) do j=Jsq,Jeq+1 do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) @@ -250,8 +240,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = 0 ; enddo endif -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv_tmp,p_ref,tv,alpha_star) & -!$OMP private(rho_in_situ) + !$OMP parallel do default(shared) private(rho_in_situ) do k=1,nz ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k),tv_tmp%S(:,j,k),p_ref, & rho_in_situ,Isq,Ieq-Isq+2,tv%eqn_of_state) @@ -260,7 +249,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, endif ! use_EOS if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,geopot_bot,p,alpha_star) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_star(i,j,nz) @@ -270,8 +259,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, enddo ; enddo enddo else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,geopot_bot,p,& -!$OMP alpha_Lay,dalpha_int) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_Lay(nz) @@ -284,11 +272,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,dM,CS,M) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * M(i,j,1) enddo ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,dM,M) + !$OMP parallel do default(shared) do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k) + dM(i,j) enddo ; enddo ; enddo @@ -312,16 +300,13 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! Note that ddM/dPb = alpha_star(i,j,1) if (present(pbce)) then - call Set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce, & - alpha_star) + call Set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce, alpha_star) endif ! Calculate the pressure force. On a Cartesian grid, ! PFu = - dM/dx and PFv = - dM/dy. if (use_EOS) then -!$OMP parallel do default(none) shared(is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,p,dp_neglect, & -!$OMP alpha_star,G,PFu,PFv,M,CS) & -!$OMP private(dp_star,PFu_bc,PFv_bc) + !$OMP parallel do default(shared) private(dp_star,PFu_bc,PFv_bc) do k=1,nz do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dp_star(i,j) = (p(i,j,K+1) - p(i,j,K)) + dp_neglect @@ -343,7 +328,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, enddo ; enddo enddo ! k-loop else ! .not. use_EOS -!$OMP parallel do default(none) shared(is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,PFu,PFv,M,G) + !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) @@ -405,11 +390,11 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! for compressibility, in m. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal ! forces from astronomical sources and self- - ! attraction and loading, in m. + ! attraction and loading, in depth units (Z). real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: I_Rho0 ! 1/Rho0, in m3 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients, in m s-2. real :: dr ! Temporary variables. @@ -442,7 +427,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - h_neglect = GV%H_subroundoff * GV%H_to_m + h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 G_Rho0 = GV%g_Earth/GV%Rho0 @@ -451,36 +436,34 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! and loading. This should really be based on bottom pressure anomalies, ! but that is not yet implemented, and the current form is correct for ! barotropic tides. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 - do i=Isq,Ieq+1 ; e(i,j,1) = -1.0*G%bathyT(i,j) ; enddo + do i=Isq,Ieq+1 ; e(i,j,1) = -G%bathyT(i,j) ; enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV,e_tidal,CS) if (CS%tides) then -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo -!$OMP end parallel - if (use_EOS) then + if (use_EOS) then ! Calculate in-situ densities (rho_star). ! With a bulk mixed layer, replace the T & S of any layers that are @@ -493,8 +476,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,nkmb,tv_tmp,tv,p_ref,GV) & -!$OMP private(Rho_cv_BL) + !$OMP parallel do default(shared) private(Rho_cv_BL) do j=Jsq,Jeq+1 do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) @@ -518,7 +500,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! This no longer includes any pressure dependency, since this routine ! will come down with a fatal error if there is any compressibility. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv_tmp,p_ref,rho_star,tv,G_Rho0) + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & Isq,Ieq-Isq+2,tv%eqn_of_state) @@ -528,8 +510,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! Here the layer Montgomery potentials, M, are calculated. if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,CS,rho_star,e,use_p_atm, & -!$OMP p_atm,I_Rho0) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = CS%GFS_scale * (rho_star(i,j,1) * e(i,j,1)) @@ -540,7 +521,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta enddo ; enddo enddo else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,GV,e,use_p_atm,p_atm,I_Rho0) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = GV%g_prime(1) * e(i,j,1) @@ -553,16 +534,13 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, & - rho_star) + call Set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, ! PFu = - dM/dx and PFv = - dM/dy. if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,js,je,is,ie,nz,e,h_neglect, & -!$OMP rho_star,G,PFu,CS,PFv,M) & -!$OMP private(h_star,PFu_bc,PFv_bc) + !$OMP parallel do default(shared) private(h_star,PFu_bc,PFv_bc) do k=1,nz do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect @@ -583,7 +561,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta enddo ; enddo enddo ! k-loop else ! .not. use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,is,ie,js,je,nz,PFu,PFv,M,G) + !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) @@ -599,14 +577,14 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! eta is the sea surface height relative to a time-invariant geoid, for ! comparison with what is used for eta in btstep. See how e was calculated ! about 200 lines above. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,eta,e,e_tidal,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,eta,e,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif @@ -619,12 +597,11 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) +subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. @@ -633,41 +610,39 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due !! to free surface height anomalies, in m2 H-1 s-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: rho_star !< The layer densities (maybe compressibility - !! compensated), times g/rho_0, in m s-2. + optional, intent(in) :: rho_star !< The layer densities (maybe compressibility + !! compensated), times g/rho_0, in m2 Z-1 s-2. + ! Local variables - real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer - ! thicknesses, in m-1. + real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses, in H-1. real :: press(SZI_(G)) ! Interface pressure, in Pa. real :: T_int(SZI_(G)) ! Interface temperature in C. real :: S_int(SZI_(G)) ! Interface salinity in PSU. real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. - real :: G_Rho0 ! g_Earth / Rho0 in m4 s-2 kg-1. - real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-2. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. + real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + real :: z_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected, in Z. integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*g_Earth - G_Rho0 = g_Earth/Rho0 + Rho0xG = Rho0*GV%g_Earth + G_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - h_neglect = GV%H_subroundoff*GV%H_to_m + z_neglect = GV%H_subroundoff*GV%H_to_Z if (use_EOS) then if (present(rho_star)) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h_neglect,pbce,rho_star,& -!$OMP GFS_scale,GV) & -!$OMP private(Ihtot) + !$OMP parallel do default(shared) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) - pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_m + Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) + pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * & @@ -675,18 +650,16 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ; enddo enddo ! end of j loop else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,tv,h_neglect,G_Rho0,Rho0xG,& -!$OMP pbce,GFS_scale,GV) & -!$OMP private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS) + !$OMP parallel do default(shared) private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) + Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) press(i) = -Rho0xG*e(i,j,1) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & Isq, Ieq-Isq+2, tv%eqn_of_state) do i=Isq,Ieq+1 - pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_m + pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo do k=2,nz do i=Isq,Ieq+1 @@ -706,15 +679,15 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ! end of j loop endif else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,GV,h_neglect,pbce) private(Ihtot) + !$OMP parallel do default(shared) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) - pbce(i,j,1) = GV%g_prime(1) * GV%H_to_m + Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) + pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & - GV%g_prime(K) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) + (GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop endif ! use_EOS @@ -723,12 +696,11 @@ end subroutine Set_pbce_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the column mass. -subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) +subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures, in Pa. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. !! Usually this ratio is 1. @@ -761,7 +733,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) use_EOS = associated(tv%eqn_of_state) - dP_dH = g_Earth * GV%H_to_kg_m2 + dP_dH = GV%H_to_Pa dp_neglect = dP_dH * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo @@ -769,8 +741,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) if (use_EOS) then if (present(alpha_star)) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,C_htot,dP_dH,p,dp_neglect, & -!$OMP pbce,alpha_star) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect) @@ -782,9 +753,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) enddo ; enddo enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv,p,C_htot, & -!$OMP dP_dH,dp_neglect,pbce) & -!$OMP private(T_int,S_int,dR_dT,dR_dS,rho_in_situ) + !$OMP parallel do default(shared) private(T_int,S_int,dR_dT,dR_dS,rho_in_situ) do j=Jsq,Jeq+1 call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), & rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) @@ -810,8 +779,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) enddo endif else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,C_htot,dP_dH,p,dp_neglect, & -!$OMP pbce,alpha_Lay,dalpha_int) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect) @@ -826,16 +794,14 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) if (GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,dpbce,GFS_scale,pbce,nz) -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dpbce(i,j) = (GFS_scale - 1.0) * pbce(i,j,1) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k) + dpbce(i,j) enddo ; enddo ; enddo -!$OMP end parallel endif end subroutine Set_pbce_nonBouss @@ -896,7 +862,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index c5e783cec3..a27f72cae2 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -127,9 +127,9 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in m. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -152,6 +152,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -165,7 +167,6 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). ! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) - real :: I_gEarth real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k @@ -185,6 +186,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 + g_Earth_z = GV%g_Earth + I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then !$OMP parallel do default(shared) @@ -202,8 +205,6 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1) enddo ; enddo ; enddo - I_gEarth = 1.0 / GV%g_Earth - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -302,7 +303,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -315,10 +316,10 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) + za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) enddo ; enddo endif @@ -402,7 +403,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -451,10 +452,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p !! calculate PFu and PFv, in H, with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -488,17 +489,17 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. + real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in m, like e. + real :: dz_neglect ! A minimal thickness in Z, like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real, parameter :: C1_6 = 1.0/6.0 @@ -520,9 +521,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff * GV%H_to_m + dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + g_Earth_z = GV%g_Earth + G_Rho0 = g_Earth_z/GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -533,33 +535,32 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -1.0*G%bathyT(i,j) + e(i,j,1) = -G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -636,12 +637,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) enddo ; enddo endif !$OMP parallel do default(shared) @@ -667,32 +668,31 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, g_Earth_z, & dz_neglect, G%bathyT, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & - G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & + rho_ref, CS%Rho0, g_Earth_z, & + G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & intx_dpa, inty_dpa) endif else - call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), & - e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, & + call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & + rho_ref, CS%Rho0, g_Earth_z, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & G%bathyT, dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - intz_dpa(i,j) = intz_dpa(i,j)*GV%m_to_H + intz_dpa(i,j) = intz_dpa(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dz(i,j) = GV%g_Earth*GV%H_to_m*h(i,j,k) + dz(i,j) = g_Earth_z * GV%H_to_Z*h(i,j,k) dpa(i,j) = (GV%Rlay(k) - rho_ref)*dz(i,j) intz_dpa(i,j) = 0.5*(GV%Rlay(k) - rho_ref)*dz(i,j)*h(i,j,k) enddo ; enddo @@ -712,7 +712,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p PFu(I,j,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - & (pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa(I,j) - & - (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%m_to_H)) * & + (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa(I,j) = intx_pa(I,j) + intx_dpa(I,j) @@ -723,7 +723,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p PFv(i,J,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - & (pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,J) - & - (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%m_to_H)) * & + (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa(i,J) = inty_pa(i,J) + inty_dpa(i,J) @@ -748,7 +748,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -758,12 +758,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif @@ -834,7 +834,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index ac1938449f..cd5961c23d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -123,9 +123,9 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in m. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -152,6 +152,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -164,7 +166,6 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). ! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) - real :: I_gEarth real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: is_bk, ie_bk, js_bk, je_bk, Isq_bk, Ieq_bk, Jsq_bk, Jeq_bk @@ -183,6 +184,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 + g_Earth_z = GV%g_Earth + I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then !$OMP parallel do default(shared) @@ -200,8 +203,6 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1) enddo ; enddo ; enddo - I_gEarth = 1.0 / GV%g_Earth - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -269,7 +270,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -282,10 +283,10 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) + za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) enddo ; enddo endif @@ -384,7 +385,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -419,7 +420,7 @@ end subroutine PressureForce_blk_AFV_nonBouss subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) @@ -434,10 +435,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !! calculate PFu and PFv, in H, with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in depth units (Z). dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -473,11 +474,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in H. real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in m, like e. + real :: dz_neglect ! A minimal thickness in Z, like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an @@ -505,9 +507,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff * GV%H_to_m + dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + g_Earth_z = GV%g_Earth + G_Rho0 = g_Earth_z / GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -518,33 +521,32 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -1.0*G%bathyT(i,j) + e(i,j,1) = -G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -616,7 +618,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at endif !$OMP parallel do default(none) shared(use_p_atm,rho_ref,G,GV,e,p_atm,nz,use_EOS,& -!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp, & +!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z, & !$OMP h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)& !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, & !$OMP Jeq_bk,ioff_bk,joff_bk,pa_bk, & @@ -636,12 +638,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (use_p_atm) then do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) + pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j) enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth)*e(i,j,1) + pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) enddo ; enddo endif do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk @@ -665,31 +667,30 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, g_Earth_z, & dz_neglect, G%bathyT, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, g_Earth_z, & G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & intx_dpa_bk, inty_dpa_bk) endif else - call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), & - e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, & + call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & + rho_ref, CS%Rho0, g_Earth_z, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & G%bathyT, dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 - intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%m_to_H + intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - dz_bk(ib,jb) = GV%g_Earth*GV%H_to_m*h(i,j,k) + dz_bk(ib,jb) = g_Earth_z*GV%H_to_Z*h(i,j,k) dpa_bk(ib,jb) = (GV%Rlay(k) - rho_ref)*dz_bk(ib,jb) intz_dpa_bk(ib,jb) = 0.5*(GV%Rlay(k) - rho_ref)*dz_bk(ib,jb)*h(i,j,k) enddo ; enddo @@ -707,7 +708,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at PFu(I,j,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - & (pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(Ib,jb) - & - (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%m_to_H)) * & + (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa_bk(Ib,jb) = intx_pa_bk(Ib,jb) + intx_dpa_bk(Ib,jb) @@ -718,7 +719,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at PFv(i,J,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - & (pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,Jb) - & - (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%m_to_H)) * & + (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa_bk(ib,Jb) = inty_pa_bk(ib,Jb) + inty_dpa_bk(ib,Jb) @@ -741,7 +742,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -751,12 +752,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif @@ -827,7 +828,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 940c99b8be..17d0779ef1 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -22,7 +22,7 @@ module MOM_barotropic use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS -use MOM_time_manager, only : time_type, set_time, operator(+), operator(-) +use MOM_time_manager, only : time_type, real_to_time, operator(+), operator(-) use MOM_variables, only : BT_cont_type, alloc_bt_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -97,7 +97,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu - !< Inverse of the basin depth at u grid points, in m-1. + !< Inverse of the basin depth at u grid points, in Z-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC @@ -109,7 +109,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv - !< Inverse of the basin depth at v grid points, in m-1. + !< Inverse of the basin depth at v grid points, in Z-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC @@ -130,20 +130,20 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. - bathyT !< A copy of bathyT (ocean bottom depth) with wide halos. + bathyT !< A copy of bathyT (ocean bottom depth) with wide halos, in depth units real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & - D_u_Cor, & !< A simply averaged depth at u points, in m. + D_u_Cor, & !< A simply averaged depth at u points, in Z. dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m. IdxCu !< A copy of G%IdxCu with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & - D_v_Cor, & !< A simply averaged depth at v points, in m. + D_v_Cor, & !< A simply averaged depth at v points, in Z. dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m. IdyCv !< A copy of G%IdyCv with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & - q_D !< f / D at PV points, in m-1 s-1. + q_D !< f / D at PV points, in Z-1 s-1. real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. @@ -496,7 +496,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points, in s-1. PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force, in m s-2. Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2. - DCor_u, & ! A simply averaged depth at u points, in m. + DCor_u, & ! A simply averaged depth at u points, in Z. Datu ! Basin depth at u-velocity grid points times the y-grid ! spacing, in H m. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & @@ -527,7 +527,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! in m s-2. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, ! in m s-2. - DCor_v, & ! A simply averaged depth at v points, in m. + DCor_v, & ! A simply averaged depth at v points, in Z. Datv ! Basin depth at v-velocity grid points times the x-grid ! spacing, in H m. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & @@ -568,7 +568,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC - real :: I_Rho0 ! The inverse of the mean density (Rho0), in m3 kg-1. + real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0), in m3 kg-1. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity in m s-1. real :: dtbt ! The barotropic time step in s. @@ -708,7 +708,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & dtbt = dt * Instep bebt = CS%bebt be_proj = CS%bebt - I_Rho0 = 1.0/GV%Rho0 + mass_to_Z = GV%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -723,7 +723,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & (CS%id_uhbt_hifreq > 0) .or. (CS%id_vhbt_hifreq > 0)) then do_hifreq_output = query_averaging_enabled(CS%diag, time_int_in, time_end_in) if (do_hifreq_output) & - time_bt_start = time_end_in - set_time(int(floor(dt+0.5))) + time_bt_start = time_end_in - real_to_time(dt) endif !--- begin setup for group halo update @@ -815,7 +815,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1))) + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) enddo ; enddo ! With very wide halos, q and D need to be calculated on the available data @@ -972,24 +972,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatu should be replaced by ! ### CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds). - BT_force_u(I,j) = forces%taux(I,j) * I_rho0*CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z *CS%IDatu(I,j)*visc_rem_u(I,j,1) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatv should be replaced by ! ### CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds). - BT_force_v(i,J) = forces%tauy(i,J) * I_rho0*CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z *CS%IDatv(i,J)*visc_rem_v(i,J,1) enddo ; enddo if (present(taux_bot) .and. present(tauy_bot)) then if (associated(taux_bot) .and. associated(tauy_bot)) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * I_rho0 * CS%IDatu(I,j) + BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * I_rho0 * CS%IDatv(i,J) + BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J) enddo ; enddo endif endif @@ -1291,7 +1291,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do j=js,je ; do I=is-1,ie ; if (CS%lin_drag_u(I,j) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i+1,j)) if (GV%Boussinesq) & - Htot = Htot + 0.5*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) + Htot = Htot + 0.5*GV%Z_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) bt_rem_u(I,j) = bt_rem_u(I,j) * (Htot / (Htot + CS%lin_drag_u(I,j) * dtbt)) Rayleigh_u(I,j) = CS%lin_drag_u(I,j) / Htot @@ -1300,7 +1300,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do J=js-1,je ; do i=is,ie ; if (CS%lin_drag_v(i,J) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i,j+1)) if (GV%Boussinesq) & - Htot = Htot + 0.5*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) + Htot = Htot + 0.5*GV%Z_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) bt_rem_v(i,J) = bt_rem_v(i,J) * (Htot / (Htot + CS%lin_drag_v(i,J) * dtbt)) Rayleigh_v(i,J) = CS%lin_drag_v(i,J) / Htot @@ -1353,7 +1353,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! Limit the sink (inward) correction to the amount of mass that is already ! inside the cell. Htot = eta(i,j) - if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) + if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot)) endif @@ -1459,7 +1459,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, 0, .true., .true.) call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, & G%HI, haloshift=0) - call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0) + call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=GV%m_to_Z) call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, & G%HI, haloshift=1) endif @@ -2008,7 +2008,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & enddo ; enddo if (do_hifreq_output) then - time_step_end = time_bt_start + set_time(int(floor(n*dtbt+0.5))) + time_step_end = time_bt_start + real_to_time(n*dtbt) call enable_averaging(dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) @@ -2323,7 +2323,7 @@ subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) elseif (CS%Nonlinear_continuity .and. present(eta)) then call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH) + call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH*GV%m_to_Z) endif det_de = 0.0 @@ -2633,21 +2633,21 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%m_to_H + eta(i,j) + BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j) + BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j) endif else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j))) + BT_OBC%H_u(I,j) = eta(i,j) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + eta(i+1,j))) + BT_OBC%H_u(I,j) = eta(i+1,j) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * BT_OBC%H_u(i,j)) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_u(i,j)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -2689,21 +2689,21 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%m_to_H + eta(i,j) + BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1) + BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1) endif else if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j)*GV%m_to_Z)) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then BT_OBC%H_v(i,J) = eta(i,j+1) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j+1) + eta(i,j+1))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j+1) + eta(i,j+1)*GV%m_to_Z)) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * BT_OBC%H_v(i,J)) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_v(i,J)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -2857,8 +2857,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do I=is-1,ie - e_u(I,nz+1) = -0.5 * GV%m_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) - D_shallow_u(I) = -GV%m_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) + e_u(I,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) + D_shallow_u(I) = -GV%Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) hatutot(I) = 0.0 enddo do k=nz,1,-1 ; do I=is-1,ie @@ -2920,8 +2920,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do i=is,ie - e_v(i,nz+1) = -0.5 * GV%m_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) - D_shallow_v(I) = -GV%m_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) + e_v(i,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) + D_shallow_v(I) = -GV%Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) hatvtot(I) = 0.0 enddo do k=nz,1,-1 ; do i=is,ie @@ -3542,7 +3542,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !! or column mass anomaly, in H (m or kg m-2). integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used - !! to overestimate the external wave speed) in m. + !! to overestimate the external wave speed) in Z. ! Local variables real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2. @@ -3557,14 +3557,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) if (GV%Boussinesq) then !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - H1 = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j) + H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j) Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - H1 = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1) + H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1) Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2) @@ -3588,13 +3588,13 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) elseif (present(add_max)) then !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = CS%dy_Cu(I,j) * GV%m_to_H * & - (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + Datu(I,j) = CS%dy_Cu(I,j) * GV%Z_to_H * & + (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = CS%dx_Cv(i,J) * GV%m_to_H * & - (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + Datv(i,J) = CS%dx_Cv(i,J) * GV%Z_to_H * & + (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) enddo ; enddo else !$OMP do @@ -3602,7 +3602,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datu(I, j) = 0.0 !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain if (CS%bathyT(i+1,j)+CS%bathyT(i,j)>0.) & - Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%m_to_H * & + Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%Z_to_H * & (CS%bathyT(i+1,j) * CS%bathyT(i,j)) / & (CS%bathyT(i+1,j) + CS%bathyT(i,j)) enddo ; enddo @@ -3611,7 +3611,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datv(i, J) = 0.0 !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain if (CS%bathyT(i,j+1)+CS%bathyT(i,j)>0.) & - Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%m_to_H * & + Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%Z_to_H * & (CS%bathyT(i,j+1) * CS%bathyT(i,j)) / & (CS%bathyT(i,j+1) + CS%bathyT(i,j)) enddo ; enddo @@ -3658,7 +3658,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) do j=js,je do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo if (GV%Boussinesq) then - do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*GV%m_to_H ; enddo + do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*GV%Z_to_H ; enddo else do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo endif @@ -3732,6 +3732,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! drag piston velocity. character(len=80) :: wave_drag_var ! The wave drag piston velocity variable ! name in wave_drag_file. + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in + ! a restart file to the internal representation in this run. real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -3958,7 +3960,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & "An estimate of how much higher SSH might get, for use \n"//& "in calculating the safe external wave speed. The \n"//& "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", & - units="m", default=min(10.0,0.05*G%max_depth)) + units="m", default=min(10.0,0.05*G%max_depth*GV%Z_to_m)) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & @@ -4056,7 +4058,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! IareaT, IdxCu, and IdyCv need to be allocated with wide halos. ALLOC_(CS%IareaT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IareaT(:,:) = 0.0 - ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_z !### Change to 0.0? + ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_m !### Change to 0.0? ALLOC_(CS%IdxCu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IdxCu(:,:) = 0.0 ALLOC_(CS%IdyCv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%IdyCv(:,:) = 0.0 ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 @@ -4065,6 +4067,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & CS%IareaT(i,j) = G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo + ! Note: G%IdxCu & G%IdyCv may be smaller than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB @@ -4097,7 +4100,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1))) + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) else ! All four h points are masked out so q_D(I,J) will is meaningless CS%q_D(I,J) = 0. endif @@ -4142,7 +4145,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! Estimate the maximum stable barotropic time step. gtot_estimate = 0.0 - do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo + do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K)*GV%m_to_Z ; enddo call set_dtbt(G, GV, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) if (dtbt_input > 0.0) then @@ -4302,7 +4305,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & do J=js-1,je ; do i=is,ie if (G%mask2dCv(i,J)>0.) then CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%bathyT(i,j+1) + G%bathyT(i,j)) - else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless + else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless CS%IDatv(i,J) = 0. endif enddo ; enddo @@ -4329,6 +4332,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & .NOT.query_initialized(CS%vhbt_IC,"vhbt_IC",restart_CS)) then do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + uH_rescale = GV%m_to_H / GV%m_to_H_restart + do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = uH_rescale * CS%uhbt_IC(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = uH_rescale * CS%vhbt_IC(I,j) ; enddo ; enddo endif call create_group_pass(pass_bt_hbt_btav, CS%ubt_IC, CS%vbt_IC, G%Domain) @@ -4413,7 +4420,7 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) call register_restart_field(CS%vbt_IC, vd(3), .false., restart_CS) if (GV%Boussinesq) then - vd(2) = var_desc("uhbt_IC", "m3 s-1", & + vd(2) = var_desc("uhbt_IC", "m3 s-1", & longname="Next initial condition for the barotropic zonal transport", & hor_grid='u', z_grid='1') vd(3) = var_desc("vhbt_IC", "m3 s-1", & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 131ecfbe13..bdf6e3f9b1 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -144,7 +144,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, logical :: x_first is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - h_min = GV%Angstrom + h_min = GV%Angstrom_H if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_continuity_PPM: Module must be initialized before it is used.") @@ -312,7 +312,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & enddo ; enddo else call PPM_reconstruction_x(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) endif do I=ish-1,ieh ; visc_rem(I,k) = 1.0 ; enddo enddo @@ -1129,7 +1129,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & enddo ; enddo else call PPM_reconstruction_y(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) endif do i=ish,ieh ; visc_rem(i,k) = 1.0 ; enddo enddo @@ -2221,6 +2221,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) type(continuity_PPM_CS), pointer :: CS !< Module's control structure. !> This include declares and sets the variable "version". #include "version_variable.h" + real :: tol_eta_m ! An unscaled version of tol_eta, in m. character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. if (associated(CS)) then @@ -2254,8 +2255,8 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "height due to the fluxes through each face. The total \n"//& "tolerance for SSH is 4 times this value. The default \n"//& "is 0.5*NK*ANGSTROM, and this should not be set less x\n"//& - "than about 10^-15*MAXIMUM_DEPTH.", units="m", & - default=0.5*G%ke*GV%Angstrom_z) + "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & + default=0.5*G%ke*GV%Angstrom_m, unscaled=tol_eta_m) call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies \n"//& @@ -2263,7 +2264,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "layer thicknesses when calculating the auxiliary \n"//& "corrected velocities. By default, this is the same as \n"//& "ETA_TOLERANCE, but can be made larger for efficiency.", & - units="m", default=CS%tol_eta) + units="m", default=tol_eta_m, scale=GV%m_to_H) call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies \n"//& "between the barotropic solution and the sum of the \n"//& @@ -2299,9 +2300,6 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) id_clock_update = cpu_clock_id('(Ocean continuity update)', grain=CLOCK_ROUTINE) id_clock_correct = cpu_clock_id('(Ocean continuity correction)', grain=CLOCK_ROUTINE) - CS%tol_eta = CS%tol_eta * GV%m_to_H - CS%tol_eta_aux = CS%tol_eta_aux * GV%m_to_H - end subroutine continuity_PPM_init !> continuity_PPM_stencil returns the continuity solver stencil size diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d02285148a..8ab7e0d337 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -30,7 +30,7 @@ module MOM_dynamics_split_RK2 use MOM_io, only : MOM_io_init, vardesc, var_desc use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS @@ -909,7 +909,7 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u ALLOC_(CS%eta(isd:ied,jsd:jed)) ; CS%eta(:,:) = 0.0 ALLOC_(CS%u_av(IsdB:IedB,jsd:jed,nz)) ; CS%u_av(:,:,:) = 0.0 ALLOC_(CS%v_av(isd:ied,JsdB:JedB,nz)) ; CS%v_av(:,:,:) = 0.0 - ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom + ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom_H thickness_units = get_thickness_units(GV) flux_units = get_flux_units(GV) @@ -992,6 +992,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. character(len=48) :: thickness_units, flux_units, eta_rest_name + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in + ! a restart file to the internal representation in this run. real :: H_convert type(group_pass_type) :: pass_av_h_uvh logical :: use_tides, debug_truncations @@ -1110,11 +1114,14 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil ! dimensions as h, either m or kg m-3. ! CS%eta(:,:) = 0.0 already from initialization. if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; CS%eta(i,j) = -G%bathyT(i,j) * GV%m_to_H ; enddo ; enddo + do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo endif do k=1,nz ; do j=js,je ; do i=is,ie CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) enddo ; enddo ; enddo + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo endif ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo @@ -1141,8 +1148,17 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) else - if (.not. query_initialized(CS%h_av,"h2",restart_CS)) & + if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then CS%h_av(:,:,:) = h(:,:,:) + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo + endif + if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + uH_rescale = GV%m_to_H / GV%m_to_H_restart + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo + endif endif call cpu_clock_begin(id_clock_pass_init) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 47d3510c5a..430443de06 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -72,7 +72,7 @@ module MOM_dynamics_unsplit use MOM_io, only : MOM_io_init use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, real_to_time, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS @@ -209,7 +209,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass !! transport since the last tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or - !! column mass, in m or kg m-2. + !! column mass, in H (m or kg m-2). type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields @@ -267,7 +267,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) - call enable_averaging(0.5*dt,Time_local-set_time(int(0.5*dt)), CS%diag) + call enable_averaging(0.5*dt,Time_local-real_to_time(0.5*dt), CS%diag) ! Here the first half of the thickness fluxes are offered for averaging. if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag) if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag) @@ -491,7 +491,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -GV%Z_to_H*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index a1615ad413..3a5db102f2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -70,7 +70,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_io, only : MOM_io_init use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS @@ -221,7 +221,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or mass transport since the last !! tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height - !! or column mass, in m or kg m-2. + !! or column mass, in H (m or kg m-2). type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with @@ -431,7 +431,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -GV%Z_to_H*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index aebba42eaa..fc688f15c0 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -26,11 +26,13 @@ module MOM_forcing_type public extractFluxes1d, extractFluxes2d, optics_type public MOM_forcing_chksum, MOM_mech_forcing_chksum -public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d, forcing_accumulate +public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d +public forcing_accumulate, fluxes_accumulate public forcing_SinglePointPrint, mech_forcing_diags, forcing_diagnostics public register_forcing_type_diags, allocate_forcing_type, deallocate_forcing_type public copy_common_forcing_fields, allocate_mech_forcing, deallocate_mech_forcing -public set_derived_forcing_fields, copy_back_forcing_fields, set_net_mass_forcing +public set_derived_forcing_fields, copy_back_forcing_fields +public set_net_mass_forcing, get_net_mass_forcing !> Structure that contains pointers to the boundary forcing used to drive the !! liquid ocean simulated by MOM. @@ -40,8 +42,6 @@ module MOM_forcing_type !! MESO_surface_forcing.F90, which is a special case of solo_driver/MOM_surface_forcing.F90. type, public :: forcing - ! Pointers in this module should be initialized to NULL. - ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & ustar => NULL(), & !< surface friction velocity scale (m/s) @@ -154,11 +154,10 @@ module MOM_forcing_type logical :: fluxes_used = .true. !< If true, all of the heat, salt, and mass !! fluxes have been applied to the ocean. - real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes + real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes !! should be applied, in s. If negative, this forcing !! type variable has not yet been inialized. - ! heat capacity real :: C_p !< heat capacity of seawater ( J/(K kg) ). !! C_p is is the same value as in thermovar_ptrs_type. @@ -169,7 +168,7 @@ module MOM_forcing_type !! This is not a convenient convention, but imposed on MOM6 by the coupler. ! For internal error tracking - integer :: num_msg = 0 !< Number of messages issues about excessive SW penetration + integer :: num_msg = 0 !< Number of messages issued about excessive SW penetration integer :: max_msg = 2 !< Maximum number of messages to issue about excessive SW penetration end type forcing @@ -213,6 +212,9 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points (m3/s) rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points (m3/s) + real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes + !! have been averaged, in s. + logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level @@ -300,7 +302,7 @@ module MOM_forcing_type integer :: id_netFWGlobalAdj = -1 integer :: id_netFWGlobalScl = -1 - ! momentum flux amd forcing diagnostic handles + ! momentum flux and forcing diagnostic handles integer :: id_taux = -1 integer :: id_tauy = -1 integer :: id_ustar = -1 @@ -887,9 +889,9 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, useRiverHeatContent = .False. useCalvingHeatContent = .False. - depthBeforeScalingFluxes = max( GV%Angstrom, 1.e-30*GV%m_to_H ) + depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc @@ -1073,6 +1075,11 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, haloshift) haloshift=hshift, symmetric=.true.) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) + if (associated(forces%ustar)) & + call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift) + if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & + call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, & + forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true.) end subroutine MOM_mech_forcing_chksum @@ -1804,7 +1811,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use end subroutine register_forcing_type_diags -!> Accumulate the forcing over time steps +!> Accumulate the forcing over time steps, taking input from a mechanical forcing type +!! and a temporary forcing-flux type. subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) type(forcing), intent(in) :: flux_tmp !< A temporary structure with current !!thermodynamic forcing fields @@ -1815,6 +1823,26 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, intent(out) :: wt2 !< The relative weight of the new fluxes + ! This subroutine copies mechancal forcing from flux_tmp to fluxes and + ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, + ! and increments the amount of time over which the buoyancy forcing should be + ! applied, all via a call to fluxes accumulate. + + call fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) + +end subroutine forcing_accumulate + +!> Accumulate the thermodynamic fluxes over time steps +subroutine fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) + type(forcing), intent(in) :: flux_tmp !< A temporary structure with current + !! thermodynamic forcing fields + type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged + !! thermodynamic forcing fields + real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, intent(out) :: wt2 !< The relative weight of the new fluxes + type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces + ! This subroutine copies mechancal forcing from flux_tmp to fluxes and ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, ! and increments the amount of time over which the buoyancy forcing should be @@ -1837,15 +1865,29 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) wt2 = 1.0 - wt1 ! = dt / (fluxes%dt_buoy_accum + dt) fluxes%dt_buoy_accum = fluxes%dt_buoy_accum + dt - ! Copy over the pressure fields. - do j=js,je ; do i=is,ie - fluxes%p_surf(i,j) = forces%p_surf(i,j) - fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) - enddo ; enddo + ! Copy over the pressure fields and accumulate averages of ustar, either from the forcing + ! type or from the temporary fluxes type. + if (present(forces)) then + do j=js,je ; do i=is,ie + fluxes%p_surf(i,j) = forces%p_surf(i,j) + fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) + + fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + fluxes%p_surf(i,j) = flux_tmp%p_surf(i,j) + fluxes%p_surf_full(i,j) = flux_tmp%p_surf_full(i,j) + + fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*flux_tmp%ustar(i,j) + enddo ; enddo + endif ! Average the water, heat, and salt fluxes, and ustar. do j=js,je ; do i=is,ie - fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j) +!### 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) 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) @@ -1933,7 +1975,7 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) call coupler_type_increment_data(flux_tmp%tr_fluxes, fluxes%tr_fluxes, & scale_factor=wt2, scale_prev=wt1) -end subroutine forcing_accumulate +end subroutine fluxes_accumulate !> This subroutine copies the computational domains of common forcing fields !! from a mech_forcing type to a (thermodynamic) forcing type. @@ -1989,9 +2031,12 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) !! as used to calculate ustar. real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. + real :: Irho0 ! Inverse of the mean density in (m^3/kg) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Irho0 = 1.0/Rho0 + if (associated(forces%taux) .and. associated(forces%tauy) .and. & associated(fluxes%ustar_gustless)) then do j=js,je ; do i=is,ie @@ -2007,48 +2052,61 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) / Rho0) +!### Change to: +! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) enddo ; enddo endif end subroutine set_derived_forcing_fields -!> This subroutine calculates determines the net mass source to th ocean from +!> This subroutine determines the net mass source to the ocean from !! a (thermodynamic) forcing type and stores it in a mech_forcing type. subroutine set_net_mass_forcing(fluxes, forces, G) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(ocean_grid_type), intent(in) :: G !< grid type + type(ocean_grid_type), intent(in) :: G !< The ocean grid type + + if (associated(forces%net_mass_src)) & + call get_net_mass_forcing(fluxes, G, forces%net_mass_src) + +end subroutine set_net_mass_forcing + +!> This subroutine calculates determines the net mass source to the ocean from +!! a (thermodynamic) forcing type and stores it in a provided array. +subroutine get_net_mass_forcing(fluxes, G, net_mass_src) + type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields + type(ocean_grid_type), intent(in) :: G !< The ocean grid type + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_mass_src !< The net mass flux of water into the ocean + !! in kg m-2 s-1. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - if (associated(forces%net_mass_src)) then - forces%net_mass_src(:,:) = 0.0 - if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%lprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%fprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%vprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%lrunoff(i,j) - enddo ; enddo ; endif - if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%frunoff(i,j) - enddo ; enddo ; endif - if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%evap(i,j) - enddo ; enddo ; endif - if (associated(fluxes%meltw)) then ; do j=js,je ; do i=is,ie + net_mass_src(:,:) = 0.0 + if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%fprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%vprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lrunoff(i,j) + enddo ; enddo ; endif + if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%frunoff(i,j) + enddo ; enddo ; endif + if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%evap(i,j) + enddo ; enddo ; endif + if (associated(fluxes%meltw)) then ; do j=js,je ; do i=is,ie forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%meltw(i,j) - enddo ; enddo ; endif - endif + enddo ; enddo ; endif -end subroutine set_net_mass_forcing +end subroutine get_net_mass_forcing !> This subroutine copies the computational domains of common forcing fields !! from a mech_forcing type to a (thermodynamic) forcing type. @@ -2071,9 +2129,8 @@ end subroutine copy_back_forcing_fields !> Offer mechanical forcing fields for diagnostics for those !! fields registered as part of register_forcing_type_diags. -subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles) +subroutine mech_forcing_diags(forces, dt, G, diag, handles) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields real, intent(in) :: dt !< time step type(ocean_grid_type), intent(in) :: G !< grid type type(diag_ctrl), intent(in) :: diag !< diagnostic type @@ -2088,20 +2145,15 @@ subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles) if ((handles%id_taux > 0) .and. associated(forces%taux)) & call post_data(handles%id_taux, forces%taux, diag) + if ((handles%id_tauy > 0) .and. associated(forces%tauy)) & call post_data(handles%id_tauy, forces%tauy, diag) - if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & - call post_data(handles%id_ustar, fluxes%ustar, diag) - if (handles%id_ustar_berg > 0) & - call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag) - if (handles%id_area_berg > 0) & - call post_data(handles%id_area_berg, fluxes%area_berg, diag) - if (handles%id_mass_berg > 0) & - call post_data(handles%id_mass_berg, fluxes%mass_berg, diag) - if (handles%id_frac_ice_cover > 0) & - call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag) - if (handles%id_ustar_ice_cover > 0) & - call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag) + + if ((handles%id_mass_berg > 0) .and. associated(forces%mass_berg)) & + call post_data(handles%id_mass_berg, forces%mass_berg, diag) + + if ((handles%id_area_berg > 0) .and. associated(forces%area_berg)) & + call post_data(handles%id_area_berg, forces%area_berg, diag) endif @@ -2152,7 +2204,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) if (associated(fluxes%meltw)) res(i,j) = res(i,j)+fluxes%meltw(i,j) enddo ; enddo - call post_data(handles%id_prcme, res, diag) + if (handles%id_prcme > 0) call post_data(handles%id_prcme, res, diag) if (handles%id_total_prcme > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_prcme, total_transport, diag) @@ -2171,7 +2223,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) if (fluxes%meltw(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%meltw(i,j) enddo ; enddo - call post_data(handles%id_net_massout, res, diag) + if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag) if (handles%id_total_net_massout > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massout, total_transport, diag) @@ -2189,7 +2241,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) if (fluxes%meltw(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%meltw(i,j) enddo ; enddo - call post_data(handles%id_net_massin, res, diag) + if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag) if (handles%id_total_net_massin > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massin, total_transport, diag) @@ -2359,7 +2411,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) if (associated(fluxes%melth)) res(i,j) = res(i,j) + fluxes%melth(i,j) enddo ; enddo - call post_data(handles%id_net_heat_coupler, res, diag) + 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) call post_data(handles%id_total_net_heat_coupler, total_transport, diag) @@ -2422,7 +2474,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) ! endif enddo ; enddo - call post_data(handles%id_heat_content_surfwater, res, diag) + 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) call post_data(handles%id_total_heat_content_surfwater, total_transport, diag) @@ -2624,8 +2676,19 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if ((handles%id_buoy > 0) .and. associated(fluxes%buoy)) & call post_data(handles%id_buoy, fluxes%buoy, diag) + if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & + call post_data(handles%id_ustar, fluxes%ustar, diag) - endif + if ((handles%id_ustar_berg > 0) .and. associated(fluxes%ustar_berg)) & + call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag) + + if ((handles%id_frac_ice_cover > 0) .and. associated(fluxes%frac_shelf_h)) & + call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag) + + if ((handles%id_ustar_ice_cover > 0) .and. associated(fluxes%ustar_shelf)) & + call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag) + + endif ! query_averaging_enabled call cpu_clock_end(handles%id_clock_forcing) end subroutine forcing_diagnostics diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index e72038a252..c0ca264d68 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -14,7 +14,7 @@ module MOM_grid #include public MOM_grid_init, MOM_grid_end, set_derived_metrics, set_first_direction -public isPointInCell, hor_index_type, get_global_grid_size +public isPointInCell, hor_index_type, get_global_grid_size, rescale_grid_bathymetry !> Ocean grid type. See mom_grid for details. type, public :: ocean_grid_type @@ -131,17 +131,18 @@ module MOM_grid y_axis_units !< The units that are used in labeling the y coordinate axes. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - bathyT !< Ocean bottom depth at tracer points, in m. + bathyT !< Ocean bottom depth at tracer points, in depth units. + real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in m. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in m. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in m. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in m. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & @@ -164,7 +165,7 @@ module MOM_grid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in meters. + real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m). end type ocean_grid_type contains @@ -345,6 +346,39 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) end subroutine MOM_grid_init +!> rescale_grid_bathymetry permits a change in the internal units for the bathymetry on the grid, +!! both rescaling the depths and recording the new internal units. +subroutine rescale_grid_bathymetry(G, m_in_new_units) + type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure + real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. + + ! Local variables + real :: rescale + integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + if (m_in_new_units == G%Zd_to_m) return + if (m_in_new_units < 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") + if (m_in_new_units == 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") + + rescale = G%Zd_to_m / m_in_new_units + do j=jsd,jed ; do i=isd,ied + G%bathyT(i,j) = rescale*G%bathyT(i,j) + enddo ; enddo + if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB + G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j) + enddo ; enddo ; endif + if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied + G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) + enddo ; enddo ; endif + G%max_depth = rescale*G%max_depth + G%Zd_to_m = m_in_new_units + +end subroutine rescale_grid_bathymetry !> set_derived_metrics calculates metric terms that are derived from other metrics. subroutine set_derived_metrics(G) diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index f30bcda8cb..c6c283dfc2 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -27,9 +27,8 @@ module MOM_interface_heights !! form for consistency with the calculation of the pressure gradient forces. !! Additionally, these height may be dilated for consistency with the !! corresponding time-average quantity from the barotropic calculation. -subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid - !! structure. +subroutine find_eta_3d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical !! grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H @@ -37,16 +36,17 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic !! variables. - real, intent(in) :: G_Earth !< Earth gravitational - !! acceleration (m/s2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights - !! (meter). + !! (Z or 1/eta_to_m m). real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. !! thicknesses when calculating interfaceheights, in H (m or kg m-2). integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. + real, optional, intent(in) :: eta_to_m !< The conversion factor from + !! the units of eta to m; by default this is GV%Z_to_m. + ! Local variables real :: p(SZI_(G),SZJ_(G),SZK_(G)+1) real :: dz_geo(SZI_(G),SZJ_(G),SZK_(G)) ! The change in geopotential height @@ -54,6 +54,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) real :: dilate(SZI_(G)) ! non-dimensional dilation factor real :: htot(SZI_(G)) ! total thickness H real :: I_gEarth + real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, isv, iev, jsv, jev, nz, halo halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) @@ -64,18 +65,19 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) if ((isvG%ied) .or. (jsvG%jed)) & call MOM_error(FATAL,"find_eta called with an overly large halo_size.") - I_gEarth = 1.0 / G_Earth + Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m + H_to_eta = GV%H_to_Z * Z_to_eta + H_to_rho_eta = GV%H_to_kg_m2 * (GV%m_to_Z * Z_to_eta) + I_gEarth = Z_to_eta / GV%g_Earth -!$OMP parallel default(none) shared(isv,iev,jsv,jev,nz,eta,G,GV,h,eta_bt,tv,p, & -!$OMP G_Earth,dz_geo,halo,I_gEarth) & -!$OMP private(dilate,htot) +!$OMP parallel default(shared) private(dilate,htot) !$OMP do - do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo + do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -Z_to_eta*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then !$OMP do do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*GV%H_to_m + eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo if (present(eta_bt)) then ! Dilate the water column to agree with the free surface height @@ -83,22 +85,22 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP do do j=jsv,jev do i=isv,iev - dilate(i) = (eta_bt(i,j)*GV%H_to_m + G%bathyT(i,j)) / & - (eta(i,j,1) + G%bathyT(i,j)) + dilate(i) = (eta_bt(i,j)*H_to_eta + Z_to_eta*G%bathyT(i,j)) / & + (eta(i,j,1) + Z_to_eta*G%bathyT(i,j)) enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%bathyT(i,j)) - G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*G%bathyT(i,j)) - Z_to_eta*G%bathyT(i,j) enddo ; enddo enddo endif else if (associated(tv%eqn_of_state)) then - ! ### THIS SHOULD BE P_SURF, IF AVAILABLE. !$OMP do do j=jsv,jev + ! ### THIS SHOULD BE P_SURF, IF AVAILABLE. do i=isv,iev ; p(i,j,1) = 0.0 ; enddo do k=1,nz ; do i=isv,iev - p(i,j,K+1) = p(i,j,K) + G_Earth*GV%H_to_kg_m2*h(i,j,k) + p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo !$OMP do @@ -115,7 +117,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) else !$OMP do do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + GV%H_to_kg_m2*h(i,j,k)/GV%Rlay(k) + eta(i,j,K) = eta(i,j,K+1) + H_to_rho_eta*h(i,j,k)/GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -127,7 +129,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do k=1,nz ; do i=isv,iev ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=isv,iev ; dilate(i) = eta_bt(i,j) / htot(i) ; enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%bathyT(i,j)) - G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*G%bathyT(i,j)) - Z_to_eta*G%bathyT(i,j) enddo ; enddo enddo endif @@ -140,7 +142,7 @@ end subroutine find_eta_3d !! with the calculation of the pressure gradient forces. Additionally, the sea !! surface height may be adjusted for consistency with the corresponding !! time-average quantity from the barotropic calculation. -subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) +subroutine find_eta_2d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -149,8 +151,6 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic !! variables. - real, intent(in) :: G_Earth !< Earth gravitational - !! acceleration (m/s2). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height !! relative to mean sea !! level (z=0) (m). @@ -159,37 +159,41 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !! water column mass per unit area (non-Boussinesq), in H (m or kg m-2). integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. + real, optional, intent(in) :: eta_to_m !< The conversion factor from + !! the units of eta to m; by default this is GV%Z_to_m. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & p ! The pressure in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dz_geo ! The change in geopotential height across a layer, in m2 s-2. - real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in kg m-2 or m. + real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in H. real :: I_gEarth + real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, is, ie, js, je, nz, halo halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke - I_gEarth = 1.0 / G_Earth + Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m + H_to_eta = GV%H_to_Z * Z_to_eta + H_to_rho_eta = GV%H_to_kg_m2 * (GV%m_to_Z * Z_to_eta) + I_gEarth = Z_to_eta / GV%g_Earth -!$OMP parallel default(none) shared(is,ie,js,je,nz,eta,G,GV,eta_bt,h,tv,p, & -!$OMP G_Earth,dz_geo,halo,I_gEarth) & -!$OMP private(htot) +!$OMP parallel default(shared) private(htot) !$OMP do - do j=js,je ; do i=is,ie ; eta(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta(i,j) = -Z_to_eta*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then if (present(eta_bt)) then !$OMP do do j=js,je ; do i=is,ie - eta(i,j) = GV%H_to_m*eta_bt(i,j) + eta(i,j) = H_to_eta*eta_bt(i,j) enddo ; enddo else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + h(i,j,k)*GV%H_to_m + eta(i,j) = eta(i,j) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo endif else @@ -199,7 +203,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do i=is,ie ; p(i,j,1) = 0.0 ; enddo do k=1,nz ; do i=is,ie - p(i,j,k+1) = p(i,j,k) + G_Earth*GV%H_to_kg_m2*h(i,j,k) + p(i,j,k+1) = p(i,j,k) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo !$OMP do @@ -214,7 +218,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + GV%H_to_kg_m2*h(i,j,k)/GV%Rlay(k) + eta(i,j) = eta(i,j) + H_to_rho_eta*h(i,j,k)/GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -225,8 +229,8 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do i=is,ie ; htot(i) = GV%H_subroundoff ; enddo do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie - eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + G%bathyT(i,j)) - & - G%bathyT(i,j) + eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + Z_to_eta*G%bathyT(i,j)) - & + Z_to_eta*G%bathyT(i,j) enddo enddo endif diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index c677f3863c..41b9bef817 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -18,15 +18,16 @@ module MOM_isopycnal_slopes !> Calculate isopycnal slopes, and optionally return N2 used in calculation. subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & - slope_x, slope_y, N2_u, N2_v, halo) + slope_x, slope_y, N2_u, N2_v, halo) !, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z or units + !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing - !! timescale, in s. + real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity + !! times a smoothing timescale, in Z2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & @@ -36,6 +37,9 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at !! interfaces between u-points (s-2) integer, optional, intent(in) :: halo !< Halo width over which to compute + + ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units + ! (This argument has been tested but for now serves no purpose.) !! of eta to m; GV%Z_to_m by default. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -63,12 +67,12 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! interface times the grid spacing, in kg m-3. real :: drdkL, drdkR ! Vertical density differences across an interface, ! in kg m-3. - real :: hg2A, hg2B, hg2L, hg2R - real :: haA, haB, haL, haR - real :: dzaL, dzaR - real :: wtA, wtB, wtL, wtR - real :: drdx, drdy, drdz ! Zonal, meridional, and vertical density gradients, - ! in units of kg m-4. + real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2. + real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H. + real :: dzaL, dzaR ! Temporary thicknesses in eta units (Z?). + real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. + real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. + real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. @@ -77,10 +81,15 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! in roundoff and can be neglected, in H. real :: h_neglect2 ! h_neglect^2, in H2. real :: dz_neglect ! A thickness in m that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in eta units (Z?). logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) + real :: Z_to_L ! A conversion factor between from units for e to the + ! units for lateral distances. + real :: L_to_Z ! A conversion factor between from units for lateral distances + ! to the units for e. + real :: H_to_Z ! A conversion factor from thickness units to the units of e. logical :: present_N2_u, present_N2_v integer :: is, ie, js, je, nz, IsdB @@ -94,13 +103,18 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & nz = G%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - dz_neglect = GV%H_subroundoff*GV%H_to_m + Z_to_L = GV%Z_to_m ; H_to_Z = GV%H_to_Z + ! if (present(eta_to_m)) then + ! Z_to_L = eta_to_m ; H_to_Z = GV%H_to_m / eta_to_m + ! endif + L_to_Z = 1.0 / Z_to_L + dz_neglect = GV%H_subroundoff * H_to_Z use_EOS = associated(tv%eqn_of_state) present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*L_to_Z*GV%m_to_Z) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. @@ -116,34 +130,32 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (use_EOS) then if (present(halo)) then - call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, 1.0, T, S, G, GV, halo+1) + call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, halo+1) else - call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, 1.0, T, S, G, GV, 1) + call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, 1) endif endif ! Find the maximum and minimum permitted streamfunction. -!$OMP parallel default(none) shared(is,ie,js,je,pres,GV,h,nz) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 pres(i,j,K+1) = pres(i,j,K) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo -!$OMP end parallel - -!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, & -!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & -!$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & -!$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & -!$OMP drdx,mag_grad2,Slope,slope2_Ratio) + + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & + !$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & + !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & + !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & + !$OMP drdx,mag_grad2,Slope,slope2_Ratio) do j=js,je ; do K=nz,2,-1 if (.not.(use_EOS)) then drdiA = 0.0 ; drdiB = 0.0 @@ -187,7 +199,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * GV%H_to_m ; dzaR = haR * GV%H_to_m + dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect @@ -207,7 +219,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + drdz**2 + mag_grad2 = drdx**2 + (L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then slope_x(I,j,K) = drdx / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -217,20 +229,20 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency (s-2) else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) + slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) endif enddo ! I enddo ; enddo ! end of j-loop - ! Calculate the meridional isopycnal slope. -!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, & -!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & -!$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & -!$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & -!$OMP drdy,mag_grad2,Slope,slope2_Ratio) + ! Calculate the meridional isopycnal slope. + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & + !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & + !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & + !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & + !$OMP drdy,mag_grad2,Slope,slope2_Ratio) do j=js-1,je ; do K=nz,2,-1 if (.not.(use_EOS)) then drdjA = 0.0 ; drdjB = 0.0 @@ -271,7 +283,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * GV%H_to_m ; dzaR = haR * GV%H_to_m + dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect @@ -291,7 +303,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + drdz**2 + mag_grad2 = drdy**2 + (L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then slope_y(i,J,K) = drdy / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -301,7 +313,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency (s-2) else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) + slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) endif enddo ! i @@ -311,14 +323,14 @@ end subroutine calc_isoneutral_slopes !> Returns tracer arrays (nominally T and S) with massless layers filled with !! sensible values, by diffusing vertically with a small but constant diffusivity. -subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) +subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) 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, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) - real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) - real, intent(in) :: dt !< The time increment, in s. + real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing + !! times a smoothing timescale, in Z2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) integer, optional, intent(in) :: halo_here !< Halo width over which to compute @@ -338,7 +350,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke - kap_dt_x2 = (2.0*kappa*dt)*GV%m_to_H**2 + kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 h_neglect = GV%H_subroundoff if (kap_dt_x2 <= 0.0) then diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 38a945233b..6296dbc35b 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -112,6 +112,10 @@ module MOM_open_boundary logical :: radiation_grad !< If true, 1D Orlanksi radiation boundary conditions are applied to !! dudv and dvdx. logical :: oblique !< Oblique waves supported at radiation boundary. + logical :: oblique_tan !< If true, 2D radiation boundary conditions are applied to + !! tangential flows. + logical :: oblique_grad !< If true, 2D radiation boundary conditions are applied to + !! dudv and dvdx. logical :: nudged !< Optional supplement to radiation boundary. logical :: nudged_tan !< Optional supplement to nudge tangential velocity. logical :: nudged_grad !< Optional supplement to nudge normal gradient of tangential velocity. @@ -151,11 +155,17 @@ module MOM_open_boundary !! the OB segment (m s-1). real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment (m). real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment (m s-1) + !! segment (s-1) + real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the + !! segment (s-1) + real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the + !! segment (m-1 s-1) real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff !! for normal velocity + real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation + !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment !! that values should be nudged towards (m s-1). real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment @@ -237,6 +247,7 @@ module MOM_open_boundary type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries real, pointer, dimension(:,:,:) :: rx_normal => NULL() !< Array storage for restarts real, pointer, dimension(:,:,:) :: ry_normal => NULL() !< Array storage for restarts + real, pointer, dimension(:,:,:) :: cff_normal => NULL() !< Array storage for restarts real :: silly_h !< A silly value of thickness outside of the domain that !! can be used to test the independence of the OBCs to !! this external data, in m. @@ -315,7 +326,7 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the relative vorticity on open boundaries. This cannot\n"// & - "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) + "be true if another OBC_XXX_VORTICITY option is True.", default=.true.) call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, & "If true, uses the external values of tangential velocity\n"// & "in the relative vorticity on open boundaries. This cannot\n"// & @@ -339,7 +350,7 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & - "be true if another OBC_XXX_STRAIN option is True.", default=.false.) + "be true if another OBC_XXX_STRAIN option is True.", default=.true.) call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & @@ -394,6 +405,8 @@ subroutine open_boundary_config(G, param_file, OBC) OBC%segment(l)%radiation_tan = .false. OBC%segment(l)%radiation_grad = .false. OBC%segment(l)%oblique = .false. + OBC%segment(l)%oblique_tan = .false. + OBC%segment(l)%oblique_grad = .false. OBC%segment(l)%nudged = .false. OBC%segment(l)%nudged_tan = .false. OBC%segment(l)%nudged_grad = .false. @@ -431,7 +444,7 @@ subroutine open_boundary_config(G, param_file, OBC) ! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) & call initialize_segment_data(G, OBC, param_file) - if (open_boundary_query(OBC, apply_Flather_OBC=.true.)) then + if (open_boundary_query(OBC, apply_open_OBC=.true.)) then call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & "The maximum magnitude of the baroclinic radiation \n"//& "velocity (or speed of characteristics). This is only \n"//& @@ -815,6 +828,13 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%open = .true. OBC%oblique_BCs_exist_globally = .true. OBC%open_u_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_TAN') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_tan = .true. + OBC%oblique_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_GRAD') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_grad = .true. elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_u_BCs_exist_globally = .true. @@ -868,6 +888,10 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%Je_obc = Je_obc call allocate_OBC_segment_data(OBC, OBC%segment(l_seg)) + if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) & + call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc:\n"//& + "Orlanski and Oblique OBC options cannot be used together on one segment.") + end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly @@ -928,6 +952,13 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%open = .true. OBC%oblique_BCs_exist_globally = .true. OBC%open_v_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_TAN') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_tan = .true. + OBC%oblique_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_GRAD') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_grad = .true. elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_v_BCs_exist_globally = .true. @@ -981,6 +1012,10 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%Je_obc = J_obc call allocate_OBC_segment_data(OBC, OBC%segment(l_seg)) + if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) & + call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc:\n"//& + "Orlanski and Oblique OBC options cannot be used together on one segment.") + end subroutine setup_v_point_obc !> Parse an OBC_SEGMENT_%%% string @@ -1499,8 +1534,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation real :: ry_new, ry_avg ! coefficients for radiation + real :: cff_new, cff_avg ! denominator in oblique real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() + real, pointer, dimension(:,:,:) :: cff_tangential=>NULL() real, parameter :: eps = 1.0e-20 type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, is, ie, js, je, nz, n @@ -1540,6 +1577,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do j=segment%HI%jsd,segment%HI%jed segment%rx_normal(I,j,k) = OBC%rx_normal(I,j,k) segment%ry_normal(I,j,k) = OBC%ry_normal(I,j,k) + segment%cff_normal(I,j,k) = OBC%cff_normal(I,j,k) enddo enddo elseif (segment%is_N_or_S .and. segment%oblique) then @@ -1548,6 +1586,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do i=segment%HI%isd,segment%HI%ied segment%rx_normal(i,J,k) = OBC%rx_normal(i,J,k) segment%ry_normal(i,J,k) = OBC%ry_normal(i,J,k) + segment%cff_normal(i,J,k) = OBC%cff_normal(i,J,k) enddo enddo endif @@ -1588,16 +1627,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - Cx = dhdt*dhdx - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) - segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I-1,j,k)) - & - (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx) + rx_new = dhdt*dhdx + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff,max(dhdt*dhdy,-cff)) + rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + segment%rx_normal(I,j,k) = rx_avg + segment%ry_normal(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then segment%normal_vel(I,j,k) = u_new(I-1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdx < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1625,7 +1677,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1655,7 +1708,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + I=segment%HI%IsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k) + rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k) + ry_tangential(I,segment%HI%JsdB,k) = segment%ry_normal(I,segment%HI%jsd,k) + ry_tangential(I,segment%HI%JedB,k) = segment%ry_normal(I,segment%HI%jed,k) + cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) + cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) + ry_tangential(I,J,k) = 0.5*(segment%ry_normal(I,j,k) + segment%ry_normal(I,j+1,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) & + + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1666,6 +1789,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) endif endif @@ -1698,16 +1823,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - Cx = dhdt*dhdx - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) - segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I+1,j,k)) - & - (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx) + rx_new = dhdt*dhdx + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff,max(dhdt*dhdy,-cff)) + rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new + segment%rx_normal(I,j,k) = rx_avg + segment%ry_normal(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then segment%normal_vel(I,j,k) = u_new(I+1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdx < 0.0) then + ! dhdt gets set to 0. on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1730,12 +1868,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(I+1,J,k) + rx_avg*v_new(I+2,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1765,7 +1904,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1777,6 +1917,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif deallocate(rx_tangential) endif + if (segment%oblique_tan .or. segment%oblique_grad) then + I=segment%HI%IsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k) + rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k) + ry_tangential(I,segment%HI%JsdB,k) = segment%ry_normal(I,segment%HI%jsd,k) + ry_tangential(I,segment%HI%JedB,k) = segment%ry_normal(I,segment%HI%jed,k) + cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) + cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) + ry_tangential(I,J,k) = 0.5*(segment%ry_normal(I,j,k) + segment%ry_normal(I,j+1,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) & + + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) + endif endif if (segment%direction == OBC_DIRECTION_N) then @@ -1809,16 +2020,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - Cy = dhdt*dhdy - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) - segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J-1,k)) - & - (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy) + ry_new = dhdt*dhdy + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff,max(dhdt*dhdx,-cff)) + rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + segment%rx_normal(I,j,k) = rx_avg + segment%ry_normal(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then segment%normal_vel(i,J,k) = v_new(i,J-1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdy < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdy <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1846,7 +2070,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1870,13 +2095,83 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I-1,j,k))*G%IdyBu(I,J-1) + & + segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + J=segment%HI%JsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) + ry_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + ry_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) + cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) + ry_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) & + + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1887,10 +2182,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) endif endif - if (segment%direction == OBC_DIRECTION_S) then J=segment%HI%JsdB if (J>G%HI%JecB) cycle @@ -1920,16 +2216,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - Cy = dhdt*dhdy - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) - segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J+1,k)) - & - (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy) + ry_new = dhdt*dhdy + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff,max(dhdt*dhdx,-cff)) + rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + segment%rx_normal(I,j,k) = rx_avg + segment%ry_normal(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then segment%normal_vel(i,J,k) = v_new(i,J+1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdy < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdy <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1957,7 +2266,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1987,7 +2297,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + J=segment%HI%JsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) + ry_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + ry_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) + cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) + ry_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) & + + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1998,6 +2378,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) endif endif enddo @@ -2094,6 +2476,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_tan(j,1,k) = (vvel(i-1,J,k)-vvel(i-1,J-1,k)) * G%mask2dT(i-1,j) + segment%grad_tan(j,2,k) = (vvel(i,J,k)-vvel(i,J-1,k)) * G%mask2dT(i,j) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - & + (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) + segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - & + (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) + enddo + enddo + endif else ! western segment I=segment%HI%isdB do k=1,G%ke @@ -2102,6 +2502,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_tan(j,1,k) = (vvel(i+2,J,k)-vvel(i+2,J-1,k)) * G%mask2dT(i+2,j) + segment%grad_tan(j,2,k) = (vvel(i+1,J,k)-vvel(i+1,J-1,k)) * G%mask2dT(i+1,j) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - & + (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) + segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - & + (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) + enddo + enddo + endif endif elseif (segment%is_N_or_S) then if (segment%direction == OBC_DIRECTION_N) then @@ -2112,6 +2530,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_tan(i,1,k) = (uvel(I,j-1,k)-uvel(I-1,j-1,k)) * G%mask2dT(i,j-1) + segment%grad_tan(i,2,k) = (uvel(I,j,k)-uvel(I-1,j,k)) * G%mask2dT(i,j) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - & + (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) + segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - & + (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) + enddo + enddo + endif else ! south segment J=segment%HI%jsdB do k=1,G%ke @@ -2120,6 +2556,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_tan(i,1,k) = (uvel(I,j+2,k)-uvel(I-1,j+2,k)) * G%mask2dT(i,j+2) + segment%grad_tan(i,2,k) = (uvel(I,j+1,k)-uvel(I-1,j+1,k)) * G%mask2dT(i,j+1) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - & + (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) + segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - & + (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) + enddo + enddo + endif endif endif @@ -2279,13 +2733,21 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_grad) then allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 endif - if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then + if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & + segment%oblique_grad) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0 allocate(segment%ry_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_normal(:,:,:)=0.0 + allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%cff_normal(:,:,:)=0.0 + endif + if (segment%oblique_tan) then + allocate(segment%grad_tan(jsd:jed,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 + endif + if (segment%oblique_grad) then + allocate(segment%grad_gradient(jsd:jed,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 endif endif @@ -2314,13 +2776,21 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_grad) then allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 endif - if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then + if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & + segment%oblique_grad) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_normal(:,:,:)=0.0 allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0 + allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%cff_normal(:,:,:)=0.0 + endif + if (segment%oblique_tan) then + allocate(segment%grad_tan(isd:ied,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 + endif + if (segment%oblique_grad) then + allocate(segment%grad_gradient(isd:ied,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 endif endif @@ -2341,12 +2811,17 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%eta)) deallocate(segment%eta) if (associated (segment%rx_normal)) deallocate(segment%rx_normal) if (associated (segment%ry_normal)) deallocate(segment%ry_normal) + if (associated (segment%cff_normal)) deallocate(segment%cff_normal) + if (associated (segment%grad_normal)) deallocate(segment%grad_normal) + if (associated (segment%grad_tan)) deallocate(segment%grad_tan) + if (associated (segment%grad_gradient)) deallocate(segment%grad_gradient) if (associated (segment%normal_vel)) deallocate(segment%normal_vel) if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) if (associated (segment%normal_trans)) deallocate(segment%normal_trans) if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) + if (associated (segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad) if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) @@ -3235,6 +3710,7 @@ subroutine mask_outside_OBCs(G, param_file, OBC) call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & default=0.0, do_not_log=.true.) + min_depth = min_depth / G%Zd_to_m allocate(color(G%isd:G%ied, G%jsd:G%jed)) ; color = 0 allocate(color2(G%isd:G%ied, G%jsd:G%jed)) ; color2 = 0 @@ -3473,6 +3949,12 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) vd = var_desc("ry_normal","m s-1", "Normal Phase Speed for NS OBCs",'v','L') call register_restart_field(OBC_CS%ry_normal, vd, .true., restart_CSp) endif + if (OBC_CS%oblique_BCs_exist_globally) then + allocate(OBC_CS%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke)) + OBC_CS%cff_normal(:,:,:) = 0.0 + vd = var_desc("cff_normal","m s-1", "denominator for oblique OBCs",'q','L') + call register_restart_field(OBC_CS%cff_normal, vd, .true., restart_CSp) + endif end subroutine open_boundary_register_restarts diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index eea4874f4e..8c3786d51a 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -44,6 +44,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) if ((isd > oG%isc) .or. (ied < oG%ied) .or. (jsd > oG%jsc) .or. (jed > oG%jed)) & call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.") + oG%Zd_to_m = dG%Zd_to_m do i=isd,ied ; do j=jsd,jed oG%geoLonT(i,j) = dG%geoLonT(i+ido,j+jdo) oG%geoLatT(i,j) = dG%geoLatT(i+ido,j+jdo) @@ -143,7 +144,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) call pass_vector(oG%geoLatCu, oG%geoLatCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_var(oG%areaBu, oG%Domain, position=CORNER) - call pass_var(oG%geoLonBu, oG%Domain, position=CORNER) + call pass_var(oG%geoLonBu, oG%Domain, position=CORNER, inner_halo=oG%isc-isd) call pass_var(oG%geoLatBu, oG%Domain, position=CORNER) call pass_vector(oG%dxBu, oG%dyBu, oG%Domain, To_All+Scalar_Pair, BGRID_NE) call pass_var(oG%CoriolisBu, oG%Domain, position=CORNER) @@ -187,6 +188,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) if ((isd > dG%isc) .or. (ied < dG%ied) .or. (jsd > dG%jsc) .or. (jed > dG%jed)) & call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.") + dG%Zd_to_m = oG%Zd_to_m do i=isd,ied ; do j=jsd,jed dG%geoLonT(i,j) = oG%geoLonT(i+ido,j+jdo) dG%geoLatT(i,j) = oG%geoLatT(i+ido,j+jdo) @@ -287,7 +289,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) call pass_vector(dG%geoLatCu, dG%geoLatCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_var(dG%areaBu, dG%Domain, position=CORNER) - call pass_var(dG%geoLonBu, dG%Domain, position=CORNER) + call pass_var(dG%geoLonBu, dG%Domain, position=CORNER, inner_halo=dG%isc-isd) call pass_var(dG%geoLatBu, dG%Domain, position=CORNER) call pass_vector(dG%dxBu, dG%dyBu, dG%Domain, To_All+Scalar_Pair, BGRID_NE) call pass_var(dG%CoriolisBu, dG%Domain, position=CORNER) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index fa5b92f31d..4aa14cb082 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -195,11 +195,11 @@ module MOM_variables real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion !! that is captured in Kd_shear. real, pointer, dimension(:,:) :: & - bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in m. - bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in m. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in m2 s-1. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in m2 s-1. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in m s-1. + bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in Z. + bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z. + kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1. + kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1. + ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in Z s-1. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic !! energy, currently in units of m3 s-3, but will later be changed to W m-2. @@ -207,13 +207,13 @@ module MOM_variables taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa. tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa. real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at u-points, in m. + !< Thickness of the viscous top boundary layer under ice shelves at u-points, in Z. real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at v-points, in m. + !< Thickness of the viscous top boundary layer under ice shelves at v-points, in Z. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in m2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in m2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in Z2 s-1. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() !< The number of layers in the viscous surface mixed layer at u-points (nondimensional). !! This is not an integer because there may be fractional layers, and it is stored in @@ -222,31 +222,31 @@ module MOM_variables real, pointer, dimension(:,:) :: nkml_visc_v => NULL() !< The number of layers in the viscous surface mixed layer at v-points (nondimensional). real, pointer, dimension(:,:) :: & - MLD => NULL() !< Instantaneous active mixing layer depth (H units). + MLD => NULL() !< Instantaneous active mixing layer depth (H units). real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in m s-1. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in m s-1. + Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in Z s-1. + Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the - !! diffusivity of density, in m2 s-1. + !! diffusivity of density, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL() !< The extra diffusivity of salinity due to double diffusion relative to the - !! diffusivity of density, in m2 s-1. + !! diffusivity of density, in Z2 s-1. ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering; ! Kd_extra_T is positive for double diffusive convection. They are only allocated if ! DOUBLE_DIFFUSION is true. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns, in m2 s-1. + !! in tracer columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns, in m2 s-1. + !! in tracer columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns, in m2 s-1. + !! corner columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc). + !! background, convection etc), in Z2 s-1. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. !! This may be at the tracer or corner points @@ -348,7 +348,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & if (present(gas_fields_ocn)) & call coupler_type_spawn(gas_fields_ocn, sfc_state%tr_fields, & - (/isd,is,ie,ied/), (/jsd,js,je,jed/), as_needed=.true.) + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) sfc_state%arrays_allocated = .true. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 4eb972148b..7b7feadb3c 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -11,7 +11,7 @@ module MOM_verticalGrid #include public verticalGridInit, verticalGridEnd -public setVerticalGridAxes +public setVerticalGridAxes, fix_restart_scaling public get_flux_units, get_thickness_units, get_tr_flux_units !> Describes the vertical ocean grid, including unit conversion factors @@ -19,8 +19,8 @@ module MOM_verticalGrid ! Commonly used parameters integer :: ke !< The number of layers/levels in the vertical - real :: max_depth !< The maximum depth of the ocean in meters. - real :: g_Earth !< The gravitational acceleration in m s-2. + real :: max_depth !< The maximum depth of the ocean in Z (often m). + real :: g_Earth !< The gravitational acceleration in m2 Z-1 s-2. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units, in kg m-3. @@ -34,13 +34,14 @@ module MOM_verticalGrid ! The following variables give information about the vertical grid. logical :: Boussinesq !< If true, make the Boussinesq approximation. - real :: Angstrom !< A one-Angstrom thickness in the model thickness units. - real :: Angstrom_z !< A one-Angstrom thickness in m. + real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units. + real :: Angstrom_Z !< A one-Angstrom thickness in the model depth units. + real :: Angstrom_m !< A one-Angstrom thickness in m. real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of !! Angstrom or larger without changing it at the bit level, in thickness units. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & - g_prime, & !< The reduced gravity at each interface, in m s-2. + g_prime, & !< The reduced gravity at each interface, in m2 Z-1 s-2. Rlay !< The target coordinate value (potential density) in each layer in kg m-3. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogenous region. @@ -51,6 +52,13 @@ module MOM_verticalGrid real :: m_to_H !< A constant that translates distances in m to the units of thickness. real :: H_to_m !< A constant that translates distances in the units of thickness to m. real :: H_to_Pa !< A constant that translates the units of thickness to pressure in Pa. + real :: m_to_Z !< A constant that translates distances in m to the units of depth. + real :: Z_to_m !< A constant that translates distances in the units of depth to m. + real :: H_to_Z !< A constant that translates thickness units to the units of depth. + real :: Z_to_H !< A constant that translates depth units to thickness units. + + real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. + real :: m_to_H_restart = 0.0 !< A copy of the m_to_H that is used in restart files. end type verticalGrid_type contains @@ -63,8 +71,8 @@ subroutine verticalGridInit( param_file, GV ) ! All memory is allocated but not necessarily set to meaningful values until later. ! Local variables - integer :: nk, H_power - real :: rescale_factor + integer :: nk, H_power, Z_power + real :: H_rescale_factor, Z_rescale_factor ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = 'MOM_verticalGrid' @@ -87,7 +95,7 @@ subroutine verticalGridInit( param_file, GV ) units="kg m-3", default=1035.0) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) - call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_z, & + call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_m, & "The minumum layer thickness, usually one-Angstrom.", & units="m", default=1.0e-10) call get_param(param_file, mdl, "H_RESCALE_POWER", H_power, & @@ -96,20 +104,31 @@ subroutine verticalGridInit( param_file, GV ) units="nondim", default=0, debuggingParam=.true.) if (abs(H_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//& "H_RESCALE_POWER is outside of the valid range of -300 to 300.") - rescale_factor = 1.0 - if (H_power /= 0) rescale_factor = 2.0**H_power + H_rescale_factor = 1.0 + if (H_power /= 0) H_rescale_factor = 2.0**H_power if (.not.GV%Boussinesq) then call get_param(param_file, mdl, "H_TO_KG_M2", GV%H_to_kg_m2,& "A constant that translates thicknesses from the model's \n"//& "internal units of thickness to kg m-2.", units="kg m-2 H-1", & default=1.0) - GV%H_to_kg_m2 = GV%H_to_kg_m2 * rescale_factor + GV%H_to_kg_m2 = GV%H_to_kg_m2 * H_rescale_factor else call get_param(param_file, mdl, "H_TO_M", GV%H_to_m, & "A constant that translates the model's internal \n"//& "units of thickness into m.", units="m H-1", default=1.0) - GV%H_to_m = GV%H_to_m * rescale_factor + GV%H_to_m = GV%H_to_m * H_rescale_factor endif + call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & + "An integer power of 2 that is used to rescale the model's \n"//& + "intenal units of depths and heights. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + if (abs(Z_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//& + "Z_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 + GV%Z_to_m = 1.0 * Z_rescale_factor + GV%m_to_Z = 1.0 / Z_rescale_factor + GV%g_Earth = GV%g_Earth * GV%Z_to_m #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -128,18 +147,22 @@ subroutine verticalGridInit( param_file, GV ) GV%H_to_kg_m2 = GV%Rho0 * GV%H_to_m GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = 1.0 / GV%H_to_m - GV%Angstrom = GV%m_to_H * GV%Angstrom_z + GV%Angstrom_H = GV%m_to_H * GV%Angstrom_m else GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = GV%Rho0 * GV%kg_m2_to_H GV%H_to_m = GV%H_to_kg_m2 / GV%Rho0 - GV%Angstrom = GV%Angstrom_z*1000.0*GV%kg_m2_to_H + GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif - GV%H_subroundoff = 1e-20 * max(GV%Angstrom,GV%m_to_H*1e-17) - GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2 + GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) + GV%H_to_Pa = (GV%g_Earth*GV%m_to_Z) * GV%H_to_kg_m2 + + GV%H_to_Z = GV%H_to_m * GV%m_to_Z + GV%Z_to_H = GV%Z_to_m * GV%m_to_H + GV%Angstrom_Z = GV%m_to_Z * GV%Angstrom_m ! Log derivative values. - call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*rescale_factor) + call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor) call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H) call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m) @@ -151,6 +174,14 @@ subroutine verticalGridInit( param_file, GV ) end subroutine verticalGridInit +!> Set the scaling factors for restart files to the scaling factors for this run. +subroutine fix_restart_scaling(GV) + type(verticalGrid_type), intent(inout) :: GV !< The ocean's vertical grid structure + + GV%m_to_Z_restart = GV%m_to_Z + GV%m_to_H_restart = GV%m_to_H +end subroutine fix_restart_scaling + !> Returns the model's thickness units, usually m or kg/m^2. function get_thickness_units(GV) character(len=48) :: get_thickness_units !< The vertical thickness units diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 6f93c7b0f0..fa31586659 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -85,7 +85,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. @@ -102,7 +102,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a logical :: prev_avail integer :: file - Angstrom = GV%Angstrom + GV%H_subroundoff + Angstrom = GV%Angstrom_H + GV%H_subroundoff ! if (.not.associated(CS)) return nz = G%ke @@ -215,7 +215,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k); enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*GV%Z_to_m*dt; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') @@ -244,13 +244,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i+1,j+1,k)); enddo - e(nz+1) = -G%bathyT(i,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -G%bathyT(i+1,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i+1,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i+1,j,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -327,7 +327,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (0.5*CS%v_av(i+1,J,k)*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') G%bathyT(i,j),G%bathyT(i+1,j) + write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i+1,j) ! From here on, the normalized accelerations are written. if (prev_avail) then @@ -413,7 +413,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. @@ -430,7 +430,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a logical :: prev_avail integer :: file - Angstrom = GV%Angstrom + GV%H_subroundoff + Angstrom = GV%Angstrom_H + GV%H_subroundoff ! if (.not.associated(CS)) return nz = G%ke @@ -547,7 +547,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k); enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*GV%Z_to_m*dt; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') @@ -575,13 +575,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a write(file,'(/,"h++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i+1,j+1,k); enddo - e(nz+1) = -G%bathyT(i,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k); enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -G%bathyT(i,j+1) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j+1) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -658,7 +658,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (0.5*CS%u_prev(I,j+1,k)*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') G%bathyT(i,j),G%bathyT(i,j+1) + write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i,j+1) ! From here on, the normalized accelerations are written. if (prev_avail) then diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 77e49442af..f8ea773f74 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -8,7 +8,7 @@ module MOM_diag_to_Z use MOM_domains, only : pass_var use MOM_coms, only : reproducing_sum -use MOM_diag_mediator, only : post_data, post_data_1d_k, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_axis_init use MOM_diag_mediator, only : axes_grp, define_axes_group use MOM_diag_mediator, only : ocean_register_diag @@ -107,7 +107,7 @@ function global_z_mean(var,G,CS,tracer) do k=1,nz ; do j=js,je ; do i=is,ie valid_point = 1.0 ! Weight factor for partial bottom cells - depth_weight = min( max( (-1.*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.) + depth_weight = min( max( (-G%Zd_to_m*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.) ! Flag the point as invalid if it contains missing data, or is below the bathymetry if (var(i,j,k) == CS%missing_tr(tracer)) valid_point = 0. @@ -115,7 +115,7 @@ function global_z_mean(var,G,CS,tracer) weight(i,j,k) = depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) ) - ! If the point is flagged, set the variable itsef to zero to avoid NaNs + ! If the point is flagged, set the variable itself to zero to avoid NaNs if (valid_point == 0.) then tmpForSumming(i,j,k) = 0.0 else @@ -190,7 +190,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB IsgB = G%IsgB ; IegB = G%IegB ; JsgB = G%JsgB ; JegB = G%JegB nkml = max(GV%nkml, 1) - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H ssh(:,:) = ssh_in linear_velocity_profiles = .true. ! Update the halos @@ -217,7 +217,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) ! Remove all massless layers. do I=Isq,Ieq nk_valid(I) = 0 - D_pt(I) = 0.5*(G%bathyT(i+1,j)+G%bathyT(i,j)) + D_pt(I) = 0.5*G%Zd_to_m*(G%bathyT(i+1,j)+G%bathyT(i,j)) if (ice_shelf) then if (frac_shelf_h(i,j)+frac_shelf_h(i+1,j) > 0.) then ! under shelf shelf_depth(I) = abs(0.5*(ssh(i+1,j)+ssh(i,j))) @@ -314,7 +314,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) shelf_depth(:) = 0.0 ! initially all is open ocean ! Remove all massless layers. do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = 0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) + nk_valid(i) = 0 ; D_pt(i) = 0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1)) if (ice_shelf) then if (frac_shelf_h(i,j)+frac_shelf_h(i,j+1) > 0.) then ! under shelf shelf_depth(i) = abs(0.5*(ssh(i,j)+ssh(i,j+1))) @@ -406,7 +406,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) shelf_depth(:) = 0.0 ! initially all is open ocean ! Remove all massless layers. do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = G%bathyT(i,j) + nk_valid(i) = 0 ; D_pt(i) = G%Zd_to_m*G%bathyT(i,j) if (ice_shelf) then if (frac_shelf_h(i,j) > 0.) then ! under shelf shelf_depth(i) = abs(ssh(i,j)) @@ -479,7 +479,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) if (CS%id_tr(m) > 0) call post_data(CS%id_tr(m), CS%tr_z(m)%p, CS%diag) if (CS%id_tr_xyave(m) > 0) then layer_ave = global_z_mean(CS%tr_z(m)%p,G,CS,m) - call post_data_1d_k(CS%id_tr_xyave(m), layer_ave, CS%diag) + call post_data(CS%id_tr_xyave(m), layer_ave, CS%diag) endif enddo endif @@ -556,13 +556,13 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) htot(i,j) = htot(i,j) + h(i,j,k) enddo ; enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dilate(i,j) = G%bathyT(i,j) / htot(i,j) + dilate(i,j) = G%Zd_to_m*G%bathyT(i,j) / htot(i,j) enddo ; enddo ! zonal transport if (CS%id_uh_Z > 0) then ; do j=js,je do I=Isq,Ieq - kz(I) = nk_z ; z_int_above(I) = -0.5*(G%bathyT(i,j)+G%bathyT(i+1,j)) + kz(I) = nk_z ; z_int_above(I) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i+1,j)) enddo do k=nk_z,1,-1 ; do I=Isq,Ieq uh_Z(I,k) = 0.0 @@ -597,7 +597,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) ! meridional transport if (CS%id_vh_Z > 0) then ; do J=Jsq,Jeq do i=is,ie - kz(i) = nk_z ; z_int_above(i) = -0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) + kz(i) = nk_z ; z_int_above(i) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1)) enddo do k=nk_z,1,-1 ; do i=is,ie vh_Z(i,k) = 0.0 @@ -678,20 +678,24 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z ! Note that by convention, e and Z_int decrease with increasing k. if (e(K+1)<=Z_bot) then wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(K)-e(K+1)) + Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) e_c = 0.5*(e(K)+e(K+1)) z1(k) = (e_c - MIN(e(K),Z_top)) * Ih z2(k) = (e_c - Z_bot) * Ih else wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K),Z_top)) / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1)) + else ; z1(k) = -0.5 ; endif z2(k) = 0.5 k_bot = k_max do k=k_top+1,k_max if (e(K+1)<=Z_bot) then k_bot = k wt(k) = e(K) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + else ; z2(k) = 0.5 ; endif else wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5 endif @@ -705,7 +709,7 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z end subroutine find_overlap -!> This subroutine determines a limited slope for val to be advected with +!> This subroutine determines a limited slope for val to be advected with !! a piecewise limited scheme. subroutine find_limited_slope(val, e, slope, k) real, dimension(:), intent(in) :: val !< A column of values that are being interpolated. @@ -715,10 +719,10 @@ subroutine find_limited_slope(val, e, slope, k) ! Local variables real :: d1, d2 - if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then + d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) + if (((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) .or. (d1*d2 <= 0.0)) then slope = 0.0 ! ; curvature = 0.0 else - d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) slope = (d1**2*(val(k+1) - val(k)) + d2**2*(val(k) - val(k-1))) * & ((e(K) - e(K+1)) / (d1*d2*(d1+d2))) ! slope = 0.5*(val(k+1) - val(k-1)) @@ -769,8 +773,8 @@ subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) do k=1,nk ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie dilate(i) = 0.0 - if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%bathyT(i,j) - 0.0) / htot(i) - e(i,nk+1) = -G%bathyT(i,j) + if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) + e(i,nk+1) = -G%Zd_to_m*G%bathyT(i,j) enddo do k=nk,1,-1 ; do i=is,ie e(i,k) = e(i,k+1) + h(i,j,k) * dilate(i) @@ -1287,12 +1291,13 @@ function register_Z_diag(var_desc, CS, day, missing) end function register_Z_diag !> Register a diagnostic to be output at depth space interfaces -function register_Zint_diag(var_desc, CS, day) +function register_Zint_diag(var_desc, CS, day, conversion) integer :: register_Zint_diag !< The returned z-interface diagnostic index type(vardesc), intent(in) :: var_desc !< A type with metadata for this diagnostic type(diag_to_Z_CS), pointer :: CS !< Control structure returned by !! previous call to diag_to_Z_init. type(time_type), intent(in) :: day !< The current model time + real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file ! Local variables character(len=64) :: var_name ! A variable's name. character(len=48) :: units ! A variable's units. @@ -1323,8 +1328,9 @@ function register_Zint_diag(var_desc, CS, day) "register_Z_diag: unknown hor_grid component "//trim(hor_grid)) end select - register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name),& - axes, day, trim(longname), trim(units), missing_value=CS%missing_value) + register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name), & + axes, day, trim(longname), trim(units), missing_value=CS%missing_value, & + conversion=conversion) end function register_Zint_diag diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index f200a15bed..30101c91a0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -6,7 +6,7 @@ module MOM_diagnostics ! This file is part of MOM6. See LICENSE.md for the license. use MOM_coms, only : reproducing_sum -use MOM_diag_mediator, only : post_data, post_data_1d_k, get_diag_time_end +use MOM_diag_mediator, only : post_data, get_diag_time_end use MOM_diag_mediator, only : register_diag_field, register_scalar_field use MOM_diag_mediator, only : register_static_field, diag_register_area_ids use MOM_diag_mediator, only : diag_ctrl, time_type, safe_alloc_ptr @@ -284,19 +284,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) if (associated(CS%e)) then - call find_eta(h, tv, GV%g_Earth, G, GV, CS%e, eta_bt) + call find_eta(h, tv, G, GV, CS%e, eta_bt, eta_to_m=1.0) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif if (associated(CS%e_D)) then if (associated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo else - call find_eta(h, tv, GV%g_Earth, G, GV, CS%e_D, eta_bt) + call find_eta(h, tv, G, GV, CS%e_D, eta_bt, eta_to_m=1.0) do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo endif @@ -324,7 +324,14 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! diagnose thickness/volumes of grid cells (meter) if (CS%id_thkcello>0 .or. CS%id_volcello>0) then if (GV%Boussinesq) then ! thkcello = h for Boussinesq - if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, GV%H_to_m*h, CS%diag) + if (CS%id_thkcello > 0) then ; if (GV%H_to_m == 1.0) then + call post_data(CS%id_thkcello, h, CS%diag) + else + do k=1,nz; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_m*h(i,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_thkcello, work_3d, CS%diag) + endif ; endif if (CS%id_volcello > 0) then ! volcello = h*area for Boussinesq do k=1,nz; do j=js,je ; do i=is,ie work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * G%areaT(i,j) @@ -344,7 +351,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif do k=1,nz ! Integrate vertically downward for pressure do i=is,ie ! Pressure for EOS at the layer center (Pa) - pressure_1d(i) = pressure_1d(i) + 0.5*(GV%g_Earth*GV%H_to_kg_m2)*h(i,j,k) + pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo ! Store in-situ density (kg/m3) in work_3d call calculate_density(tv%T(:,j,k),tv%S(:,j,k), pressure_1d, & @@ -353,7 +360,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & work_3d(i,j,k) = (GV%H_to_kg_m2*h(i,j,k)) / work_3d(i,j,k) enddo do i=is,ie ! Pressure for EOS at the bottom interface (Pa) - pressure_1d(i) = pressure_1d(i) + 0.5*(GV%g_Earth*GV%H_to_kg_m2)*h(i,j,k) + pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo enddo ! k enddo ! j @@ -434,13 +441,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! layer mean potential temperature if (CS%id_temp_layer_ave>0) then temp_layer_ave = global_layer_mean(tv%T, h, G, GV) - call post_data_1d_k(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) + call post_data(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) endif ! layer mean salinity if (CS%id_salt_layer_ave>0) then salt_layer_ave = global_layer_mean(tv%S, h, G, GV) - call post_data_1d_k(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) + call post_data(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) endif call calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) @@ -808,9 +815,9 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) endif if (CS%id_col_ht > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, z_top) + call find_eta(h, tv, G, GV, z_top, eta_to_m=1.0) do j=js,je ; do i=is,ie - z_bot(i,j) = z_top(i,j) + G%bathyT(i,j) + z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo call post_data(CS%id_col_ht, z_bot, CS%diag) endif @@ -819,7 +826,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then - IG_Earth = 1.0 / GV%g_Earth + IG_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) ! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=js,je ; do i=is,ie ; z_bot(i,j) = 0.0 ; enddo ; enddo do k=1,nz @@ -828,7 +835,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) z_bot(i,j) = z_top(i,j) - GV%H_to_m*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), & - z_top, z_bot, 0.0, GV%H_to_kg_m2, GV%g_Earth, & + z_top, z_bot, 0.0, GV%H_to_kg_m2, (GV%g_Earth*GV%m_to_Z), & G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth @@ -853,7 +860,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) ! pbo = (mass * g) + p_surf ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie - btm_pres(i,j) = mass(i,j) * GV%g_Earth + btm_pres(i,j) = mass(i,j) * (GV%g_Earth*GV%m_to_Z) if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif @@ -1209,7 +1216,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, & ! post total volume of the liquid ocean if (IDs%id_volo > 0) then do j=js,je ; do i=is,ie - work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%bathyT(i,j)) + work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%Zd_to_m*G%bathyT(i,j)) enddo ; enddo volo = global_area_integral(work_2d, G) call post_data(IDs%id_volo, volo, diag) @@ -1822,6 +1829,8 @@ subroutine write_static_fields(G, GV, tv, diag) real :: tmp_h(SZI_(G),SZJ_(G)) integer :: id, i, j + tmp_h(:,:) = 0.0 + id = register_static_field('ocean_model', 'geolat', diag%axesT1, & 'Latitude of tracer (T) points', 'degrees_north') if (id > 0) call post_data(id, G%geoLatT, diag, .true.) @@ -1898,7 +1907,16 @@ subroutine write_static_fields(G, GV, tv, diag) cmor_standard_name='sea_floor_depth_below_geoid',& area=diag%axesT1%id_area, & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + if (id > 0) then + if (G%Zd_to_m == 1.0) then + call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + else + do j=G%jsc,G%jec ; do i=G%isc,G%iec + tmp_h(i,j) = G%bathyT(i,j) * G%Zd_to_m + enddo ; enddo + call post_data(id, tmp_h, diag, .true., mask=G%mask2dT) + endif + endif id = register_static_field('ocean_model', 'wet', diag%axesT1, & '0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area) @@ -1952,6 +1970,14 @@ subroutine write_static_fields(G, GV, tv, diag) 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) + id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & + 'sine of the clockwise angle of the ocean grid north to true north', 'none') + if (id > 0) call post_data(id, G%sin_rot, diag, .true.) + + id = register_static_field('ocean_model', 'cos_rot', diag%axesT1, & + 'cosine of the clockwise angle of the ocean grid north to true north', 'none') + if (id > 0) call post_data(id, G%cos_rot, diag, .true.) + ! This static diagnostic is from CF 1.8, and is the fraction of a cell ! covered by ocean, given as a percentage (poorly named). @@ -1961,8 +1987,9 @@ subroutine write_static_fields(G, GV, tv, diag) cmor_long_name='Sea Area Fraction', & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) then - tmp_h(:,:) = 0. - tmp_h(G%isc:G%iec,G%jsc:G%jec) = 100. * G%mask2dT(G%isc:G%iec,G%jsc:G%jec) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + tmp_h(i,j) = 100. * G%mask2dT(i,j) + enddo ; enddo call post_data(id, tmp_h, diag, .true.) endif diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 3392f85437..91a4dd96ab 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -498,7 +498,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo @@ -640,10 +640,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc hbelow = 0.0 do k=nz,1,-1 hbelow = hbelow + h(i,j,k) * H_to_m - hint = H_0APE(K) + (hbelow - G%bathyT(i,j)) - hbot = H_0APE(K) - G%bathyT(i,j) + hint = H_0APE(K) + (hbelow - G%Zd_to_m*G%bathyT(i,j)) + hbot = H_0APE(K) - G%Zd_to_m*G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -652,8 +652,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc hbelow = 0.0 do k=nz,1,-1 hint = H_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. - hbot = max(H_0APE(K) - G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & + hbot = max(H_0APE(K) - G%Zd_to_m*G%bathyT(i,j), 0.0) + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -1088,7 +1088,7 @@ subroutine create_depth_list(G, CS) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%bathyT(i,j) + Dlist(list_pos) = G%Zd_to_m*G%bathyT(i,j) Arealist(list_pos) = G%mask2dT(i,j)*G%areaT(i,j) enddo ; enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 0ca8201ebe..e8d58e502b 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -29,7 +29,7 @@ module MOM_wave_speed !! wave speed. This parameter controls the default behavior of !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of - !! calculating the equivalent barotropic wave speed. (m) + !! calculating the equivalent barotropic wave speed. (Z) !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic @@ -58,7 +58,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & !! for the purposes of calculating vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as !! monotonic for the purposes of calculating vertical - !! modal structure. + !! modal structure, in m. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) @@ -66,7 +66,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m s-2. + gprime ! The reduced gravity across each interface, in m2 Z-1 s-2. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -78,13 +78,13 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & real det, ddet, detKm1, detKm2, ddetKm1, ddetKm2 real :: lam, dlam, lam0 real :: min_h_frac - real :: H_to_pres - real :: H_to_m ! Local copy of a unit conversion factor. + real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses in m. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum + real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths, in Z2 m-2. real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. @@ -109,12 +109,14 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif + L2_to_Z2 = GV%m_to_Z**2 + l_use_ebt_mode = CS%use_ebt_mode if (present(use_ebt_mode)) l_use_ebt_mode = use_ebt_mode l_mono_N2_column_fraction = CS%mono_N2_column_fraction if (present(mono_N2_column_fraction)) l_mono_N2_column_fraction = mono_N2_column_fraction - l_mono_N2_depth = CS%mono_N2_depth - if (present(mono_N2_depth)) l_mono_N2_depth = mono_N2_depth + l_mono_N2_depth = GV%m_to_Z*CS%mono_N2_depth + if (present(mono_N2_depth)) l_mono_N2_depth = GV%m_to_Z*mono_N2_depth calc_modal_structure = l_use_ebt_mode if (present(modal_structure)) calc_modal_structure = .true. if (calc_modal_structure) then @@ -124,18 +126,17 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%g_Earth * GV%Rho0 - H_to_m = GV%H_to_m rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,min_h_frac,use_EOS,T,S,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & -!$OMP H_to_pres,H_to_m,cg1,g_Rho0,rescale,I_rescale) & +!$OMP H_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2) & !$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & !$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT, & !$OMP drho_dS,drxh_sum,kc,Hc,Tc,Sc,I_Hnew,gprime, & @@ -148,7 +149,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -156,20 +157,20 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -179,16 +180,16 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -312,26 +313,29 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & speed2_tot = 0.0 if (l_use_ebt_mode) then Igu(1) = 0. ! Neumann condition for pressure modes - sum_hc = Hc(1)*GV%H_to_m - N2min = gprime(2)/Hc(1) + sum_hc = Hc(1)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH + N2min = L2_to_Z2*gprime(2)/Hc(1) do k=2,kc hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then - if (G%bathyT(i,j)-sum_hcN2min*hw) then + if (G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%bathyT(i,j) .and. & + L2_to_Z2*gp > N2min*hw) then ! Filters out regions where N2 increases with depth but only in a lower fraction of water column - gp = N2min/hw - elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. gp>N2min*hw) then + gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH + !### This should be gp = GV%Z_to_m**2* (N2min*hw) + elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. L2_to_Z2*gp>N2min*hw) then ! Filters out regions where N2 increases with depth but only below a certain depth - gp = N2min/hw + gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH + !### This should be gp = GV%Z_to_m**2* (N2min*hw) else - N2min = gp/hw + N2min = L2_to_Z2 * gp/hw endif endif Igu(k) = 1.0/(gp*Hc(k)) Igl(k-1) = 1.0/(gp*Hc(k-1)) speed2_tot = speed2_tot + gprime(k)*(Hc(k-1)+Hc(k))*0.707 - sum_hc = sum_hc + Hc(k)*GV%H_to_m + sum_hc = sum_hc + Hc(k)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH enddo !Igl(kc) = 0. ! Neumann condition for pressure modes Igl(kc) = 2.*Igu(kc) ! Dirichlet condition for pressure modes @@ -448,9 +452,9 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & mode_struct(1:kc)=0. endif ! Note that remapping_core_h requires that the same units be used - ! for both the source and target grid thicknesses. - call remapping_core_h(CS%remapping_CS, kc, Hc, mode_struct, & - nz, GV%H_to_m*h(i,j,:), modal_structure(i,j,:)) + ! for both the source and target grid thicknesses, here in H. + call remapping_core_h(CS%remapping_CS, kc, GV%Z_to_H*Hc(:), mode_struct, & + nz, h(i,j,:), modal_structure(i,j,:), 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H) endif else cg1(i,j) = 0.0 @@ -505,7 +509,7 @@ subroutine tdma6(n, a, b, c, lam, y) do k = n-1, 1, -1 y(k) = ( yy(k) - c(k) * y(k+1) ) * beta(k) enddo -end subroutine +end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) @@ -555,7 +559,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) integer :: numint ! number of widows (intervals) in root searching range integer :: nrootsfound ! number of extra roots found (not including 1st root) real :: min_h_frac - real :: H_to_pres + real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa) real :: H_to_m ! Local copy of a unit conversion factor. real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses in m. @@ -595,7 +599,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif ; endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%g_Earth * GV%Rho0 @@ -619,7 +623,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -627,20 +631,20 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -650,16 +654,16 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -786,7 +790,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) speed2_tot = speed2_tot + gprime(K)*(Hc(k-1)+Hc(k)) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) @@ -794,11 +798,8 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! Calcualte depth at bottom z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth - if (abs(z_int(kc+1)-htot(i)) > 1.e-10) then - call MOM_error(WARNING, "wave_structure: mismatch in total depths") - print *, "kc=", kc - print *, "z_int(kc+1)=", z_int(kc+1) - print *, "htot(i)=", htot(i) + if (abs(z_int(kc+1)-htot(i)) > 1.e-12*htot(i)) then + call MOM_error(FATAL, "wave_structure: mismatch in total depths") endif ! Define the diagonals of the tridiagonal matrix @@ -954,19 +955,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) call MOM_error(WARNING, "wave_speed: root not found "// & " after sub_it_max subdivisions of original"// & " interval.") - !if (ig == 144 .and. jg == 5) then - !print *, "xbl=",xbl - !print *, "xbr=",xbr - !print *, "Wave_speed: kc=",kc - !print *, 'Wave_speed: z_int(ig,jg)=', z_int(1:kc+1) - !print *, 'Wave_speed: N2(ig,jg)=', N2(1:kc+1) - !print *, 'Wave_speed: gprime=', gprime(1:kc+1) - !print *, 'Wave_speed: htot=', htot(i) - !print *, 'Wave_speed: cn1=', cn(i,j,1) - !print *, 'Wave_speed: numint=', numint - !print *, 'Wave_speed: nrootsfound=', nrootsfound - !stop - !endif endif ! sub_it == sub_it_max enddo ! sub_it-loop------------------------------------------------- endif ! det_l*ddet_l < 0.0 @@ -979,20 +967,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! oops, lamMax not large enough - could add code to increase (BDM) ! set unfound modes to zero for now (BDM) cn(i,j,nrootsfound+2:nmodes) = 0.0 - !if (ig == 83 .and. jg == 2) then - ! call MOM_error(WARNING, "wave_speed: not all modes found "// & - ! " within search range: increase numint.") - ! print *, "Increase lamMax at ig=",ig," jg=",jg - ! print *, "where lamMax=", lamMax - ! print *, 'numint=', numint - ! print *, "nrootsfound=", nrootsfound - ! print *, "xbl=",xbl - ! print *, "xbr=",xbr - !print *, "kc=",kc - !print *, 'z_int(ig,jg)=', z_int(1:kc+1) - !print *, 'N2(ig,jg)=', N2(1:kc+1) - !stop - !endif else ! else shift interval and keep looking until nmodes or numint is reached det_l = det_r @@ -1132,9 +1106,9 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ if (.not.associated(CS)) call MOM_error(FATAL, & "wave_speed_set_param called with an associated control structure.") - if (present(use_ebt_mode)) CS%use_ebt_mode=use_ebt_mode - if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction=mono_N2_column_fraction - if (present(mono_N2_depth)) CS%mono_N2_depth=mono_N2_depth + if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode + if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction + if (present(mono_N2_depth)) CS%mono_N2_depth = mono_N2_depth end subroutine wave_speed_set_param diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0890006c98..735690eb81 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -44,7 +44,7 @@ module MOM_wave_structure real, allocatable, dimension(:,:,:) :: z_depths !< Depths of layer interfaces, in m. real, allocatable, dimension(:,:,:) :: N2 - !< Squared buoyancy frequency at each interface + !< Squared buoyancy frequency at each interface, in S-2. integer, allocatable, dimension(:,:):: num_intfaces !< Number of layer interfaces (including surface and bottom) real :: int_tide_source_x !< X Location of generation site @@ -108,7 +108,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m s-2. + gprime ! The reduced gravity across each interface, in m2 Z-1 s-2. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -123,15 +123,14 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real :: lam real :: min_h_frac real :: H_to_pres - real :: H_to_m ! Local copy of a unit conversion factor. real, dimension(SZI_(G)) :: & - hmin, & ! Thicknesses in m. + hmin, & ! Thicknesses in Z. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. + real :: g_Rho0 ! G_Earth/Rho0 in m5 Z-1 s-2 kg-1. real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector @@ -152,6 +151,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real :: w2avg ! average of squared vertical velocity structure funtion real :: int_dwdz2, int_w2, int_N2w2, KE_term, PE_term, W0 ! terms in vertically averaged energy equation + real :: gp_unscaled ! A version of gprime rescaled to units of m s-2. real, dimension(SZK_(G)-1) :: lam_z ! product of eigen value and gprime(k); one value for each ! interface (excluding surface and bottom) real, dimension(SZK_(G)-1) :: a_diag, b_diag, c_diag @@ -178,11 +178,10 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = GV%g_Earth /GV%Rho0 use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%g_Earth * GV%Rho0 - H_to_m = GV%H_to_m rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) @@ -192,7 +191,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i,j) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i,j)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -200,20 +199,20 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -223,16 +222,16 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -368,20 +367,20 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) N2(1) = N2(2) ; N2(kc+1) = N2(kc) ! Calcualte depth at bottom z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth - if (abs(z_int(kc+1)-htot(i,j)) > 1.e-10) then - call MOM_error(WARNING, "wave_structure: mismatch in total depths") - print *, "kc=", kc - print *, "z_int(kc+1)=", z_int(kc+1) - print *, "htot(i,j)=", htot(i,j) + if (abs(z_int(kc+1)-htot(i,j)) > 1.e-14*htot(i,j)) then + call MOM_error(FATAL, "wave_structure: mismatch in total depths") endif + ! Note that many of the calcluation from here on revert to using vertical + ! distances in m, not Z. + ! Populate interior rows of tridiagonal matrix; must multiply through by ! gprime to get tridiagonal matrix to the symmetrical form: ! [-1/H(k-1)]e(k-1) + [1/H(k-1)+1/H(k)-lam_z]e(k) + [-1/H(k)]e(k+1) = 0, @@ -389,30 +388,33 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! Frist, populate interior rows do K=3,kc-1 row = K-1 ! indexing for TD matrix rows - lam_z(row) = lam*gprime(K) - a_diag(row) = gprime(K)*(-Igu(K)) - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) - c_diag(row) = gprime(K)*(-Igl(K)) + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled + a_diag(row) = gp_unscaled*(-Igu(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) + c_diag(row) = gp_unscaled*(-Igl(K)) if (isnan(lam_z(row)))then ; print *, "Wave_structure: lam_z(row) is NAN" ; endif if (isnan(a_diag(row)))then ; print *, "Wave_structure: a(k) is NAN" ; endif if (isnan(b_diag(row)))then ; print *, "Wave_structure: b(k) is NAN" ; endif if (isnan(c_diag(row)))then ; print *, "Wave_structure: c(k) is NAN" ; endif enddo ! Populate top row of tridiagonal matrix - K=2 ; row = K-1 - lam_z(row) = lam*gprime(K) + K=2 ; row = K-1 ; + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled a_diag(row) = 0.0 - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) - c_diag(row) = gprime(K)*(-Igl(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) + c_diag(row) = gp_unscaled*(-Igl(K)) ! Populate bottom row of tridiagonal matrix K=kc ; row = K-1 - lam_z(row) = lam*gprime(K) - a_diag(row) = gprime(K)*(-Igu(K)) - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled + a_diag(row) = gp_unscaled*(-Igu(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) c_diag(row) = 0.0 ! Guess a vector shape to start with (excludes surface and bottom) - e_guess(1:kc-1) = sin(z_int(2:kc)/htot(i,j)*Pi) + e_guess(1:kc-1) = sin((z_int(2:kc)/htot(i,j)) *Pi) e_guess(1:kc-1) = e_guess(1:kc-1)/sqrt(sum(e_guess(1:kc-1)**2)) ! Perform inverse iteration with tri-diag solver @@ -441,11 +443,12 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) !(including surface and bottom) w2avg = 0.0 do k=1,nzm-1 - dz(k) = Hc(k) + dz(k) = GV%Z_to_m*Hc(k) w2avg = w2avg + 0.5*(w_strct(K)**2+w_strct(K+1)**2)*dz(k) enddo - w2avg = w2avg/htot(i,j) - w_strct = w_strct/sqrt(htot(i,j)*w2avg*I_a_int) + !### Some mathematical cancellations could occur in the next two lines. + w2avg = w2avg / htot(i,j) + w_strct = w_strct / sqrt(htot(i,j)*w2avg*I_a_int) ! Calculate vertical structure function of u (i.e. dw/dz) do K=2,nzm-1 @@ -495,45 +498,13 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) endif ! Store values in control structure - CS%w_strct(i,j,1:nzm) = w_strct - CS%u_strct(i,j,1:nzm) = u_strct - CS%W_profile(i,j,1:nzm) = W_profile - CS%Uavg_profile(i,j,1:nzm)= Uavg_profile - CS%z_depths(i,j,1:nzm) = z_int - CS%N2(i,j,1:nzm) = N2 + CS%w_strct(i,j,1:nzm) = w_strct(:) + CS%u_strct(i,j,1:nzm) = u_strct(:) + CS%W_profile(i,j,1:nzm) = W_profile(:) + CS%Uavg_profile(i,j,1:nzm)= Uavg_profile(:) + CS%z_depths(i,j,1:nzm) = GV%Z_to_m*z_int(:) + CS%N2(i,j,1:nzm) = N2(:) CS%num_intfaces(i,j) = nzm - - !----for debugging; delete later---- - !if (ig == ig_stop .and. jg == jg_stop) then - !print *, 'cn(ig,jg)=', cn(i,j) - !print *, "e_guess=", e_guess(1:kc-1) - !print *, "|e_guess|=", sqrt(sum(e_guess(1:kc-1)**2)) - !print *, 'f0=', sqrt(f2) - !print *, 'freq=', freq - !print *, 'Kh=', sqrt(Kmag2) - !print *, 'Wave_structure: z_int(ig,jg)=', z_int(1:nzm) - !print *, 'Wave_structure: N2(ig,jg)=', N2(1:nzm) - !print *, 'gprime=', gprime(1:nzm) - !print *, '1/Hc=', 1/Hc - !print *, 'Wave_structure: a_diag(ig,jg)=', a_diag(1:kc-1) - !print *, 'Wave_structure: b_diag(ig,jg)=', b_diag(1:kc-1) - !print *, 'Wave_structure: c_diag(ig,jg)=', c_diag(1:kc-1) - !print *, 'Wave_structure: lam_z(ig,jg)=', lam_z(1:kc-1) - !print *, 'Wave_structure: w_strct(ig,jg)=', w_strct(1:nzm) - !print *, 'En(i,j)=', En(i,j) - !print *, 'Wave_structure: W_profile(ig,jg)=', W_profile(1:nzm) - !print *,'int_dwdz2 =',int_dwdz2 - !print *,'int_w2 =',int_w2 - !print *,'int_N2w2 =',int_N2w2 - !print *,'KEterm=',KE_term - !print *,'PEterm=',PE_term - !print *, 'W0=',W0 - !print *,'Uavg_profile=',Uavg_profile(1:nzm) - !open(unit=1,file='out_N2',form='formatted') ; write(1,*) N2 ; close(1) - !open(unit=2,file='out_z',form='formatted') ; write(2,*) z_int ; close(2) - !endif - !----------------------------------- - else ! If not enough layers, default to zero nzm = kc+1 @@ -584,8 +555,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) real, dimension(:), intent(out) :: x !< vector of unknown values to solve for. ! Local variables integer :: nrow ! number of rows in A matrix - real, allocatable, dimension(:,:) :: A_check ! for solution checking - real, allocatable, dimension(:) :: y_check ! for solution checking +! real, allocatable, dimension(:,:) :: A_check ! for solution checking +! real, allocatable, dimension(:) :: y_check ! for solution checking real, allocatable, dimension(:) :: c_prime, y_prime, q, alpha ! intermediate values for solvers real :: Q_prime, beta ! intermediate values for solver @@ -597,8 +568,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) allocate(y_prime(nrow)) allocate(q(nrow)) allocate(alpha(nrow)) - allocate(A_check(nrow,nrow)) - allocate(y_check(nrow)) +! allocate(A_check(nrow,nrow)) +! allocate(y_check(nrow)) if (method == 'TDMA_T') then ! Standard Thomas algoritim (4th variant). @@ -648,7 +619,7 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) ! symmetric, diagonally dominant matrix, with h>0. ! Need to add a check for these conditions. do k=1,nrow-1 - if (abs(a(k+1)-c(k)) > 1.e-10) then + if (abs(a(k+1)-c(k)) > 1.e-10*(abs(a(k+1))+abs(c(k)))) then call MOM_error(WARNING, "tridiag_solver: matrix not symmetric; need symmetry when invoking TDMA_H") endif enddo @@ -671,8 +642,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) Q_prime = beta*(h(k)+alpha(k-1)*Q_prime) enddo if ((h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) == 0.0)then - call MOM_error(WARNING, "Tridiag_solver: this system is not stable; overriding beta(nrow).") - beta = 1/(1e-15) ! place holder for unstable systems - delete later + call MOM_error(FATAL, "Tridiag_solver: this system is not stable.") ! ; overriding beta(nrow) + ! This has hard-coded dimensions: beta = 1/(1e-15) ! place holder for unstable systems - delete later else beta = 1/(h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) endif @@ -686,7 +657,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) !print *, 'x=',x(1:nrow) endif - deallocate(c_prime,y_prime,q,alpha,A_check,y_check) + deallocate(c_prime,y_prime,q,alpha) +! deallocate(A_check,y_check) end subroutine tridiag_solver diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 30ac795c56..9a823d23eb 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -625,21 +625,21 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity (PSU) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in m. + intent(in) :: z_b !< Height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa m. + !! top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -649,9 +649,8 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & !! pressure anomaly at the top and bottom of the layer !! divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -877,16 +876,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity of the layer in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in m. + intent(in) :: z_b !< Height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is !! subtracted out to reduce the magnitude !! of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly @@ -894,7 +893,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the - !! anomaly at the top of the layer, in Pa m. + !! anomaly at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between !! the pressure anomaly at the top and bottom of the @@ -904,9 +903,8 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! the pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. real :: T5(5), S5(5), p5(5), r5(5) @@ -914,16 +912,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: w_left, w_right real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho, I_Rho - real :: dz ! The layer thickness, in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz ! The layer thickness, in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in Z-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. - real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m, n, ioff, joff @@ -1054,7 +1052,6 @@ end subroutine int_density_dz_generic ! ========================================================================== !> Compute pressure gradient force integrals by quadrature for the case where !! T and S are linear profiles. -! ========================================================================== subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & rho_0, G_e, dz_subroundoff, bathyT, HII, HIO, EOS, dpa, & intz_dpa, intx_dpa, inty_dpa, & @@ -1070,27 +1067,26 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S_b !< Salinity at the cell bottom (ppt) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< The geometric height at the top - !! of the layer, usually in m + intent(in) :: z_t !< The geometric height at the top of the layer, + !! in depth units (Z), usually m. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< The geometric height at the bottom - !! of the layer, usually in m + intent(in) :: z_b !< The geometric height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, intent(in) :: dz_subroundoff !< A miniscule thickness !! change with the same units as z_t real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: bathyT !< The depth of the bathymetry in m + intent(in) :: bathyT !< The depth of the bathymetry in units of Z. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa m. + !! top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -1111,53 +1107,34 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! It is assumed that the salinity and temperature profiles are linear in the ! vertical. The top and bottom values within each layer are provided and ! a linear interpolation is used to compute intermediate values. -! -! Arguments: T - potential temperature relative to the surface in C -! (the 't' and 'b' subscripts refer to the values at -! the top and the bottom of each layer) -! (in) S - salinity in PSU. -! (the 't' and 'b' subscripts refer to the values at -! the top and the bottom of each layer) -! (in) z_t - height at the top of the layer in m. -! (in) z_b - height at the top of the layer in m. -! (in) rho_ref - A mean density, in kg m-3, that is subtracted out to reduce -! the magnitude of each of the integrals. -! (The pressure is calucated as p~=-z*rho_0*G_e.) -! (in) rho_0 - A density, in kg m-3, that is used to calculate the pressure -! (as p~=-z*rho_0*G_e) used in the equation of state. -! (in) G_e - The Earth's gravitational acceleration, in m s-2. -! (in) G - The ocean's grid structure. -! (in) form_of_eos - integer that selects the eqn of state. -! (out) dpa - The change in the pressure anomaly across the layer, -! in Pa. -! (out,opt) intz_dpa - The integral through the thickness of the layer of the -! pressure anomaly relative to the anomaly at the top of -! the layer, in Pa m. -! (out,opt) intx_dpa - The integral in x of the difference between the -! pressure anomaly at the top and bottom of the layer -! divided by the x grid spacing, in Pa. -! (out,opt) inty_dpa - The integral in y of the difference between the -! pressure anomaly at the top and bottom of the layer -! divided by the y grid spacing, in Pa. -! (in,opt) useMassWghtInterp - If true, uses mass weighting to interpolate -! T/S for top and bottom integrals. - - real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: wt_t(5), wt_b(5) - real :: rho_anom - real :: w_left, w_right, intz(5) - real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. - real :: GxRho, I_Rho - real :: dz(HIO%iscB:HIO%iecB+1), dz_x(5,HIO%iscB:HIO%iecB), dz_y(5,HIO%isc:HIO%iec) - real :: weight_t, weight_b, hWght, massWeightToggle - real :: Ttl, Tbl, Ttr, Tbr, Stl, Sbl, Str, Sbr, hL, hR, iDenom + + ! Local variables + real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations, in degC + real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations, in ppt + real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations, in Pa + real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations, in kg m-3 + real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations, in degC + real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations, in ppt + real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations, in Pa + real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations, in kg m-3 + real :: wt_t(5), wt_b(5) ! Top and bottom weights, ND. + real :: rho_anom ! A density anomaly in kg m-3. + real :: w_left, w_right ! Left and right weights, ND. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations, in Pa. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant, ND. + real :: GxRho ! Gravitational acceleration times density, in kg m-1 Z-1 s-2. + real :: I_Rho ! The inverse of the reference density, in m3 kg-1. + real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points in Z. + real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations, in Z. + real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations, in Z. + real :: weight_t, weight_b ! Nondimensional wieghts of the top and bottom. + real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). + real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners, in degC. + real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners, in ppt. + real :: hWght ! A topographically limited thicknes weight, in Z. + real :: hL, hR ! Thicknesses to the left and right, in Z. + real :: iDenom ! The denominator of the thickness weight expressions, in Z-2. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n integer :: iin, jin, ioff, joff integer :: pos @@ -1378,20 +1355,21 @@ end subroutine int_density_dz_generic_plm !> Find the depth at which the reconstructed pressure matches P_tgt subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, & - rho_ref, G_e, EOS, P_b, z_out) + rho_ref, G_e, EOS, P_b, z_out, z_tol) real, intent(in) :: T_t !< Potential temperatue at the cell top (degC) real, intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) real, intent(in) :: S_t !< Salinity at the cell top (ppt) real, intent(in) :: S_b !< Salinity at the cell bottom (ppt) - real, intent(in) :: z_t !< Absolute height of top of cell (m) (Boussinesq ????) - real, intent(in) :: z_b !< Absolute height of bottom of cell (m) + real, intent(in) :: z_t !< Absolute height of top of cell (Z) (Boussinesq ????) + real, intent(in) :: z_b !< Absolute height of bottom of cell (Z) real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t (Pa) real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out (Pa) real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to - real, intent(in) :: G_e !< Gravitational acceleration (m/s2) + real, intent(in) :: G_e !< Gravitational acceleration (m2 Z-1 s-2) type(EOS_type), pointer :: EOS !< Equation of state structure real, intent(out) :: P_b !< Pressure at the bottom of the cell (Pa) - real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt (m) + real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt (Z) + real, optional, intent(in) :: z_tol !< The tolerance in finding z_out, in Z. ! Local variables real :: top_weight, bottom_weight, rho_anom, w_left, w_right, GxRho, dz, dp, F_guess, F_l, F_r real :: Pa, Pa_left, Pa_right, Pa_tol ! Pressure anomalies, P = integral of g*(rho-rho_ref) dz @@ -1417,7 +1395,8 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t Pa_left = P_t - P_tgt ! Pa_left < 0 F_r = 1. Pa_right = P_b - P_tgt ! Pa_right > 0 - Pa_tol = GxRho * 1.e-5 + Pa_tol = GxRho * 1.e-5 ! 1e-5 has diimensions of m, but should be converted to the units of z. + if (present(z_tol)) Pa_tol = GxRho * z_tol F_guess = F_l - Pa_left / ( Pa_right -Pa_left ) * ( F_r - F_l ) Pa = Pa_right - Pa_left ! To get into iterative loop do while ( abs(Pa) > Pa_tol ) @@ -1458,7 +1437,7 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. - real, intent(in) :: pos !< The fractional vertical position, nondim. + real, intent(in) :: pos !< The fractional vertical position, nondim, 0 to 1. type(EOS_type), pointer :: EOS !< Equation of state structure ! Local variables real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. @@ -2009,10 +1988,10 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & ! real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. @@ -2206,10 +2185,10 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index d35961b997..a4535ec961 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -402,23 +402,23 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in m. + intent(in) :: z_b !< Height at the top of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out !! to reduce the magnitude of each of the integrals. !! (The pressure is calucated as p~=-z*rho_0*G_e.) real, intent(in) :: rho_0 !< Density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the !! equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the !! layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer, in Pa m. + !! at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -428,11 +428,10 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to - !! interpolate T/S for top and bottom integrals. + !! interpolate T/S for top and bottom integrals. ! Local variables real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed) :: al0_2d, p0_2d, lambda_2d @@ -441,16 +440,16 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: eps, eps2, rem real :: GxRho, I_Rho real :: p_ave, I_al0, I_Lzz - real :: dz ! The layer thickness, in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz ! The layer thickness, in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in m-Z. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. @@ -634,9 +633,9 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate !! dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -649,10 +648,10 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: dp ! The pressure change through a layer, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 7168e2f2f7..d63929bd62 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -323,9 +323,9 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in m. + intent(in) :: z_b !< Height at the top of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted !! out to reduce the magnitude of each of the !! integrals. @@ -333,8 +333,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! the pressure (as p~=-z*rho_0_pres*G_e) used in !! the equation of state. rho_0_pres is not used !! here. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, - !! in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. real, intent(in) :: dRho_dT !< The derivative of density with temperature, !! in kg m-3 C-1. @@ -346,7 +345,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer, in Pa m. + !! at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -356,24 +355,23 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to - !! interpolate T/S for top and bottom integrals. + !! interpolate T/S for top and bottom integrals. ! Local variables real :: rho_anom ! The density anomaly from rho_ref, in kg m-3. real :: raL, raR ! rho_anom to the left and right, in kg m-3. - real :: dz, dzL, dzR ! Layer thicknesses in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz, dzL, dzR ! Layer thicknesses in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in Z-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_6 = 1.0/6.0, C1_90 = 1.0/90.0 ! Rational constants. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, ioff, joff, m @@ -529,9 +527,9 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & !! in m2 s-2. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. ! Local variables @@ -541,10 +539,10 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & real :: dp, dpL, dpR ! Layer pressure thicknesses in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index fb84d4d48d..a4c1787855 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -64,7 +64,7 @@ module MOM_diag_mediator !> Make a diagnostic available for averaging or output. interface post_data - module procedure post_data_3d, post_data_2d, post_data_0d + module procedure post_data_3d, post_data_2d, post_data_1d_k, post_data_0d end interface post_data !> A group of 1D axes that comprise a 1D/2D/3D mesh @@ -752,14 +752,15 @@ end subroutine post_data_0d subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) integer, intent(in) :: diag_field_id !< The id for an output variable returned by a !! previous call to register_diag_field. - real, intent(in) :: field(:) !< 1-d array being offered for output or averaging + real, target, intent(in) :: field(:) !< 1-d array being offered for output or averaging type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. ! Local variables logical :: used ! The return value of send_data is not used for anything. + real, dimension(:), pointer :: locfield => NULL() logical :: is_stat - integer :: isv, iev, jsv, jev + integer :: k, ks, ke type(diag_type), pointer :: diag => null() if (id_clock_diag_mediator>0) call cpu_clock_begin(id_clock_diag_mediator) @@ -770,11 +771,29 @@ subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) 'post_data_1d_k: Unregistered diagnostic id') diag => diag_cs%diags(diag_field_id) do while (associated(diag)) + + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then + ks = lbound(field,1) ; ke = ubound(field,1) + allocate( locfield( ks:ke ) ) + + do k=ks,ke + if (field(k) == diag_cs%missing_value) then + locfield(k) = diag_cs%missing_value + else + locfield(k) = field(k) * diag%conversion_factor + endif + enddo + else + locfield => field + endif + if (is_stat) then - used = send_data(diag%fms_diag_id, field) + used = send_data(diag%fms_diag_id, locfield) elseif (diag_cs%ave_enabled) then - used = send_data(diag%fms_diag_id, field, diag_cs%time_end, weight=diag_cs%time_int) + used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, weight=diag_cs%time_int) endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) + diag => diag%next enddo @@ -800,7 +819,7 @@ subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask) 'post_data_2d: Unregistered diagnostic id') diag => diag_cs%diags(diag_field_id) do while (associated(diag)) - call post_data_2d_low(diag, field, diag_cs, is_static, mask) + call post_data_2d_low(diag, field, diag_cs, is_static, mask) diag => diag%next enddo @@ -2171,7 +2190,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) character(len=240), allocatable :: diag_coords(:) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diag_mediator" ! This module's name. + character(len=40) :: mdl = "MOM_diag_mediator" ! This module's name. id_clock_diag_mediator = cpu_clock_id('(Ocean diagnostics framework)', grain=CLOCK_MODULE) id_clock_diag_remap = cpu_clock_id('(Ocean diagnostics remapping)', grain=CLOCK_ROUTINE) @@ -2185,22 +2204,22 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) enddo ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, & + call get_param(param_file, mdl, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, & 'The number of diagnostic vertical coordinates to use.\n'//& 'For each coordinate, an entry in DIAG_COORDS must be provided.', & default=1) if (diag_cs%num_diag_coords>0) then allocate(diag_coords(diag_cs%num_diag_coords)) if (diag_cs%num_diag_coords==1) then ! The default is to provide just one instance of Z* - call get_param(param_file, mod, 'DIAG_COORDS', diag_coords, & + call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, & 'A list of string tuples associating diag_table modules to\n'//& 'a coordinate definition used for diagnostics. Each string\n'//& 'is of the form "MODULE_SUFFIX PARAMETER_SUFFIX COORDINATE_NAME".', & default='z Z ZSTAR') else ! If using more than 1 diagnostic coordinate, all must be explicitly defined - call get_param(param_file, mod, 'DIAG_COORDS', diag_coords, & + call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, & 'A list of string tuples associating diag_table modules to\n'//& 'a coordinate definition used for diagnostics. Each string\n'//& 'is of the form "MODULE_SUFFIX,PARAMETER_SUFFIX,COORDINATE_NAME".', & @@ -2214,10 +2233,10 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) deallocate(diag_coords) endif - call get_param(param_file, mod, 'DIAG_MISVAL', diag_cs%missing_value, & + call get_param(param_file, mdl, 'DIAG_MISVAL', diag_cs%missing_value, & 'Set the default missing value to use for diagnostics.', & default=1.e20) - call get_param(param_file, mod, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & + call get_param(param_file, mdl, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & 'Instead of writing diagnostics to the diag manager, write\n' //& 'a textfile containing the checksum (bitcount) of the array.', & default=.false.) @@ -2244,7 +2263,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) if (is_root_pe() .and. (diag_CS%available_diag_doc_unit < 0)) then write(this_pe,'(i6.6)') PE_here() doc_file_dflt = "available_diags."//this_pe - call get_param(param_file, mod, "AVAILABLE_DIAGS_FILE", doc_file, & + call get_param(param_file, mdl, "AVAILABLE_DIAGS_FILE", doc_file, & "A file into which to write a list of all available \n"//& "ocean diagnostics that can be included in a diag_table.", & default=doc_file_dflt, do_not_log=(diag_CS%available_diag_doc_unit/=-1)) @@ -2282,7 +2301,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) if (is_root_pe() .and. (diag_CS%chksum_diag_doc_unit < 0) .and. diag_CS%diag_as_chksum) then write(this_pe,'(i6.6)') PE_here() doc_file_dflt = "chksum_diag."//this_pe - call get_param(param_file, mod, "CHKSUM_DIAG_FILE", doc_file, & + call get_param(param_file, mdl, "CHKSUM_DIAG_FILE", doc_file, & "A file into which to write all checksums of the \n"//& "diagnostics listed in the diag_table.", & default=doc_file_dflt, do_not_log=(diag_CS%chksum_diag_doc_unit/=-1)) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 737e7a3fbf..be3a02f777 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -269,22 +269,22 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), & - G%bathyT(i,j)*GV%m_to_H, sum(h(i,j,:)), & + GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), & zInterfaces, zScale=GV%m_to_H) elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & - GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) + GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & - G%bathyT(i,j), h(i,j,:), T(i, j, :), S(i, j, :), & + G%Zd_to_m*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then ! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & -! G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: SLIGHT coordinate not coded for diagnostics yet!") elseif (remap_cs%vertical_coord == coordinateMode('HYCOM1')) then ! call build_hycom1_column(remap_cs%regrid_cs, nz, & -! G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: HYCOM1 coordinate not coded for diagnostics yet!") endif remap_cs%h(i,j,:) = zInterfaces(1:nz) - zInterfaces(2:nz+1) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 103b328aa1..417274500d 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -27,22 +27,23 @@ module MOM_domains use mpp_domains_mod, only : compute_block_extent => mpp_compute_block_extent use mpp_parameter_mod, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER use mpp_parameter_mod, only : To_East => WUPDATE, To_West => EUPDATE, Omit_Corners => EDGEUPDATE -use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE +use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE, CENTER use fms_io_mod, only : file_exist, parse_mask_table implicit none ; private public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain -public :: pass_var, pass_vector, broadcast, PE_here, root_PE, num_PEs -public :: pass_var_start, pass_var_complete, fill_symmetric_edges +public :: pass_var, pass_vector, PE_here, root_PE, num_PEs +public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast public :: pass_vector_start, pass_vector_complete public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs -public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER +public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER, CENTER public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners public :: create_group_pass, do_group_pass, group_pass_type public :: start_group_pass, complete_group_pass public :: compute_block_extent, get_global_shape +public :: get_simple_array_i_ind, get_simple_array_j_ind !> Do a halo update on an array interface pass_var @@ -118,7 +119,6 @@ module MOM_domains !! domain in the i-direction in a define_domain call. integer :: Y_FLAGS !< Flag that specifies the properties of the !! domain in the j-direction in a define_domain call. - logical :: use_io_layout !< True if an I/O layout is available. logical, pointer :: maskmap(:,:) => NULL() !< A pointer to an array indicating !! which logical processors are actually used for !! the ocean code. The other logical processors @@ -179,8 +179,7 @@ subroutine pass_var_3d(array, MOM_dom, sideflag, complete, position, halo, & end subroutine pass_var_3d !> pass_var_2d does a halo update for a two-dimensional array. -subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & - clock) +subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, inner_halo, clock) real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points !! exchanged. type(MOM_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain @@ -198,9 +197,18 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & !! by default. integer, optional, intent(in) :: halo !< The size of the halo to update - the full halo !! by default. - integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be + integer, optional, intent(in) :: inner_halo !< The size of an inner halo to avoid updating, + !! or 0 to avoid updating symmetric memory + !! computational domain points. Setting this >=0 + !! also enforces that complete=.true. + integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be !! started then stopped to time this routine. + ! Local variables + real, allocatable, dimension(:,:) :: tmp + integer :: pos, i_halo, j_halo + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed, IscB, IecB, JscB, JecB + integer :: inner, i, j, isfw, iefw, isfe, iefe, jsfs, jefs, jsfn, jefn integer :: dirflag logical :: block_til_complete @@ -208,8 +216,15 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & dirflag = To_All ! 60 if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif - block_til_complete = .true. - if (present(complete)) block_til_complete = complete + block_til_complete = .true. ; if (present(complete)) block_til_complete = complete + pos = CENTER ; if (present(position)) pos = position + + if (present(inner_halo)) then ; if (inner_halo >= 0) then + ! Store the original values. + allocate(tmp(size(array,1), size(array,2))) + tmp(:,:) = array(:,:) + block_til_complete = .true. + endif ; endif if (present(halo) .and. MOM_dom%thin_halo_updates) then call mpp_update_domains(array, MOM_dom%mpp_domain, flags=dirflag, & @@ -220,6 +235,46 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & complete=block_til_complete, position=position) endif + if (present(inner_halo)) then ; if (inner_halo >= 0) then + call mpp_get_compute_domain(MOM_dom%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(MOM_dom%mpp_domain, isd, ied, jsd, jed) + ! Convert to local indices for arrays starting at 1. + isc = isc - (isd-1) ; iec = iec - (isd-1) ; ied = ied - (isd-1) ; isd = 1 + jsc = jsc - (jsd-1) ; jec = jec - (jsd-1) ; jed = jed - (jsd-1) ; jsd = 1 + i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1) + + ! Figure out the array index extents of the eastern, western, northern and southern regions to copy. + if (pos == CENTER) then + if (size(array,1) == ied) then + isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + else ; call MOM_error(FATAL, "pass_var_2d: wrong i-size for CENTER array.") ; endif + if (size(array,2) == jed) then + isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + else ; call MOM_error(FATAL, "pass_var_2d: wrong j-size for CENTER array.") ; endif + elseif (pos == CORNER) then + if (size(array,1) == ied) then + isfw = max(isc - (i_halo+1), 1) ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + elseif (size(array,1) == ied+1) then + isfw = isc - i_halo ; iefw = isc+1 ; isfe = iec+1 ; iefe = min(iec + 1 + i_halo, ied+1) + else ; call MOM_error(FATAL, "pass_var_2d: wrong i-size for CORNER array.") ; endif + if (size(array,2) == jed) then + jsfs = max(jsc - (j_halo+1), 1) ; jefs = jsc ; jsfn = jec ; jefn = jec + j_halo + elseif (size(array,2) == jed+1) then + jsfs = jsc - j_halo ; jefs = jsc+1 ; jsfn = jec+1 ; jefn = min(jec + 1 + j_halo, jed+1) + else ; call MOM_error(FATAL, "pass_var_2d: wrong j-size for CORNER array.") ; endif + else + call MOM_error(FATAL, "pass_var_2d: Unrecognized position") + endif + + ! Copy back the stored inner halo points + do j=jsfs,jefn ; do i=isfw,iefw ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfs,jefn ; do i=isfe,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfs,jefs ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfn,jefn ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + + deallocate(tmp) + endif ; endif + if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif end subroutine pass_var_2d @@ -1401,11 +1456,11 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(njproc_nm), layout(2), & - "The number of processors in the x-direction. With \n"//& !### FIX THIS COMMENT + "The number of processors in the y-direction. With \n"//& "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(layout_nm), layout, & - "The processor layout that was acutally used.",& + "The processor layout that was actually used.",& layoutParam=.true.) ! Idiot check that fewer PEs than columns have been requested @@ -1490,7 +1545,6 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & MOM_dom%Y_FLAGS = Y_FLAGS MOM_dom%layout = layout MOM_dom%io_layout = io_layout - MOM_dom%use_io_layout = (io_layout(1) + io_layout(2) > 0) if (is_static) then ! A requirement of equal sized compute domains is necessary when STATIC_MEMORY_ @@ -1554,7 +1608,6 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & MOM_dom%X_FLAGS = MD_in%X_FLAGS ; MOM_dom%Y_FLAGS = MD_in%Y_FLAGS MOM_dom%layout(:) = MD_in%layout(:) ; MOM_dom%io_layout(:) = MD_in%io_layout(:) - MOM_dom%use_io_layout = (MOM_dom%io_layout(1) + MOM_dom%io_layout(2) > 0) if (associated(MD_in%maskmap)) then mask_table_exists = .true. @@ -1685,31 +1738,29 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & isg, ieg, jsg, jeg, idg_offset, jdg_offset, & symmetric, local_indexing, index_offset) type(MOM_domain_type), & - intent(in) :: Domain !< The MOM domain from which to extract information - integer, intent(out) :: isc !< The start i-index of the computational domain - integer, intent(out) :: iec !< The end i-index of the computational domain - integer, intent(out) :: jsc !< The start j-index of the computational domain - integer, intent(out) :: jec !< The end j-index of the computational domain - integer, intent(out) :: isd !< The start i-index of the data domain - integer, intent(out) :: ied !< The end i-index of the data domain - integer, intent(out) :: jsd !< The start j-index of the data domain - integer, intent(out) :: jed !< The end j-index of the data domain - integer, intent(out) :: isg !< The start i-index of the global domain - integer, intent(out) :: ieg !< The end i-index of the global domain - integer, intent(out) :: jsg !< The start j-index of the global domain - integer, intent(out) :: jeg !< The end j-index of the global domain - integer, intent(out) :: idg_offset !< The offset between the corresponding global and - !! data i-index spaces. - integer, intent(out) :: jdg_offset !< The offset between the corresponding global and - !! data j-index spaces. - logical, intent(out) :: symmetric !< True if symmetric memory is used. - logical, optional, & - intent(in) :: local_indexing !< If true, local tracer array indices start at 1, - !! as in most MOM6 code. - integer, optional, & - intent(in) :: index_offset !< A fixed additional offset to all indices. This - !! can be useful for some types of debugging with - !! dynamic memory allocation. + intent(in) :: Domain !< The MOM domain from which to extract information + integer, intent(out) :: isc !< The start i-index of the computational domain + integer, intent(out) :: iec !< The end i-index of the computational domain + integer, intent(out) :: jsc !< The start j-index of the computational domain + integer, intent(out) :: jec !< The end j-index of the computational domain + integer, intent(out) :: isd !< The start i-index of the data domain + integer, intent(out) :: ied !< The end i-index of the data domain + integer, intent(out) :: jsd !< The start j-index of the data domain + integer, intent(out) :: jed !< The end j-index of the data domain + integer, intent(out) :: isg !< The start i-index of the global domain + integer, intent(out) :: ieg !< The end i-index of the global domain + integer, intent(out) :: jsg !< The start j-index of the global domain + integer, intent(out) :: jeg !< The end j-index of the global domain + integer, intent(out) :: idg_offset !< The offset between the corresponding global and + !! data i-index spaces. + integer, intent(out) :: jdg_offset !< The offset between the corresponding global and + !! data j-index spaces. + logical, intent(out) :: symmetric !< True if symmetric memory is used. + logical, optional, intent(in) :: local_indexing !< If true, local tracer array indices start at 1, + !! as in most MOM6 code. + integer, optional, intent(in) :: index_offset !< A fixed additional offset to all indices. This + !! can be useful for some types of debugging with + !! dynamic memory allocation. ! Local variables integer :: ind_off logical :: local @@ -1741,6 +1792,79 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & end subroutine get_domain_extent +!> Return the (potentially symmetric) computational domain i-bounds for an array +!! passed without index specifications (i.e. indices start at 1) based on an array size. +subroutine get_simple_array_i_ind(domain, size, is, ie, symmetric) + type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information + integer, intent(in) :: size !< The i-array size + integer, intent(out) :: is !< The computational domain starting i-index. + integer, intent(out) :: ie !< The computational domain ending i-index. + logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes + !! can be considered. + ! Local variables + logical :: sym + character(len=120) :: mesg, mesg2 + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed + + call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed) + + isc = isc-isd+1 ; iec = iec-isd+1 ; ied = ied-isd+1 ; isd = 1 + sym = Domain%symmetric ; if (present(symmetric)) sym = symmetric + + if (size == ied) then ; is = isc ; ie = iec + elseif (size == 1+iec-isc) then ; is = 1 ; ie = size + elseif (sym .and. (size == 1+ied)) then ; is = isc ; ie = iec+1 + elseif (sym .and. (size == 2+iec-isc)) then ; is = 1 ; ie = size+1 + else + write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_i_ind. \")') size + if (sym) then + write(mesg2,'("Valid sizes are : ", 2i7)') ied, 1+iec-isc + else + write(mesg2,'("Valid sizes are : ", 4i7)') ied, 1+iec-isc, 1+ied, 2+iec-isc + endif + call MOM_error(FATAL, trim(mesg)//trim(mesg2)) + endif + +end subroutine get_simple_array_i_ind + + +!> Return the (potentially symmetric) computational domain j-bounds for an array +!! passed without index specifications (i.e. indices start at 1) based on an array size. +subroutine get_simple_array_j_ind(domain, size, js, je, symmetric) + type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information + integer, intent(in) :: size !< The j-array size + integer, intent(out) :: js !< The computational domain starting j-index. + integer, intent(out) :: je !< The computational domain ending j-index. + logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes + !! can be considered. + ! Local variables + logical :: sym + character(len=120) :: mesg, mesg2 + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed + + call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed) + + jsc = jsc-jsd+1 ; jec = jec-jsd+1 ; jed = jed-jsd+1 ; jsd = 1 + sym = Domain%symmetric ; if (present(symmetric)) sym = symmetric + + if (size == jed) then ; js = jsc ; je = jec + elseif (size == 1+jec-jsc) then ; js = 1 ; je = size + elseif (sym .and. (size == 1+jed)) then ; js = jsc ; je = jec+1 + elseif (sym .and. (size == 2+jec-jsc)) then ; js = 1 ; je = size+1 + else + write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_j_ind. \")') size + if (sym) then + write(mesg2,'("Valid sizes are : ", 2i7)') jed, 1+jec-jsc + else + write(mesg2,'("Valid sizes are : ", 4i7)') jed, 1+jec-jsc, 1+jed, 2+jec-jsc + endif + call MOM_error(FATAL, trim(mesg)//trim(mesg2)) + endif + +end subroutine get_simple_array_j_ind + !> Returns the global shape of h-point arrays subroutine get_global_shape(domain, niglobal, njglobal) type(MOM_domain_type), intent(in) :: domain !< MOM domain diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 403729559d..37500d31c2 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -11,6 +11,7 @@ module MOM_dyn_horgrid implicit none ; private public create_dyn_horgrid, destroy_dyn_horgrid, set_derived_dyn_horgrid +public rescale_dyn_horgrid_bathymetry !> Describes the horizontal ocean grid with only dynamic memory arrays type, public :: dyn_horgrid_type @@ -130,17 +131,18 @@ module MOM_dyn_horgrid ! Except on a Cartesian grid, these are usually some variant of "degrees". real, allocatable, dimension(:,:) :: & - bathyT !< Ocean bottom depth at tracer points, in m. + bathyT !< Ocean bottom depth at tracer points, in depth units. + real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real, allocatable, dimension(:,:) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in m. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in m. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units. real, allocatable, dimension(:,:) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in m. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in m. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real, allocatable, dimension(:,:) :: & @@ -158,7 +160,7 @@ module MOM_dyn_horgrid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in meters. + real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m). end type dyn_horgrid_type contains @@ -272,6 +274,40 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) end subroutine create_dyn_horgrid +!> rescale_dyn_horgrid_bathymetry permits a change in the internal units for the bathymetry on the +!! grid, both rescaling the depths and recording the new internal depth units. +subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. + + ! Local variables + real :: rescale + integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + if (m_in_new_units == G%Zd_to_m) return + if (m_in_new_units < 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") + if (m_in_new_units == 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") + + rescale = G%Zd_to_m / m_in_new_units + do j=jsd,jed ; do i=isd,ied + G%bathyT(i,j) = rescale*G%bathyT(i,j) + enddo ; enddo + if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB + G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j) + enddo ; enddo ; endif + if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied + G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) + enddo ; enddo ; endif + G%max_depth = rescale*G%max_depth + G%Zd_to_m = m_in_new_units + +end subroutine rescale_dyn_horgrid_bathymetry + !> set_derived_dyn_horgrid calculates metric terms that are derived from other metrics. subroutine set_derived_dyn_horgrid(G) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index ae876b16dd..5c80fb9d51 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -6,8 +6,8 @@ module MOM_file_parser use MOM_coms, only : root_PE, broadcast use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_error_handler, only : is_root_pe, stdlog, stdout -use MOM_time_manager, only : set_time, get_time, time_type, get_ticks_per_second -use MOM_time_manager, only : set_date, get_date +use MOM_time_manager, only : get_time, time_type, get_ticks_per_second +use MOM_time_manager, only : set_date, get_date, real_to_time, operator(-), set_time use MOM_document, only : doc_param, doc_module, doc_init, doc_end, doc_type use MOM_document, only : doc_openBlock, doc_closeBlock use MOM_string_functions, only : left_int, left_ints, slasher @@ -124,6 +124,7 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) character(len=*), optional, intent(in) :: doc_file_dir !< An optional directory in which to write out !! the documentation files. The default is effectively './'. + ! Local variables logical :: file_exists, unit_in_use, Netcdf_file, may_check integer :: ios, iounit, strlen, i character(len=240) :: doc_path @@ -247,8 +248,8 @@ subroutine close_param_file(CS, quiet_close, component) ! Local variables character(len=128) :: docfile_default character(len=40) :: mdl ! This module's name. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, n, num_unused if (present(quiet_close)) then ; if (quiet_close) then @@ -339,13 +340,14 @@ subroutine populate_param_data(iounit, filename, param_data) type(file_data_type), intent(inout) :: param_data !< A list of the input lines that set parameters !! after comments have been stripped out. + ! Local variables character(len=INPUT_STR_LENGTH) :: line integer :: num_lines logical :: inMultiLineComment -! Find the number of keyword lines in a parameter file -! Allocate the space to hold the lines in param_data%line -! Populate param_data%line with the keyword lines from parameter file + ! Find the number of keyword lines in a parameter file + ! Allocate the space to hold the lines in param_data%line + ! Populate param_data%line with the keyword lines from parameter file if (iounit <= 0) return @@ -434,8 +436,10 @@ end subroutine populate_param_data function openMultiLineComment(string) character(len=*), intent(in) :: string !< The input string to process logical :: openMultiLineComment -! True if a /* appears on this line without a closing */ + + ! Local variables integer :: icom, last + openMultiLineComment = .false. last = lastNonCommentIndex(string)+1 icom = index(string(last:), "/*") @@ -460,9 +464,11 @@ end function closeMultiLineComment function lastNonCommentIndex(string) character(len=*), intent(in) :: string !< The input string to process integer :: lastNonCommentIndex -! Find position of last character before any comments -! This s/r is the only place where a comment needs to be defined + + ! Local variables integer :: icom, last + + ! This subroutine is the only place where a comment needs to be defined last = len_trim(string) icom = index(string(:last), "!") ; if (icom > 0) last = icom-1 ! F90 style icom = index(string(:last), "//") ; if (icom > 0) last = icom-1 ! C++ style @@ -474,7 +480,7 @@ end function lastNonCommentIndex function lastNonCommentNonBlank(string) character(len=*), intent(in) :: string !< The input string to process integer :: lastNonCommentNonBlank -! Find position of last non-blank character before any comments + lastNonCommentNonBlank = len_trim(string(:lastNonCommentIndex(string))) ! Ignore remaining trailing blanks end function lastNonCommentNonBlank @@ -482,8 +488,9 @@ end function lastNonCommentNonBlank function replaceTabs(string) character(len=*), intent(in) :: string !< The input string to process character(len=len(string)) :: replaceTabs -! Returns string with tabs replaced by a blank + integer :: i + do i=1, len(string) if (string(i:i)==achar(9)) then replaceTabs(i:i)=" " @@ -497,8 +504,9 @@ end function replaceTabs function removeComments(string) character(len=*), intent(in) :: string !< The input string to process character(len=len(string)) :: removeComments -! Trims comments and leading blanks from string + integer :: last + removeComments=repeat(" ",len(string)) last = lastNonCommentNonBlank(string) removeComments(:last)=adjustl(string(:last)) ! Copy only the non-comment part of string @@ -509,11 +517,12 @@ end function removeComments function simplifyWhiteSpace(string) character(len=*), intent(in) :: string !< A string to modify to simpify white space character(len=len(string)+16) :: simplifyWhiteSpace -! Constructs a string with all repeated whitespace replaced with single blanks -! and insert white space where it helps delineate tokens (e.g. around =) + + ! Local variables integer :: i,j logical :: nonBlank = .false., insideString = .false. character(len=1) :: quoteChar=" " + nonBlank = .false.; insideString = .false. ! NOTE: For some reason this line is needed?? i=0 simplifyWhiteSpace=repeat(" ",len(string)+16) @@ -567,11 +576,7 @@ subroutine read_param_int(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -603,11 +608,7 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -632,25 +633,25 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing) end subroutine read_param_int_array !> This subroutine reads the value of a real model parameter from a parameter file. -subroutine read_param_real(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, +subroutine read_param_real(CS, varname, value, fail_if_missing, scale) + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters - character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read - real, intent(inout) :: value !< The value of the parameter that may be + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file - logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied + !! by before it is returned. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined call get_variable_line(CS, varname, found, defined, value_string) if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then read(value_string(1),*,err=1003) value + if (present(scale)) value = scale*value else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -668,26 +669,27 @@ subroutine read_param_real(CS, varname, value, fail_if_missing) end subroutine read_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file. -subroutine read_param_real_array(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, +subroutine read_param_real_array(CS, varname, value, fail_if_missing, scale) + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters - character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read - real, dimension(:), intent(inout) :: value !< The value of the parameter that may be + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file - logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied + !! by before it is returned. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined call get_variable_line(CS, varname, found, defined, value_string) if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then read(value_string(1),*,end=991,err=1004) value - 991 return +991 continue + if (present(scale)) value(:) = scale*value(:) + return else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -713,11 +715,7 @@ subroutine read_param_char(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -740,11 +738,8 @@ subroutine read_param_char_array(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1), loc_string logical :: found, defined integer :: i, i_out @@ -781,11 +776,8 @@ subroutine read_param_logical(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -811,17 +803,13 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f logical, optional, intent(out) :: date_format !< If present, this indicates whether this !! parameter was read in a date format, so that it can !! later be logged in the same format. -! This subroutine determines the value of an time-type model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. The unique argument -! to read time is the number of seconds to use as the unit of time being read. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) character(len=240) :: err_msg logical :: found, defined real :: real_time, time_unit - integer :: days, secs, vals(7) + integer :: vals(7) if (present(date_format)) date_format = .false. @@ -854,10 +842,8 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f else time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit read( value_string(1), *) real_time - days = int(real_time*(time_unit/86400.0)) - secs = int(floor((real_time*(time_unit/86400.0)-days)*86400.0 + 0.5)) - value = set_time(secs, days) - endif + value = real_to_time(real_time*time_unit) + endif else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -908,6 +894,7 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL logical, optional, intent(in) :: paramIsLogical !< If true, this is a logical parameter !! that can be simply defined without parsing a value_string. + ! Local variables character(len=INPUT_STR_LENGTH) :: val_str, lname, origLine character(len=INPUT_STR_LENGTH) :: line, continuationBuffer, blockName character(len=FILENAME_LENGTH) :: filename @@ -1230,8 +1217,9 @@ function overrideWarningHasBeenIssued(chain, varName) !! override warnings issued character(len=*), intent(in) :: varName !< The name of the variable being queried for warnings logical :: overrideWarningHasBeenIssued -! Returns true if an override warning has been issued for the variable varName + ! Local variables type(link_parameter), pointer :: newLink => NULL(), this => NULL() + overrideWarningHasBeenIssued = .false. this => chain do while( associated(this) ) @@ -1293,15 +1281,14 @@ subroutine log_param_int(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log integer, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of an integer parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') trim(modulename), trim(varname), trim(left_int(value)) @@ -1326,15 +1313,14 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log integer, dimension(:), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of an integer parameter to a log file, -! along with its name and the module it came from. + character(len=1320) :: mesg character(len=240) :: myunits @@ -1360,13 +1346,12 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log real, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') & @@ -1392,11 +1377,10 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log real, dimension(:), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + character(len=1320) :: mesg character(len=240) :: myunits @@ -1425,15 +1409,14 @@ subroutine log_param_logical(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log logical, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter logical, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a logical parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits if (value) then @@ -1462,15 +1445,14 @@ subroutine log_param_char(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log character(len=*), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a character string parameter to a log -! file, along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') & @@ -1497,18 +1479,19 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log type(time_type), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter type(time_type), optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for !! real-number output. logical, optional, intent(in) :: log_date !< If true, log the time_type in date format. !! If missing the default is false. - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + ! Local variables real :: real_time, real_default logical :: use_timeunit, date_format character(len=240) :: mesg, myunits @@ -1582,6 +1565,7 @@ function convert_date_to_string(date) result(date_string) type(time_type), intent(in) :: date !< The date to be translated into a string. character(len=40) :: date_string !< A date string in a format like YYYY-MM-DD HH:MM:SS.sss + ! Local variables character(len=40) :: sub_string real :: real_secs integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec @@ -1618,7 +1602,7 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & integer, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter integer, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1630,12 +1614,11 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1666,7 +1649,7 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be reset !! from the parameter file character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter integer, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1678,12 +1661,11 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1706,7 +1688,7 @@ end subroutine get_param_int_array !! and logs it in documentation files. subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, debuggingParam) + static_value, debuggingParam, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1714,7 +1696,7 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & real, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1726,10 +1708,13 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is + !! multiplied by before it is returned. + real, optional, intent(out) :: unscaled !< The value of the parameter that would be + !! returned without any multiplication by a scaling factor. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1746,12 +1731,15 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, debuggingParam) endif + if (present(unscaled)) unscaled = value + if (present(scale)) value = scale*value + end subroutine get_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file !! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, static_value) + default, fail_if_missing, do_not_read, do_not_log, static_value, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1759,7 +1747,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & real, dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1771,6 +1759,10 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files + real, optional, intent(in) :: scale !< A scaling factor that the parameter is + !! multiplied by before it is returned. + real, dimension(:), optional, intent(out) :: unscaled !< The value of the parameter that would be + !! returned without any multiplication by a scaling factor. logical :: do_read, do_log @@ -1788,6 +1780,9 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & units, default) endif + if (present(unscaled)) unscaled(:) = value(:) + if (present(scale)) value(:) = scale*value(:) + end subroutine get_param_real_array !> This subroutine reads the value of a character string model parameter from a parameter file @@ -1802,7 +1797,7 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & character(len=*), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1814,12 +1809,11 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1849,7 +1843,7 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & character(len=*), dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1861,8 +1855,8 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + + ! Local variables logical :: do_read, do_log integer :: i, len_tot, len_val character(len=240) :: cat_val @@ -1903,7 +1897,7 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & logical, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter logical, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1915,12 +1909,11 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1952,7 +1945,7 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & type(time_type), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter type(time_type), optional, intent(in) :: default !< The default value of the parameter type(time_type), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1966,14 +1959,13 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & !! parameter to the documentation files real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for !! real-number input to be translated to a time. - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file logical, optional, intent(in) :: log_as_date !< If true, log the time_type in date !! format. The default is false. -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log, date_format, log_date do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -2001,7 +1993,7 @@ end subroutine get_param_time subroutine clearParameterBlock(CS) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters -! Resets the parameter block name to blank + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then block => CS%blockName @@ -2018,7 +2010,7 @@ subroutine openParameterBlock(CS,blockName,desc) !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: blockName !< The name of a parameter block being added character(len=*), optional, intent(in) :: desc !< A description of the parameter block being added -! Tags blockName onto the end of the active parameter block name + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then block => CS%blockName @@ -2034,7 +2026,7 @@ end subroutine openParameterBlock subroutine closeParameterBlock(CS) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters -! Remove the lowest level of recursion from the active block name + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then @@ -2055,7 +2047,7 @@ function pushBlockLevel(oldblockName,newBlockName) character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names character(len=*), intent(in) :: newBlockName !< A new block name to add to the end of the sequence character(len=len(oldBlockName)+40) :: pushBlockLevel -! Extends block name (deeper level of parameter block) + if (len_trim(oldBlockName)>0) then pushBlockLevel=trim(oldBlockName)//'%'//trim(newBlockName) else @@ -2067,7 +2059,7 @@ end function pushBlockLevel function popBlockLevel(oldblockName) character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names character(len=len(oldBlockName)+40) :: popBlockLevel -! Truncates block name (shallower level of parameter block) + integer :: i i = index(trim(oldBlockName), '%', .true.) if (i>1) then diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 19b73ee07f..afadf6bdfa 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -19,7 +19,7 @@ module MOM_horizontal_regridding use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, write_field use MOM_string_functions, only : uppercase -use MOM_time_manager, only : time_type, set_time, get_external_field_size +use MOM_time_manager, only : time_type, get_external_field_size use MOM_time_manager, only : init_external_field, time_interp_external use MOM_time_manager, only : get_external_field_axes, get_external_field_missing use MOM_variables, only : thermo_var_ptrs @@ -446,7 +446,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0 allocate(last_row(id)) ; last_row(:)=0.0 - max_depth = maxval(G%bathyT) + max_depth = G%Zd_to_m*maxval(G%bathyT) call mpp_max(max_depth) if (z_edges_in(kd+1)mpp_get_info, get_file_atts=>mpp_get_atts use mpp_io_mod, only : get_file_fields=>mpp_get_fields, get_file_times=>mpp_get_times -use mpp_io_mod, only : read_field=>mpp_read, io_infra_init=>mpp_io_init +use mpp_io_mod, only : io_infra_init=>mpp_io_init use netcdf @@ -38,7 +39,7 @@ module MOM_io public :: close_file, create_file, field_exists, field_size, fieldtype, get_filename_appendix public :: file_exists, flush_file, get_file_info, get_file_atts, get_file_fields -public :: get_file_times, open_file, read_axis_data, read_data, read_field +public :: get_file_times, open_file, read_axis_data, read_data public :: num_timelevels, MOM_read_data, MOM_read_vector, ensembler public :: reopen_file, slasher, write_field, write_version_number, MOM_io_init public :: open_namelist_file, check_nml_error, io_infra_init, io_infra_end @@ -154,9 +155,7 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit endif one_file = .true. - if (domain_set) then - one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout) - endif + if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then call open_file(unit, filename, MPP_OVERWR, MPP_NETCDF, threading=thread) @@ -398,9 +397,7 @@ subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit endif one_file = .true. - if (domain_set) then - one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout) - endif + if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then call open_file(unit, filename, MPP_APPEND, MPP_NETCDF, threading=thread) @@ -849,21 +846,27 @@ end function FMS_file_exists !> This function uses the fms_io function read_data to read 1-D !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_1d(filename, fieldname, data, timelevel) +subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data integer, optional, intent(in) :: timelevel !< The time level in the file to read + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) + if (present(scale)) then ; if (scale /= 1.0) then + data(:) = scale*data(:) + endif ; endif + end subroutine MOM_read_data_1d !> This function uses the fms_io function read_data to read a distributed !! 2-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -871,17 +874,27 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je) = scale*data(is:ie,js:je) + endif ; endif + end subroutine MOM_read_data_2d !> This function uses the fms_io function read_data to read a distributed !! 3-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional array into which the data @@ -889,17 +902,27 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je,:) = scale*data(is:ie,js:je,:) + endif ; endif + end subroutine MOM_read_data_3d !> This function uses the fms_io function read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:,:), intent(inout) :: data !< The 4-dimensional array into which the data @@ -907,10 +930,20 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je,:,:) = scale*data(is:ie,js:je,:,:) + endif ; endif + end subroutine MOM_read_data_4d @@ -918,7 +951,7 @@ end subroutine MOM_read_data_4d !! 2-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair) + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -929,8 +962,10 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized - + logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied + !! by before they are returned. + integer :: is, ie, js, je integer :: u_pos, v_pos u_pos = EAST_FACE ; v_pos = NORTH_FACE @@ -945,6 +980,15 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=v_pos) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(u_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(u_data,2), js, je) + u_data(is:ie,js:je) = scale*u_data(is:ie,js:je) + call get_simple_array_i_ind(MOM_Domain, size(v_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(v_data,2), js, je) + v_data(is:ie,js:je) = scale*v_data(is:ie,js:je) + endif ; endif + end subroutine MOM_read_vector_2d @@ -952,7 +996,7 @@ end subroutine MOM_read_vector_2d !! 3-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair) + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -963,8 +1007,11 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied + !! by before they are returned. + integer :: is, ie, js, je integer :: u_pos, v_pos u_pos = EAST_FACE ; v_pos = NORTH_FACE @@ -979,6 +1026,15 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=v_pos) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(u_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(u_data,2), js, je) + u_data(is:ie,js:je,:) = scale*u_data(is:ie,js:je,:) + call get_simple_array_i_ind(MOM_Domain, size(v_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(v_data,2), js, je) + v_data(is:ie,js:je,:) = scale*v_data(is:ie,js:je,:) + endif ; endif + end subroutine MOM_read_vector_3d @@ -1012,7 +1068,7 @@ end subroutine MOM_io_init !! !! * write_field: write a field to an open file. !! * write_time: write a value of the time axis to an open file. -!! * read_field: read a field from an open file. +!! * read_data: read a variable from an open file. !! * read_time: read a time from an open file. !! !! * name_output_file: provide a name for an output file based on a diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index c395443a8f..4d89dccc7b 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -9,15 +9,15 @@ module MOM_restart use MOM_string_functions, only : lowercase use MOM_grid, only : ocean_grid_type use MOM_io, only : create_file, fieldtype, file_exists, open_file, close_file -use MOM_io, only : read_field, write_field, MOM_read_data, read_data, get_filename_appendix +use MOM_io, only : write_field, MOM_read_data, read_data, get_filename_appendix use MOM_io, only : get_file_info, get_file_atts, get_file_fields, get_file_times use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE -use MOM_time_manager, only : time_type, get_time, get_date, set_date, set_time -use MOM_time_manager, only : days_in_month +use MOM_time_manager, only : time_type, time_type_to_real, real_to_time +use MOM_time_manager, only : days_in_month, get_date, set_date use MOM_verticalGrid, only : verticalGrid_type -use mpp_mod, only: mpp_chksum +use mpp_mod, only: mpp_chksum,mpp_pe use mpp_io_mod, only: mpp_attribute_exist, mpp_get_atts implicit none ; private @@ -801,15 +801,14 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) ! With parallel read & write, it is possible to disable the following... -! jgj: this was set to 4294967292, changed to 4294967295 (see mpp_parameter.F90) - if (CS%large_file_support) max_file_size = 4294967295_8 + ! The maximum file size is 4294967292, according to the NetCDF documentation. + if (CS%large_file_support) max_file_size = 4294967292_8 num_files = 0 next_var = 0 nz = 1 ; if (present(GV)) nz = GV%ke - call get_time(time,seconds,days) - restart_time = real(days) + real(seconds)/86400.0 + restart_time = time_type_to_real(time) / 86400.0 restartname = trim(CS%restartfile) if (present(filename)) restartname = trim(filename) @@ -918,7 +917,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) elseif (associated(CS%var_ptr1d(m)%p)) then check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr1d(m)%p) elseif (associated(CS%var_ptr0d(m)%p)) then - check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p) + check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p,pelist=(/mpp_pe()/)) endif enddo @@ -982,7 +981,7 @@ subroutine restore_state(filename, directory, day, G, CS) character(len=80) :: varname ! A variable's name. integer :: num_file ! The number of files (restart files and others ! explicitly in filename) that are open. - integer :: i, n, m, start_of_day, num_days, missing_fields + integer :: i, n, m, missing_fields integer :: isL, ieL, jsL, jeL, is0, js0 integer :: sizes(7) integer :: ndim, nvar, natt, ntime, pos @@ -1028,9 +1027,7 @@ subroutine restore_state(filename, directory, day, G, CS) t1 = time_vals(1) deallocate(time_vals) - start_of_day = INT((t1 - INT(t1)) *86400) ! Number of seconds. - num_days = INT(t1) - day = set_time(start_of_day, num_days) + day = real_to_time(t1*86400.0) exit enddo @@ -1096,117 +1093,46 @@ subroutine restore_state(filename, directory, day, G, CS) call mpp_get_atts(fields(i),checksum=checksum_file) is_there_a_checksum = .true. endif - if (.NOT. CS%checksum_required ) is_there_a_checksum = .false. ! Do not need to do data checksumming. + if (.NOT. CS%checksum_required) is_there_a_checksum = .false. ! Do not need to do data checksumming. if (associated(CS%var_ptr1d(m)%p)) then ! Read a 1d array, which should be invariant to domain decomposition. call read_data(unit_path(n), varname, CS%var_ptr1d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) + G%Domain%mpp_domain, timelevel=1) + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar... call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) - elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif ((pos == 0) .and. associated(CS%var_ptr3d(m)%p)) then ! Read a non-decomposed 3d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif ((pos == 0) .and. associated(CS%var_ptr4d(m)%p)) then ! Read a non-decomposed 4d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - elseif (unit_is_global(n) .or. G%Domain%use_io_layout) then - if (associated(CS%var_ptr3d(m)%p)) then - ! Read 3d array... Time level 1 is always used. - call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif (associated(CS%var_ptr2d(m)%p)) then ! Read 2d array... + G%Domain%mpp_domain, timelevel=1) + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p,pelist=(/mpp_pe()/)) + elseif (associated(CS%var_ptr2d(m)%p)) then ! Read a 2d array. + if (pos /= 0) then call MOM_read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif (associated(CS%var_ptr4d(m)%p)) then ! Read 4d array... - call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - else - call MOM_error(FATAL, "MOM_restart restore_state: "//& - "No pointers set for "//trim(varname)) + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & + no_domain=.true., timelevel=1) endif - else ! Do not use an io_layout. !### GET RID OF THIS BRANCH ONCE read_data_4d_new IS AVAILABLE. - ! This file is decomposed onto the current processors. We need - ! to check whether the sizes look right, and abort if not. - call get_file_atts(fields(i),ndim=ndim,siz=sizes) - - ! NOTE: The index ranges f var_ptrs always start with 1, so with - ! symmetric memory the staggering is swapped from NE to SW! - is0 = 1-G%isd - if ((pos == EAST_FACE) .or. (pos == CORNER)) is0 = 1-G%IsdB - if (sizes(1) == G%iec-G%isc+1) then - isL = G%isc+is0 ; ieL = G%iec+is0 - elseif (sizes(1) == G%IecB-G%IscB+1) then - isL = G%IscB+is0 ; ieL = G%IecB+is0 - elseif (((pos == EAST_FACE) .or. (pos == CORNER)) .and. & - (G%IscB == G%isc) .and. (sizes(1) == G%iec-G%isc+2)) then - ! This is reading a symmetric file in a non-symmetric model. - isL = G%isc-1+is0 ; ieL = G%iec+is0 - else - call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//& - " has the wrong i-size in "//trim(unit_path(n))) - exit - endif - - js0 = 1-G%jsd - if ((pos == NORTH_FACE) .or. (pos == CORNER)) js0 = 1-G%JsdB - if (sizes(2) == G%jec-G%jsc+1) then - jsL = G%jsc+js0 ; jeL = G%jec+js0 - elseif (sizes(2) == G%jecB-G%jscB+1) then - jsL = G%jscB+js0 ; jeL = G%jecB+js0 - elseif (((pos == NORTH_FACE) .or. (pos == CORNER)) .and. & - (G%JscB == G%jsc) .and. (sizes(2) == G%jec-G%jsc+2)) then - ! This is reading a symmetric file in a non-symmetric model. - jsL = G%jsc-1+js0 ; jeL = G%jec+js0 - else - call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//& - " has the wrong j-size in "//trim(unit_path(n))) - exit + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) + elseif (associated(CS%var_ptr3d(m)%p)) then ! Read a 3d array. + if (pos /= 0) then + call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & + no_domain=.true., timelevel=1) endif - - if (associated(CS%var_ptr3d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:), 1) - endif - elseif (associated(CS%var_ptr2d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL), 1) - endif - elseif (associated(CS%var_ptr4d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:), 1) - endif - else - call MOM_error(FATAL, "MOM_restart restore_state: "//& - "No pointers set for "//trim(varname)) + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) + elseif (associated(CS%var_ptr4d(m)%p)) then ! Read a 4d array. + if (pos /= 0) then + call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & + no_domain=.true., timelevel=1) endif + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) + else + call MOM_error(FATAL, "MOM_restart restore_state: No pointers set for "//trim(varname)) endif if (is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data)) then @@ -1371,8 +1297,12 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & enddo fname = filename(start_char:m-1) start_char = m - do while ((start_char <= len_trim(filename)) .and. (filename(start_char:start_char) == ' ')) - start_char = start_char + 1 + do while (start_char <= len_trim(filename)) + if (filename(start_char:start_char) == ' ') then + start_char = start_char + 1 + else + exit + endif enddo if ((fname(1:1)=='r') .and. ( len_trim(fname) == 1)) then @@ -1411,24 +1341,11 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & threading = MULTIPLE, fileset = SINGLE_FILE) if (present(global_files)) global_files(n) = .true. elseif (CS%parallel_restartfiles) then - if (G%Domain%use_io_layout) then - ! Look for decomposed files using the I/O Layout. - fexists = file_exists(filepath, G%Domain) - if (fexists .and. (present(units))) & - call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & - domain=G%Domain%mpp_domain) - else - ! Look for any PE-specific files of the form NAME.nc.####. - if (num_PEs()>10000) then - write(filepath, '(a,i6.6)' ) trim(filepath)//'.', pe_here() - else - write(filepath, '(a,i4.4)' ) trim(filepath)//'.', pe_here() - endif - inquire(file=filepath, exist=fexists) - if (fexists .and. (present(units))) & - call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & - threading = MULTIPLE, fileset = SINGLE_FILE) - endif + ! Look for decomposed files using the I/O Layout. + fexists = file_exists(filepath, G%Domain) + if (fexists .and. (present(units))) & + call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & + domain=G%Domain%mpp_domain) if (fexists .and. present(global_files)) global_files(n) = .false. endif diff --git a/src/framework/MOM_time_manager.F90 b/src/framework/MOM_time_manager.F90 index 25c367c1ef..229c3ded3a 100644 --- a/src/framework/MOM_time_manager.F90 +++ b/src/framework/MOM_time_manager.F90 @@ -20,8 +20,9 @@ module MOM_time_manager implicit none ; private -public :: time_type, get_time, set_time, time_type_to_real, real_to_time_type -public :: set_ticks_per_second , get_ticks_per_second +public :: time_type, get_time, set_time +public :: time_type_to_real, real_to_time_type, real_to_time +public :: set_ticks_per_second, get_ticks_per_second public :: operator(+), operator(-), operator(*), operator(/) public :: operator(>), operator(<), operator(>=), operator(<=) public :: operator(==), operator(/=), operator(//) @@ -35,4 +36,29 @@ module MOM_time_manager public :: get_external_field_axes public :: get_external_field_missing +contains + +!> This is an alternate implementation of the FMS function real_to_time_type that is accurate over +!! a larger range of input values. With 32 bit signed integers, this version should work over the +!! entire valid range (2^31 days or ~5.8835 million years) of time_types, whereas the standard +!! version in the FMS time_manager stops working for conversions of times greater than 2^31 seconds, +!! or ~68.1 years. +function real_to_time(x, err_msg) + type(time_type) :: real_to_time !< The output time as a time_type + real, intent(in) :: x !< The input time in real seconds. + character(len=*), intent(out), optional :: err_msg !< An optional returned error message. + + ! Local variables + integer :: seconds, days, ticks + real :: real_subsecond_remainder + + days = floor(x/86400.) + seconds = floor(x - 86400.*days) + real_subsecond_remainder = x - (days*86400. + seconds) + ticks = nint(real_subsecond_remainder * get_ticks_per_second()) + + real_to_time = set_time(seconds=seconds, days=days, ticks=ticks, err_msg=err_msg) +end function real_to_time + + end module MOM_time_manager diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e1a61f355c..3a27c988c9 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -25,7 +25,7 @@ module MOM_ice_shelf use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, restore_state, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real, time_type_to_real, real_to_time use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_variables, only : surface use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum @@ -47,7 +47,7 @@ module MOM_ice_shelf use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum, uvchksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init -use time_manager_mod, only : print_time, time_type_to_real, real_to_time_type +use time_manager_mod, only : print_time implicit none ; private #include @@ -754,6 +754,10 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + call MOM_error(FATAL,"add_shelf_forces: Incompatible ocean and ice shelf grids.") + ISS => CS%ISS find_area = .true. ; if (present(do_shelf_area)) find_area = do_shelf_area @@ -823,6 +827,10 @@ subroutine add_shelf_pressure(G, CS, fluxes) integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + call MOM_error(FATAL,"add_shelf_pressure: Incompatible ocean and ice shelf grids.") + do j=js,je ; do i=is,ie press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) if (associated(fluxes%p_surf)) then @@ -877,6 +885,10 @@ subroutine add_shelf_flux(G, CS, state, fluxes) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + call MOM_error(FATAL,"add_shelf_flux: Incompatible ocean and ice shelf grids.") + ISS => CS%ISS call add_shelf_pressure(G, CS, fluxes) @@ -979,7 +991,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ! just compute changes in mass after first time step if (t0>0.0) then - Time0 = real_to_time_type(t0) + Time0 = real_to_time(t0) last_hmask(:,:) = ISS%hmask(:,:) ; last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) last_h_shelf = last_mass_shelf/CS%density_ice @@ -1098,16 +1110,17 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call set_grid_metrics(dG, param_file) ! call set_diag_mediator_grid(CS%grid, CS%diag) - ! The ocean grid is possibly different - if (associated(ocn_grid)) CS%ocn_grid => ocn_grid + ! The ocean grid possibly uses different symmetry. + if (associated(ocn_grid)) then ; CS%ocn_grid => ocn_grid + else ; CS%ocn_grid => CS%grid ; endif ! Convenience pointers G => CS%grid OG => CS%ocn_grid if (is_root_pe()) then - write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed - write(0,*) 'IG: ', G%isd, G%isc, G%iec, G%ied, G%jsd, G%jsc, G%jsd, G%jed + write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed + write(0,*) 'IG: ', G%isd, G%isc, G%iec, G%ied, G%jsd, G%jsc, G%jsd, G%jed endif CS%Time = Time ! ### This might not be in the right place? @@ -1344,10 +1357,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! when SHELF_THERMO = True. These fluxes are necessary if one wants to ! use either ENERGETICS_SFC_PBL (ALE mode) or BULKMIXEDLAYER (layer mode). if (present(fluxes)) & - call allocate_forcing_type(G, fluxes, ustar=.true., shelf=.true., & + call allocate_forcing_type(CS%ocn_grid, fluxes, ustar=.true., shelf=.true., & press=.true., water=CS%isthermo, heat=CS%isthermo) if (present(forces)) & - call allocate_mech_forcing(G, forces, ustar=.true., shelf=.true., press=.true.) + call allocate_mech_forcing(CS%ocn_grid, forces, ustar=.true., shelf=.true., press=.true.) else call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes in solo mode.") if (present(fluxes)) & @@ -1364,6 +1377,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call destroy_dyn_horgrid(dG) + !### Rescale the topography in the grid, and record the units. + ! Set up the restarts. call restart_init(param_file, CS%restart_CSp, "Shelf.res") call register_restart_field(ISS%mass_shelf, "shelf_mass", .true., CS%restart_CSp, & diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index e504db90c7..eea9ee322a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -17,7 +17,7 @@ module MOM_ice_shelf_dynamics use MOM_io, only : file_exists, slasher, MOM_read_data use MOM_restart, only : register_restart_field, query_initialized use MOM_restart, only : MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, set_time !MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs @@ -523,18 +523,18 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time !< The current model time - integer :: i, j, iters, isd, ied, jsd, jed - real :: rhoi, rhow, OD - type(time_type) :: dummy_time + integer :: i, j, iters, isd, ied, jsd, jed + real :: rhoi, rhow, OD + type(time_type) :: dummy_time rhoi = CS%density_ice rhow = CS%density_ocean_avg - dummy_time = set_time (0,0) + dummy_time = set_time(0,0) isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j) + OD = G%Zd_to_m*G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -829,7 +829,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) do k=0,1 do l=0,1 if ((ISS%hmask(i,j) == 1) .and. & - (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then + (rhoi/rhow * H_node(i-1+k,j-1+l) - G%Zd_to_m*G%bathyT(i,j) <= 0)) then nodefloat = nodefloat + 1 endif enddo @@ -888,7 +888,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) err_init = 0 ; err_tempu = 0; err_tempv = 0 @@ -947,7 +947,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) err_max = 0 @@ -1111,7 +1111,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & + H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, & G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1182,7 +1182,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & + H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, & G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -2123,7 +2123,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) ! prelim - go through and calculate S ! or is this faster? - BASE(:,:) = -G%bathyT(:,:) + OD(:,:) + BASE(:,:) = -G%Zd_to_m*G%bathyT(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) do j=jsc-1,jec+1 @@ -2222,7 +2222,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) taud_y(I,J) = taud_y(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh if (CS%float_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2) + neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * (G%Zd_to_m*G%bathyT(i,j)) ** 2) else neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j) ** 2 endif @@ -2738,7 +2738,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati enddo ; enddo enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_diagonal_subgrid_basal & (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) @@ -2953,7 +2953,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j) Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal & @@ -3089,7 +3089,7 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) + OD = G%Zd_to_m*G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -3609,7 +3609,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: hmask !< A mask indicating which tracer points are + intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h0 !< The initial ice shelf thicknesses in m. @@ -3850,7 +3850,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: hmask !< A mask indicating which tracer points are + intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 140983d0fb..54728f61d9 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -99,7 +99,7 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) "Unrecognized coordinate setup"//trim(config)) end select if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz) - if (debug) call chksum(GV%g_prime, "MOM_initialize_coord: g_prime ", 1, nz) + if (debug) call chksum(GV%Z_to_m*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) call setVerticalGridAxes( GV%Rlay, GV ) ! Copy the maximum depth across from the input argument @@ -118,8 +118,8 @@ end subroutine MOM_initialize_coord subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< A structure indicating the open file to - !! parse for model parameter values. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -133,10 +133,10 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & - units="m s-2", fail_if_missing=.true.) + units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo @@ -151,8 +151,8 @@ end subroutine set_coord_from_gprime subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -167,7 +167,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -193,8 +193,8 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< the reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -219,10 +219,10 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & - units="m s-2", fail_if_missing=.true.) + units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) ! ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs @@ -244,8 +244,8 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -264,7 +264,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and \n"//& "salinities are read.", fail_if_missing=.true.) @@ -282,7 +282,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile @@ -292,8 +292,8 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -343,7 +343,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -373,8 +373,8 @@ end subroutine set_coord_from_TS_range subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -389,7 +389,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -423,8 +423,8 @@ end subroutine set_coord_from_file subroutine set_coord_linear(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -443,7 +443,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) "all interfaces.", units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -466,8 +466,8 @@ end subroutine set_coord_linear subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< A structure indicating the open file to - !! parse for model parameter values. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, + !! in m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -480,7 +480,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index ba64d8e75c..b754b19bcb 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -165,7 +165,8 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) end subroutine MOM_initialize_fixed -!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. +!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this +!! point the topography is in units of m, but this can be changed later. subroutine MOM_initialize_topography(D, max_depth, G, PF) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & @@ -176,7 +177,6 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. -! Set up the bottom depth, G%bathyT either analytically or from file character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index be82ffc33f..0f5a8505ab 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -183,6 +183,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" integer :: err=0, ni, nj, global_indices(4) type(MOM_domain_type) :: SGdom ! Supergrid domain + logical :: lon_bug ! If true use an older buggy answer in the tripolar longitude. integer :: i, j, i2, j2 integer :: npei,npej integer, dimension(:), allocatable :: exni,exnj @@ -193,6 +194,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) + call get_param(param_file, mdl, "USE_TRIPOLAR_GEOLONB_BUG", lon_bug, & + "If true, use older code that incorrectly sets the longitude \n"//& + "in some points along the tripolar fold to be off by 360 degrees.", & + default=.true.) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(adjustl(inputdir)) // trim(adjustl(grid_file)) @@ -220,7 +225,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) SGdom%niglobal = 2*G%domain%niglobal SGdom%njglobal = 2*G%domain%njglobal SGdom%layout(:) = G%domain%layout(:) - SGdom%use_io_layout = G%domain%use_io_layout SGdom%io_layout(:) = G%domain%io_layout(:) global_indices(1) = 1+SGdom%nihalo global_indices(2) = SGdom%niglobal+SGdom%nihalo @@ -241,8 +245,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) symmetry=.true., name="MOM_MOSAIC") endif - if (SGdom%use_io_layout) & - call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout) + call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout) deallocate(exni) deallocate(exnj) @@ -250,7 +253,11 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) tmpZ(:,:) = 999. call MOM_read_data(filename, 'x', tmpZ, SGdom, position=CORNER) - call pass_var(tmpZ, SGdom, position=CORNER) + if (lon_bug) then + call pass_var(tmpZ, SGdom, position=CORNER) + else + call pass_var(tmpZ, SGdom, position=CORNER, inner_halo=0) + endif call extrapolate_metric(tmpZ, 2*(G%jsc-G%jsd)+2, missing=999.) do j=G%jsd,G%jed ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*j G%geoLonT(i,j) = tmpZ(i2-1,j2-1) @@ -1211,7 +1218,8 @@ subroutine initialize_masks(G, PF) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: PF !< Parameter file structure ! Local variables - real :: Dmin, min_depth, mask_depth + real :: Dmin ! The depth for masking in the same units as G%bathyT (Z). + real :: min_depth, mask_depth ! Depths in the same units as G%bathyT (Z). character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j @@ -1221,11 +1229,11 @@ subroutine initialize_masks(G, PF) "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& "If MASKING_DEPTH is specified, then all depths shallower than\n"//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0) + units="m", default=0.0, scale=1.0/G%Zd_to_m) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all\n"//& "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & - units="m", default=-9999.0) + units="m", default=-9999.0, scale=1.0/G%Zd_to_m) Dmin = min_depth if (mask_depth>=0.) Dmin = mask_depth diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index e818c33acd..31dfc551b5 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -525,25 +525,71 @@ subroutine initialize_grid_rotation_angle(G, PF) !! to parse for model parameter values. real :: angle, lon_scale - integer :: i, j + real :: len_lon ! The periodic range of longitudes, usually 360 degrees. + real :: pi_720deg ! One quarter the conversion factor from degrees to radians. + real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. + character(len=40) :: mdl = "initialize_grid_rotation_angle" ! This subroutine's name. + logical :: use_bugs + integer :: i, j, m, n + + call get_param(PF, mdl, "GRID_ROTATION_ANGLE_BUGS", use_bugs, & + "If true, use an older algorithm to calculate the sine and \n"//& + "cosines needed rotate between grid-oriented directions and \n"//& + "true north and east. Differences arise at the tripolar fold.", & + default=.True.) + + if (use_bugs) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & + G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & + G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) + G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo - do j=G%jsc,G%jec ; do i=G%isc,G%iec - lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & - G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & - G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) - G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo + ! This is not right at a tripolar or cubed-sphere fold. + call pass_var(G%cos_rot, G%Domain) + call pass_var(G%sin_rot, G%Domain) + else + pi_720deg = atan(1.0) / 180.0 + len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon + do j=G%jsc,G%jec ; do i=G%isc,G%iec + do n=1,2 ; do m=1,2 + lonB(m,n) = modulo_around_point(G%geoLonBu(I+m-2,J+n-2), G%geoLonT(i,j), len_lon) + enddo ; enddo + lon_scale = cos(pi_720deg*((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J)) + & + (G%geoLatBu(I,J-1) + G%geoLatBu(I-1,J)) ) ) + angle = atan2(lon_scale*((lonB(1,2) - lonB(2,1)) + (lonB(2,2) - lonB(1,1))), & + (G%geoLatBu(I-1,J) - G%geoLatBu(I,J-1)) + & + (G%geoLatBu(I,J) - G%geoLatBu(I-1,J-1)) ) + G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo - ! ### THIS DOESN'T SEEM RIGHT AT A CUBED-SPHERE FOLD -RWH - call pass_var(G%cos_rot, G%Domain) - call pass_var(G%sin_rot, G%Domain) + call pass_vector(G%cos_rot, G%sin_rot, G%Domain, stagger=AGRID) + endif end subroutine initialize_grid_rotation_angle +! ----------------------------------------------------------------------------- +!> Return the modulo value of x in an interval [xc-(Lx/2) xc+(Lx/2)] +!! If Lx<=0, then it returns x without applying modulo arithmetic. +function modulo_around_point(x, xc, Lx) result(x_mod) + real, intent(in) :: x !< Value to which to apply modulo arithmetic + real, intent(in) :: xc !< Center of modulo range + real, intent(in) :: Lx !< Modulo range width + real :: x_mod !< x shifted by an integer multiple of Lx to be close to xc. + + if (Lx > 0.0) then + x_mod = modulo(x - (xc - 0.5*Lx), Lx) + (xc - 0.5*Lx) + else + x_mod = x + endif +end function modulo_around_point + ! ----------------------------------------------------------------------------- !> This subroutine sets the open face lengths at selected points to restrict !! passages to their observed widths based on a named set of sizes. @@ -762,6 +808,8 @@ subroutine reset_face_lengths_list(G, param_file) real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() real :: lat, lon ! The latitude and longitude of a point. + real :: len_lon ! The periodic range of longitudes, usually 360 degrees. + real :: len_lat ! The range of latitudes, usually 180 degrees. real :: lon_p, lon_m ! The longitude of a point shifted by 360 degrees. logical :: check_360 ! If true, check for longitudes that are shifted by ! +/- 360 degrees from the specified range of values. @@ -808,6 +856,8 @@ subroutine reset_face_lengths_list(G, param_file) call read_face_length_list(iounit, filename, num_lines, lines) endif + len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon + len_lat = 180.0 ; if (G%len_lat > 0.0) len_lat = G%len_lat ! Broadcast the number of lines and allocate the required space. call broadcast(num_lines, root_PE()) u_pt = 0 ; v_pt = 0 @@ -849,11 +899,11 @@ subroutine reset_face_lengths_list(G, param_file) read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) if (is_root_PE()) then if (check_360) then - if ((abs(u_lon(1,u_pt)) > 360.0) .or. (abs(u_lon(2,u_pt)) > 360.0)) & + if ((abs(u_lon(1,u_pt)) > len_lon) .or. (abs(u_lon(2,u_pt)) > len_lon)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "u-longitude found when reading line "//trim(line)//" from file "//& trim(filename)) - if ((abs(u_lat(1,u_pt)) > 180.0) .or. (abs(u_lat(2,u_pt)) > 180.0)) & + if ((abs(u_lat(1,u_pt)) > len_lat) .or. (abs(u_lat(2,u_pt)) > len_lat)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "u-latitude found when reading line "//trim(line)//" from file "//& trim(filename)) @@ -876,11 +926,11 @@ subroutine reset_face_lengths_list(G, param_file) read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) if (is_root_PE()) then if (check_360) then - if ((abs(v_lon(1,v_pt)) > 360.0) .or. (abs(v_lon(2,v_pt)) > 360.0)) & + if ((abs(v_lon(1,v_pt)) > len_lon) .or. (abs(v_lon(2,v_pt)) > len_lon)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "v-longitude found when reading line "//trim(line)//" from file "//& trim(filename)) - if ((abs(v_lat(1,v_pt)) > 180.0) .or. (abs(v_lat(2,v_pt)) > 180.0)) & + if ((abs(v_lat(1,v_pt)) > len_lat) .or. (abs(v_lat(2,v_pt)) > len_lat)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "v-latitude found when reading line "//trim(line)//" from file "//& trim(filename)) @@ -906,7 +956,7 @@ subroutine reset_face_lengths_list(G, param_file) do j=jsd,jed ; do I=IsdB,IedB lat = G%geoLatCu(I,j) ; lon = G%geoLonCu(I,j) - if (check_360) then ; lon_p = lon+360.0 ; lon_m = lon-360.0 + if (check_360) then ; lon_p = lon+len_lon ; lon_m = lon-len_lon else ; lon_p = lon ; lon_m = lon ; endif do npt=1,u_pt @@ -936,7 +986,7 @@ subroutine reset_face_lengths_list(G, param_file) do J=JsdB,JedB ; do i=isd,ied lat = G%geoLatCv(i,J) ; lon = G%geoLonCv(i,J) - if (check_360) then ; lon_p = lon+360.0 ; lon_m = lon-360.0 + if (check_360) then ; lon_p = lon+len_lon ; lon_m = lon-len_lon else ; lon_p = lon ; lon_m = lon ; endif do npt=1,v_pt @@ -1099,12 +1149,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) character(len=*), intent(in) :: directory !< The directory into which to place the geometry file. character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file !! (otherwise the file is "ocean_geometry") -! This subroutine writes out a file containing all of the ocean geometry -! and grid data uses by the MOM ocean model. -! Arguments: G - The ocean's grid structure. Effectively intent in. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) directory - The directory into which to place the file. + + ! Local variables. character(len=240) :: filepath character(len=40) :: mdl = "write_ocean_geometry_file" integer, parameter :: nFlds=23 @@ -1194,7 +1240,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) call write_field(unit, fields(3), G%Domain%mpp_domain, G%geoLatT) call write_field(unit, fields(4), G%Domain%mpp_domain, G%geoLonT) - call write_field(unit, fields(5), G%Domain%mpp_domain, G%bathyT) + do j=js,je ; do i=is,ie ; out_h(i,j) = G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + call write_field(unit, fields(5), G%Domain%mpp_domain, out_h) call write_field(unit, fields(6), G%Domain%mpp_domain, G%CoriolisBu) ! I think that all of these copies are holdovers from a much earlier diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0f9c17022d..b19e6fc518 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -34,7 +34,7 @@ module MOM_state_initialization use MOM_ALE_sponge, only : set_up_ALE_sponge_field, initialize_ALE_sponge use MOM_ALE_sponge, only : ALE_sponge_CS use MOM_string_functions, only : uppercase, lowercase -use MOM_time_manager, only : time_type, set_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes, verticalGrid_type @@ -147,6 +147,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & character(len=200) :: filename2 ! The name of an input files. character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: dt ! The baroclinic dynamics timestep for this run, in s. logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -159,7 +162,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & ! by a large surface pressure, such as with an ice sheet. logical :: regrid_accelerate integer :: regrid_iterations - logical :: Analytic_FV_PGF, obsol_test +! logical :: Analytic_FV_PGF, obsol_test logical :: convert logical :: just_read ! If true, only read the parameters because this ! is a run from a restart file; this option @@ -174,8 +177,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -450,6 +451,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & do_not_log=just_read) if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") + if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & + call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_m) if (depress_sfc) call depress_surface(h, G, GV, PF, tv, just_read_params=just_read) if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params=just_read) @@ -469,6 +472,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true.) + if (new_sim .and. debug) & + call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_m) call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, & dt=dt, initial=.true.) endif @@ -482,6 +487,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & G, restart_CS) if (present(Time_in)) Time = Time_in + if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo + endif endif if ( use_temperature ) then @@ -500,7 +509,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & write(mesg,'("MOM_IS: S[",I2,"]")') k call hchksum(tv%S(:,:,k), mesg, G%HI, haloshift=1) enddo ; endif - endif call get_param(PF, mdl, "SPONGE", use_sponge, & @@ -523,19 +531,17 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & case ("DOME2D"); call DOME2d_initialize_sponges(G, GV, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, tv, PF, useALE, & - sponge_CSp, ALE_sponge_CSp) - case ("USER"); call user_initialize_sponges(G, use_temperature, tv, & - PF, sponge_CSp, h) - case ("BFB"); call BFB_initialize_sponges_southonly(G, use_temperature, tv, & - PF, sponge_CSp, h) - case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, & - PF, useALE, sponge_CSp, ALE_sponge_CSp) - case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & - PF, sponge_CSp, h) + sponge_CSp, ALE_sponge_CSp) + case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) + case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, PF, & + sponge_CSp, h) + case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, PF, useALE, & + sponge_CSp, ALE_sponge_CSp) + case ("phillips"); call Phillips_initialize_sponges(G, GV, tv, PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & - sponge_CSp, ALE_sponge_CSp) - case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, & - PF, sponge_CSp, ALE_sponge_CSp, Time) + sponge_CSp, ALE_sponge_CSp) + case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, PF, & + sponge_CSp, ALE_sponge_CSp, Time) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized sponge configuration "//trim(config)) end select @@ -613,7 +619,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne !! only read parameters without changing h. ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! Interface heights, in depth units. integer :: inconsistent = 0 logical :: correct_thickness logical :: just_read ! If true, just read parameters but set nothing. @@ -643,10 +649,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne if (file_has_thickness) then !### Consider adding a parameter to use to rescale h. if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "h", h(:,:,:), G%Domain) - do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = GV%m_to_H * h(i,j,k) - enddo ; enddo ; enddo + call MOM_read_data(filename, "h", h(:,:,:), G%Domain, scale=GV%m_to_H) else call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the \n"//& @@ -654,22 +657,22 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne "would indicate.", default=.false., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain) + call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=GV%m_to_Z) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, eta, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta(i,j,K) - eta(i,j,K+1)) + h(i,j,k) = GV%Z_to_H * (eta(i,j,K) - eta(i,j,K+1)) endif enddo ; enddo ; enddo do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0) & + if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -688,7 +691,7 @@ end subroutine initialize_thickness_from_file !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most -!! layers are contracted to GV%Angstrom_z. +!! layers are contracted to GV%Angstrom_m. !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the @@ -696,15 +699,16 @@ end subroutine initialize_thickness_from_file subroutine adjustEtaToFitBathymetry(G, GV, eta, h) 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)+1), intent(inout) :: eta !< Interface heights, in m + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations - real, parameter :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) + real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) real :: hTmp, eTmp, dilate character(len=100) :: mesg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + hTolerance = 0.1*GV%m_to_Z contractions = 0 do j=js,je ; do i=is,ie @@ -720,14 +724,14 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) call MOM_error(WARNING, 'adjustEtaToFitBathymetry: '//mesg) endif - ! To preserve previous answers, delay converting thicknesses to units of H - ! until the end of this routine. + ! To preserve previous answers in non-Boussinesq cases, delay converting + ! thicknesses to units of H until the end of this routine. do k=nz,1,-1 ; do j=js,je ; do i=is,ie ! Collapse layers to thinnest possible if the thickness less than ! the thinnest possible (or negative). - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_Z else h(i,j,k) = (eta(i,j,K) - eta(i,j,K+1)) endif @@ -741,9 +745,9 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) if (-eta(i,j,nz+1) < G%bathyT(i,j) - hTolerance) then dilations = dilations + 1 if (eta(i,j,1) <= eta(i,j,nz+1)) then - do k=1,nz ; h(i,j,k) = (eta(i,j,1)+G%bathyT(i,j)) / real(nz) ; enddo + do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo else - dilate = (eta(i,j,1)+G%bathyT(i,j)) / (eta(i,j,1)-eta(i,j,nz+1)) + dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) do k=1,nz ; h(i,j,k) = h(i,j,k) * dilate ; enddo endif do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) ; enddo @@ -752,7 +756,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) ! Now convert thicknesses to units of H. do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k)*GV%m_to_H + h(i,j,k) = h(i,j,k)*GV%Z_to_H enddo ; enddo ; enddo call sum_across_PEs(dilations) @@ -776,10 +780,10 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units, usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz @@ -804,14 +808,14 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -831,10 +835,10 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually - ! negative because it is positive upward. + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units (Z). logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var @@ -861,7 +865,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) call log_param(param_file, mdl, "INPUTDIR/INTERFACE_IC_FILE", filename) e0(:) = 0.0 - call MOM_read_data(filename, eta_var, e0(:)) + call MOM_read_data(filename, eta_var, e0(:), scale=GV%m_to_Z) if ((abs(e0(1)) - 0.0) > 0.001) then ! This list probably starts with the interior interface, so shift it up. @@ -869,11 +873,8 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) e0(1) = 0.0 endif - if (e0(2) > e0(1)) then - ! Switch to the convention for interface heights increasing upward. - do k=1,nz - e0(K) = -e0(K) - enddo + if (e0(2) > e0(1)) then ! Switch to the convention for interface heights increasing upward. + do k=1,nz ; e0(K) = -e0(K) ; enddo endif do j=js,je ; do i=is,ie @@ -882,14 +883,14 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -929,8 +930,8 @@ subroutine convert_thickness(h, G, GV, tv) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB max_itt = 10 Boussinesq = GV%Boussinesq - I_gEarth = 1.0 / GV%g_Earth - Hm_rho_to_Pa = (GV%g_Earth * GV%H_to_m) ! = GV%H_to_Pa / GV%Rho0 + I_gEarth = 1.0 / (GV%g_Earth*GV%m_to_Z) + Hm_rho_to_Pa = GV%g_Earth * GV%H_to_Z ! = GV%H_to_Pa / GV%Rho0 if (Boussinesq) then call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.") @@ -1027,14 +1028,10 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain) - - if (scale_factor /= 1.0) then ; do j=js,je ; do i=is,ie - eta_sfc(i,j) = eta_sfc(i,j) * scale_factor - enddo ; enddo ; endif + call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then ! if (eta_sfc(i,j) < eta(i,j,nz+1)) then @@ -1055,9 +1052,9 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) do k=1,nz if (eta(i,j,K) <= eta_sfc(i,j)) exit if (eta(i,j,K+1) >= eta_sfc(i,j)) then - h(i,j,k) = GV%Angstrom + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = max(GV%Angstrom, h(i,j,k) * & + h(i,j,k) = max(GV%Angstrom_H, h(i,j,k) * & (eta_sfc(i,j) - eta(i,j,K+1)) / (eta(i,j,K) - eta(i,j,K+1)) ) endif enddo @@ -1084,10 +1081,11 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity and temperature within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path - real :: scale_factor, min_thickness + real :: scale_factor ! A file-dependent scaling vactor for the input pressurs. + real :: min_thickness ! The minimum layer thickness, recast into Z units. integer :: i, j, k logical :: just_read ! If true, just read parameters but set nothing. - logical :: use_remapping + logical :: use_remapping ! If true, remap the initial conditions. type(remapping_CS), pointer :: remap_CS => NULL() just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -1107,15 +1105,14 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) "file SURFACE_PRESSURE_FILE into a surface pressure.", & units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & - units='m', default=1.e-3, do_not_log=just_read) + units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & default=.false., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, p_surf_var, p_surf, G%Domain) - if (scale_factor /= 1.) p_surf(:,:) = scale_factor * p_surf(:,:) + call MOM_read_data(filename, p_surf_var, p_surf, G%Domain, scale=scale_factor) if (use_remapping) then allocate(remap_CS) @@ -1134,33 +1131,38 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV%Rho0, GV%g_Earth, G%bathyT(i,j), min_thickness, & - tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), & - p_surf(i,j), h(i,j,:), remap_CS) + call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth, G%bathyT(i,j), & + min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & + tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & + z_tol=1.0e-5*GV%m_to_Z) enddo ; enddo end subroutine trim_for_ice -!> Adjust the layer thicknesses by cutting away the top at the depth where the hydrostatic -!! pressure matches p_surf -subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & - T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS) - integer, intent(in) :: nk !< Number of layers - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: Rho0 !< Reference density (kg/m3) - real, intent(in) :: G_earth !< Gravitational acceleration (m/s2) - real, intent(in) :: depth !< Depth of ocean column (m) - real, intent(in) :: min_thickness !< Smallest thickness allowed (m) - real, dimension(nk), intent(inout) :: T !< Layer mean temperature + +!> Adjust the layer thicknesses by removing the top of the water column above the +!! depth where the hydrostatic pressure matches p_surf +subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & + T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS, z_tol) + integer, intent(in) :: nk !< Number of layers + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2) + real, intent(in) :: depth !< Depth of ocean column (Z) + real, intent(in) :: min_thickness !< Smallest thickness allowed (Z) + real, dimension(nk), intent(inout) :: T !< Layer mean temperature real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer - real, dimension(nk), intent(inout) :: S !< Layer mean salinity + real, dimension(nk), intent(inout) :: S !< Layer mean salinity real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer real, intent(in) :: p_surf !< Imposed pressure on ocean at surface (Pa) - real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) + real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated + real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth + !! matching the specified pressure, in Z. + ! Local variables real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions real, dimension(nk) :: h0, S0, T0, h1, S1, T1 @@ -1170,7 +1172,7 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & ! Calculate original interface positions e(nk+1) = -depth do k=nk,1,-1 - e(K) = e(K+1) + h(k) + e(K) = e(K+1) + GV%H_to_Z*h(k) h0(k) = h(nk+1-k) ! Keep a copy to use in remapping enddo @@ -1178,7 +1180,8 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & e_top = e(1) do k=1,nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, p_surf, Rho0, G_earth, tv%eqn_of_state, P_b, z_out) + P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, & + P_b, z_out, z_tol=z_tol) if (z_out>=e(K)) then ! Imposed pressure was less that pressure at top of cell exit @@ -1195,14 +1198,14 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & if (e_tope_top) then + if (e(K) > e_top) then ! Original e(K) is too high e(K) = e_top e_top = e_top - min_thickness ! Next interface must be at least this deep endif ! This layer needs trimming - h(k) = max( min_thickness, e(K) - e(K+1) ) - if (e(K) NULL() type(thermo_var_ptrs) :: tv_loc ! A temporary thermo_var container type(verticalGrid_type) :: GV_loc ! A temporary vertical grid structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_initialize_layers_from_Z" ! This module's name. integer :: is, ie, js, je, nz ! compute domain indices @@ -1924,11 +1928,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) integer :: nkml, nkbl ! number of mixed and buffer layers integer :: kd, inconsistent - integer :: nkd ! number of levels to use for regridding input arrays + integer :: nkd ! number of levels to use for regridding input arrays + real :: eps_Z ! A negligibly thin layer thickness, in Z. real :: PI_180 ! for conversion from degrees to radians real, dimension(:,:), pointer :: shelf_area => NULL() - real :: min_depth + real :: min_depth ! The minimum depth in Z. real :: dilate real :: missing_value_temp, missing_value_salt logical :: correct_thickness @@ -1947,19 +1952,19 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) real, dimension(:), allocatable :: z_edges_in, z_in, Rb real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z. real, dimension(SZI_(G),SZJ_(G)) :: nlevs - real, dimension(SZI_(G)) :: press + real, dimension(SZI_(G)) :: press ! Pressures in Pa. ! Local variables for ALE remapping - real, dimension(:), allocatable :: hTarget + real, dimension(:), allocatable :: hTarget ! Target thicknesses in Z. real, dimension(:,:), allocatable :: area_shelf_h real, dimension(:,:), allocatable, target :: frac_shelf_h real, dimension(:,:,:), allocatable, target :: tmpT1dIn, tmpS1dIn real, dimension(:,:,:), allocatable :: tmp_mask_in real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding - real :: zTopOfCell, zBottomOfCell + real :: zTopOfCell, zBottomOfCell ! Heights in Z units type(regridding_CS) :: regridCS ! Regridding parameters and work arrays type(remapping_CS) :: remapCS ! Remapping parameters and work arrays @@ -1995,7 +2000,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0) + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0, scale=GV%m_to_Z) call get_param(PF, mdl, "NKML",nkml,default=0) call get_param(PF, mdl, "NKBL",nkbl,default=0) @@ -2069,6 +2074,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) return ! All run-time parameters have been read, so return. endif + !### Change this to GV%Angstrom_Z + eps_z = 1.0e-10*GV%m_to_Z + ! Read input grid coordinates for temperature and salinity field ! in z-coordinate dataset. The file is REQUIRED to contain the ! following: @@ -2084,14 +2092,18 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! to the North/South Pole past the limits of the input data, they are extrapolated using the average ! value at the northernmost/southernmost latitude. - call horiz_interp_and_extrap_tracer(tfilename, potemp_var,1.0,1, & + call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1.0, 1, & G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, tripolar_n, homogenize) - call horiz_interp_and_extrap_tracer(sfilename, salin_var,1.0,1, & + call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1.0, 1, & G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, tripolar_n, homogenize) kd = size(z_in,1) + ! Convert the units and sign convention of z_in and Z_edges_in. + do k=1,kd ; z_in(k) = GV%m_to_Z*z_in(k) ; enddo + do k=1,size(Z_edges_in,1) ; Z_edges_in(k) = -GV%m_to_Z*Z_edges_in(k) ; enddo + allocate(rho_z(isd:ied,jsd:jed,kd)) allocate(area_shelf_h(isd:ied,jsd:jed)) allocate(frac_shelf_h(isd:ied,jsd:jed)) @@ -2099,13 +2111,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) press(:) = tv%p_ref ! Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 or NEMO - call convert_temp_salt_for_TEOS10(temp_z,salt_z, press, G, kd, mask_z, eos) + call convert_temp_salt_for_TEOS10(temp_z, salt_z, press, G, kd, mask_z, eos) - do k=1,kd - do j=js,je - call calculate_density(temp_z(:,j,k),salt_z(:,j,k), press, rho_z(:,j,k), is, ie, eos) - enddo - enddo ! kd + do k=1,kd ; do j=js,je + call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), is, ie, eos) + enddo ; enddo call pass_var(temp_z,G%Domain) call pass_var(salt_z,G%Domain) @@ -2152,7 +2162,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) tmp_mask_in(i,j,1:kd) = mask_z(i,j,:) do k = 1, nkd if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then - zBottomOfCell = max( -z_edges_in(k+1), -G%bathyT(i,j) ) + zBottomOfCell = max( z_edges_in(k+1), -G%bathyT(i,j) ) tmpT1dIn(i,j,k) = temp_z(i,j,k) tmpS1dIn(i,j,k) = salt_z(i,j,k) elseif (k>1) then @@ -2163,10 +2173,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) tmpT1dIn(i,j,k) = -99.9 tmpS1dIn(i,j,k) = -99.9 endif - h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) + h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) + h1(i,j,kd) = h1(i,j,kd) + GV%Z_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo @@ -2177,12 +2187,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Build the target grid (and set the model thickness to it) ! This call can be more general but is hard-coded for z* coordinates... ???? - call ALE_initRegridding( GV, G%max_depth, PF, mdl, regridCS ) ! sets regridCS + call ALE_initRegridding( GV, GV%Z_to_m*G%max_depth, PF, mdl, regridCS ) ! sets regridCS if (.not. remap_general) then ! This is the old way of initializing to z* coordinates only allocate( hTarget(nz) ) - hTarget = getCoordinateResolution( regridCS ) + hTarget = GV%m_to_Z * getCoordinateResolution( regridCS ) do j = js, je ; do i = is, ie h(i,j,:) = 0. if (G%mask2dT(i,j)>0.) then @@ -2190,7 +2200,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz zBottomOfCell = max( zTopOfCell - hTarget(k), -G%bathyT(i,j) ) - h(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) + h(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo else @@ -2240,46 +2250,46 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) Rb(1) = 0.0 ; Rb(nz+1) = 2.0*GV%Rlay(nz) - GV%Rlay(nz-1) zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%bathyT(is:ie,js:je), & - nlevs(is:ie,js:je), nkml, nkbl, min_depth) + nlevs(is:ie,js:je), nkml, nkbl, min_depth, eps_z=eps_z) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, zi, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_z)) then - zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then + zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (zi(i,j,K) - zi(i,j,K+1)) + h(i,j,k) = GV%Z_to_H * (zi(i,j,K) - zi(i,j,K+1)) endif enddo ; enddo ; enddo inconsistent=0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0) & + if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) if ((inconsistent > 0) .and. (is_root_pe())) then - write(mesg,'("Thickness initial conditions are inconsistent ",'// & - '"with topography in ",I5," places.")') inconsistent + write(mesg, '("Thickness initial conditions are inconsistent ",'// & + '"with topography in ",I5," places.")') inconsistent call MOM_error(WARNING, mesg) endif endif - tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:),-1.0*z_edges_in,zi(is:ie,js:je,:), & - nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & - nlevs(is:ie,js:je),dbg,idbg,jdbg) - tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:),-1.0*z_edges_in,zi(is:ie,js:je,:), & - nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & - nlevs(is:ie,js:je)) + tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:), z_edges_in, zi(is:ie,js:je,:), & + nkml, nkbl, missing_value, G%mask2dT(is:ie,js:je), nz, & + nlevs(is:ie,js:je),dbg,idbg,jdbg, eps_z=eps_z) + tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:), z_edges_in, zi(is:ie,js:je,:), & + nkml, nkbl, missing_value, G%mask2dT(is:ie,js:je), nz, & + nlevs(is:ie,js:je), eps_z=eps_z) do k=1,nz nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) >= 1.0) then nPoints = nPoints + 1 tempAvg = tempAvg + tv%T(i,j,k) - saltAvg =saltAvg + tv%S(i,j,k) + saltAvg = saltAvg + tv%S(i,j,k) endif ; enddo ; enddo ! Horizontally homogenize data to produce perfectly "flat" initial conditions @@ -2288,8 +2298,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call sum_across_PEs(tempAvg) call sum_across_PEs(saltAvg) if (nPoints>0) then - tempAvg = tempAvg/real(nPoints) - saltAvg = saltAvg/real(nPoints) + tempAvg = tempAvg / real(nPoints) + saltAvg = saltAvg / real(nPoints) endif tv%T(:,:,k) = tempAvg tv%S(:,:,k) = saltAvg @@ -2301,13 +2311,13 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Fill land values do k=1,nz ; do j=js,je ; do i=is,ie if (tv%T(i,j,k) == missing_value) then - tv%T(i,j,k)=temp_land_fill - tv%S(i,j,k)=salt_land_fill + tv%T(i,j,k) = temp_land_fill + tv%S(i,j,k) = salt_land_fill endif enddo ; enddo ; enddo ! Finally adjust to target density - ks=max(0,nkml)+max(0,nkbl)+1 + ks = max(0,nkml)+max(0,nkbl)+1 if (adjust_temperature .and. .not. useALEremapping) then call determine_temperature(tv%T(is:ie,js:je,:), tv%S(is:ie,js:je,:), & @@ -2315,8 +2325,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif - deallocate(z_in,z_edges_in,temp_z,salt_z,mask_z) - deallocate(rho_z) ; deallocate(area_shelf_h, frac_shelf_h) + deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) + deallocate(rho_z, area_shelf_h, frac_shelf_h) call pass_var(h, G%Domain) call pass_var(tv%T, G%Domain) @@ -2356,15 +2366,15 @@ subroutine MOM_state_init_tests(G, GV, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), & + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*(GV%g_Earth*GV%m_to_Z)*z(k), & rho(k), tv%eqn_of_state) - P_tot = P_tot + GV%g_Earth * rho(k) * h(k) + P_tot = P_tot + (GV%g_Earth*GV%m_to_Z) * rho(k) * h(k) enddo P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, 0.5*P_tot, GV%Rho0, GV%g_Earth, tv%eqn_of_state, P_b, z_out) + P_t, 0.5*P_tot, GV%Rho0, (GV%g_Earth*GV%m_to_Z), tv%eqn_of_state, P_b, z_out) write(0,*) k,P_t,P_b,0.5*P_tot,e(K),e(K+1),z_out P_t = P_b enddo @@ -2374,7 +2384,7 @@ subroutine MOM_state_init_tests(G, GV, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV%Rho0, GV%g_Earth, -e(nk+1), GV%Angstrom, & + call cut_off_column_top(nk, tv, GV, (GV%g_Earth*GV%m_to_Z), -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 67cf7bbd24..fb5487780f 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -16,7 +16,6 @@ module MOM_tracer_initialization_from_Z use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type, isPointInCell use MOM_string_functions, only : uppercase -use MOM_time_manager, only : time_type, set_time use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -27,6 +26,7 @@ module MOM_tracer_initialization_from_Z use MOM_remapping, only : remapping_core_h use MOM_verticalGrid, only : verticalGrid_type use MOM_horizontal_regridding, only : myStats, horiz_interp_and_extrap_tracer + implicit none ; private #include @@ -44,7 +44,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m. + intent(in) :: h !< Layer thickness, in H (often m or kg m-2). real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized type(param_file_type), intent(in) :: PF !< parameter file character(len=*), intent(in) :: src_file !< source filename @@ -65,31 +65,24 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, character(len=10) :: remapScheme logical :: homog,useALE -! This include declares and sets the variable "version". -#include "version_variable.h" - + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_initialize_tracers_from_Z" ! This module's name. integer :: is, ie, js, je, nz ! compute domain indices - integer :: isg, ieg, jsg, jeg ! global extent integer :: isd, ied, jsd, jed ! data domain indices - integer :: i, j, k, kd - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi real, allocatable, dimension(:,:,:), target :: tr_z, mask_z real, allocatable, dimension(:), target :: z_edges_in, z_in ! Local variables for ALE remapping - real, dimension(:), allocatable :: h1, h2, hTarget, deltaE, tmpT1d - real, dimension(:), allocatable :: tmpT1dIn - real :: zTopOfCell, zBottomOfCell + real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H units. + real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses in Z. + real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in Z. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays - real, dimension(:,:,:), allocatable :: hSrc - - real :: tempAvg, missing_value - integer :: nPoints, ans + real :: missing_value + integer :: nPoints integer :: id_clock_routine, id_clock_ALE logical :: reentrant_x, tripolar_n @@ -100,7 +93,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -119,7 +111,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - if (PRESENT(homogenize)) homog=homogenize if (PRESENT(useALEremapping)) useALE=useALEremapping if (PRESENT(remappingScheme)) remapScheme=remappingScheme @@ -128,11 +119,11 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, convert=1.0 if (PRESENT(src_var_unit_conversion)) convert = src_var_unit_conversion - call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, & G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, homog) kd = size(z_edges_in,1)-1 + do k=1,kd+1 ; z_edges_in(k) = GV%m_to_Z*z_edges_in(k) ; enddo call pass_var(tr_z,G%Domain) call pass_var(mask_z,G%Domain) @@ -143,51 +134,38 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, ! First we reserve a work space for reconstructions of the source data allocate( h1(kd) ) allocate( hSrc(isd:ied,jsd:jed,kd) ) - allocate( tmpT1dIn(kd) ) call initialize_remapping( remapCS, remapScheme, boundary_extrapolation=.false. ) ! Data for reconstructions ! Next we initialize the regridding package so that it knows about the target grid - allocate( hTarget(nz) ) - allocate( h2(nz) ) - allocate( tmpT1d(nz) ) - allocate( deltaE(nz+1) ) do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then ! Build the source grid zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 + z_bathy = G%bathyT(i,j) do k = 1, kd if (mask_z(i,j,k) > 0.) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(i,j) ) - tmpT1dIn(k) = tr_z(i,j,k) + zBottomOfCell = -min( z_edges_in(k+1), z_bathy ) elseif (k>1) then - zBottomOfCell = -G%bathyT(i,j) - tmpT1dIn(k) = tmpT1dIn(k-1) - else ! This next block should only ever be reached over land - tmpT1dIn(k) = -99.9 + zBottomOfCell = -z_bathy endif h1(k) = zTopOfCell - zBottomOfCell if (h1(k)>0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(kd) = h1(kd) + ( zTopOfCell + G%bathyT(i,j) ) ! In case data is deeper than model + h1(kd) = h1(kd) + ( zTopOfCell + z_bathy ) ! In case data is deeper than model else tr(i,j,:) = 0. endif ! mask2dT - hSrc(i,j,:) = h1(:) + hSrc(i,j,:) = GV%Z_to_H * h1(:) enddo ; enddo call ALE_remap_scalar(remapCS, G, GV, kd, hSrc, tr_z, h, tr, all_cells=.false. ) deallocate( hSrc ) deallocate( h1 ) - deallocate( h2 ) - deallocate( hTarget ) - deallocate( tmpT1d ) - deallocate( tmpT1dIn ) - deallocate( deltaE ) do k=1,nz - call myStats(tr(:,:,k),missing_value,is,ie,js,je,k,'Tracer from ALE()') + call myStats(tr(:,:,k), missing_value, is, ie, js, je, k, 'Tracer from ALE()') enddo call cpu_clock_end(id_clock_ALE) endif ! useALEremapping diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 95c7b9fa3f..23bda0fce0 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -19,8 +19,8 @@ module MIDAS_vertmap module procedure fill_boundaries_int end interface -real, parameter :: epsln=1.e-10 !< A hard-wired constant! - !! \todo Get rid of this constant +! real, parameter :: epsln=1.e-10 !< A hard-wired constant! + !! \todo Get rid of this constant contains @@ -71,7 +71,8 @@ end function wright_eos_2d function alpha_wright_eos_2d(T,S,p) result(drho_dT) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with respect to temperature (kg m-3 C-1) + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with + !! respect to temperature (kg m-3 C-1) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom,I_denom2 @@ -110,7 +111,8 @@ end function alpha_wright_eos_2d function beta_wright_eos_2d(T,S,p) result(drho_dS) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with respect to salinity (kg m-3 PSU-1) + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with + !! respect to salinity (kg m-3 PSU-1) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom,I_denom2 @@ -141,58 +143,58 @@ end function beta_wright_eos_2d #endif !> Layer model routine for remapping tracers -function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug,i_debug,j_debug) result(tr) - real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. - real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (m) - integer, intent(in) :: nlay !< The number of vertical layers in the target grid - real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), intent(in) :: e !< The depths of the target layer interfaces (m) - integer, intent(in) :: nkml !< The number of mixed layers - integer, intent(in) :: nkbl !< The number of buffer layers - real, intent(in) :: land_fill !< fill in data over land (1) - real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet !< The wet mask for the source data (valid points) - real, dimension(size(tr_in,1),size(tr_in,2)), optional, intent(in) ::nlevs !< The number of input levels with valid data - logical, optional, intent(in) :: debug !< optional debug flag - integer, optional, intent(in) :: i_debug !< i-index of point for debugging - integer, optional, intent(in) :: j_debug !< j-index of point for debugging +function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlevs, & + debug, i_debug, j_debug, eps_z) result(tr) + real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. + real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (Z or m) + integer, intent(in) :: nlay !< The number of vertical layers in the target grid + real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), & + intent(in) :: e !< The depths of the target layer interfaces (Z or m) + integer, intent(in) :: nkml !< The number of mixed layers + integer, intent(in) :: nkbl !< The number of buffer layers + real, intent(in) :: land_fill !< fill in data over land (1) + real, dimension(size(tr_in,1),size(tr_in,2)), & + intent(in) :: wet !< The wet mask for the source data (valid points) + real, dimension(size(tr_in,1),size(tr_in,2)), & + optional, intent(in) :: nlevs !< The number of input levels with valid data + logical, optional, intent(in) :: debug !< optional debug flag + integer, optional, intent(in) :: i_debug !< i-index of point for debugging + integer, optional, intent(in) :: j_debug !< j-index of point for debugging + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr !< tracers in layer space + ! Local variables real, dimension(size(tr_in,3)) :: tr_1d !< a copy of the input tracer concentrations in a column. - real, dimension(nlay+1) :: e_1d - real, dimension(nlay) :: tr_ + real, dimension(nlay+1) :: e_1d ! A 1-d column of intreface heights, in the same units as e. + real, dimension(nlay) :: tr_ ! A 1-d column of tracer concentrations integer, dimension(size(tr_in,1),size(tr_in,2)) :: nlevs_data !< number of valid levels in the input dataset integer :: n,i,j,k,l,nx,ny,nz,nt,kz integer :: k_top,k_bot,k_bot_prev,kk,kstart - real :: sl_tr + real :: sl_tr ! The tracer concentration slope times the layer thickess, in tracer units. + real :: epsln_Z ! A negligibly thin layer thickness, in Z. real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 - real, dimension(size(tr_in,3)) :: z1,z2 !< z1 and z2 are the depths of the top and bottom limits of the part - ! of a z-cell that contributes to a layer, relative to the cell - ! center and normalized by the cell thickness, nondim. - ! Note that -1/2 <= z1 <= z2 <= 1/2. + real, dimension(size(tr_in,3)) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom + ! limits of the part of a z-cell that contributes to a layer, relative + ! to the cell center and normalized by the cell thickness, nondim. + ! Note that -1/2 <= z1 <= z2 <= 1/2. - logical :: debug_msg, debug_ + logical :: debug_msg, debug_, debug_pt nx = size(tr_in,1); ny=size(tr_in,2); nz = size(tr_in,3) nlevs_data = size(tr_in,3) - if (PRESENT(nlevs)) then - nlevs_data = anint(nlevs) - endif + if (PRESENT(nlevs)) nlevs_data = anint(nlevs) + epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z - debug_=.false. - if (PRESENT(debug)) then - debug_=debug - endif - - debug_msg = .false. - if (debug_) then - debug_msg=.true. - endif + debug_=.false. ; if (PRESENT(debug)) debug_ = debug + debug_msg = debug_ + debug_pt = debug_ ; if (PRESENT(i_debug) .and. PRESENT(j_debug)) debug_pt = debug_ do j=1,ny i_loop: do i=1,nx if (nlevs_data(i,j) == 0 .or. wet(i,j) == 0.) then - tr(i,j,:) = land_fill - cycle i_loop + tr(i,j,:) = land_fill + cycle i_loop endif do k=1,nz @@ -205,108 +207,83 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, k_bot = 1 ; k_bot_prev = -1 do k=1,nlay if (e_1d(k+1) > z_edges(1)) then - tr(i,j,k) = tr_1d(1) + tr(i,j,k) = tr_1d(1) elseif (e_1d(k) < z_edges(nlevs_data(i,j)+1)) then - if (debug_msg) then - print *,'*** WARNING : Found interface below valid range of z data ' - print *,'(i,j,z_bottom,interface)= ',& - i,j,z_edges(nlevs_data(i,j)+1),e_1d(k) - print *,'z_edges= ',z_edges - print *,'e=',e_1d - print *,'*** I will extrapolate below using the bottom-most valid values' - debug_msg = .false. - endif - tr(i,j,k) = tr_1d(nlevs_data(i,j)) + if (debug_msg) then + print *,'*** WARNING : Found interface below valid range of z data ' + print *,'(i,j,z_bottom,interface)= ',& + i,j,z_edges(nlevs_data(i,j)+1),e_1d(k) + print *,'z_edges= ',z_edges + print *,'e=',e_1d + print *,'*** I will extrapolate below using the bottom-most valid values' + debug_msg = .false. + endif + tr(i,j,k) = tr_1d(nlevs_data(i,j)) else - kstart=k_bot - call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), & - kstart, k_top, k_bot, wt, z1, z2) - - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) - endif - endif - endif - kz = k_top - sl_tr=0.0; ! cur_tr=0.0 - if (kz /= k_bot_prev) then - ! Calculate the intra-cell profile. - if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then - sl_tr = find_limited_slope(tr_1d, z_edges, kz) - endif - endif - if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j) - ! This is the piecewise linear form. - tr(i,j,k) = wt(kz) * & - (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - ! if (debug_) then - ! print *,'k,k_top,k_bot= ',k,k_top,k_bot - ! endif - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr - endif - endif - endif - - do kz=k_top+1,k_bot-1 - tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz) - enddo - - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0003 k,tr = ',k,tr(i,j,k) - endif - endif - endif - - if (k_bot > k_top) then - kz = k_bot - ! Calculate the intra-cell profile. - sl_tr = 0.0 ! ; cur_tr = 0.0 - if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then - sl_tr = find_limited_slope(tr_1d, z_edges, kz) - ! if (debug_) then - ! print *,'002 sl_tr,k,kz,nlevs= ',sl_tr,k,kz,nlevs_data(i,j),nlevs(i,j) - ! endif - endif - ! This is the piecewise linear form. - tr(i,j,k) = tr(i,j,k) + wt(kz) * & - (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) - print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) - endif - endif - endif + kstart=k_bot + call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), & + kstart, k_top, k_bot, wt, z1, z2) + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) + endif ; endif + kz = k_top + sl_tr=0.0; ! cur_tr=0.0 + if (kz /= k_bot_prev) then + ! Calculate the intra-cell profile. + if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then + sl_tr = find_limited_slope(tr_1d, z_edges, kz) + endif + endif + if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j) + ! This is the piecewise linear form. + tr(i,j,k) = wt(kz) * (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) + ! For the piecewise parabolic form add the following... + ! + C1_3*wt(kz) * cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr + endif ; endif + + do kz=k_top+1,k_bot-1 + tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz) + enddo + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0003 k,tr = ',k,tr(i,j,k) + endif ; endif + + if (k_bot > k_top) then + kz = k_bot + ! Calculate the intra-cell profile. + sl_tr = 0.0 ! ; cur_tr = 0.0 + if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then + sl_tr = find_limited_slope(tr_1d, z_edges, kz) + endif + ! This is the piecewise linear form. + tr(i,j,k) = tr(i,j,k) + wt(kz) * & + (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) + ! For the piecewise parabolic form add the following... + ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) + print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) + endif ; endif - endif - k_bot_prev = k_bot + endif + k_bot_prev = k_bot endif enddo ! k-loop do k=2,nlay ! simply fill vanished layers with adjacent value - if (e_1d(k)-e_1d(k+1) <= epsln) tr(i,j,k)=tr(i,j,k-1) + if (e_1d(k)-e_1d(k+1) <= epsln_Z) tr(i,j,k)=tr(i,j,k-1) enddo enddo i_loop enddo - return - end function tracer_z_init !> Return the index where to insert item x in list a, assuming a is sorted. @@ -360,10 +337,9 @@ end function bisect_fast #ifdef PY_SOLO ! Only for stand-alone python -!> This subroutine determines the potential temperature and -!! salinity that is consistent with the target density -!! using provided initial guess -subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start) +!> This subroutine determines the potential temperature and salinity that +!! is consistent with the target density using provided initial guess +subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start) real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. @@ -372,49 +348,40 @@ subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start) integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) real, intent(in) :: land_fill !< land fill value real(kind=8), dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers + ! Local variables - real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin - real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS - real(kind=8), dimension(size(temp,1)) :: press - integer :: nx,ny,nz,nt,i,j,k,n,itt - logical :: adjust_salt , old_fit - real :: dT_dS real, parameter :: T_max = 35.0, T_min = -2.0 - real, parameter :: S_min = 0.5, S_max=65.0 - real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 #else -!> This subroutine determines the potential temperature and -!! salinity that is consistent with the target density -!! using provided initial guess -subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos) - real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) - real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) - real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. - real, intent(in) :: p_ref !< reference pressure, in Pa. - integer, intent(in) :: niter !< maximum number of iterations - integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) - real, intent(in) :: land_fill !< land fill value - real, dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers - type(eos_type), pointer :: eos !< seawater equation of state control structure - ! Local variables - real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin - real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS +!> This subroutine determines the potential temperature and salinity that +!! is consistent with the target density using provided initial guess +subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start, eos) + real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) + real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) + real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. + real, intent(in) :: p_ref !< reference pressure, in Pa. + integer, intent(in) :: niter !< maximum number of iterations + integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) + real, intent(in) :: land_fill !< land fill value + real, dimension(:,:,:), intent(in) :: h !< layer thickness, used only to avoid working on massless layers + type(eos_type), pointer :: eos !< seawater equation of state control structure + + real, parameter :: T_max = 31.0, T_min = -2.0 +#endif + ! Local variables (All of which need documentation!) + real(kind=8), dimension(size(temp,1),size(temp,3)) :: T, S, dT, dS, rho, hin + real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT, drho_dS real(kind=8), dimension(size(temp,1)) :: press - integer :: nx,ny,nz,nt,i,j,k,n,itt + integer :: nx, ny, nz, nt, i, j, k, n, itt real :: dT_dS - logical :: adjust_salt , old_fit - real, parameter :: T_max = 31.0, T_min = -2.0 + logical :: adjust_salt, old_fit real, parameter :: S_min = 0.5, S_max=65.0 real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 -#endif old_fit = .true. ! reproduces siena behavior - ! will switch to the newer - ! method which simultaneously adjusts - ! temp and salt based on the ratio - ! of the thermal and haline coefficients. + ! will switch to the newer method which simultaneously adjusts + ! temp and salt based on the ratio of the thermal and haline coefficients. - nx=size(temp,1);ny=size(temp,2); nz=size(temp,3) + nx=size(temp,1) ; ny=size(temp,2) ; nz=size(temp,3) press(:) = p_ref @@ -431,72 +398,59 @@ subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos drho_dT=alpha_wright_eos_2d(T,S,p_ref) #else do k=1, nz - call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) - call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos) + call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, eos) enddo #endif - do k=k_start,nz - do i=1,nx - -! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then - if (abs(rho(i,k)-R(k))>tol) then - if (old_fit) then - dT(i,k)=(R(k)-rho(i,k))/drho_dT(i,k) - if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj - if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj - T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) - else - dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.) - dS(i,k) = (R(k)-rho(i,k))/(drho_dS(i,k) - drho_dT(i,k)*dT_dS ) - dT(i,k)= -dT_dS*dS(i,k) -! if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj -! if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj - T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) - S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) - endif + do k=k_start,nz ; do i=1,nx + +! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then + if (abs(rho(i,k)-R(k))>tol) then + if (old_fit) then + dT(i,k) = max(min((R(k)-rho(i,k)) / drho_dT(i,k), max_t_adj), -max_t_adj) + T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) + else + dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.) + !### RWH: Based on the dimensions alone, the expression above should be: + ! dT_dS = 10.0 - min(-drho_dS(i,k)/drho_dT(i,k),10.) + dS(i,k) = (R(k)-rho(i,k)) / (drho_dS(i,k) - drho_dT(i,k)*dT_dS ) + dT(i,k) = -dT_dS*dS(i,k) + ! dT(i,k) = max(min(dT(i,k), max_t_adj), -max_t_adj) + T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) + S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min) endif - enddo - enddo + endif + enddo ; enddo if (maxval(abs(dT)) < tol) then adjust_salt = .false. exit iter_loop endif enddo iter_loop - if (adjust_salt .and. old_fit) then - iter_loop2: do itt = 1,niter + if (adjust_salt .and. old_fit) then ; do itt = 1,niter #ifdef PY_SOLO - rho=wright_eos_2d(T,S,p_ref) - drho_dS=beta_wright_eos_2d(T,S,p_ref) + rho = wright_eos_2d(T,S,p_ref) + drho_dS = beta_wright_eos_2d(T,S,p_ref) #else - do k=1, nz - call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) - call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) - enddo + do k=1, nz + call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) + call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) + enddo #endif - do k=k_start,nz - do i=1,nx -! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then - if (abs(rho(i,k)-R(k))>tol ) then - dS(i,k)=(R(k)-rho(i,k))/drho_dS(i,k) - if (dS(i,k)>max_s_adj) dS(i,k)=max_s_adj - if (dS(i,k)<-1.0*max_s_adj) dS(i,k)=-1.0*max_s_adj - S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) - endif - enddo - enddo - if (maxval(abs(dS)) < tol) then - exit iter_loop2 - endif - enddo iter_loop2 - endif + do k=k_start,nz ; do i=1,nx +! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then + if (abs(rho(i,k)-R(k)) > tol) then + dS(i,k) = max(min((R(k)-rho(i,k)) / drho_dS(i,k), max_s_adj), -max_s_adj) + S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min) + endif + enddo ; enddo + if (maxval(abs(dS)) < tol) exit + enddo ; endif temp(:,j,:)=T(:,:) salt(:,j,:)=S(:,:) enddo - return - end subroutine determine_temperature !> This subroutine determines the layers bounded by interfaces e that overlap @@ -505,57 +459,62 @@ end subroutine determine_temperature !! of each layer that overlaps that depth range. !! Note that by convention, e decreases with increasing k and Z_top > Z_bot. subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) - real, dimension(:), intent(in) :: e !< the interface positions, in m. - real, intent(in) :: Z_top !< The top of the range being mapped to, in m. - real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m. - integer, intent(in) :: k_max !< The number of valid layers. - integer, intent(in) :: k_start !< The layer at which to start searching. - integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. - integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. - real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot. - real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level - real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level + real, dimension(:), intent(in) :: e !< The interface positions, in m or Z. + real, intent(in) :: Z_top !< The top of the range being mapped to, in m or Z. + real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m or Z. + integer, intent(in) :: k_max !< The number of valid layers. + integer, intent(in) :: k_start !< The layer at which to start searching. + integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. + integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. + real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot, nondim. + real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level, nondim. + real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level, nondim. + ! Local variables real :: Ih, e_c, tot_wt, I_totwt integer :: k - wt(:)=0.0; z1(:)=0.0; z2(:)=0.0 - k_top = k_start; k_bot= k_start; wt(1) = 1.0; z1(1)=-0.5; z2(1) = 0.5 - - do k=k_start,k_max ;if (e(k+1)k_max) return - - ! Determine the fractional weights of each layer. - ! Note that by convention, e and Z_int decrease with increasing k. - if (e(k+1)<=Z_bot) then - wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(k)-e(k+1)) - e_c = 0.5*(e(k)+e(k+1)) - z1(k) = (e_c - MIN(e(k),Z_top)) * Ih - z2(k) = (e_c - Z_bot) * Ih - else - wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) - z2(k) = 0.5 - k_bot = k_max - do k=k_top+1,k_max - if (e(k+1)<=Z_bot) then - k_bot = k - wt(k) = e(k) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) - else - wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 - endif - tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. - if (k>=k_bot) exit - enddo - - I_totwt = 1.0 / tot_wt - do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo + wt(:)=0.0 ; z1(:)=0.0 ; z2(:)=0.0 + k_top = k_start ; k_bot = k_start ; wt(1) = 1.0 ; z1(1) = -0.5 ; z2(1) = 0.5 + + do k=k_start,k_max ; if (e(K+1) < Z_top) exit ; enddo + k_top = k + + if (k>k_max) return + + ! Determine the fractional weights of each layer. + ! Note that by convention, e and Z_int decrease with increasing k. + if (e(K+1) <= Z_bot) then + wt(k) = 1.0 ; k_bot = k + Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) + e_c = 0.5*(e(K)+e(K+1)) + z1(k) = (e_c - MIN(e(K), Z_top)) * Ih + z2(k) = (e_c - Z_bot) * Ih + else + wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0. + ! Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1)) + else ; z1(k) = -0.5 ; endif + z2(k) = 0.5 + k_bot = k_max + do k=k_top+1,k_max + if (e(K+1) <= Z_bot) then + k_bot = k + wt(k) = e(K) - Z_bot ; z1(k) = -0.5 + if (e(K) /= e(K+1)) then + z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + else ; z2(k) = 0.5 ; endif + else + wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5 endif + tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. + if (k>=k_bot) exit + enddo - return + I_totwt = 0.0 ; if (tot_wt > 0.0) I_totwt = 1.0 / tot_wt + do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo + endif end subroutine find_overlap @@ -563,56 +522,55 @@ end subroutine find_overlap !! a piecewise limited scheme. function find_limited_slope(val, e, k) result(slope) real, dimension(:), intent(in) :: val !< An column the values that are being interpolated. - real, dimension(:), intent(in) :: e !< A column's interface heights, in m. - integer, intent(in) :: k !< The layer whose slope is being determined. + real, dimension(:), intent(in) :: e !< A column's interface heights, in Z or m. + integer, intent(in) :: k !< The layer whose slope is being determined. real :: slope !< The normalized slope in the intracell distribution of val. ! Local variables - real :: amx,bmx,amn,bmn,cmn,dmn + real :: amn, cmn real :: d1, d2 if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then - slope = 0.0 ! ; curvature = 0.0 + slope = 0.0 ! ; curvature = 0.0 else - d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) - slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & - (e(k) - e(k+1)) / (d1*d2*(d1+d2)) - ! slope = 0.5*(val(k+1) - val(k-1)) - ! This is S.J. Lin's form of the PLM limiter. - amx=max(val(k-1),val(k)) - bmx = max(amx,val(k+1)) - amn = min(abs(slope),2.0*(bmx-val(k))) - bmn = min(val(k-1),val(k)) - cmn = 2.0*(val(k)-min(bmn,val(k+1))) - dmn = min(amn,cmn) - slope = sign(1.0,slope) * dmn - - ! min(abs(slope), & - ! 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & - ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) - ! curvature = 0.0 + d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) + if (d1*d2 > 0.0) then + slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & + (e(K) - e(K+1)) / (d1*d2*(d1+d2)) + ! slope = 0.5*(val(k+1) - val(k-1)) + ! This is S.J. Lin's form of the PLM limiter. + amn = min(abs(slope), 2.0*(max(val(k-1), val(k), val(k+1)) - val(k))) + cmn = 2.0*(val(k) - min(val(k-1), val(k), val(k+1))) + slope = sign(1.0, slope) * min(amn, cmn) + + ! min(abs(slope), 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & + ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) + ! curvature = 0.0 + else + slope = 0.0 ! ; curvature = 0.0 + endif endif - return - end function find_limited_slope !> Find interface positions corresponding to density profile -function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) +function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps_z) result(zi) real, dimension(:,:,:), & - intent(in) :: rho !< potential density in z-space (kg m-3) + intent(in) :: rho !< potential density in z-space (kg m-3) real, dimension(size(rho,3)), & - intent(in) :: zin !< levels (m) - real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) + intent(in) :: zin !< Input data levels, in Z (often m). + real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) real, dimension(size(rho,1),size(rho,2)), & - intent(in) :: depth !< ocean depth (m) + intent(in) :: depth !< ocean depth in Z real, dimension(size(rho,1),size(rho,2)), & - optional, intent(in) ::nlevs !< number of valid points in each column + optional, intent(in) :: nlevs !< number of valid points in each column logical, optional, intent(in) :: debug !< optional debug flag - integer, optional, intent(in) :: nkml !< number of mixed layer pieces - integer, optional, intent(in) :: nkbl !< number of buffer layer pieces - real, optional, intent(in) :: hml !< mixed layer depth + integer, optional, intent(in) :: nkml !< number of mixed layer pieces + integer, optional, intent(in) :: nkbl !< number of buffer layer pieces + real, optional, intent(in) :: hml !< mixed layer depth, in Z + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. + real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi !< The returned interface, in the same units az zin. + ! Local variables - real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi real, dimension(size(rho,1),size(rho,3)) :: rho_ real, dimension(size(rho,1)) :: depth_ logical :: unstable @@ -620,11 +578,13 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) integer, dimension(size(rho,1),size(Rb,1)) :: ki_ real, dimension(size(rho,1),size(Rb,1)) :: zi_ integer, dimension(size(rho,1),size(rho,2)) :: nlevs_data - integer, dimension(size(rho,1)) :: lo,hi + integer, dimension(size(rho,1)) :: lo, hi real :: slope,rsm,drhodz,hml_ integer :: n,i,j,k,l,nx,ny,nz,nt integer :: nlay,kk,nkml_,nkbl_ logical :: debug_ = .false. + real :: epsln_Z ! A negligibly thin layer thickness, in Z. + real :: epsln_rho ! A negligibly small density change, in kg m-3. real, parameter :: zoff=0.999 nlay=size(Rb)-1 @@ -636,95 +596,86 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) nx = size(rho,1); ny=size(rho,2); nz = size(rho,3) nlevs_data(:,:) = size(rho,3) - nkml_=0;nkbl_=0;hml_=0.0 - if (PRESENT(nkml)) nkml_=max(0,nkml) - if (PRESENT(nkbl)) nkbl_=max(0,nkbl) - if (PRESENT(hml)) hml_=hml + nkml_ = 0 ; if (PRESENT(nkml)) nkml_ = max(0, nkml) + nkbl_ = 0 ; if (PRESENT(nkbl)) nkbl_ = max(0, nkbl) + hml_ = 0.0 ; if (PRESENT(hml)) hml_ = hml + epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z + epsln_rho = 1.0e-10 if (PRESENT(nlevs)) then - nlevs_data(:,:) = nlevs(:,:) + nlevs_data(:,:) = nlevs(:,:) endif do j=1,ny rho_(:,:) = rho(:,j,:) i_loop: do i=1,nx if (debug_) then - print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j) - print *,'initial density profile= ', rho_(i,:) + print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j) + print *,'initial density profile= ', rho_(i,:) endif unstable=.true. dir=1 do while (unstable) unstable=.false. if (dir == 1) then - do k=2,nlevs_data(i,j)-1 - if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then - if (k == 2) then - rho_(i,k-1)=rho_(i,k)-epsln - else - drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) - if (drhodz < 0.0) then - unstable=.true. - endif - rho_(i,k) = rho_(i,k-1)+drhodz*zoff*(zin(k)-zin(k-1)) - endif - endif - enddo - dir=-1*dir + do k=2,nlevs_data(i,j)-1 + if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then + if (k == 2) then + rho_(i,k-1) = rho_(i,k)-epsln_rho + else + drhodz = (rho_(i,k+1)-rho_(i,k-1)) / (zin(k+1)-zin(k-1)) + if (drhodz < 0.0) unstable=.true. + rho_(i,k) = rho_(i,k-1) + drhodz*zoff*(zin(k)-zin(k-1)) + endif + endif + enddo + dir = -1*dir else - do k=nlevs_data(i,j)-1,2,-1 - if (rho_(i,k+1) - rho_(i,k) < 0.0) then - if (k == nlevs_data(i,j)-1) then - rho_(i,k+1)=rho_(i,k-1)+epsln - else - drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) - if (drhodz < 0.0) then - unstable=.true. - endif - rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k)) - endif - endif - enddo - dir=-1*dir + do k=nlevs_data(i,j)-1,2,-1 + if (rho_(i,k+1) - rho_(i,k) < 0.0) then + if (k == nlevs_data(i,j)-1) then + rho_(i,k+1) = rho_(i,k-1)+epsln_rho + else + drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) + if (drhodz < 0.0) unstable=.true. + rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k)) + endif + endif + enddo + dir = -1*dir endif enddo if (debug_) then - print *,'final density profile= ', rho_(i,:) + print *,'final density profile= ', rho_(i,:) endif enddo i_loop ki_(:,:) = 0 zi_(:,:) = 0.0 - depth_(:)=-1.0*depth(:,j) - lo(:)=1 - hi(:)=nlevs_data(:,j) - ki_ = bisect_fast(rho_,Rb,lo,hi) - ki_(:,:) = max(1,ki_(:,:)-1) + depth_(:) = -1.0*depth(:,j) + lo(:) = 1 + hi(:) = nlevs_data(:,j) + ki_ = bisect_fast(rho_, Rb, lo, hi) + ki_(:,:) = max(1, ki_(:,:)-1) do i=1,nx do l=2,nlay - slope = (zin(ki_(i,l)+1) - zin(ki_(i,l)))/max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln) + slope = (zin(ki_(i,l)+1) - zin(ki_(i,l))) / max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln_rho) zi_(i,l) = -1.0*(zin(ki_(i,l)) + slope*(Rb(l)-rho_(i,ki_(i,l)))) - zi_(i,l) = max(zi_(i,l),depth_(i)) - zi_(i,l) = min(zi_(i,l),-1.0*hml_) + zi_(i,l) = max(zi_(i,l), depth_(i)) + zi_(i,l) = min(zi_(i,l), -1.0*hml_) enddo - zi_(i,nlay+1)=depth_(i) + zi_(i,nlay+1) = depth_(i) do l=2,nkml_+1 - zi_(i,l)=max(((1.0-real(l))/real(nkml_))*hml_,depth_(i)) + zi_(i,l) = max(hml_*((1.0-real(l))/real(nkml_)), depth_(i)) enddo do l=nlay,nkml_+2,-1 - if (zi_(i,l) < zi_(i,l+1)+epsln) then - zi_(i,l)=zi_(i,l+1)+epsln - endif - if (zi_(i,l)>-1.0*hml_) then - zi_(i,l)=max(-1.0*hml_,depth_(i)) - endif + if (zi_(i,l) < zi_(i,l+1) + epsln_Z) zi_(i,l) = zi_(i,l+1) + epsln_Z + if (zi_(i,l) > -1.0*hml_) zi_(i,l) = max(-1.0*hml_, depth_(i)) enddo enddo - zi(:,j,:)=zi_(:,:) + zi(:,j,:) = zi_(:,:) enddo - return - end function find_interfaces !> Create a 2d-mesh of grid coordinates from 1-d arrays diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 17cc300bd2..f9dae9b246 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -19,7 +19,7 @@ module MOM_oda_driver_mod use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist use time_manager_mod, only : time_type, decrement_time, increment_time -use time_manager_mod, only : get_date, get_time, operator(>=),operator(/=),operator(==),operator(<) +use time_manager_mod, only : get_date, operator(>=),operator(/=),operator(==),operator(<) use constants_mod, only : radius, epsln ! ODA Modules use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 7e68eac52a..949268c7e9 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -215,13 +215,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = GV%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP do @@ -612,7 +612,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, EKE, & bottomFac2, barotrFac2, LmixScale, & Lrhines, Leady) @@ -717,7 +717,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, & beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & Lrhines(i,j), Leady(i,j)) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2a166bac09..3be015faa4 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -316,17 +316,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Toggle whether to use a Laplacian viscosity derived from MEKE use_MEKE_Ku = associated(MEKE%Ku) -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & -!$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & -!$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & -!$OMP mod_Leith, legacy_bound) & -!$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & -!$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & -!$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & -!$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & -!$OMP div_xx, div_xx_dx, div_xx_dy, & -!$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) + !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & + !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & + !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & + !$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & + !$OMP mod_Leith, legacy_bound) & + !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & + !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & + !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & + !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & + !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & + !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz ! The following are the forms of the horizontal tension and horizontal diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 3205f81b02..ed8245d2be 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -18,9 +18,7 @@ module MOM_internal_tides use MOM_io, only : slasher, vardesc, MOM_read_data use MOM_restart, only : register_restart_field, MOM_restart_CS, restart_init, save_restart use MOM_spatial_means, only : global_area_mean -use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) -use MOM_time_manager, only : get_time, get_date, set_time, set_date -use MOM_time_manager, only : time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real, operator(+), operator(/), operator(-) use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_structure, only: wave_structure_init, wave_structure, wave_structure_CS @@ -350,7 +348,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Extract the energy for mixing due to bottom drag------------------------------- if (CS%apply_bottom_drag) then do j=jsd,jed ; do i=isd,ied - I_D_here = 1.0 / max(G%bathyT(i,j), 1.0) + ! Note the 1 m dimensional scale here. Should this be a parameter? + I_D_here = 1.0 / (GV%Z_to_m*max(G%bathyT(i,j), 1.0*GV%m_to_Z)) drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, vel_btTide(i,j)**2 + & tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here enddo ; enddo @@ -592,13 +591,8 @@ subroutine sum_En(G, CS, En, label) integer :: m,fr,a real :: En_sum, tmpForSumming, En_sum_diff, En_sum_pdiff character(len=160) :: mesg ! The text of an error message - integer :: seconds - real :: Isecs_per_day = 1.0 / 86400.0 real :: days - call get_time(CS%Time, seconds) - days = real(seconds) * Isecs_per_day - En_sum = 0.0 tmpForSumming = 0.0 do a=1,CS%nAngle @@ -614,6 +608,7 @@ subroutine sum_En(G, CS, En, label) CS%En_sum = En_sum !! Print to screen !if (is_root_pe()) then + ! days = time_type_to_real(CS%Time) / 86400.0 ! write(mesg,*) trim(label)//': days =', days, ', En_sum=', En_sum, & ! ', En_sum_diff=', En_sum_diff, ', Percent change=', En_sum_pdiff, '%' ! call MOM_mesg(mesg) @@ -2318,7 +2313,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) call MOM_read_data(filename, 'h2', h2, G%domain, timelevel=1) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict rms topo to 10 percent of column depth. - h2(i,j) = min(0.01*G%bathyT(i,j)**2, h2(i,j)) + h2(i,j) = min(0.01*(G%Zd_to_m*G%bathyT(i,j))**2, h2(i,j)) ! Compute the fixed part; units are [kg m-2] here ! will be multiplied by N and En to get into [W m-2] CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index ecc586d025..7f33140fb7 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -393,11 +393,11 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then - call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2) + call find_eta(h, tv, G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) - call calc_Visbeck_coeffs(h, e, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) @@ -417,19 +417,17 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. -subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) +subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position (m) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points (1/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points (1/s2) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + ! Local variables - real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) - real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at u points (for diagnostics) real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency (1/s) @@ -438,8 +436,6 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) integer :: is, ie, js, je, nz integer :: i, j, k, kb_max real :: S2max, wNE, wSE, wSW, wNW - real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G)) - real :: SN_v_local(SZI_(G), SZJB_(G),SZK_(G)) real :: H_u(SZIB_(G)), H_v(SZI_(G)) real :: S2_u(SZIB_(G), SZJ_(G)) real :: S2_v(SZI_(G), SZJB_(G)) @@ -456,12 +452,7 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) S2max = CS%Visbeck_S_max**2 -!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h, & -!$OMP S2_u,S2_v,slope_x,slope_y, & -!$OMP SN_u_local,SN_v_local,N2_u,N2_v, S2max) & -!$OMP private(E_x,E_y,S2,H_u,H_v,Hdn,Hup,H_geom,N2, & -!$OMP wNE, wSE, wSW, wNW) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 CS%SN_u(i,j) = 0.0 CS%SN_v(i,j) = 0.0 @@ -471,7 +462,7 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) ! calculate the first-mode gravity wave speed and then blend the equatorial ! and midlatitude deformation radii, using calc_resoln_function as a template. -!$OMP do + !$OMP parallel do default(shared) private(S2,H_u,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) do j = js,je do I=is-1,ie CS%SN_u(I,j) = 0. ; H_u(I) = 0. ; S2_u(I,j) = 0. @@ -517,7 +508,7 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) enddo enddo -!$OMP do + !$OMP parallel do default(shared) private(S2,H_v,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) do J = js-1,je do i=is,ie CS%SN_v(i,J) = 0. ; H_v(i) = 0. ; S2_v(i,J) = 0. @@ -563,8 +554,6 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) enddo enddo -!$OMP end parallel - ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then if (CS%id_S2_u > 0) call post_data(CS%id_S2_u, S2_u, CS%diag) @@ -600,6 +589,8 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) real :: N2 ! Brunt-Vaisala frequency (1/s) real :: Hup, Hdn ! Thickness from above, below (m or kg m-2) real :: H_geom ! The geometric mean of Hup*Hdn, in m or kg m-2. + real :: Z_to_L ! A conversion factor between from units for e to the + ! units for lateral distances. real :: one_meter ! One meter in thickness units of m or kg m-2. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max @@ -618,33 +609,25 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff - H_cutoff = real(2*nz) * (GV%Angstrom + h_neglect) - -!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h,H_cutoff,h_neglect, & -!$OMP one_meter,SN_u_local,SN_v_local,calculate_slopes) & -!$OMP private(E_x,E_y,S2,Hdn,Hup,H_geom,N2) -!$OMP do - do j=js-1,je+1 ; do i=is-1,ie+1 - CS%SN_u(i,j) = 0.0 - CS%SN_v(i,j) = 0.0 - enddo ; enddo + H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) + Z_to_L = GV%Z_to_m ! To set the length scale based on the deformation radius, use wave_speed to ! calculate the first-mode gravity wave speed and then blend the equatorial ! and midlatitude deformation radii, using calc_resoln_function as a template. -!$OMP do + !$OMP parallel do default(shared) private(E_x,E_y,S2,Hdn,Hup,H_geom,N2) do k=nz,CS%VarMix_Ktop,-1 if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = (e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = (e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo @@ -666,10 +649,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k) / (GV%H_to_m * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 - SN_u_local(I,j,k) = (H_geom * GV%H_to_m) * S2 * N2 + SN_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo do J=js-1,je ; do i=is,ie S2 = ( E_y(i,J)**2 + 0.25*( & @@ -677,52 +660,56 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k) / (GV%H_to_m * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 - SN_v_local(i,J,k) = (H_geom * GV%H_to_m) * S2 * N2 + SN_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo enddo ! k -!$OMP do - do j = js,je + !$OMP parallel do default(shared) + do j=js,je + do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie CS%SN_u(I,j) = CS%SN_u(I,j) + SN_u_local(I,j,k) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom ) ) + !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA - if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_m ) then - CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / max(G%bathyT(I,j), G%bathyT(I+1,j)) ) + if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then + CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & + (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 endif enddo enddo -!$OMP do + !$OMP parallel do default(shared) do J=js-1,je - do k=nz,CS%VarMix_Ktop,-1 ; do I=is,ie + do i=is,ie ; CS%SN_v(i,J) = 0.0 ; enddo + do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) enddo ; enddo do i=is,ie - !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom ) ) + !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA - if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_m ) then - CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / max(G%bathyT(i,J), G%bathyT(i,J+1)) ) + if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then + CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & + (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 endif enddo enddo -!$OMP end parallel end subroutine calc_slope_functions_using_just_e !> Initializes the variables mixing coefficients container -subroutine VarMix_init(Time, G, param_file, diag, CS) +subroutine VarMix_init(Time, G, GV, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(VarMix_CS), pointer :: CS !< Variable mixing coefficients @@ -804,6 +791,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & default=.false., do_not_log=.true.) + CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE CS%calculate_Eady_growth_rate = CS%calculate_Eady_growth_rate .or. use_MEKE call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & default=0., do_not_log=.true.) @@ -839,7 +827,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & - default=1.0e-6) + default=1.0e-6, scale=GV%m_to_Z**2) !### Add units argument. endif if (CS%calculate_Eady_growth_rate) then diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index f37b298edc..27a60e7a38 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -15,7 +15,7 @@ module MOM_mixed_layer_restrat use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc use MOM_lateral_mixing_coeffs, only : VarMix_CS -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density @@ -138,17 +138,17 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization (H units) htot_slow, & ! The sum of the thicknesses of layers in the mixed layer (H units) Rml_av_slow ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m4 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1) real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) - real :: h_vel ! htot interpolated onto velocity points in metre (not H). + real :: h_vel ! htot interpolated onto velocity points in Z (not H). real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points (m s-1) + real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1) real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected (H units) - real :: dz_neglect ! A tiny thickness (in m) that is usually lost in roundoff so can be neglected + real :: dz_neglect ! A tiny thickness (in Z) that is usually lost in roundoff so can be neglected real :: I4dt ! 1/(4 dt) (sec-1) real :: Ihtot,Ihtot_slow! total mixed layer thickness real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux @@ -273,9 +273,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff*GV%H_to_m + dz_neglect = GV%H_subroundoff*GV%H_to_Z proper_averaging = .not. CS%MLE_use_MLD_ave_bug if (CS%front_length>0.) then res_upscale = .true. @@ -304,7 +304,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var keep_going = .true. do k=1,nz do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state) @@ -338,7 +338,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1) call hchksum(MLD_fast,'mixed_layer_restrat: MLD',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1) + call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=GV%m_to_Z) endif ! TO DO: @@ -348,7 +348,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -358,23 +358,23 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. - h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD - h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo @@ -424,7 +424,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -434,23 +434,23 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. - h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD - h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo @@ -559,17 +559,17 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer (H units) Rml_av ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m4 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1) real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) - real :: h_vel ! htot interpolated onto velocity points (meter; not H) + real :: h_vel ! htot interpolated onto velocity points (Z; not H) real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points (m s-1) + real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1) real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H units) - real :: dz_neglect ! tiny thickness (in m) that usually lost in roundoff and can be neglected (meter) + real :: dz_neglect ! tiny thickness (in Z) that usually lost in roundoff and can be neglected (meter) real :: I4dt ! 1/(4 dt) real :: I2htot ! Twice the total mixed layer thickness at velocity points (H units) real :: z_topx2 ! depth of the top of a layer at velocity points (H units) @@ -597,10 +597,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff*GV%H_to_m + dz_neglect = GV%H_subroundoff*GV%H_to_Z if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") @@ -625,7 +625,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo enddo @@ -644,9 +644,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) do i=is,ie ; utimescale_diag(i,j) = 0.0 ; enddo do i=is,ie ; vtimescale_diag(i,j) = 0.0 ; enddo do I=is-1,ie - h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_m + h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -661,7 +661,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) utimescale_diag(I,j) = timescale uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(i) == 0) then do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo @@ -692,9 +692,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) ! V- component !$OMP do do J=js-1,je ; do i=is,ie - h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_m + h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -709,7 +709,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) vtimescale_diag(i,J) = timescale vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo else @@ -771,17 +771,22 @@ end subroutine mixedlayer_restrat_BML !> Initialize the mixed layer restratification module -logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) +logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS, restart_CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + ! Local variables -! This include declares and sets the variable "version". -#include "version_variable.h" - real :: flux_to_kg_per_s + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. + ! This include declares and sets the variable "version". +# include "version_variable.h" + integer :: i, j ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -878,7 +883,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) CS%id_MLD = register_diag_field('ocean_model', 'MLD_restrat', diag%axesT1, Time, & 'Mixed Layer Depth as used in the mixed-layer restratification parameterization', 'm') CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, & - 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', 'm s2') + 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', & + 'm s2', conversion=GV%m_to_Z) CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, & 'Transport stream function amplitude for zonal restratification of mixed layer', 'm3 s-1') CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, & @@ -888,6 +894,26 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, & 'Surface meridional velocity component of mixed layer restratification', 'm s-1') + ! Rescale variables from restart files if the internal dimensional scalings have changed. + if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then + if (query_initialized(CS%MLD_filtered, "MLD_MLE_filtered", restart_CS) .and. & + (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%MLD_filtered(i,j) = H_rescale * CS%MLD_filtered(i,j) + enddo ; enddo + endif + endif + if (CS%MLE_MLD_decay_time2>0.) then + if (query_initialized(CS%MLD_filtered_slow, "MLD_MLE_filtered_slow", restart_CS) .and. & + (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%MLD_filtered_slow(i,j) = H_rescale * CS%MLD_filtered_slow(i,j) + enddo ; enddo + endif + endif + ! If MLD_filtered is being used, we need to update halo regions after a restart if (associated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) @@ -899,7 +925,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure - type(MOM_restart_CS), pointer :: restart_CS !< Restart structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! Local variables type(vardesc) :: vd logical :: mixedlayer_restrat_init diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index fd05c4a5a2..982b73698f 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -86,7 +86,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean - ! sea level,in H units, positive up. + ! sea level, in Z, positive up. real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! uhD & vhD are the diffusive u*h & real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! v*h fluxes (m2 H s-1) @@ -111,7 +111,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS KH_v_CFL ! The maximum stable interface height diffusivity at v grid points (m2 s-1) real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity (m2/s) - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) @@ -130,7 +129,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H if (associated(MEKE)) then if (associated(MEKE%GM_src)) then @@ -162,7 +160,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ! Calculates interface heights, e, in m. - call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=1) + call find_eta(h, tv, G, GV, e, halo_size=1) ! Set the diffusivities. !$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, & @@ -376,7 +374,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS do j=js,je ; do i=is,ie h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) - if (h(i,j,k) < GV%Angstrom) h(i,j,k) = GV%Angstrom + if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo enddo @@ -402,15 +400,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces !! at v points (m2/s) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m3/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m3/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m2 H s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m2 H s-1) real, dimension(:,:), pointer :: cg1 !< Wave speed (m/s) real, intent(in) :: dt !< Time increment (s) type(MEKE_type), pointer :: MEKE !< MEKE control structue @@ -425,6 +423,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! density gradients. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points + ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -434,12 +433,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself, when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt, in m3 s-1. + ! by dt, in H m2 s-1. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer, ND. 0 0.0) & h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1) @@ -587,7 +583,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & !$OMP uhD,h_avail,G_scale,work_u,CS,slope_x,cg1, & !$OMP diag_sfn_x, diag_sfn_unlim_x,N2_floor, & -!$OMP present_slope_x,H_to_m,m_to_H,G_rho0) & +!$OMP present_slope_x,G_rho0) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -644,7 +640,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * H_to_m ; dzaR = haR * H_to_m + dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect @@ -663,8 +659,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haB = 0.5*(h(i,j,k) + h(i+1,j,k)) + h_neglect ! hN2_u is used with the FGNV streamfunction formulation - hN2_u(I,K) = (0.5 * H_to_m * ( hg2A / haA + hg2B / haB )) * & - max(drdz*G_rho0 , N2_floor) + hN2_u(I,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * & + max(drdz*G_rho0, N2_floor) endif if (present_slope_x) then Slope = slope_x(I,j,k) @@ -679,7 +675,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + drdz**2 + mag_grad2 = drdx**2 + (GV%m_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -693,13 +689,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * GV%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface (m3 s-1). - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -725,10 +721,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = GV%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope) hN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -741,9 +737,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn) then do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(I,j)>0.) then - h_harm = H_to_m * max( h_neglect, & + h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) - c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / h_harm + c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -764,9 +760,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (uhtot(I,j) <= 0.0) then ! The transport that must balance the transport below is positive. - Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * H_to_m + Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z else ! (uhtot(I,j) > 0.0) - Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * H_to_m + Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * GV%H_to_Z endif ! The actual streamfunction at each interface. @@ -777,7 +773,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * m_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) + Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. @@ -819,7 +815,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! A second order centered estimate is used for the density transfered ! between water columns. - Work_u(I,j) = Work_u(I,j) + ( G_scale * H_to_m ) * & + Work_u(I,j) = Work_u(I,j) + G_scale * & ( uhtot(I,j) * drdkDe_u(I,K) - & (uhD(I,j,K) * drdi_u(I,K)) * 0.25 * & ((e(i,j,K) + e(i,j,K+1)) + (e(i+1,j,K) + e(i+1,j,K+1))) ) @@ -836,7 +832,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & !$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1, & !$OMP diag_sfn_y, diag_sfn_unlim_y,N2_floor, & -!$OMP present_slope_y,m_to_H,H_to_m,G_rho0) & +!$OMP present_slope_y,G_rho0) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -890,7 +886,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * H_to_m ; dzaR = haR * H_to_m + dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect @@ -909,8 +905,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haB = 0.5*(h(i,j,k) + h(i,j+1,k)) + h_neglect ! hN2_v is used with the FGNV streamfunction formulation - hN2_v(i,K) = (0.5 * H_to_m * ( hg2A / haA + hg2B / haB )) * & - max(drdz*G_rho0 , N2_floor) + hN2_v(i,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * & + max(drdz*G_rho0, N2_floor) endif if (present_slope_y) then Slope = slope_y(i,J,k) @@ -925,7 +921,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + drdz**2 + mag_grad2 = drdy**2 + (GV%m_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -939,13 +935,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * GV%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface (m3 s-1). - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -971,10 +967,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = GV%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope) hN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -987,9 +983,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn) then do k=1,nz ; do i=is,ie ; if (G%mask2dCv(i,J)>0.) then - h_harm = H_to_m * max( h_neglect, & + h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) - c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / h_harm + c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1010,9 +1006,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (vhtot(i,J) <= 0.0) then ! The transport that must balance the transport below is positive. - Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * H_to_m + Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z else ! (vhtot(I,j) > 0.0) - Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * H_to_m + Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * GV%H_to_Z endif ! The actual streamfunction at each interface. @@ -1023,7 +1019,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * m_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) + Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. @@ -1065,7 +1061,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! A second order centered estimate is used for the density transfered ! between water columns. - Work_v(i,J) = Work_v(i,J) + ( G_scale * H_to_m ) * & + Work_v(i,J) = Work_v(i,J) + G_scale * & ( vhtot(i,J) * drdkDe_v(i,K) - & (vhD(i,J,K) * drdj_v(i,K)) * 0.25 * & ((e(i,j,K) + e(i,j,K+1)) + (e(i,j+1,K) + e(i,j+1,K+1))) ) @@ -1098,7 +1094,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV drdiB = drho_dT_u(I) * (T(i+1,j,1)-T(i,j,1)) + & drho_dS_u(I) * (S(i+1,j,1)-S(i,j,1)) endif - Work_u(I,j) = Work_u(I,j) + ( G_scale * H_to_m ) * & + Work_u(I,j) = Work_u(I,j) + G_scale * & ( (uhD(I,j,1) * drdiB) * 0.25 * & ((e(i,j,1) + e(i,j,2)) + (e(i+1,j,1) + e(i+1,j,2))) ) @@ -1123,7 +1119,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV drdjB = drho_dT_v(i) * (T(i,j+1,1)-T(i,j,1)) + & drho_dS_v(i) * (S(i,j+1,1)-S(i,j,1)) endif - Work_v(i,J) = Work_v(i,J) - ( G_scale * H_to_m ) * & + Work_v(i,J) = Work_v(i,J) - G_scale * & ( (vhD(i,J,1) * drdjB) * 0.25 * & ((e(i,j,1) + e(i,j,2)) + (e(i,j+1,1) + e(i,j+1,2))) ) enddo @@ -1154,7 +1150,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) integer, intent(in) :: nk !< Number of layers real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers (m s-2) real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces (m s-2) - real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (m3 s-1) + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (Z m2 s-1 or arbitrary units) !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables @@ -1188,7 +1184,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces @@ -1248,7 +1244,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real :: sl_Kp1 ! The sign-corrected slope of the interface below, ND. real :: I_sl_K ! The (limited) inverse of sl_K, ND. real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1, ND. - real :: I_4t ! A quarter of inverse of the damping timescale, in s-1. + real :: I_4t ! A quarter of a unit conversion factor divided by + ! the damping timescale, in s-1. real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1. real :: denom, I_denom ! A denominator and its inverse, various units. real :: Kh_min ! A local floor on the diffusivity, in m2 s-1. @@ -1344,7 +1341,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Limit the diffusivities - I_4t = Kh_scale / (4.0*dt) + I_4t = GV%Z_to_m*Kh_scale / (4.0*dt) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1387,7 +1384,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i+1,j,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0 ; if (dH < 0) sign = -1.0 + sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) @@ -1410,7 +1407,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i,j+1,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0 ; if (dH < 0) sign = -1.0 + sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) @@ -1604,10 +1601,10 @@ end subroutine add_detangling_Kh subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature (C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity (ppt) - real, intent(in) :: kappa !< Constant diffusivity to use (m2/s) + real, intent(in) :: kappa !< Constant diffusivity to use (Z2/s) real, intent(in) :: dt !< Time increment (s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity (ppt) @@ -1636,8 +1633,8 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke h_neglect = GV%H_subroundoff - kap_dt_x2 = (2.0*kappa*dt)*GV%m_to_H**2 - h0 = 1.0e-16*sqrt(kappa*dt)*GV%m_to_H + kap_dt_x2 = (2.0*kappa*dt)*GV%Z_to_H**2 + h0 = 1.0e-16*sqrt(kappa*dt)*GV%Z_to_H if (kap_dt_x2 <= 0.0) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,T_f,T_in,S_f,S_in) @@ -1745,7 +1742,7 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & - default=1.0e-6) + default=1.0e-6, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of\n"// & "Ferrari et al., 2010, which effectively emphasizes\n"//& @@ -1821,9 +1818,11 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) CS%id_sfn_y = register_diag_field('ocean_model', 'GM_sfn_y', diag%axesCvi, Time, & 'Parameterized Meridional Overturning Streamfunction', 'm3 s-1') CS%id_sfn_unlim_x = register_diag_field('ocean_model', 'GM_sfn_unlim_x', diag%axesCui, Time, & - 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', 'm3 s-1') + 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', & + 'm3 s-1', conversion=GV%Z_to_m) CS%id_sfn_unlim_y = register_diag_field('ocean_model', 'GM_sfn_unlim_y', diag%axesCvi, Time, & - 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', 'm3 s-1') + 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', & + 'm3 s-1', conversion=GV%Z_to_m) end subroutine thickness_diffuse_init diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 95c9b10047..a552bfe1ca 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -393,28 +393,31 @@ end subroutine tidal_forcing_sensitivity !> This subroutine calculates the geopotential anomalies that drive the tides, !! including self-attraction and loading. Optionally, it also returns the !! partial derivative of the local geopotential height with the input sea surface -!! height. For now, eta and eta_tidal are both geopotential heights in m, but -!! probably the input for eta should really be replaced with the column mass -!! anomalies. -subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) +!! height. For now, eta and eta_tidal are both geopotential heights in depth +!! units, but probably the input for eta should really be replaced with the +!! column mass anomalies. +subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to_Z) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< The time for the caluculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from - !! a time-mean geoid in m. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential - !! anomalies, in m. + !! a time-mean geoid in depth units (Z). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height + !! anomalies, in depth units (Z). type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of !! eta_tidal with the local value of !! eta, nondim. + real, optional, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. + ! Local variables real :: eta_astro(SZI_(G),SZJ_(G)) real :: eta_SAL(SZI_(G),SZJ_(G)) real :: now ! The relative time in seconds. real :: amp_cosomegat, amp_sinomegat real :: cosomegat, sinomegat - real :: eta_prop + real :: m_Z ! A scaling factor from m to depth units. + real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal. integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -447,10 +450,12 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) enddo ; enddo endif + m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z + do c=1,CS%nc m = CS%struct(c) - amp_cosomegat = CS%amp(c)*CS%love_no(c)*cos(CS%freq(c)*now + CS%phase0(c)) - amp_sinomegat = CS%amp(c)*CS%love_no(c)*sin(CS%freq(c)*now + CS%phase0(c)) + amp_cosomegat = m_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) + amp_sinomegat = m_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + & amp_sinomegat*CS%sin_struct(i,j,m)) @@ -461,7 +466,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) + CS%ampsal(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) + m_Z*CS%ampsal(i,j,c) * & (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c)) enddo ; enddo enddo ; endif @@ -470,8 +475,8 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) - CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & - (cosomegat*CS%cosphase_prev(i,j,c)+sinomegat*CS%sinphase_prev(i,j,c)) + eta_tidal(i,j) = eta_tidal(i,j) - m_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & + (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c)) enddo ; enddo enddo ; endif diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index ec285072ed..c842b813c9 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -18,10 +18,11 @@ module MOM_ALE_sponge use MOM_error_handler, only : MOM_error, FATAL, NOTE, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer use MOM_spatial_means, only : global_i_mean use MOM_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping -use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer +use MOM_verticalGrid, only : verticalGrid_type ! GMM - Planned extension: Support for time varying sponge targets. implicit none ; private @@ -139,7 +140,8 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ !! to parse for model parameter values (in). type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module (in/out). - real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. + real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge + !! input layers, in thickness units (H). ! This include declares and sets the variable "version". @@ -330,7 +332,7 @@ end function get_ALE_sponge_nz_data subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). real, allocatable, dimension(:,:,:), & - intent(inout) :: data_h !< The thicknesses of the sponge input layers. + intent(inout) :: data_h !< The thicknesses of the sponge input layers, in H. logical, dimension(SZI_(G),SZJ_(G)), & intent(out) :: sponge_mask !< A logical mask that is true where !! sponges are being applied. @@ -666,10 +668,10 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 do k=1,nz_data if (mask_z(CS%col_i(col),CS%col_j(col),k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(CS%col_i(col),CS%col_j(col)) ) + zBottomOfCell = -min( z_edges_in(k+1), G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ) ! tmpT1d(k) = sp_val(CS%col_i(col),CS%col_j(col),k) elseif (k>1) then - zBottomOfCell = -G%bathyT(CS%col_i(col),CS%col_j(col)) + zBottomOfCell = -G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ! tmpT1d(k) = tmpT1d(k-1) ! else ! This next block should only ever be reached over land ! tmpT1d(k) = -99.9 @@ -679,7 +681,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model - hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) + hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ) CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0. CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24 CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data) @@ -736,7 +738,8 @@ end subroutine set_up_ALE_sponge_vel_field_fixed !> This subroutine stores the reference profile at uand v points for the variable !! whose address is given by u_ptr and v_ptr. -subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v,fieldname_v, Time, G, CS, u_ptr, v_ptr) +subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename_v, fieldname_v, & + Time, G, CS, u_ptr, v_ptr) character(len=*), intent(in) :: filename_u !< File name for u field character(len=*), intent(in) :: fieldname_u !< Name of u variable in file character(len=*), intent(in) :: filename_v !< File name for v field @@ -835,7 +838,7 @@ end subroutine set_up_ALE_sponge_vel_field_varying subroutine apply_ALE_sponge(h, dt, G, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness, in m (in) + intent(inout) :: h !< Layer thickness, in H (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge (in). diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 3253003119..dec3187a99 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -170,11 +170,12 @@ module MOM_CVMix_KPP !> Initialize the CVMix KPP module and set up diagnostics !! Returns True if KPP is to be used, False otherwise. -logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) +logical function KPP_init(paramFile, G, GV, diag, Time, CS, passive, Waves) ! Arguments type(param_file_type), intent(in) :: paramFile !< File parser type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(diag_ctrl), target, intent(in) :: diag !< Diagnostics type(time_type), intent(in) :: Time !< Model time type(KPP_CS), pointer :: CS !< Control structure @@ -493,7 +494,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s') + 'Diffusivity passed to KPP', 'm2/s', conversion=GV%Z_to_m**2) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & @@ -533,7 +534,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) CS%Vt2(:,:,:) = 0. if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) - allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) );CS%OBLdepthprev(:,:)=0.0 + allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) ) ; CS%OBLdepthprev(:,:) = 0.0 if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) ) @@ -581,12 +582,12 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) - !< (out) Vertical viscosity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (Z2/s) + !< (out) Vertical diffusivity including KPP (Z2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (Z2/s) + !< (out) Vertical diffusivity including KPP (Z2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (Z2/s) + !< (out) Vertical viscosity including KPP (Z2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) @@ -612,8 +613,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=GV%Z_to_m**2) endif #endif @@ -621,9 +622,7 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) - !$OMP parallel do default(private) firstprivate(nonLocalTrans) & - !$OMP shared(G,GV,CS,uStar,h,Waves,& - !$OMP buoyFlux,nonLocalTransHeat,nonLocalTransScalar,Kt,Ks,Kv) + !$OMP parallel do default(shared) firstprivate(nonLocalTrans) ! loop over horizontal points on processor do j = G%jsc, G%jec do i = G%isc, G%iec @@ -671,9 +670,9 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) Kviscosity(:) = 0. ! Viscosity (m2/s) else - Kdiffusivity(:,1) = Kt(i,j,:) - Kdiffusivity(:,2) = Ks(i,j,:) - Kviscosity(:)=Kv(i,j,:) + Kdiffusivity(:,1) = GV%Z_to_m**2 * Kt(i,j,:) + Kdiffusivity(:,2) = GV%Z_to_m**2 * Ks(i,j,:) + Kviscosity(:) = GV%Z_to_m**2 * Kv(i,j,:) endif call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity (m2/s) @@ -814,17 +813,17 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k)=Kv(i,j,k) + Kt(i,j,k) = Kt(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,2) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k)=Kv(i,j,k) + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,2) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m_to_Z**2 * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo endif endif @@ -837,8 +836,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then - call hchksum(Kt, "KPP out: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP out: Ks",G%HI,haloshift=0) + call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif #endif @@ -865,7 +864,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, ! Arguments type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) @@ -931,7 +930,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, #endif ! some constants - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 ! loop over horizontal points on processor !$OMP parallel do default(shared) @@ -1309,7 +1308,7 @@ end subroutine KPP_compute_BLD subroutine KPP_smooth_BLD(CS,G,GV,h) ! Arguments type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 74fc2d6f2d..851951af3e 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -132,9 +132,9 @@ logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2') CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & - 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s') + 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & - 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s') + 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2) call CVMix_init_conv(convect_diff=CS%kd_conv_const, & convect_visc=CS%kv_conv_const, & @@ -160,13 +160,15 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) !! computed based on Brunt Vaisala. real, dimension(SZK_(G)) :: rho_1d !< water density in a column, this is also !! a dummy variable, same reason as above. + real, dimension(SZK_(G)+1) :: kv_col !< Viscosities at interfaces in the column (m2 s-1) + real, dimension(SZK_(G)+1) :: kd_col !< Diffusivities at interfaces in the column (m2 s-1) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) integer :: kOBL !< level of OBL extent real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k - g_o_rho0 = GV%g_Earth / GV%Rho0 + g_o_rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 @@ -215,8 +217,9 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) ! gets index of the level and interface above hbl kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call CVMix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & - Tdiff_out=CS%kd_conv(i,j,:), & + kv_col(:) = 0.0 ; kd_col(:) = 0.0 + call CVMix_coeffs_conv(Mdiff_out=kv_col(:), & + Tdiff_out=kd_col(:), & Nsqr=CS%N2(i,j,:), & dens=rho_1d(:), & dens_lwr=rho_lwr(:), & @@ -224,11 +227,15 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) max_nlev=G%ke, & OBL_ind=kOBL) - ! Do not apply mixing due to convection within the boundary layer - do k=1,kOBL - CS%kv_conv(i,j,k) = 0.0 - CS%kd_conv(i,j,k) = 0.0 - enddo + do K=1,G%ke+1 + CS%kv_conv(i,j,K) = GV%m_to_Z**2 * kv_col(K) + CS%kd_conv(i,j,K) = GV%m_to_Z**2 * kd_col(K) + enddo + ! Do not apply mixing due to convection within the boundary layer + do k=1,kOBL + CS%kv_conv(i,j,k) = 0.0 + CS%kd_conv(i,j,k) = 0.0 + enddo enddo enddo diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 117c958acb..eabce5056b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -46,8 +46,8 @@ module MOM_CVMix_ddiff !!@} ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (m2/s) - real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (m2/s) +! real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (Z2/s) +! real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (Z2/s) real, allocatable, dimension(:,:,:) :: R_rho !< Double-diffusion density ratio (nondim) end type CVMix_ddiff_cs @@ -136,10 +136,10 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) CS%diag => diag CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & 'Double-diffusion density ratio', 'nondim') @@ -167,9 +167,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). + !! diffusivity for temp (Z2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt (m2/sec). + !! diffusivity for salt (Z2/sec). type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. integer, intent(in) :: j !< Meridional grid indice. @@ -185,6 +185,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) beta_dS, & !< beta*dS across interfaces dT, & !< temp. difference between adjacent layers (degC) dS !< salt difference between adjacent layers + real, dimension(SZK_(G)+1) :: & + Kd1_T, & !< Diapycanal diffusivity of temperature, in m2 s-1. + Kd1_S !< Diapycanal diffusivity of salinity, in m2 s-1. real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) integer :: kOBL !< level of OBL extent @@ -196,8 +199,6 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) alpha_dT(:) = 0.0; beta_dS(:) = 0.0; dRho_dT(:) = 0.0 dRho_dS(:) = 0.0; dT(:) = 0.0; dS(:) = 0.0 - ! set Kd_T and Kd_S to zero to avoid passing values from previous call - Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 ! GMM, I am leaving some code commented below. We need to pass BLD to ! this soubroutine to avoid adding diffusivity above that. This needs @@ -263,12 +264,17 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) ! gets index of the level and interface above hbl !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call CVMix_coeffs_ddiff(Tdiff_out=Kd_T(i,j,:), & - Sdiff_out=Kd_S(i,j,:), & + Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0 + call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), & + Sdiff_out=Kd1_S(:), & strat_param_num=alpha_dT(:), & strat_param_denom=beta_dS(:), & nlev=G%ke, & max_nlev=G%ke) + do K=1,G%ke+1 + Kd_T(i,j,K) = GV%m_to_Z**2 * Kd1_T(K) + Kd_S(i,j,K) = GV%m_to_Z**2 * Kd1_S(K) + enddo ! Do not apply mixing due to convection within the boundary layer !do k=1,kOBL diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 6f73d7984c..d80ccf1114 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -22,7 +22,7 @@ module MOM_CVMix_shear public calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_is_used, CVMix_shear_end !> Control structure including parameters for CVMix interior shear schemes. -type, public :: CVMix_shear_cs +type, public :: CVMix_shear_cs ! TODO: private logical :: use_LMD94 !< Flags to use the LMD94 scheme logical :: use_PP81 !< Flags to use Pacanowski and Philander (JPO 1981) logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter @@ -50,8 +50,7 @@ module MOM_CVMix_shear contains !> Subroutine for calculating (internal) vertical diffusivities/viscosities -subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & - kv, G, GV, CS ) +subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. @@ -59,9 +58,9 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables @@ -69,11 +68,13 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real :: GoRho real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d - real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number + real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number + real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces (m2/s) + real, dimension(G%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces (m2/s) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 do j = G%jsc, G%jec do i = G%isc, G%iec @@ -147,23 +148,31 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & if (CS%id_ri_grad_smooth > 0) CS%ri_grad_smooth(i,j,:) = Ri_Grad(:) endif + do K=1,G%ke+1 + Kvisc(K) = GV%Z_to_m**2 * kv(i,j,K) + Kdiff(K) = GV%Z_to_m**2 * kd(i,j,K) + enddo ! Call to CVMix wrapper for computing interior mixing coefficients. - call CVMix_coeffs_shear(Mdiff_out=kv(i,j,:), & - Tdiff_out=kd(i,j,:), & + call CVMix_coeffs_shear(Mdiff_out=Kvisc(:), & + Tdiff_out=Kdiff(:), & RICH=Ri_Grad(:), & nlev=G%ke, & max_nlev=G%ke) + do K=1,G%ke+1 + kv(i,j,K) = GV%m_to_Z**2 * Kvisc(K) + kd(i,j,K) = GV%m_to_Z**2 * Kdiff(K) + enddo enddo enddo ! write diagnostics - if (CS%id_kd > 0) call post_data(CS%id_kd,kd, CS%diag) - if (CS%id_kv > 0) call post_data(CS%id_kv,kv, CS%diag) - if (CS%id_N2 > 0) call post_data(CS%id_N2,CS%N2, CS%diag) - if (CS%id_S2 > 0) call post_data(CS%id_S2,CS%S2, CS%diag) - if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad,CS%ri_grad, CS%diag) - if (CS%id_ri_grad_smooth > 0) call post_data(CS%id_ri_grad_smooth,CS%ri_grad_smooth, CS%diag) + if (CS%id_kd > 0) call post_data(CS%id_kd, kd, CS%diag) + if (CS%id_kv > 0) call post_data(CS%id_kv, kv, CS%diag) + if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) + if (CS%id_S2 > 0) call post_data(CS%id_S2, CS%S2, CS%diag) + if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad, CS%ri_grad, CS%diag) + if (CS%id_ri_grad_smooth > 0) call post_data(CS%id_ri_grad_smooth ,CS%ri_grad_smooth, CS%diag) end subroutine calculate_CVMix_shear @@ -248,29 +257,33 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2') - if (CS%id_N2 > 0) & - allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%N2(:,:,:) = 0. + if (CS%id_N2 > 0) then + allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%N2(:,:,:) = 0. + endif CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & 'Square of vertical shear used by MOM_CVMix_shear module','1/s2') - if (CS%id_S2 > 0) & - allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%S2(:,:,:) = 0. + if (CS%id_S2 > 0) then + allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%S2(:,:,:) = 0. + endif CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, & 'Gradient Richarson number used by MOM_CVMix_shear module','nondim') - if (CS%id_ri_grad > 0) & !Initialize w/ large Richardson value - allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad(:,:,:) = 1.e8 + if (CS%id_ri_grad > 0) then !Initialize w/ large Richardson value + allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad(:,:,:) = 1.e8 + endif CS%id_ri_grad_smooth = register_diag_field('ocean_model', 'ri_grad_shear_smooth', & diag%axesTi, Time, & 'Smoothed gradient Richarson number used by MOM_CVMix_shear module','nondim') - if (CS%id_ri_grad_smooth > 0) & !Initialize w/ large Richardson value - allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad_smooth(:,:,:) = 1.e8 + if (CS%id_ri_grad_smooth > 0) then !Initialize w/ large Richardson value + allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad_smooth(:,:,:) = 1.e8 + endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & - 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s') + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & - 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s') + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) end function CVMix_shear_init diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 8e7256cfe2..19181b1bf9 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -30,7 +30,7 @@ module MOM_bkgnd_mixing public sfc_bkgnd_mixing !> Control structure including parameters for this module. -type, public :: bkgnd_mixing_cs +type, public :: bkgnd_mixing_cs ! TODO: private ! Parameters real :: Bryan_Lewis_c1 !< The vertical diffusivity values for Bryan-Lewis profile @@ -49,8 +49,8 @@ module MOM_bkgnd_mixing !! horiz_varying_background=.true. real :: bckgrnd_vdc_ban !< Banda Sea diffusivity (Gordon) when !! horiz_varying_background=.true. - real :: Kd_min !< minimum diapycnal diffusivity (m2/s) - real :: Kd !< interior diapycnal diffusivity (m2/s) + real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) + real :: Kd !< interior diapycnal diffusivity (Z2/s) real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the !! Henyey scaling from the mixing @@ -59,10 +59,9 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness (meter) when - !! bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness (Z) when bulkmixedlayer==.false. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on !! latitude, like GFDL CM2.1/CM2M. There is no !! physical justification for this form, and it can @@ -96,10 +95,10 @@ module MOM_bkgnd_mixing integer :: id_kd_bkgnd = -1 !< Diagnotic IDs integer :: id_kv_bkgnd = -1 !< Diagnostic IDs - real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (m2/s) + real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (Z2/s) ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (m2/s) - real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (m2/s) + real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (Z2/s) + real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (Z2/s) character(len=40) :: bkgnd_scheme_str = "none" !< Background scheme identifier @@ -141,7 +140,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KV", Kv, & "The background kinematic viscosity in the interior. \n"//& @@ -150,7 +149,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd) + units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) ! The following is needed to set one of the choices of vertical background mixing @@ -170,11 +169,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd) + units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& - "mixed layer is not used.", units="m", fail_if_missing=.true.) + "mixed layer is not used.", units="m", scale=GV%m_to_Z, fail_if_missing=.true.) endif call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) @@ -224,22 +223,22 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "BCKGRND_VDC1", & CS%bckgrnd_vdc1, & "Background diffusivity (Ledwell) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.16e-04) + units="m2 s-1",default = 0.16e-04, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "BCKGRND_VDC_EQ", & CS%bckgrnd_vdc_eq, & "Equatorial diffusivity (Gregg) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.01e-04) + units="m2 s-1",default = 0.01e-04, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", & CS%bckgrnd_vdc_psim, & "Max. PSI induced diffusivity (MacKinnon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.13e-4) + units="m2 s-1",default = 0.13e-4, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "BCKGRND_VDC_BAN", & CS%bckgrnd_vdc_ban, & "Banda Sea diffusivity (Gordon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 1.0e-4) + units="m2 s-1",default = 1.0e-4, scale=GV%m_to_Z**2) endif call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & @@ -314,18 +313,19 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) ! Register diagnostics CS%diag => diag CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & - 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s') + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & - 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s') + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2) end subroutine bkgnd_mixing_init !> Get surface vertical background diffusivities/viscosities. -subroutine sfc_bkgnd_mixing(G, CS) +subroutine sfc_bkgnd_mixing(G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by - !! a previous call to bkgnd_mixing_init. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by + !! a previous call to bkgnd_mixing_init. ! local variables real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. @@ -368,33 +368,34 @@ subroutine sfc_bkgnd_mixing(G, CS) enddo ; enddo endif - if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0) + if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=GV%Z_to_m**2) end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities -subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) +subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay!< squared buoyancy frequency associated + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay!< Diapycnal diffusivity of each layer m2 s-1. - real, dimension(:,:,:), pointer :: kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. - integer, intent(in) :: j !< Meridional grid indice. - type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer Z2 s-1. + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + !! (not layer!) in Z2 s-1 + integer, intent(in) :: j !< Meridional grid index + type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. ! local variables - real, dimension(SZI_(G), SZK_(G)+1) :: depth_2d !< distance from surface of an interface (m) - real, dimension(SZI_(G)) :: & - depth !< distance from surface of an interface (meter) - real :: depth_c !< depth of the center of a layer (meter) - real :: I_Hmix !< inverse of fixed mixed layer thickness (1/m) + real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces (m) + real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces (m2 s-1) + real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces (m2 s-1) + real, dimension(SZI_(G)) :: depth !< distance from surface of an interface (Z) + real :: depth_c !< depth of the center of a layer (Z) + real :: I_Hmix !< inverse of fixed mixed layer thickness (1/Z) real :: I_2Omega !< 1/(2 Omega) (sec) real :: N_2Omega real :: N02_N2 @@ -412,48 +413,50 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) deg_to_rad = atan(1.0)/45.0 ! = PI/180 epsilon = 1.e-10 - depth_2d(:,:) = 0.0 ! Set up the background diffusivity. if (CS%Bryan_Lewis_diffusivity) then do i=is,ie + depth_int(1) = 0.0 do k=2,nz+1 - depth_2d(i,k) = depth_2d(i,k-1) + GV%H_to_m*h(i,j,k-1) + depth_int(k) = depth_int(k-1) + GV%H_to_m*h(i,j,k-1) enddo call CVMix_init_bkgnd(max_nlev=nz, & - zw = depth_2d(i,:), & !< interface depth, must be positive. + zw = depth_int(:), & !< interface depths relative to the surface in m, must be positive. bl1 = CS%Bryan_Lewis_c1, & bl2 = CS%Bryan_Lewis_c2, & bl3 = CS%Bryan_Lewis_c3, & bl4 = CS%Bryan_Lewis_c4, & prandtl = CS%prandtl_bkgnd) - call CVMix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & - Tdiff_out=CS%kd_bkgnd(i,j,:), & - nlev=nz, & - max_nlev=nz) + Kd_col(:) = 0.0 ; Kv_col(:) = 0.0 ! Is this line necessary? + call CVMix_coeffs_bkgnd(Mdiff_out=Kv_col, Tdiff_out=Kd_col, nlev=nz, max_nlev=nz) - ! Update Kd + ! Update Kd and Kv. + do K=1,nz+1 + CS%Kv_bkgnd(i,j,K) = GV%m_to_Z**2*Kv_col(K) + CS%Kd_bkgnd(i,j,K) = GV%m_to_Z**2*Kd_col(K) + enddo do k=1,nz - kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(CS%kd_bkgnd(i,j,K) + CS%kd_bkgnd(i,j,K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & - (.not. CS%horiz_varying_background) .and. (CS%Kd/= CS%Kdml)) then + (.not. CS%horiz_varying_background) .and. (CS%Kd /= CS%Kdml)) then I_Hmix = 1.0 / CS%Hmix do i=is,ie ; depth(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - depth_c = depth(i) + 0.5*GV%H_to_m*h(i,j,k) - if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml - elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) + depth_c = depth(i) + 0.5*GV%H_to_Z*h(i,j,k) + if (depth_c <= CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kdml + elseif (depth_c >= 2.0*CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & - (2.0*CS%Kdml - CS%Kd_sfc(i,j)) + Kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif - depth(i) = depth(i) + GV%H_to_m*h(i,j,k) + depth(i) = depth(i) + GV%H_to_Z*h(i,j,k) enddo ; enddo elseif (CS%horiz_varying_background) then @@ -505,13 +508,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - kd_lay(i,j,k) = CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = CS%Kd_sfc(i,j) enddo ; enddo endif @@ -521,19 +524,17 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) - CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd + CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) + CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo endif - ! Update kv + ! Update Kv if (associated(kv)) then - do i=is,ie - do k=1,nz+1 - kv(i,j,k) = kv(i,j,k) + CS%kv_bkgnd(i,j,k) - enddo - enddo + do k=1,nz+1 ; do i=is,ie + Kv(i,j,k) = Kv(i,j,k) + CS%Kv_bkgnd(i,j,k) + enddo ; enddo endif ! TODO: In both CS%Bryan_Lewis_diffusivity and CS%horiz_varying_background, KV and KD at surface diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 1974249df1..eb7dae1590 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -42,13 +42,13 @@ module MOM_bulk_mixed_layer !! the mixed layer is converted to TKE, nondim. real :: bulk_Ri_convective !< The efficiency with which convectively !! released mean kinetic energy becomes TKE, nondim. - real :: Hmix_min !< The minimum mixed layer thickness in m. + real :: Hmix_min !< The minimum mixed layer thickness in H. real :: H_limit_fluxes !< When the total ocean depth is less than this - !! value, in m, scale away all surface forcing to + !! value, in H, scale away all surface forcing to !! avoid boiling the ocean. - real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in m s-1. If the value is small enough, - !! this should not affect the solution. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems, + !! in Z s-1. If the value is small enough, this should + !! not affect the solution. real :: omega !< The Earth's rotation rate, in s-1. real :: dT_dS_wt !< When forced to extrapolate T & S to match the !! layer densities, this factor (in deg C / PSU) is @@ -81,8 +81,8 @@ module MOM_bulk_mixed_layer type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. logical :: TKE_diagnostics = .false. !< If true, calculate extensive diagnostics of the TKE budget logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff - !! at the river mouths to "rivermix_depth" meters - real :: rivermix_depth = 0.0 !< Used if "do_rivermix" = T + !! at the river mouths to rivermix_depth + real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true, in Z. logical :: limit_det !< If true, limit the extent of buffer layer !! detrainment to be consistent with neighbors. real :: lim_det_dH_sfc !< The fractional limit in the change between grid @@ -105,9 +105,9 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, PSU. -! These are terms in the mixed layer TKE budget, all in m3 s-2. + ! These are terms in the mixed layer TKE budget, all in Z m2 s-3. real, allocatable, dimension(:,:) :: & - ML_depth, & !< The mixed layer depth in m. + ML_depth, & !< The mixed layer depth in H. diag_TKE_wind, & !< The wind source of TKE. diag_TKE_RiBulk, & !< The resolved KE source of TKE. diag_TKE_conv, & !< The convective source of TKE. @@ -116,8 +116,8 @@ module MOM_bulk_mixed_layer diag_TKE_conv_decay, & !< The decay of convective TKE. diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. - diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W m-2. - diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W m-2. + diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W Z m-3. + diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W Z m-3. logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass @@ -204,7 +204,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & type(optics_type), pointer :: optics !< The structure containing the inverse of the !! vertical absorption decay scale for !! penetrating shortwave radiation, in m-1. - real, dimension(:,:), pointer :: Hml !< active mixed layer depth + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth, in m. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -286,7 +286,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! new, sorted index space. Here layer 0 is an initially massless layer that ! will be used to hold the new mixed layer properties. real, dimension(SZI_(G),SZK0_(GV)) :: & - h, & ! The layer thickness, in m or kg m-2. + h, & ! The layer thickness, in H (often m or kg m-2). T, & ! The layer temperatures, in deg C. S, & ! The layer salinities, in psu. R0, & ! The potential density referenced to the surface, in kg m-3. @@ -294,7 +294,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real, dimension(SZI_(G),SZK_(GV)) :: & u, & ! The zonal velocity, in m s-1. v, & ! The meridional velocity, in m s-1. - h_orig, & ! The original thickness in m or kg m-2. + h_orig, & ! The original thickness in H (often m or kg m-2). d_eb, & ! The downward increase across a layer in the entrainment from ! below, in H. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. @@ -305,12 +305,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & - h_miss ! The summed absolute mismatch, in m. + h_miss ! The summed absolute mismatch, in Z. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step, in m3 s-2. + ! time step, in Z m2 s-2. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection, in m3 s-2. + ! the depth of free convection, in Z m2 s-2. htot, & ! The total depth of the layers being considered for ! entrainment, in H. R0_tot, & ! The integrated potential density referenced to the surface @@ -346,7 +346,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity, in kg m-3 psu-1. TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a - ! time step, in m3 s-2. + ! time step, in Z m2 s-2. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -365,21 +365,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection, - ! in m3 s-2. + ! in Z m2 s-2. h_CA ! The depth to which convective adjustment has gone in H. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment, in m3 s-2. + ! adjustment, in Z m2 s-2. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment, m3 s-2. + ! adjustment, Z m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) - ! after entrainment but before any buffer layer detrainment, m. + ! after entrainment but before any buffer layer detrainment, in Z. Hsfc_used, & ! The thickness of the surface region after buffer layer - ! detrainment, in units of m. + ! detrainment, in units of Z. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the - ! neighboring water columns, in m. + ! neighboring water columns, in Z. h_sum, & ! The total thickness of the water column, in H. hmbl_prev ! The previous thickness of the mixed and buffer layers, in H. real, dimension(SZI_(G)) :: & @@ -391,16 +391,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real :: H_nbr ! A minimum thickness based on neighboring thicknesses, in H. real :: absf_x_H ! The absolute value of f times the mixed layer thickness, - ! in units of m s-1. - real :: kU_star ! Ustar times the Von Karmen constant, in m s-1. + ! in units of Z s-1. + real :: kU_star ! Ustar times the Von Karmen constant, in Z s-1. real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. integer :: i, j, k, is, ie, js, je, nz, nkmb, n integer :: nsw ! The number of bands of penetrating shortwave radiation. - real :: H_limit_fluxes ! CS%H_limit fluxes converted to units of H. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixed_layer: "//& @@ -422,19 +420,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & Idt = 1.0 / dt Idt_diag = 1.0 / dt__diag write_diags = .true. ; if (present(last_call)) write_diags = last_call - H_limit_fluxes = CS%H_limit_fluxes * GV%m_to_H p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref nsw = CS%nsw if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then -!$OMP parallel default(none) shared(is,ie,js,je,nkmb,h_sum,hmbl_prev,h_3d,nz) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 h_sum(i,j) = 0.0 ; hmbl_prev(i,j) = 0.0 enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 do k=1,nkmb ; do i=is-1,ie+1 h_sum(i,j) = h_sum(i,j) + h_3d(i,j,k) @@ -444,7 +440,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & h_sum(i,j) = h_sum(i,j) + h_3d(i,j,k) enddo ; enddo enddo -!$OMP end parallel call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_h_sum_hmbl_prev, h_sum,G%Domain) @@ -459,9 +454,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & reset_diags = .false. ! This is the second call to mixedlayer. if (reset_diags) then -!$OMP parallel default(none) shared(is,ie,js,je,CS) if (CS%TKE_diagnostics) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_RiBulk(i,j) = 0.0 CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_pen_SW(i,j) = 0.0 @@ -470,18 +464,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & enddo ; enddo endif if (allocated(CS%diag_PE_detrain)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_PE_detrain(i,j) = 0.0 enddo ; enddo endif if (allocated(CS%diag_PE_detrain2)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_PE_detrain2(i,j) = 0.0 enddo ; enddo endif -!$OMP end parallel endif if (CS%ML_resort) then @@ -503,7 +496,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & do k=1,nz ; do i=is,ie h(i,k) = h_3d(i,j,k) ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) h_orig(i,k) = h_3d(i,j,k) - eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom + eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) do n=1,nsw opacity_band(n,i,k) = GV%H_to_m*optics%opacity_band(n,i,j,k) @@ -567,7 +560,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth*GV%g_Earth*Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*GV%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -587,7 +580,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! net_salt = salt ( g(salt)/m2 for non-Bouss and ppt*m/s for Bouss ) via surface fluxes ! Pen_SW_bnd = components to penetrative shortwave radiation call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & + CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h(:,1:), T(:,1:), netMassInOut, netMassOut, Net_heat, Net_salt, Pen_SW_bnd,& tv, aggregate_FW_forcing) @@ -621,7 +614,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, CS) - call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, CS%H_limit_fluxes, & CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) @@ -641,10 +634,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & h(i,0) = htot(i) endif ; enddo if (write_diags .and. allocated(CS%ML_depth)) then ; do i=is,ie - CS%ML_depth(i,j) = h(i,0) * GV%H_to_m + CS%ML_depth(i,j) = h(i,0) * GV%H_to_m ! Rescale the diagnostic. enddo ; endif if (associated(Hml)) then ; do i=is,ie - Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m) + Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m) ! Rescale the diagnostic for output. enddo ; endif ! At this point, return water to the original layers, but constrained to @@ -678,14 +671,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & hmbl_prev(i,j-1) - dHD*min(h_sum(i,j),h_sum(i,j-1)), & hmbl_prev(i,j+1) - dHD*min(h_sum(i,j),h_sum(i,j+1))) ) - Hsfc_min(i,j) = GV%H_to_m*max(h(i,0), min(Hsfc(i), H_nbr)) + Hsfc_min(i,j) = GV%H_to_Z * max(h(i,0), min(Hsfc(i), H_nbr)) if (CS%limit_det) max_BL_det(i) = max(0.0, Hsfc(i)-H_nbr) enddo endif if (CS%id_Hsfc_max > 0) then ; do i=is,ie - Hsfc_max(i,j) = Hsfc(i)*GV%H_to_m + Hsfc_max(i,j) = GV%H_to_Z * Hsfc(i) enddo ; endif endif @@ -709,9 +702,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,0)*GV%H_to_m ; enddo + do i=is,ie ; Hsfc_used(i,j) = GV%H_to_Z * h(i,0) ; enddo do k=CS%nkml+1,nkmb ; do i=is,ie - Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_m + Hsfc_used(i,j) = Hsfc_used(i,j) + GV%H_to_Z * h(i,k) enddo ; enddo endif @@ -726,20 +719,20 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_Star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_Star = 0.41*GV%m_to_Z*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & - fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) + fluxes%frac_shelf_h(i,j) * (0.41*GV%m_to_Z*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * h(i,0) * & + absf_x_H = 0.25 * GV%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in ! MOM_vert_friction.F90, this line will have to be modified accordingly. h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / & - (kU_star**2)) ) + (kU_star**2)) ) do k=2,CS%nkml ! The other layers are evenly distributed through the mixed layer. h_3d(i,j,k) = (h(i,0)-h_3d(i,j,1)) * Inkmlm1 @@ -795,28 +788,27 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%id_h_mismatch > 0) then do i=is,ie - h_miss(i,j) = abs(h_3d(i,j,1) - (h_orig(i,1) + & + h_miss(i,j) = GV%H_to_Z * abs(h_3d(i,j,1) - (h_orig(i,1) + & (eaml(i,1) + (ebml(i,1) - eaml(i,1+1))))) enddo do k=2,nz-1 ; do i=is,ie - h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,k) - (h_orig(i,k) + & + h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,k) - (h_orig(i,k) + & ((eaml(i,k) - ebml(i,k-1)) + (ebml(i,k) - eaml(i,k+1))))) enddo ; enddo do i=is,ie - h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,nz) - (h_orig(i,nz) + & + h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,nz) - (h_orig(i,nz) + & ((eaml(i,nz) - ebml(i,nz-1)) + ebml(i,nz)))) - h_miss(i,j) = GV%H_to_m * h_miss(i,j) enddo endif enddo ! j loop + !$OMP end parallel ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. ! This needs to happen after the H update and before the next post_data. call diag_update_remap_grids(CS%diag) -!$OMP end parallel if (write_diags) then if (CS%id_ML_depth > 0) & @@ -860,9 +852,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & dKE_CA, cTKE, j, G, GV, CS, nz_conv) 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),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are - !! referred to as H below. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in H (often m or kg m-2). + !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h !! points, m s-1. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h @@ -881,10 +872,10 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer, in H. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in m3 s-2. + !! adjustment, in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment, - !! in m3 s-2. + !! in Z m2 s-2. integer, intent(in) :: j !< The j-index to work on. type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. integer, optional, intent(in) :: nz_conv !< If present, the number of layers @@ -895,27 +886,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! layers and mixed layers to remove hydrostatic instabilities. Any water that ! is lighter than currently in the mixed- or buffer- layer is entrained. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) u - Zonal velocities interpolated to h points, m s-1. -! (in/out) v - Zonal velocities interpolated to h points, m s-1. -! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3. -! (in/out) Rcv - The coordinate defining potential density, in kg m-3. -! (in/out) T - Layer temperatures, in deg C. -! (in/out) S - Layer salinities, in psu. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (out) dKE_CA - The vertically integrated change in kinetic energy due -! to convective adjustment, in m3 s-2. -! (out) cTKE - The buoyant turbulent kinetic energy source due to -! convective adjustment, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. -! (in,opt) nz_conv - If present, the number of layers over which to do -! convective adjustment (perhaps CS%nkml). + ! Local variables real, dimension(SZI_(G)) :: & htot, & ! The total depth of the layers being considered for ! entrainment, in H. @@ -934,13 +905,13 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & h_orig_k1 ! The depth of layer k1 before convective adjustment, in H. real :: h_ent ! The thickness from a layer that is entrained, in H. real :: Ih ! The inverse of a thickness, in H-1. - real :: g_H2_2Rho0 ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the mean density, in m6 s-2 H-2 kg-1. + real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of + ! the conversion from H to Z divided by the mean density, + ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -962,8 +933,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & do i=is,ie if ((h(i,k) > eps(i,k)) .and. (R0_tot(i) > h(i,k1)*R0(i,k))) then h_ent = h(i,k)-eps(i,k) - cTKE(i,k1) = cTKE(i,k1) + (h_ent * g_H2_2Rho0 * & - (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2) + cTKE(i,k1) = cTKE(i,k1) + h_ent * g_H2_2Rho0 * & + (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2 if (k < nkmb) then cTKE(i,k1) = cTKE(i,k1) + cTKE(i,k) dKE_CA(i,k1) = dKE_CA(i,k1) + dKE_CA(i,k) @@ -990,7 +961,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Ih = 1.0 / h(i,k1) R0(i,k1) = R0_tot(i) * Ih u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih - dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_m * (CS%bulk_Ri_convective * & + dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (CS%bulk_Ri_convective * & (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2))) Rcv(i,k1) = Rcv_tot(i) * Ih T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih @@ -1018,7 +989,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & 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),SZK_(GV)), & - intent(inout) :: h !< Layer thickness, in m or kg m-2. + intent(inout) :: h !< Layer thickness, in H (often m or kg m-2). !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: d_eb !< The downward increase across a layer in the @@ -1081,12 +1052,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating !! shortwave radiation, in H-1. !! The indicies of opacity_band are band, i, k. - real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic - !! energy source due to free - !! convection, in m3 s-2. - real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change - !! in kinetic energy due to free - !! convection, in m3 s-2. + real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source + !! due to free convection, in Z m2 s-2. + real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic + !! energy due to free convection, in Z m2 s-2. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. @@ -1107,32 +1076,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! This subroutine causes the mixed layer to entrain to the depth of free ! convection. The depth of free convection is the shallowest depth at which the ! fluid is denser than the average of the fluid above. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (out) htot - The accumulated mixed layer thickness, in H. -! (out) Ttot - The depth integrated mixed layer temperature, in deg C H. -! (out) Stot - The depth integrated mixed layer salinity, in psu H. -! (out) uhtot - The depth integrated mixed layer zonal velocity, H m s-1. -! (out) vhtot - The integrated mixed layer meridional velocity, H m s-1. -! (out) R0_tot - The integrated mixed layer potential density referenced -! to 0 pressure, in kg m-2. -! (out) Rcv_tot - The integrated mixed layer coordinate variable -! potential density, in kg m-2. -! (in) nsw - The number of bands of penetrating shortwave radiation. -! (out) Pen_SW_bnd - The penetrating shortwave heating at the sea surface -! in each penetrating band, in K H, size nsw x SZI_(G). -! (out) Conv_en - The buoyant turbulent kinetic energy source due to -! free convection, in m3 s-2. -! (out) dKE_FC - The vertically integrated change in kinetic energy due -! to free convection, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indices. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. + ! Local variables real, dimension(SZI_(G)) :: & massOutRem, & ! Evaporation that remains to be supplied, in H. netMassIn ! mass entering through ocean surface (H) @@ -1154,9 +1099,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: h_evap ! The thickness that is evaporated, in H. real :: dh_Newt ! The Newton's method estimate of the change in ! h_ent between iterations, in H. - real :: g_H2_2Rho0 ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the mean density, in m6 s-2 H-2 kg-1. + real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of + ! the conversion from H to Z divided by the mean density, + ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS real :: Angstrom ! The minimum layer thickness, in H. real :: opacity ! The opacity converted to units of H-1. real :: sum_Pen_En ! The potential energy change due to penetrating @@ -1169,9 +1114,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & C2, & ! Temporary variable with units of kg m-3 H-1. r_SW_top ! Temporary variables with units of H kg m-3. - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) Idt = 1.0/dt is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1388,7 +1333,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (h_ent > 0.0) then if (htot(i) > 0.0) & dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * & - ((GV%H_to_m*h_ent) / (htot(i)*(h_ent+htot(i)))) * & + ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) htot(i) = htot(i) + h_ent @@ -1411,34 +1356,33 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, j, ksort, G, GV, CS) 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)), intent(in) :: htot !< The accumlated mixed layer thickness, in m - !! or kg m-2. (Intent in). + real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in H + !! (often m or kg m-2). real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective !! adjustment, in H. type(forcing), intent(in) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy - !! source due to free convection, - !! in m3 s-2. + real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source + !! due to free convection, in Z m2 s-2. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection, - !! in m3 s-2. + !! in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment, - !! in m3 s-2. + !! in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in m3 s-2. + !! adjustment, in Z m2 s-2. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step, in m3 s-2. + !! mixing over a time step, in Z m2 s-2. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE, in H-1. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available !! for driving mixing at river mouths - !! integrated over a time step, in m3 s-2. + !! integrated over a time step, in Z m2 s-2. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! in H-1 and H-2. @@ -1453,48 +1397,23 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. -! Arguments: htot - The accumlated mixed layer thickness, in m or kg m-2. (Intent in) -! The units of htot are referred to as H below. -! (in) h_CA - The mixed layer depth after convective adjustment, in H. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) Conv_en - The buoyant turbulent kinetic energy source due to -! free convection, in m3 s-2. -! (in) cTKE - The buoyant turbulent kinetic energy source due to -! convective adjustment, in m3 s-2. -! (in) dKE_FC - The vertically integrated change in kinetic energy due -! to free convection, in m3 s-2. -! (in) dKE_CA - The vertically integrated change in kinetic energy due -! to convective adjustment, in m3 s-2. -! (out) TKE - The turbulent kinetic energy available for mixing over a -! time step, in m3 s-2. -! (out) Idecay_len_TKE - The inverse of the vertical decay scale for -! TKE, in H-1. -! (out) cMKE - Coefficients of HpE and HpE^2 in calculating the -! denominator of MKE_rate, in H-1 and H-2. -! (in) dt - The time step in s. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. - real :: dKE_conv ! The change in mean kinetic energy due - ! to all convection, in m3 s-2. + ! Local variables + real :: dKE_conv ! The change in mean kinetic energy due to all convection, in Z m2 s-2. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2, ND. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2, ND. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive, in m3 s2. + ! that release is positive, in Z m2 s2. real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. - real :: totEn ! The total potential energy released by convection, m3 s-2. + real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. real :: Ih ! The inverse of a thickness, in H-1. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. real :: absf ! The absolute value of f averaged to thickness points, s-1. - real :: U_star ! The friction velocity in m s-1. - real :: absf_Ustar ! The absolute value of f divided by U_star, in m-1. - real :: wind_TKE_src ! The surface wind source of TKE, in m3 s-3. + real :: U_star ! The friction velocity in Z s-1. + real :: absf_Ustar ! The absolute value of f divided by U_star, in Z-1. + real :: wind_TKE_src ! The surface wind source of TKE, in Z m2 s-3. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls), ND. integer :: is, ie, nz, i @@ -1504,11 +1423,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_Star = fluxes%ustar(i,j) + U_Star = GV%m_to_Z * fluxes%ustar(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * GV%m_to_Z * fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min @@ -1519,7 +1438,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif absf_Ustar = absf / U_Star - Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_m + Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_Z ! The first number in the denominator could be anywhere up to 16. The ! value of 3 was chosen to minimize the time-step dependence of the amount @@ -1531,8 +1450,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! scales contribute to mixed layer deepening at similar rates, even though ! small scales are dissipated more rapidly (implying they are less efficient). ! Ih = 1.0/(16.0*0.41*U_star*dt) - Ih = GV%H_to_m/(3.0*0.41*U_star*dt) - cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_m) * Ih + Ih = GV%H_to_Z/(3.0*0.41*U_star*dt) + cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih if (Idecay_len_TKE(i) > 0.0) then exp_kh = exp(-htot(i)*Idecay_len_TKE(i)) @@ -1546,11 +1465,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) < 0.0) Conv_En(i) = 0.0 if (cTKE(i,1) > 0.0) then ; TKE_CA = cTKE(i,1) ; else ; TKE_CA = 0.0 ; endif if ((htot(i) >= h_CA(i)) .or. (TKE_CA == 0.0)) then - totEn = Conv_En(i) + TKE_CA + totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA) - if (totEn > 0.0) then - nstar_FC = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_m))**3 * totEn)) + if (totEn_Z > 0.0) then + nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & + sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1558,17 +1477,17 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, else ! This reconstructs the Buoyancy flux within the topmost htot of water. if (Conv_En(i) > 0.0) then - totEn = Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) - nstar_FC = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_m))**3 * totEn)) + totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) + nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & + sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif - totEn = Conv_En(i) + TKE_CA + totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then - nstar_CA = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_m))**3 * totEn)) + nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & + sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_CA = CS%nstar endif @@ -1590,27 +1509,26 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC ! At this point, it is assumed that cTKE is positive and stored in TKE_CA! ! Note: Removed factor of 2 in u*^3 terms. - TKE(i) = (dt*CS%mstar)*((U_Star*U_Star*U_Star)*exp_kh) + & - (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) -! Add additional TKE at river mouths + TKE(i) = (dt*CS%mstar)*((GV%Z_to_m**2*(U_Star*U_Star*U_Star))*exp_kh) + & + (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA) - if (CS%do_rivermix) then + if (CS%do_rivermix) then ! Add additional TKE at river mouths TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(U_Star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(GV%Z_to_m**2*U_Star*U_Star*U_Star) * diag_wt CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + & - wind_TKE_src + TKE_river(i) * diag_wt + ( wind_TKE_src + TKE_river(i) * diag_wt ) CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & (exp_kh-1.0)*(wind_TKE_src + dKE_conv*Idt_diag) CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + & - Idt_diag*(nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) + Idt_diag * (nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + & - Idt_diag*((CS%nstar-nstar_FC)*Conv_En(i) + (CS%nstar-nstar_CA)*TKE_CA) + Idt_diag * ((CS%nstar-nstar_FC)*Conv_En(i) + (CS%nstar-nstar_CA)*TKE_CA) CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & - Idt_diag*(cTKE(i,1)-TKE_CA) + Idt_diag * (cTKE(i,1)-TKE_CA) endif enddo @@ -1680,7 +1598,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step, in m3 s-2. + !! step, in Z m2 s-2. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & @@ -1688,30 +1606,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. ! This subroutine calculates mechanically driven entrainment. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (in/out) htot - The accumlated mixed layer thickness, in H. -! (in/out) Ttot - The depth integrated mixed layer temperature, in deg C H. -! (in/out) Stot - The depth integrated mixed layer salinity, in psu H. -! (in/out) uhtot - The depth integrated mixed layer zonal velocity, H m s-1. -! (in/out) vhtot - The integrated mixed layer meridional velocity, H m s-1. -! (in/out) R0_tot - The integrated mixed layer potential density referenced -! to 0 pressure, in H kg m-3. -! (in/out) Rcv_tot - The integrated mixed layer coordinate variable -! potential density, in H kg m-3. -! (in) nsw - The number of bands of penetrating shortwave radiation. -! (in/out) Pen_SW_bnd - The penetrating shortwave heating at the sea surface -! in each penetrating band, in K H, size nsw x SZI_(G). -! (in/out) TKE - The turbulent kinetic energy available for mixing over a -! time step, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. + ! Local variables real :: SW_trans ! The fraction of shortwave radiation that is not ! absorbed in a layer, nondimensional. real :: Pen_absorbed ! The amount of penetrative shortwave radiation @@ -1729,18 +1625,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! conversion from H to m divided by the mean density, ! in m5 s-2 H-1 kg-1. real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained, - ! in units of m3 s-2. + ! in units of Z m2 s-2. real :: dRL ! Work required to mix water from the next layer ! across the mixed layer, in m2 s-2. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in ! TKE, divided by layer thickness in m, in m2 s-2. real :: C1 ! A temporary variable in units of m2 s-2. real :: dMKE ! A temporary variable related to the release of mean - ! kinetic energy, with units of H m3 s-2. - real :: TKE_ent ! The TKE that remains if h_ent were entrained, in m3 s-2. + ! kinetic energy, with units of H Z m2 s-2. + real :: TKE_ent ! The TKE that remains if h_ent were entrained, in Z m2 s-2. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy, in m3 s2. - real :: dTKE_dh ! The partial derivative of TKE with h_ent, in m3 s-2 H-1. + ! release of mean kinetic energy, in Z m2 s2. + real :: dTKE_dh ! The partial derivative of TKE with h_ent, in Z m2 s-2 H-1. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to ! dTKE_dh, in m2 s-2. real :: EF4_val ! The result of EF4() (see later), in H-1. @@ -1748,7 +1644,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! in roundoff and can be neglected, in H. real :: dEF4_dh ! The partial derivative of EF4 with h, in H-2. real :: Pen_En1 ! A nondimensional temporary variable. - real :: kh, exp_kh ! Nondimensional temporary variables related to the. + real :: kh, exp_kh ! Nondimensional temporary variables related to the real :: f1_kh ! fractional decay of TKE across a layer. real :: x1, e_x1 ! Nondimensional temporary variables related to real :: f1_x1, f2_x1 ! the relative decay of TKE and SW radiation across @@ -1756,15 +1652,13 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: E_HxHpE ! Entrainment divided by the product of the new and old ! thicknesses, in H-1. real :: Hmix_min ! The minimum mixed layer depth in H. - real :: H_to_m ! Local copies of unit conversion factors. real :: opacity real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 - H_to_m = GV%H_to_m - g_H_2Rho0 = (GV%g_Earth * H_to_m) / (2.0 * GV%Rho0) - Hmix_min = CS%Hmix_min * GV%m_to_H + g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) + Hmix_min = CS%Hmix_min h_neglect = GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1776,7 +1670,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & h_avail = h(i,k) - eps(i,k) if ((h_avail > 0.) .and. ((TKE(i) > 0.) .or. (htot(i) < Hmix_min))) then dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) ) - dMKE = (H_to_m * CS%bulk_Ri_ML) * 0.5 * & + dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) ! Find the TKE that would remain if the entire layer were entrained. @@ -1822,7 +1716,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & HpE = htot(i)+h_avail MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2)) EF4_val = EF4(htot(i)+h_neglect,h_avail,Idecay_len_TKE(i)) - TKE_full_ent = (exp_kh*TKE(i) - (h_avail*H_to_m)*(dRL*f1_kh + Pen_En_Contrib)) + & + TKE_full_ent = (exp_kh*TKE(i) - (h_avail*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib)) + & MKE_rate*dMKE*EF4_val if ((TKE_full_ent >= 0.0) .or. (h_avail+htot(i) <= Hmix_min)) then ! The layer will be fully entrained. @@ -1832,18 +1726,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & E_HxHpE = h_ent / ((htot(i)+h_neglect)*(htot(i)+h_ent+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & Idt_diag * ((exp_kh-1.0)*TKE(i) + & - (h_ent*H_to_m)*dRL*(1.0-f1_kh) + & + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & MKE_rate*dMKE*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & - Idt_diag*(H_to_m*h_ent)*dRL + Idt_diag*(GV%H_to_Z*h_ent)*dRL CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - & - Idt_diag*(H_to_m*h_ent)*Pen_En_Contrib + Idt_diag*(GV%H_to_Z*h_ent)*Pen_En_Contrib CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + & Idt_diag*MKE_rate*dMKE*E_HxHpE endif TKE(i) = TKE_full_ent - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150 + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*GV%m_to_Z else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1902,16 +1796,16 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & C1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) endif ; enddo ! (Pen_SW_bnd(n,i) > 0.0) - TKE_ent1 = exp_kh*TKE(i) - (h_ent*H_to_m)*(dRL*f1_kh + Pen_En_Contrib) + TKE_ent1 = exp_kh*TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) EF4_val = EF4(htot(i)+h_neglect,h_ent,Idecay_len_TKE(i),dEF4_dh) HpE = htot(i)+h_ent MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2)) TKE_ent = TKE_ent1 + dMKE*EF4_val*MKE_rate ! TKE_ent is the TKE that would remain if h_ent were entrained. - dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*H_to_m) + & - Pen_dTKE_dh_Contrib*H_to_m) + dMKE * MKE_rate* & - (dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE)) + dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*GV%H_to_Z) + & + Pen_dTKE_dh_Contrib*GV%H_to_Z) + dMKE * MKE_rate* & + (dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE)) ! dh_Newt = -TKE_ent / dTKE_dh ! Bisect if the Newton's method prediction is outside of the bounded range. if (TKE_ent > 0.0) then @@ -1931,7 +1825,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif h_ent = h_ent + dh_Newt - if (ABS(dh_Newt) < 0.2*GV%Angstrom) exit + if (ABS(dh_Newt) < 0.2*GV%Angstrom_H) exit enddo endif @@ -1945,12 +1839,12 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & E_HxHpE = h_ent / ((htot(i)+h_neglect)*(HpE+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & Idt_diag * ((exp_kh-1.0)*TKE(i) + & - (h_ent*H_to_m)*dRL*(1.0-f1_kh) + & + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & dMKE*MKE_rate*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & - Idt_diag*(h_ent*H_to_m)*dRL + Idt_diag*(h_ent*GV%H_to_Z)*dRL CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - & - Idt_diag*(h_ent*H_to_m)*Pen_En_Contrib + Idt_diag*(h_ent*GV%H_to_Z)*Pen_En_Contrib CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + & Idt_diag*dMKE*MKE_rate*E_HxHpE endif @@ -2522,7 +2416,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! rho_0*g, in units of H2. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers, both in units of J H2 m-4. + ! buffer layers, both in units of J H2 Z m-5. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer, in H. @@ -2564,11 +2458,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! K psu-1 and psu K-1. real :: I_denom ! A work variable with units of psu2 m6 kg-2. - real :: G_2 ! 1/2 G_Earth, in m s-2. - real :: Rho0xG ! Rho0 times G_Earth, in kg m-2 s-2. + real :: G_2 ! 1/2 G_Earth, in m2 Z-1 s-2. + real :: Rho0xG ! Rho0 times G_Earth, in kg m-1 Z-1 s-2. real :: I2Rho0 ! 1 / (2 Rho0), in m3 kg-1. real :: Idt_H2 ! The square of the conversion from thickness - ! to m divided by the time step in m2 H-2 s-1. + ! to Z divided by the time step in Z2 H-2 s-1. logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. real :: h_neglect ! A thickness that is so small it is usually lost @@ -2595,15 +2489,15 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, h_neglect = GV%H_subroundoff G_2 = 0.5*GV%g_Earth Rho0xG = GV%Rho0 * GV%g_Earth - Idt_H2 = GV%H_to_m**2 / dt_diag + Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. - h_min_bl_thick = 5.0 * GV%m_to_H + h_min_bl_thick = 5.0 * GV%m_to_H !### DIMENSIONAL CONSTANT dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 /dT_dS_gauge num_events = 10.0 - detrainment_timescale = 4.0*3600.0 + detrainment_timescale = 4.0*3600.0 !### DIMENSIONAL CONSTANT if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// & "CS%nkbl must be 2 in mixedlayer_detrain_2.") @@ -3242,7 +3136,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_merge if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & - CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap) + CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap) else ! Not mergeable_bl. ! There is no further detrainment from the buffer layers, and the ! upper buffer layer water is distributed optimally between the @@ -3318,7 +3212,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_det if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & - CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap) + CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap) endif endif ! End of detrainment... @@ -3409,12 +3303,12 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: I_denom ! A work variable with units of psu2 m6 kg-2. real :: Sdown, Tdown real :: dt_Time, Timescale = 86400.0*30.0! *365.0/12.0 - real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the mean density times the time step, in m6 s-3 H-2 kg-1. + real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of + ! the conversion from H to m divided by the mean + ! density times the time step, in m7 s-3 Z-1 H-2 kg-1. !### CHECK UNITS real :: g_H2_2dt ! Half the gravitational acceleration times the ! square of the conversion from H to m divided - ! by the diagnostic time step, in m3 H-2 s-3. + ! by the diagnostic time step, in m4 Z-1 H-2 s-3. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3426,17 +3320,16 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e "CS%nkbl must be 1 in mixedlayer_detrain_1.") Idt = 1.0/dt dt_Time = dt/Timescale - g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (GV%g_Earth * GV%H_to_m**2) / (2.0 * dt_diag) + g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml do i=is,ie ; if (h(i,k) > 0.0) then Ih = 1.0 / (h(i,nkmb) + h(i,k)) if (CS%TKE_diagnostics) & - CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & - g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * & - (R0(i,nkmb) - R0(i,k)) + CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & + g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k)) if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + & g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k)) @@ -3532,10 +3425,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e ! temperature and salinity. If none is available a pseudo-orthogonal ! extrapolation is used. The 10.0 and 0.9 in the following are ! arbitrary but probably about right. - if ((h(i,k+1) < 10.0*GV%Angstrom) .or. & + if ((h(i,k+1) < 10.0*GV%Angstrom_H) .or. & ((RcvTgt(k+1)-Rcv(i,nkmb)) >= 0.9*(Rcv(i,k1) - Rcv(i,0)))) then if (k>=nz-1) then ; orthogonal_extrap = .true. - elseif ((h(i,k+2) <= 10.0*GV%Angstrom) .and. & + elseif ((h(i,k+2) <= 10.0*GV%Angstrom_H) .and. & ((RcvTgt(k+1)-Rcv(i,nkmb)) < 0.9*(Rcv(i,k+2)-Rcv(i,0)))) then k1 = k+2 else ; orthogonal_extrap = .true. ; endif @@ -3667,7 +3560,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. - real :: omega_frac_dflt, ustar_min_dflt + real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3727,7 +3620,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) units="nondim", default=CS%bulk_Ri_ML) call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth \n"//& - "is determined dynamically.", units="m", default=0.0) + "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H, & + unscaled=Hmix_min_m) call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & "If true, limit the detrainment from the buffer layers \n"//& @@ -3755,7 +3649,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean \n"//& "depth is less than DEPTH_LIMIT_FLUXES.", & - units="m", default=0.1*CS%Hmix_min) + units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) call get_param(param_file, mdl, "OMEGA",CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) @@ -3782,12 +3676,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. - ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) + ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that should be used by the \n"//& "bulk mixed layer model in setting vertical TKE decay \n"//& "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt) + default=ustar_min_dflt, scale=GV%m_to_Z) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & @@ -3808,7 +3702,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& - "defined.", units="m", default=0.0) + "defined.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & @@ -3827,33 +3721,36 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3') + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3') + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, & - Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', 'm3 s-3') + Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', & + 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3') + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3') + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, & - Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3') + Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=GV%Z_to_m) CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, & - Time, 'Spurious source of potential energy from mixed layer detrainment', 'W m-2') + Time, 'Spurious source of potential energy from mixed layer detrainment', & + 'W m-2', conversion=GV%Z_to_m) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & - Time, 'Spurious source of potential energy from mixed layer only detrainment', 'W m-2') + Time, 'Spurious source of potential energy from mixed layer only detrainment', & + 'W m-2', conversion=GV%Z_to_m) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & - Time, 'Summed absolute mismatch in entrainment terms', 'm') + Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm') + Time, 'Surface region thickness that is used', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_max = register_diag_field('ocean_model', 'Hs_max', diag%axesT1, & - Time, 'Maximum surface region thickness', 'm') + Time, 'Maximum surface region thickness', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_min = register_diag_field('ocean_model', 'Hs_min', diag%axesT1, & - Time, 'Minimum surface region thickness', 'm') + Time, 'Minimum surface region thickness', 'm', conversion=GV%Z_to_m) !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & @@ -3875,9 +3772,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) endif - if (max(CS%id_TKE_wind, CS%id_TKE_RiBulk, CS%id_TKE_conv, & - CS%id_TKE_mixing, CS%id_TKE_pen_SW, CS%id_TKE_mech_decay, & - CS%id_TKE_conv_decay) > 0) then + if (max(CS%id_TKE_wind, CS%id_TKE_RiBulk, CS%id_TKE_conv, CS%id_TKE_mixing, & + CS%id_TKE_pen_SW, CS%id_TKE_mech_decay, CS%id_TKE_conv_decay) > 0) then call safe_alloc_alloc(CS%diag_TKE_wind, isd, ied, jsd, jed) call safe_alloc_alloc(CS%diag_TKE_RiBulk, isd, ied, jsd, jed) call safe_alloc_alloc(CS%diag_TKE_conv, isd, ied, jsd, jed) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ee412b358c..58dc219d0c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -29,9 +29,9 @@ module MOM_diabatic_aux !> Control structure for diabatic_aux type, public :: diabatic_aux_CS ; private - logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff - !! at the river mouths to "rivermix_depth" meters - real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in m. + logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the + !! river mouths to a depth of "rivermix_depth" + real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in Z. logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to !! to cool the topmost layer down to the freezing !! point. The default is false. @@ -77,7 +77,7 @@ module MOM_diabatic_aux !! 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) +subroutine make_frazil(h, tv, G, GV, 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)), & @@ -88,6 +88,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) !! call to diabatic_aux_init. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: p_surf !< The pressure at the ocean surface, in Pa. + integer, optional, intent(in) :: halo !< Halo width over which to calculate frazil ! Frazil formation keeps the temperature above the freezing point. ! This subroutine warms any water that is colder than the (currently @@ -113,7 +114,11 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) 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 + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif call cpu_clock_begin(id_clock_frazil) @@ -177,7 +182,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) endif hc = (tv%C_p*GV%H_to_kg_m2) * h(i,j,k) - if (h(i,j,k) <= 10.0*GV%Angstrom) then + 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 fraz_col(i) = fraz_col(i) + hc * (T_freeze(i) - tv%T(i,j,k)) @@ -221,22 +226,21 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. real, dimension(SZI_(G),SZK_(G)) :: & - c1_T, c1_S ! Variables used by the tridiagonal solvers, in m or kg m-2. + c1_T, c1_S ! Variables used by the tridiagonal solvers, in H. real, dimension(SZI_(G),SZK_(G)+1) :: & - mix_T, mix_S ! Mixing distances in both directions across each - ! interface, in m or kg m-2. + mix_T, mix_S ! Mixing distances in both directions across each interface, in H. real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness, in m or kg m-2. + ! added to ensure positive definiteness, in H. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m or kg m-2. + ! in roundoff and can be neglected, in H. real :: I_h_int ! The inverse of the thickness associated with an - ! interface, in m-1 or m2 kg-1. + ! interface, in H-1. real :: b_denom_T ! The first term in the denominators for the expressions - real :: b_denom_S ! for b1_T and b1_S, both in m or kg m-2. - - integer :: i, j, k, is, ie, js, je, nz + real :: b_denom_S ! for b1_T and b1_S, both in H. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() - real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() + real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities in Z2 s-1. + integer :: i, j, k, is, ie, js, je, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff @@ -257,8 +261,8 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) do j=js,je do i=is,ie I_h_int = 1.0 / (0.5 * (h(i,j,1) + h(i,j,2)) + h_neglect) - mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%m_to_H**2) * I_h_int - mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%m_to_H**2) * I_h_int + mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%Z_to_H**2) * I_h_int + mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%Z_to_H**2) * I_h_int h_tr = h(i,j,1) + h_neglect b1_T(i) = 1.0 / (h_tr + mix_T(i,2)) @@ -271,8 +275,8 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) do k=2,nz-1 ; do i=is,ie ! Calculate the mixing across the interface below this layer. I_h_int = 1.0 / (0.5 * (h(i,j,k) + h(i,j,k+1)) + h_neglect) - mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%m_to_H**2) * I_h_int - mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%m_to_H**2) * I_h_int + mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%Z_to_H**2) * I_h_int + mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%Z_to_H**2) * I_h_int c1_T(i,k) = mix_T(i,K) * b1_T(i) c1_S(i,k) = mix_S(i,K) * b1_S(i) @@ -309,7 +313,7 @@ end subroutine differential_diffuse_T_S !> This subroutine keeps salinity from falling below a small but positive threshold. !! This usually occurs when the ice model attempts to extract more salt then !! is actually available to it from the ocean. -subroutine adjust_salt(h, tv, G, GV, CS) +subroutine adjust_salt(h, tv, G, GV, CS, 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)), & @@ -318,6 +322,7 @@ subroutine adjust_salt(h, tv, G, GV, CS) !! available thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init. + integer, optional, intent(in) :: halo !< Halo width over which to work ! local variables real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement @@ -325,6 +330,9 @@ subroutine adjust_salt(h, tv, G, GV, CS) real :: mc !< A layer's mass kg m-2 . integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif ! call cpu_clock_begin(id_clock_adjust_salt) @@ -340,7 +348,7 @@ subroutine adjust_salt(h, tv, G, GV, CS) if ((G%mask2dT(i,j) > 0.0) .and. & ((tv%S(i,j,k) < S_min) .or. (salt_add_col(i,j) > 0.0))) then mc = GV%H_to_kg_m2 * h(i,j,k) - if (h(i,j,k) <= 10.0*GV%Angstrom) then + if (h(i,j,k) <= 10.0*GV%Angstrom_H) then ! Very thin layers should not be adjusted by the salt flux if (tv%S(i,j,k) < S_min) then salt_add_col(i,j) = salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k)) @@ -421,7 +429,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) do i=is,ie T(i,k)=tv%T(i,j,k); S(i,k)=tv%S(i,j,k) ! avoid very small thickness - h_2d(i,k)=MAX(h(i,j,k), GV%Angstrom) + h_2d(i,k)=MAX(h(i,j,k), GV%Angstrom_H) enddo call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), is, & @@ -651,25 +659,32 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD ! Local variables - real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK, dK, dKm1, pRef_MLD - real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 - real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth - real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML - real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 - real, parameter :: dz_subML = 50. ! Depth below ML over which to diagnose stratification (m) + real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences, in kg m-3. + real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. + real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z. + real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3. + real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in Z. + real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2. + real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in Z2. + real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit + ! conversion factor, in kg m-1 Z-1 s-2. + real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1. + real :: dz_subML ! Depth below ML over which to diagnose stratification, in Z. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho - id_N2 = -1 - if (PRESENT(id_N2subML)) id_N2 = id_N2subML + id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML + + id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq - id_SQ = -1 - if (PRESENT(id_N2subML)) id_SQ = id_MLDsq + Rho_x_gE = GV%g_Earth * GV%Rho0 + gE_rho0 = GV%m_to_Z**2 * GV%g_Earth / GV%Rho0 + dz_subML = 50.*GV%m_to_Z is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pRef_MLD(:) = 0. ; pRef_N2(:) = 0. do j=js,je - do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_m ; enddo ! Depth of center of surface layer + do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_Z ; enddo ! Depth of center of surface layer call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is, ie-is+1, tv%eqn_of_state) do i=is,ie deltaRhoAtK(i) = 0. @@ -678,21 +693,21 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia subMLN2(i,j) = 0. rho1(i) = 0. d1(i) = 0. - pRef_N2(i) = GV%g_Earth * GV%Rho0 * h(i,j,1) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = GV%g_Earth * GV%H_to_kg_m2 * h(i,j,1) ! This might change answers at roundoff. + pRef_N2(i) = Rho_x_gE * h(i,j,1) * GV%H_to_Z ! Boussinesq approximation!!!! ????? + !### This should be: pRef_N2(i) = GV%H_to_Pa * h(i,j,1) ! This might change answers at roundoff. endif enddo do k=2,nz do i=is,ie dKm1(i) = dK(i) ! Depth of center of layer K-1 - dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_m ! Depth of center of layer K + dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_Z ! Depth of center of layer K enddo ! Stratification, N2, immediately below the mixed layer, averaged over at least 50 m. if (id_N2>0) then do i=is,ie - pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? + !### This should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k) !### This might change answers at roundoff. enddo call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_N2, rhoAtK, is, ie-is+1, tv%eqn_of_state) @@ -703,12 +718,12 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia d1(i) = dK(i) !### It looks to me like there is bad logic here. - RWH ! Use pressure at the bottom of the upper layer used in calculating d/dz rho - pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? + !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k) !### This might change answers at roundoff. endif if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then - subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) + subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) endif endif enddo ! i-loop @@ -732,7 +747,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia if ((MLD(i,j)==0.) .and. (deltaRhoAtK(i)0 .and. subMLN2(i,j)==0. .and. d1(i)>0. .and. dK(i)-d1(i)>0.) then ! ! Use what ever stratification we can, measured over what ever distance is available - ! subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) + ! subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) ! endif enddo enddo ! j-loop @@ -775,7 +790,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity, in m3 kg-1 / (g kg-1). real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface in m2 s-3 + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface in Z2 s-3 ! Local variables integer, parameter :: maxGroundings = 5 @@ -809,8 +824,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand real :: hGrounding(maxGroundings) real :: Temp_in, Salin_in - real :: I_G_Earth, g_Hconv2 - real :: GoRho +! real :: I_G_Earth + real :: g_Hconv2 + real :: GoRho ! g_Earth times a unit conversion factor divided by density, in Z m3 s-2 kg-1 logical :: calculate_energetics logical :: calculate_buoyancy integer :: i, j, is, ie, js, je, k, nz, n, nsw @@ -829,8 +845,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 - I_G_Earth = 1.0 / GV%g_Earth - g_Hconv2 = GV%g_Earth * GV%H_to_kg_m2**2 +! I_G_Earth = 1.0 / GV%g_Earth + g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then @@ -845,7 +861,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! To accommodate vanishing upper layers, we need to allow for an instantaneous ! distribution of forcing over some finite vertical extent. The bulk mixed layer ! code handles this issue properly. - H_limit_fluxes = max(GV%Angstrom, 1.E-30*GV%m_to_H) + H_limit_fluxes = max(GV%Angstrom_H, 1.E-30*GV%m_to_H) ! diagnostic to see if need to create mass to avoid grounding if (CS%id_createdH>0) CS%createdH(:,:) = 0. @@ -888,7 +904,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & do i=is,ie ; pres(i) = 0.0 ; enddo ! Add surface pressure? do k=1,nz do i=is,ie - d_pres(i) = GV%g_Earth * GV%H_to_kg_m2 * h2d(i,k) + d_pres(i) = GV%H_to_Pa * h2d(i,k) p_lay(i) = pres(i) + 0.5*d_pres(i) pres(i) = pres(i) + d_pres(i) enddo @@ -896,8 +912,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo ! do i=is,ie -! dT_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) -! dS_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) +! dT_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) +! dS_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) ! enddo enddo pen_TKE_2d(:,:) = 0.0 @@ -1023,7 +1039,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%m_to_H*GV%H_to_Pa + RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%Z_to_H*GV%H_to_Pa cTKE(i,j,k) = cTKE(i,j,k) + max(0.0, RivermixConst*dSV_dS(i,j,1) * & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1)) @@ -1090,7 +1106,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & tv%T(i,j,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & tv%T(i,j,k) * dThickness * GV%H_to_kg_m2 -!NOTE tv%T should be T2d +!### NOTE: tv%T should be T2d in the expressions above. ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand @@ -1240,7 +1256,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_m * ( & + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * GV%m_to_Z**2 * ( & dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo @@ -1290,7 +1306,7 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_aux" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_aux" ! This module's name. character(len=48) :: thickness_units integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -1307,15 +1323,15 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, CS%diag => diag ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for auxiliary diabatic processes.") - call get_param(param_file, mod, "RECLAIM_FRAZIL", CS%reclaim_frazil, & + call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & "If true, try to use any frazil heat deficit to cool any\n"//& "overlying layers down to the freezing point, thereby \n"//& "avoiding the creation of thin ice when the SST is above \n"//& "the freezing point.", default=.true.) - call get_param(param_file, mod, "PRESSURE_DEPENDENT_FRAZIL", & + call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", & CS%pressure_dependent_frazil, & "If true, use a pressure dependent freezing temperature \n"//& "when making frazil. The default is false, which will be \n"//& @@ -1323,18 +1339,18 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, default=.false.) if (use_ePBL) then - call get_param(param_file, mod, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& + call get_param(param_file, mdl, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& "If true, the model does not check if fluxes are being applied\n"//& "over land points. This is needed when the ocean is coupled \n"//& "with ice shelves and sea ice, since the sea ice mask needs to \n"//& "be different than the ocean mask to avoid sea ice formation \n"//& "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) - call get_param(param_file, mod, "DO_RIVERMIX", CS%do_rivermix, & + call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & "If true, apply additional mixing whereever there is \n"//& "runoff, so that it is mixed down to RIVERMIX_DEPTH \n"//& "if the ocean is that deep.", default=.false.) if (CS%do_rivermix) & - call get_param(param_file, mod, "RIVERMIX_DEPTH", CS%rivermix_depth, & + call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& "defined.", units="m", default=0.0) else @@ -1342,11 +1358,11 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, endif if (GV%nkml == 0) then - call get_param(param_file, mod, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & + call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & default=.false.) - call get_param(param_file, mod, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & + call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & "If true, use the fluxes%calving_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*froz_runoff.", & default=.false.) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 6c5f361833..2e4ee0835b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -61,8 +61,7 @@ module MOM_diabatic_driver use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS -use MOM_time_manager, only : operator(-), set_time -use MOM_time_manager, only : operator(<=), time_type ! for testing itides (BDM) +use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS use MOM_tracer_diabatic, only : tracer_vertdiff use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs @@ -148,16 +147,17 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! in m2 s-1. The entrainment at the bottom is at + !! in Z2 s-1. The entrainment at the bottom is at !! least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom, in m2 s-1. + !! near the bottom, in Z2 s-1. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied, in m. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be !! evaporated in one time-step (non-dim). - + integer :: halo_TS_diff = 0 !< The temperature, salinity and thickness halo size that + !! must be valid for the diffusivity calculations. logical :: useKPP = .false. !< use CVMix/KPP diffusivities and non-local transport logical :: salt_reject_below_ML !< If true, add salt below mixed layer (layer mode only) logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers. @@ -291,9 +291,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! one time step (m for Bouss, kg/m^2 for non-Bouss) eb_t, & ! amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd, & ! diapycnal diffusivity of layers (m^2/sec) + Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec) h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) ! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! (m for Bouss, kg/m^2 for non-Bouss) @@ -302,13 +302,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & cTKE, & ! convective TKE requirements for each layer in J/m^2. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment (m/s) - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) - + cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux (m2/s3), used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux (Z2/s3), used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity @@ -321,13 +319,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss) + ! near the boundaries in H (m for Bouss and kg/m^2 for non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) @@ -336,7 +334,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, + eaml, & ! The equivalent of ea and eb due to mixed layer processes, in H ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be ! pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. @@ -368,7 +366,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is ! coupled to the bottom within a timestep (m) - real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m. + real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in H. real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. @@ -382,11 +380,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in m2/s + real :: Kd_add_here ! An added diffusivity in Z2/s 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 @@ -409,7 +407,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -442,7 +440,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) @@ -450,9 +448,9 @@ 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, 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) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) endif if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") @@ -468,15 +466,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) - do k=1,nz ; do j=js,je ; do i=is,ie + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) + call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) @@ -554,41 +553,40 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%Kv_slow and visc%TKE_turb (not clear that TKE_turb is used as input ???? - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, & + Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") ! Set diffusivities for heat and salt separately -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,k) - Kd_heat(i,j,k) = Kd_int(i,j,k) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif -!$OMP end parallel if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat",G%HI,haloshift=0) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt",G%HI,haloshift=0) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif if (CS%useKPP) then @@ -612,10 +610,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) if (associated(Hml)) then + !$OMP parallel default(shared) call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + !$OMP end parallel call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy KPP's BLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) @@ -627,8 +626,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_heat, "after KPP Kd_heat",G%HI,haloshift=0) - call hchksum(Kd_salt, "after KPP Kd_salt",G%HI,haloshift=0) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif endif ! endif for KPP @@ -672,13 +671,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo -!$OMP end parallel endif endif @@ -687,8 +684,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) ! Increment vertical diffusion and viscosity due to convection -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) @@ -698,7 +694,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) endif enddo ; enddo ; enddo -!$OMP end parallel endif ! Save fields before boundary forcing is applied for tendency diagnostics @@ -739,14 +734,18 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, GV) call pass_var(Hml, G%domain, halo=1) - ! If visc%MLD exists, copy KPP's BLD into it + ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) + elseif (associated(visc%MLD)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV) + call pass_var(visc%MLD, G%domain, halo=1) endif ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie + !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) @@ -765,7 +764,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif else @@ -830,17 +829,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea_t,ea_s,GV,dt,Kd_salt,Kd_heat,eb_t,eb_s) & -!$OMP private(hval) + !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_heat(i,j,k) + hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie - eb_t(i,j,nz) = 0.; eb_s(i,j,nz) = 0. + eb_t(i,j,nz) = 0. ; eb_s(i,j,nz) = 0. enddo ; enddo if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat" //& "and Kd_salt (diabatic)") @@ -922,7 +920,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -939,9 +937,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd, + ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -959,7 +957,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -985,7 +983,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else @@ -1171,9 +1169,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! one time step (m for Bouss, kg/m^2 for non-Bouss) eb, & ! amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd, & ! diapycnal diffusivity of layers (m^2/sec) + Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec) h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! (m for Bouss, kg/m^2 for non-Bouss) @@ -1205,9 +1203,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) @@ -1262,11 +1260,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in m2/s + real :: Kd_add_here ! An added diffusivity in Z2/s 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 @@ -1287,7 +1285,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -1319,7 +1317,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) @@ -1327,9 +1325,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en 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, 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) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) endif if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") @@ -1344,15 +1342,16 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) - do k=1,nz ; do j=js,je ; do i=is,ie + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) + call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) @@ -1479,10 +1478,16 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? ! And sets visc%Kv_shear - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) + if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then + if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.) + if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) + call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) + endif + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, & + Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1490,8 +1495,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0) endif @@ -1506,32 +1511,29 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,k) - Kd_heat(i,j,k) = Kd_int(i,j,k) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif -!$OMP end parallel call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux) call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) if (associated(Hml)) then call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) @@ -1541,32 +1543,32 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif if (.not. CS%KPPisPassive) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = Kd_salt(i,j,k) - Kd_int(i,j,k) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = Kd_heat(i,j,k) - Kd_int(i,j,k) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive -!$OMP end parallel + call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0) endif endif ! endif for KPP @@ -1575,12 +1577,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) - enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. + do k=1,nz ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + enddo ; enddo ; enddo + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! endif @@ -1644,7 +1647,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) + ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_int(i,j,K) eb(i,j,k-1) = ea(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -1659,7 +1662,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_Lay=Kd, Kd_int=Kd_int) + ea, eb, kb, Kd_Lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -1712,7 +1715,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! If visc%MLD exists, copy the ePBL's MLD into it if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV) call pass_var(visc%MLD, G%domain, halo=1) Hml(:,:) = visc%MLD(:,:) endif @@ -1727,11 +1730,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) @@ -1742,7 +1745,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif else @@ -1789,10 +1792,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en hold(i,j,nz) = h(i,j,nz) h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) if (h(i,j,1) <= 0.0) then - h(i,j,1) = GV%Angstrom + h(i,j,1) = GV%Angstrom_H endif if (h(i,j,nz) <= 0.0) then - h(i,j,nz) = GV%Angstrom + h(i,j,nz) = GV%Angstrom_H endif enddo do k=2,nz-1 ; do i=is,ie @@ -1800,7 +1803,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & (eb(i,j,k) - ea(i,j,k+1))) if (h(i,j,k) <= 0.0) then - h(i,j,k) = GV%Angstrom + h(i,j,k) = GV%Angstrom_H endif enddo ; enddo enddo @@ -2080,9 +2083,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd, + ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2099,7 +2102,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -2130,7 +2133,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) else @@ -2234,12 +2237,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) do k=1,nz do i=is-1,ie+1 - hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 - hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 + hold(i,js-1,k) = GV%Angstrom_H ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 + hold(i,je+1,k) = GV%Angstrom_H ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 enddo do j=js,je - hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 - hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 + hold(is-1,j,k) = GV%Angstrom_H ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 + hold(ie+1,j,k) = GV%Angstrom_H ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 enddo enddo @@ -2722,7 +2725,7 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_driver" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "adiabatic_driver_init called with an "// & @@ -2735,7 +2738,7 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") end subroutine adiabatic_driver_init @@ -2768,7 +2771,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_driver" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name. character(len=48) :: thickness_units character(len=40) :: var_name character(len=160) :: var_descript @@ -2796,28 +2799,28 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified via calls to initialize_sponge and possibly \n"//& "set_up_sponge_field.", default=.false.) - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", use_temperature, & + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, & + call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, & "If true, use an implied energetics planetary boundary \n"//& "layer scheme to determine the diffusivity and viscosity \n"//& "in the surface boundary layer.", default=.false.) - call get_param(param_file, mod, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, & + call get_param(param_file, mdl, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, & "If true, the diffusivity from ePBL is added to all\n"//& "other diffusivities. Otherwise, the larger of kappa-\n"//& "shear and ePBL diffusivities are used.", default=.true.) - call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differentialDiffusion, & "If true, apply parameterization of double-diffusion.", & default=.false. ) - call get_param(param_file, mod, "USE_KPP", CS%use_KPP, & + call get_param(param_file, mdl, "USE_KPP", CS%use_KPP, & "If true, turns on the [CVMix] KPP scheme of Large et al., 1994,\n"// & "to calculate diffusivities and non-local transport in the OBL.", & default=.false., do_not_log=.true.) @@ -2833,55 +2836,55 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%use_CVMix_shear = CVMix_shear_is_used(param_file) if (CS%bulkmixedlayer) then - call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & + call get_param(param_file, mdl, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& "before interior diapycnal mixing. 0 by default.", & units="nondim", default=0.0) - call get_param(param_file, mod, "NKBL", CS%nkbl, default=2, do_not_log=.true.) + call get_param(param_file, mdl, "NKBL", CS%nkbl, default=2, do_not_log=.true.) else CS%ML_mix_first = 0.0 endif if (use_temperature) then - call get_param(param_file, mod, "DO_GEOTHERMAL", CS%use_geothermal, & + call get_param(param_file, mdl, "DO_GEOTHERMAL", CS%use_geothermal, & "If true, apply geothermal heating.", default=.false.) else CS%use_geothermal = .false. endif - call get_param(param_file, mod, "INTERNAL_TIDES", CS%use_int_tides, & + call get_param(param_file, mdl, "INTERNAL_TIDES", CS%use_int_tides, & "If true, use the code that advances a separate set of \n"//& "equations for the internal tide energy density.", default=.false.) CS%nMode = 1 if (CS%use_int_tides) then ! SET NUMBER OF MODES TO CONSIDER - call get_param(param_file, mod, "INTERNAL_TIDE_MODES", CS%nMode, & + call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & "The number of distinct internal tide modes \n"//& "that will be calculated.", default=1, do_not_log=.true.) ! The following parameters are used in testing the internal tide code. ! GET LOCATION AND DURATION OF ENERGY POINT SOURCE FOR TESTING (BDM) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & "If true, apply an arbitrary generation site for internal tide testing", & default=.false.) if (CS%int_tide_source_test)then - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & "Y Location of generation site for internal tide", default=1.) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & "Time interval from start of experiment for adding wave source", & units="days", default=0) CS%time_max_source = increment_time(Time,0,days=CS%tlen_days) endif ! GET UNIFORM MODE VELOCITY FOR TESTING (BDM) - call get_param(param_file, mod, "UNIFORM_CG", CS%uniform_cg, & + call get_param(param_file, mdl, "UNIFORM_CG", CS%uniform_cg, & "If true, set cg = cg_test everywhere for test case", default=.false.) if (CS%uniform_cg)then - call get_param(param_file, mod, "CG_TEST", CS%cg_test, & + call get_param(param_file, mdl, "CG_TEST", CS%cg_test, & "Uniform group velocity of internal tide for test case", default=1.) endif endif - call get_param(param_file, mod, "MASSLESS_MATCH_TARGETS", & + call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & CS%massless_match_targets, & "If true, the temperature and salinity of massless layers \n"//& "are kept consistent with their target densities. \n"//& @@ -2889,7 +2892,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "diffusively to match massive neighboring layers.", & default=.true.) - call get_param(param_file, mod, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, & + call get_param(param_file, mdl, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, & "If true, the net incoming and outgoing fresh water fluxes are combined\n"//& "and applied as either incoming or outgoing depending on the sign of the net.\n"//& "If false, the net incoming fresh water flux is added to the model and\n"//& @@ -2897,44 +2900,44 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "into the first non-vanished layer for which the column remains stable", & default=.true.) - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) - call get_param(param_file, mod, "DEBUG_CONSERVATION", CS%debugConservation, & + call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debugConservation, & "If true, monitor conservation and extrema.", & default=.false., debuggingParam=.true.) - call get_param(param_file, mod, "DEBUG_ENERGY_REQ", CS%debug_energy_req, & + call get_param(param_file, mdl, "DEBUG_ENERGY_REQ", CS%debug_energy_req, & "If true, debug the energy requirements.", default=.false., do_not_log=.true.) - call get_param(param_file, mod, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, & + call get_param(param_file, mdl, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, & "If true, mix the passive tracers in massless layers at \n"//& "the bottom into the interior as though a diffusivity of \n"//& "KD_MIN_TR were operating.", default=.true.) if (CS%mix_boundary_tracers) then - call get_param(param_file, mod, "KD", Kd, fail_if_missing=.true.) - call get_param(param_file, mod, "KD_MIN_TR", CS%Kd_min_tr, & + call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) + call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to \n"//& "tracers, especially in massless layers near the bottom. \n"//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) - call get_param(param_file, mod, "KD_BBL_TR", CS%Kd_BBL_tr, & + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=GV%m_to_Z**2) + call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will \n"//& "allow for explicitly specified bottom fluxes. The \n"//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& - "over the same distance.", units="m2 s-1", default=0.) + "over the same distance.", units="m2 s-1", default=0., scale=GV%m_to_Z**2) endif - call get_param(param_file, mod, "TRACER_TRIDIAG", CS%tracer_tridiag, & + call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & "If true, use the passive tracer tridiagonal solver for T and S\n", & default=.false.) - call get_param(param_file, mod, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, & + call get_param(param_file, mdl, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, & "The smallest depth over which forcing can be applied. This\n"//& "only takes effect when near-surface layers become thin\n"//& "relative to this scale, in which case the forcing tendencies\n"//& "scaled down by distributing the forcing over this depth scale.", & units="m", default=0.001) - call get_param(param_file, mod, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, & + call get_param(param_file, mdl, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, & "The largest fraction of a layer than can be lost to forcing\n"//& "(e.g. evaporation, sea-ice formation) in one time-step. The unused\n"//& "mass loss is passed down through the column.", & @@ -2988,20 +2991,21 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv",diag%axesTi, & Time, "Advective diapycnal salnity flux across interfaces", & "psu m s-1") - CS%id_MLD_003 = register_diag_field('ocean_model','MLD_003',diag%axesT1,Time, & - 'Mixed layer depth (delta rho = 0.03)', 'm', cmor_field_name='mlotst', & - cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & + CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & + 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=GV%Z_to_m, & + cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & cmor_standard_name='ocean_mixed_layer_thickness_defined_by_sigma_t') - CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1,Time, & - long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & - standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t',units='m2') + CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1, Time, & + long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & + standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t', & + units='m2', conversion=GV%Z_to_m**2) CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & - 'Mixed layer depth (delta rho = 0.125)', 'm') + 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=GV%Z_to_m) CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & 'Squared buoyancy frequency below mixed layer', 's-2') CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & - 'Mixed layer depth (used defined)', 'm') - call get_param(param_file, mod, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & + 'Mixed layer depth (used defined)', 'm', conversion=GV%Z_to_m) + call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & "The density difference used to determine a diagnostic mixed\n"//& "layer depth, MLD_user, following the definition of Levitus 1982. \n"//& "The MLD is the depth at which the density is larger than the\n"//& @@ -3017,15 +3021,15 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, z_grid='z') CS%id_Tdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Tflx_dia_adv", "degC m s-1", & - "Advective diapycnal temperature flux across interfaces, interpolated to z",& + "Advective diapycnal temperature flux across interfaces, interpolated to z", & z_grid='z') CS%id_Tadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Sflx_dia_diff", "psu m s-1", & - "Diffusive diapycnal salinity flux across interfaces, interpolated to z",& + "Diffusive diapycnal salinity flux across interfaces, interpolated to z", & z_grid='z') CS%id_Sdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Sflx_dia_adv", "psu m s-1", & - "Advective diapycnal salinity flux across interfaces, interpolated to z",& + "Advective diapycnal salinity flux across interfaces, interpolated to z", & z_grid='z') CS%id_Sadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) endif @@ -3052,26 +3056,26 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, !call set_diffusivity_init(Time, G, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp) CS%id_Kd_interface = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, & - 'Total diapycnal diffusivity at interfaces', 'm2 s-1') + 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1') + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & - 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, & cmor_field_name='difvho', & cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') ! CS%useKPP is set to True if KPP-scheme is to be used, False otherwise. ! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive - CS%useKPP = KPP_init(param_file, G, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) + CS%useKPP = KPP_init(param_file, G, GV, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) if (CS%useKPP) then allocate( CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTheat(:,:,:) = 0. allocate( CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTscalar(:,:,:) = 0. @@ -3088,7 +3092,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'set DOUBLE_DIFFUSION=False and USE_CVMIX_DDIFF=True.') endif - call get_param(param_file, mod, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, & + call get_param(param_file, mdl, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, & "If true, place salt from brine rejection below the mixed layer,\n"// & "into the first non-vanished layer for which the column remains stable", & default=.false.) @@ -3286,7 +3290,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! initialize module for setting diffusivities call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & - CS%int_tide_CSp, CS%tidal_mixing_CSp) + CS%int_tide_CSp, CS%tidal_mixing_CSp, CS%halo_TS_diff) ! set up the clocks for this module @@ -3316,14 +3320,14 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, if (CS%use_energetic_PBL) & call energetic_PBL_init(Time, G, GV, param_file, diag, CS%energetic_PBL_CSp) - call regularize_layers_init(Time, G, param_file, diag, CS%regularize_layers_CSp) + call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) if (CS%debug_energy_req) & call diapyc_energy_req_init(Time, G, param_file, diag, CS%diapyc_en_rec_CSp) ! obtain information about the number of bands for penetrative shortwave if (use_temperature) then - call get_param(param_file, mod, "PEN_SW_NBANDS", nbands, default=1) + call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) call opacity_init(Time, G, param_file, diag, CS%tracer_flow_CSp, CS%opacity_CSp, CS%optics) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index b3ddad75fd..93676a384c 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -5,7 +5,7 @@ module MOM_diapyc_energy_req !! \author By Robert Hallberg, May 2015 -use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data_1d_k, register_diag_field +use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data, register_diag_field use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -53,7 +53,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) !! in s. type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & - optional, intent(in) :: Kd_int !< Interface diffusivities. + optional, intent(in) :: Kd_int !< Interface diffusivities in Z2 s-1. ! Local variables real, dimension(GV%ke) :: & @@ -75,7 +75,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) !$OMP do do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then - do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*Kd_int(i,j,K) ; enddo + do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*GV%Z_to_m**2*Kd_int(i,j,K) ; enddo else htot = 0.0 ; h_top(1) = 0.0 do k=1,nz @@ -89,13 +89,13 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) h_bot(K) = h_bot(K+1) + h_col(k) enddo - ustar = 0.01 ! Change this to being an input parameter? + ustar = 0.01*GV%m_to_Z ! Change this to being an input parameter? absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz - tmp1 = h_top(K) * h_bot(K) * GV%H_to_m - Kd(K) = CS%test_Kh_scaling * & + tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z + Kd(K) = CS%test_Kh_scaling * GV%Z_to_m**2 * & ustar * 0.41 * (tmp1*ustar) / (absf*tmp1 + htot*ustar) enddo endif @@ -117,7 +117,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & 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(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, - !! in m or kg m-2. + !! in H (m or kg m-2). real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities, @@ -132,7 +132,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & logical, optional, intent(in) :: may_print !< If present and true, write out diagnostics !! of energy use. type(diapyc_energy_req_CS), & - optional, pointer :: CS !< This module's control structure. + optional, pointer :: CS !< This module's control structure. ! This subroutine uses a substantially refactored tridiagonal equation for ! diapycnal mixing of temperature and salinity to estimate the potential energy @@ -251,7 +251,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & nz = G%ke h_neglect = GV%H_subroundoff - I_G_Earth = 1.0 / GV%g_Earth + I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) debug = .true. surface_BL = .true. ; bottom_BL = .true. ; halves = .true. @@ -269,7 +269,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & T0(k) = T_in(k) ; S0(k) = S_in(k) h_tr(k) = h_in(k) htot = htot + h_tr(k) - pres(K+1) = pres(K) + GV%g_Earth * GV%H_to_kg_m2 * h_tr(k) + pres(K+1) = pres(K) + GV%H_to_Pa * h_tr(k) p_lay(k) = 0.5*(pres(K) + pres(K+1)) Z_int(K+1) = Z_int(K) - GV%H_to_m * h_tr(k) enddo @@ -290,7 +290,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do k=1,nz dMass = GV%H_to_kg_m2 * h_tr(k) - dPres = GV%g_Earth * dMass + dPres = (GV%g_Earth*GV%m_to_Z) * dMass dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) dT_to_dColHt(k) = dMass * dSV_dT(k) * CS%ColHt_scaling @@ -910,43 +910,43 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & K=nz if (do_print) then - if (CS%id_ERt>0) call post_data_1d_k(CS%id_ERt, PE_chg_k(:,1), CS%diag) - if (CS%id_ERb>0) call post_data_1d_k(CS%id_ERb, PE_chg_k(:,2), CS%diag) - if (CS%id_ERc>0) call post_data_1d_k(CS%id_ERc, PE_chg_k(:,3), CS%diag) - if (CS%id_ERh>0) call post_data_1d_k(CS%id_ERh, PE_chg_k(:,4), CS%diag) - if (CS%id_Kddt>0) call post_data_1d_k(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag) - if (CS%id_Kd>0) call post_data_1d_k(CS%id_Kd, Kd, CS%diag) - if (CS%id_h>0) call post_data_1d_k(CS%id_h, GV%H_to_m*h_tr, CS%diag) - if (CS%id_zInt>0) call post_data_1d_k(CS%id_zInt, Z_int, CS%diag) - if (CS%id_CHCt>0) call post_data_1d_k(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag) - if (CS%id_CHCb>0) call post_data_1d_k(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag) - if (CS%id_CHCc>0) call post_data_1d_k(CS%id_CHCc, ColHt_cor_k(:,3), CS%diag) - if (CS%id_CHCh>0) call post_data_1d_k(CS%id_CHCh, ColHt_cor_k(:,4), CS%diag) - if (CS%id_T0>0) call post_data_1d_k(CS%id_T0, T0, CS%diag) - if (CS%id_Tf>0) call post_data_1d_k(CS%id_Tf, Tf, CS%diag) - if (CS%id_S0>0) call post_data_1d_k(CS%id_S0, S0, CS%diag) - if (CS%id_Sf>0) call post_data_1d_k(CS%id_Sf, Sf, CS%diag) + if (CS%id_ERt>0) call post_data(CS%id_ERt, PE_chg_k(:,1), CS%diag) + if (CS%id_ERb>0) call post_data(CS%id_ERb, PE_chg_k(:,2), CS%diag) + if (CS%id_ERc>0) call post_data(CS%id_ERc, PE_chg_k(:,3), CS%diag) + if (CS%id_ERh>0) call post_data(CS%id_ERh, PE_chg_k(:,4), CS%diag) + if (CS%id_Kddt>0) call post_data(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag) + if (CS%id_Kd>0) call post_data(CS%id_Kd, Kd, CS%diag) + if (CS%id_h>0) call post_data(CS%id_h, GV%H_to_m*h_tr, CS%diag) + if (CS%id_zInt>0) call post_data(CS%id_zInt, Z_int, CS%diag) + if (CS%id_CHCt>0) call post_data(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag) + if (CS%id_CHCb>0) call post_data(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag) + if (CS%id_CHCc>0) call post_data(CS%id_CHCc, ColHt_cor_k(:,3), CS%diag) + if (CS%id_CHCh>0) call post_data(CS%id_CHCh, ColHt_cor_k(:,4), CS%diag) + if (CS%id_T0>0) call post_data(CS%id_T0, T0, CS%diag) + if (CS%id_Tf>0) call post_data(CS%id_Tf, Tf, CS%diag) + if (CS%id_S0>0) call post_data(CS%id_S0, S0, CS%diag) + if (CS%id_Sf>0) call post_data(CS%id_Sf, Sf, CS%diag) if (CS%id_N2_0>0) then N2(1) = 0.0 ; N2(nz+1) = 0.0 do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = (GV%g_Earth * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo - call post_data_1d_k(CS%id_N2_0, N2, CS%diag) + call post_data(CS%id_N2_0, N2, CS%diag) endif if (CS%id_N2_f>0) then N2(1) = 0.0 ; N2(nz+1) = 0.0 do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = (GV%g_Earth * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo - call post_data_1d_k(CS%id_N2_f, N2, CS%diag) + call post_data(CS%id_N2_f, N2, CS%diag) endif endif diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 3074faa243..b82c697b8d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -52,8 +52,8 @@ module MOM_energetic_PBL !! energy is converted to a turbulent velocity, relative to !! mechanically forced turbulent kinetic energy, nondim. !! Making this larger increases the diffusivity. - real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar. - !! Making this larger increases the diffusivity. + real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit + !! conversion factor. Making this larger increases the diffusivity. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the !! diffusive length scale by rotation. Making this larger decreases !! the diffusivity in the planetary boundary layer. @@ -62,8 +62,8 @@ module MOM_energetic_PBL !! boundary layer thickness. The default is 0, but a !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when - !! Use_MLD_iteration is true, in m. - real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in m. + !! Use_MLD_iteration is true, in Z. + real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z. !! The default (0) does not set a minimum. real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE !! due to enhanced dissipation in the presence of negative (unstable) @@ -145,8 +145,8 @@ module MOM_energetic_PBL diag_TKE_conv_decay, & !< The decay of convective TKE, in J m-2. diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer, in J m-2. ! Additional output parameters also 2d - ML_depth, & !< The mixed layer depth in m. (result after iteration step) - ML_depth2, & !< The mixed layer depth in m. (guess for iteration step) + ML_depth, & !< The mixed layer depth in Z. (result after iteration step) + ML_depth2, & !< The mixed layer depth in Z. (guess for iteration step) Enhance_M, & !< The enhancement to the turbulent velocity scale (non-dim) MSTAR_MIX, & !< Mstar used in EPBL MSTAR_LT, & !< Mstar for Langmuir turbulence @@ -183,9 +183,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_3d !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are referred - !! to as H below. + intent(inout) :: h_3d !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points, !! m s-1. @@ -212,11 +210,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real, intent(in) :: dt !< Time increment, in s. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces, - !! in m2 s-1. + !! in Z2 s-1. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Buoy_Flux !< The surface buoyancy flux. in m2/s3. + intent(in) :: Buoy_Flux !< The surface buoyancy flux in Z2/s3. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two callse to !! mixedlayer, in s. @@ -257,33 +255,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! For a traditional Kraus-Turner mixed layer, the values are: ! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -! Arguments: h_3d - Layer thickness, in m or kg m-2. (Intent in/out) -! The units of h are referred to as H below. -! (in) u_3d - Zonal velocities interpolated to h points, m s-1. -! (in) v_3d - Zonal velocities interpolated to h points, m s-1. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - Time increment, in s. -! (out) Kd_int - The diagnosed diffusivities at interfaces, in m2 s-1. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! mixedlayer_init. -! (in) dSV_dT - The partial derivative of in-situ specific volume with -! potential temperature, in m3 kg-1 K-1. -! (in) dSV_dS - The partial derivative of in-situ specific volume with -! salinity, in m3 kg-1 ppt-1. -! (in) TKE_forced - The forcing requirements to homogenize the forcing -! that has been applied to each layer through each layer, in J m-2. -! (in) Buoy_Flux - The surface buoyancy flux. in m2/s3. -! (in,opt) dt_diag - The diagnostic time step, which may be less than dt -! if there are two callse to mixedlayer, in s. -! (in,opt) last_call - if true, this is the last call to mixedlayer in the -! current time step, so diagnostics will be written. -! The default is .true. - real, dimension(SZI_(G),SZK_(GV)) :: & h, & ! The layer thickness, in H (usually m or kg m-2). T, & ! The layer temperatures, in deg C. @@ -364,9 +335,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dt_h ! The timestep divided by the averages of the thicknesses around ! a layer, times a thickness conversion factor, in H s m-2. real :: h_bot ! The distance from the bottom, in H. - real :: h_rsum ! The running sum of h from the top, in H. + real :: h_rsum ! The running sum of h from the top, in Z. real :: I_hs ! The inverse of h_sum, in H-1. - real :: I_mld ! The inverse of the current value of MLD, in H-1. + real :: I_MLD ! The inverse of the current value of MLD, in Z-1. real :: h_tt ! The distance from the surface or up to the next interface ! that did not exhibit turbulent mixing from this scheme plus ! a surface mixing roughness length given by h_tt_min, in H. @@ -376,14 +347,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: vonKar ! The vonKarman constant. real :: I_dtrho ! 1.0 / (dt * Rho0) in m3 kg-1 s-1. This is ! used convert TKE back into ustar^3. - real :: U_star ! The surface friction velocity, in m s-1. + real :: U_star ! The surface friction velocity, in Z s-1. real :: U_Star_Mean ! The surface friction without gustiness in m s-1. real :: vstar ! An in-situ turbulent velocity, in m s-1. real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. real :: LA ! The Langmuir number (non-dim) real :: LAmod ! A modified Langmuir number accounting for other parameters. real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a - ! conversion factor from H to M, in m H-1. + ! conversion factor from H to Z, in Z H-1. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing, nondim. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing, nondim. between 0 and 1. @@ -402,7 +373,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dPE_conv ! The convective change in column potential energy, in J m-2. real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K), in J m-2. real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K), in J m-2 H-1. - real :: Kd_guess0, PE_chg_g0, dPEa_dKd_g0, Kddt_h_g0 + real :: Kd_guess0 ! A first guess of the diapycnal diffusivity, in Z2 s-1. + real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 + real :: dPEa_dKd_g0 + real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided + ! by the average thicknesses around a layer, in H (m or kg m-2). real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) ! for very small values of Kddt_h(K), in J m-2 H-1. @@ -431,18 +406,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0), in m3 kg-1 s-1. real, dimension(SZI_(G),SZJ_(G)) :: & - Hsfc_used ! The thickness of the surface region after buffer layer + Hsfc_used ! The thickness of the surface region in Z logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. - ! detrainment, in units of m. ! Local column copies of energy change diagnostics, all in J m-2. real :: dTKE_conv, dTKE_forcing, dTKE_mixing real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth ! - needed to compute new mixing length. - real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in m. - real :: max_MLD, min_MLD ! Iteration bounds, in m, which are adjusted at each step + real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in Z. + real :: max_MLD, min_MLD ! Iteration bounds, in Z, which are adjusted at each step ! - These are initialized based on surface/bottom ! 1. The iteration guesses a value (possibly from ! prev step or neighbor). @@ -490,29 +464,29 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & integer, save :: NOTCONVERGED! !-End BGR iteration parameters----------------------------------------- real :: N2_dissipation - real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) + real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only) - real :: STAB_SCALE ! Composite of Stabilizing length scales: - ! Ekman scale and Monin-Obukhov scale. - real :: iL_Ekman ! Inverse of Ekman length scale - real :: iL_Obukhov ! Inverse of Obukhov length scale + real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales, in Z + real :: iL_Ekman ! Inverse of Ekman length scale, in Z-1 + real :: iL_Obukhov ! Inverse of Obukhov length scale, in Z-1 real :: MLD_o_Ekman ! > real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_stab ! > real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_un ! > - real :: C_MO = 1. ! Constant in STAB_SCALE for Monin-Obukhov - real :: C_EK = 2. ! Constant in STAB_SCALE for Ekman length - real :: MLD_over_STAB ! Mixing layer depth divided by STAB_SCALE - real :: MSTAR_MIX! The value of mstar (Proportionality of TKE to drive mixing to ustar + real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov + real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length + real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale + real :: MSTAR_MIX ! The value of mstar (Proportionality of TKE to drive mixing to ustar ! cubed) which is computed as a function of latitude, boundary layer depth, ! and the Monin-Obukhov depth. - real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence + real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence real :: MSTAR_Conv_Adj ! Adjustment made to mstar due to convection reducing mechanical mixing. real :: MSTAR_STAB, MSTAR_ROT ! Mstar in each limit, max is used. logical :: debug=.false. ! Change this hard-coded value for debugging. -! The following arrays are used only for debugging purposes. + + ! The following arrays are used only for debugging purposes. real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt real, dimension(SZI_(G),SZK_(GV)) :: & @@ -577,7 +551,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !!OMP TKE_forced,debug,H_neglect,dSV_dT, & !!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & !!OMP max_itt,Kd_int) & -!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & +!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & !!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, & !!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & !!OMP pres,dMass,dPres,dT_to_dPE,dS_to_dPE, & @@ -609,8 +583,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & Kd(i,K) = 0.0 enddo ; enddo do i=is,ie - CS%ML_depth(i,j) = h(i,1)*GV%H_to_m - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_m + CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z + !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z sfc_connected(i) = .true. enddo @@ -626,17 +600,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! interface. do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - U_Star = fluxes%ustar(i,j) + U_star = GV%m_to_Z*fluxes%ustar(i,j) U_Star_Mean = fluxes%ustar_gustless(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & + fluxes%frac_shelf_h(i,j) * GV%m_to_Z*fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min ! Computing Bf w/ limiters. - Bf_Stable = max(0.0,buoy_Flux(i,j)) ! Positive for stable - Bf_Unstable = min(0.0,buoy_flux(i,j)) ! Negative for unstable + Bf_Stable = max(0.0, buoy_Flux(i,j)) ! Positive for stable + Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -646,13 +620,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif ! Computing stability scale which correlates with TKE for mixing, where ! TKE for mixing = TKE production minus TKE dissipation - Stab_Scale = u_star**2 / ( VonKar * ( C_MO * BF_Stable/u_star - C_EK * u_star * absf(i))) + Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i))) ! Inverse of Ekman and Obukhov - iL_Ekman = absf(i)/U_star - iL_Obukhov = buoy_flux(i,j)*vonkar/U_Star**3 + iL_Ekman = absf(i) / U_star + iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3) if (CS%Mstar_Mode == CS%CONST_MSTAR) then - mech_TKE(i) = (dt*CS%mstar*GV%Rho0)*((U_Star**3)) + mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * GV%Z_to_m**3 * U_star**3 conv_PErel(i) = 0.0 if (CS%TKE_diagnostics) then @@ -692,7 +666,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & pres(i,1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(i,k) - dPres = GV%g_Earth * dMass + dPres = (GV%g_Earth*GV%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) dT_to_dColHt(i,k) = dMass * dSV_dT(i,j,k) @@ -714,18 +688,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !/The following lines are for the iteration over MLD !{ ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_m ; enddo + max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo min_MLD = 0.0 !min_MLD will initialize as 0. !/BGR: May add user-input bounds for max/min MLD !/BGR: Add MLD_guess based on stored previous value. ! note that this is different from ML_Depth already ! computed by EPBL, need to figure out why. - if (CS%MLD_iteration_guess .and. CS%ML_Depth2(i,j) > 1.) then + if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*GV%m_to_Z)) then !If prev value is present use for guess. - MLD_guess=CS%ML_Depth2(i,j) + MLD_guess = CS%ML_Depth2(i,j) else - !Otherwise guess middle of water column (or stab_scale if smaller). + !Otherwise guess middle of water column (or Stab_Scale if smaller). MLD_guess = 0.5 * (min_MLD+max_MLD) endif @@ -738,8 +712,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then ! Reset ML_depth - CS%ML_depth(i,j) = h(i,1)*GV%H_to_m - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_m + CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z + !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z sfc_connected(i) = .true. @@ -771,8 +745,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif elseif (CS%MSTAR_MODE == CS%EKMAN_o_OBUKHOV) then !### Please refrain from using the construct A / B / C in place of A/(B*C). - mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable/u_star**2/(absf(i)+1.e-10)) - mstar_ROT = CS%C_EK*log(max(1.,u_star/(absf(i)+1.e-10)/mld_guess)) + mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / U_star**2 / (absf(i)+1.e-10)) + mstar_ROT = CS%C_EK * log(max(1., U_star / (absf(i)+1.e-10) / MLD_guess)) if ( CS%MSTAR_CAP <= 0.0) then !No cap. MSTAR_MIX = max(mstar_STAB,& ! 1st term if balance of rotation and stabilizing ! the balance is f(L_Ekman,L_Obukhov) @@ -795,18 +769,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! Adjustment for unstable buoyancy flux. ! Convection reduces mechanical mixing because there ! is less density gradient to mix. (Statically unstable near surface) - MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable+1.e-10) / & - ( (-Bf_Unstable+1.e-10)+ & - 2. *MSTAR_MIX *U_STAR**3 / MLD_GUESS ) + MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*GV%m_to_Z**2) / & + ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2) + & + 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) if (CS%USE_LT) then - call get_Langmuir_Number( LA, G, GV, abs(MLD_guess), u_star_mean, I, J, & + call get_Langmuir_Number( LA, G, GV, abs(GV%Z_to_m*MLD_guess), u_star_mean, i, j, & H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) ! 2. Get parameters for modified LA - MLD_o_Ekman = abs(MLD_guess*iL_Ekman) - MLD_o_Obukhov_stab = abs(max(0.,MLD_guess*iL_Obukhov)) - MLD_o_Obukhov_un = abs(min(0.,MLD_guess*iL_Obukhov)) - Ekman_o_Obukhov_stab = abs(max(0.,iL_Obukhov/(iL_Ekman+1.e-10))) - Ekman_o_Obukhov_un = abs(min(0.,iL_Obukhov/(iL_Ekman+1.e-10))) + MLD_o_Ekman = abs(MLD_guess * iL_Ekman) + MLD_o_Obukhov_stab = abs(max(0., MLD_guess*iL_Obukhov)) + MLD_o_Obukhov_un = abs(min(0., MLD_guess*iL_Obukhov)) + Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) + Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) ! 3. Adjust LA based on various parameters. ! Assumes linear factors based on length scale ratios to adjust LA ! Note when these coefficients are set to 0 recovers simple LA. @@ -830,7 +804,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif endif !Reset mech_tke and conv_perel values (based on new mstar) - mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * (dt*GV%Rho0*U_Star**3) + mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * & + GV%Z_to_m**3 * (dt*GV%Rho0*U_star**3) conv_PErel(i) = 0.0 if (CS%TKE_diagnostics) then CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 @@ -881,7 +856,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & I_MLD = 1.0 / MLD_guess ; h_rsum = 0.0 MixLen_shape(1) = 1.0 do K=2,nz+1 - h_rsum = h_rsum + h(i,k-1)*GV%H_to_m + h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z if (CS%MixLenExponent==2.0)then MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2!CS%MixLenExponent @@ -913,7 +888,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! different rates. The following form is often used for mechanical ! stirring from the surface, perhaps due to breaking surface gravity ! waves and wind-driven turbulence. - Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_Star) * GV%H_to_m + Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z exp_kh = 1.0 if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i)) if (CS%TKE_diagnostics) & @@ -984,7 +959,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) endif endif - dt_h = (GV%m_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) + dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) ! This tests whether the layers above and below this interface are in ! a convetively stable configuration, without considering any effects of @@ -1074,13 +1049,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) if (TKE_here > 0.0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - hbs_here = GV%H_to_m * min(hb_hs(i,K), MixLen_shape(K)) + hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) Mixing_Length_Used(k) = MAX(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) !Note setting Kd_guess0 to Mixing_Length_Used(K) here will ! change the answers. Therefore, skipping that. if (.not.CS%Use_MLD_Iteration) then - Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & + Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) @@ -1126,16 +1101,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) if (TKE_here > 0.0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - hbs_here = GV%H_to_m * min(hb_hs(i,K), MixLen_shape(K)) + hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) if (.not.CS%Use_MLD_Iteration) then ! Note again (as prev) that using Mixing_Length_Used here ! instead of redoing the computation will change answers... - Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & + Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else - Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) + Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) endif else vstar = 0.0 ; Kd(i,k) = 0.0 @@ -1174,8 +1149,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 endif if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_m * h(i,k) - !CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_m * h(i,k) + CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) + ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) endif Kddt_h(K) = Kd(i,k)*dt_h @@ -1199,8 +1174,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src) conv_PErel(i) = TKE_reduc*conv_PErel(i) if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_m * h(i,k) - !CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_m * h(i,k) + CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) + ! CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) endif elseif (tot_TKE == 0.0) then ! This can arise if nstar_FC = 0. @@ -1302,7 +1277,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + & - (PE_chg / PE_chg_g0) * GV%H_to_m * h(i,k) + (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k) tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 sfc_disconnect = .true. endif @@ -1386,18 +1361,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ITmin(obl_it) = min_MLD ! Track min } For debug purpose ITguess(obl_it) = MLD_guess ! Track guess } !/ - MLD_FOUND=0.0 ; FIRST_OBL=.true. + MLD_found = 0.0 ; FIRST_OBL = .true. if (CS%Orig_MLD_iteration) then !This is how the iteration was original conducted do k=2,nz if (FIRST_OBL) then !Breaks when OBL found - if (Vstar_Used(k) > 1.e-10 .and. k < nz) then - MLD_FOUND = MLD_FOUND + h(i,k-1)*GV%H_to_m + if ((Vstar_Used(k) > 1.e-10*GV%m_to_Z) .and. k < nz) then + MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z else FIRST_OBL = .false. - if (MLD_FOUND-CS%MLD_tol > MLD_guess) then + if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess - elseif ((MLD_guess-MLD_FOUND) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_m)) then + elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then OBL_CONVERGED = .true.!Break convergence loop if (OBL_IT_STATS) then !Compute iteration statistics MAXIT = max(MAXIT,obl_it) @@ -1415,10 +1390,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & enddo else !New method uses ML_DEPTH as computed in ePBL routine - MLD_FOUND=CS%ML_DEPTH(i,j) - if (MLD_FOUND-CS%MLD_tol > MLD_guess) then + MLD_found = CS%ML_Depth(i,j) + if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess - elseif (abs(MLD_guess-MLD_FOUND) < (CS%MLD_tol)) then + elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then OBL_CONVERGED = .true.!Break convergence loop if (OBL_IT_STATS) then !Compute iteration statistics MAXIT = max(MAXIT,obl_it) @@ -1433,8 +1408,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif endif ! For next pass, guess average of minimum and maximum values. - MLD_guess = min_MLD*0.5 + max_MLD*0.5 - ITresult(obl_it) = MLD_FOUND + MLD_guess = 0.5*(min_MLD + max_MLD) + ITresult(obl_it) = MLD_found endif ; enddo ! Iteration loop for converged boundary layer thickness. if (.not.OBL_CONVERGED) then !/Temp output, warn that EPBL didn't converge @@ -1477,9 +1452,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_M if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = MSTAR_MIX if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT - if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = (MLD_guess*iL_Obukhov) - if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = (MLD_guess*iL_Ekman) - if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = (iL_Obukhov/(iL_Ekman+1.e-10)) + if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov + if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman + if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m) if (allocated(CS%La)) CS%La(i,j) = LA if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod else @@ -1496,9 +1471,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif ; enddo ; ! Close of i-loop - Note unusual loop order! if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_m ; enddo + do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_Z ; enddo do k=2,nz ; do i=is,ie - if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_m + if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_Z enddo ; enddo endif @@ -1855,15 +1830,22 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig !> Copies the ePBL active mixed layer depth into MLD -subroutine energetic_PBL_get_MLD(CS, MLD, G) +subroutine energetic_PBL_get_MLD(CS, MLD, G, GV, m_to_MLD_units) type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer, in m + real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD ! Local variables + real :: scale ! A dimensional rescaling factor integer :: i,j + + scale = GV%Z_to_m ; if (present(m_to_MLD_units)) scale = scale * m_to_MLD_units + do j = G%jsc, G%jec ; do i = G%isc, G%iec - MLD(i,j) = CS%ML_depth(i,j) + MLD(i,j) = scale*CS%ML_Depth(i,j) enddo ; enddo + end subroutine energetic_PBL_get_MLD !> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship @@ -1892,7 +1874,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) CT=CT+1 u10a = u10 alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/GV%g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess z0=z0sm+z0rough CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop @@ -1948,22 +1930,21 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) real :: pi, u10 pi = 4.0*atan(1.0) if (ustar > 0.0) then - ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV) + ! Computing u10 based on ustar and COARE 3.5 relationships + call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV) ! surface Stokes drift us = us_to_u10*u10 - ! - ! significant wave height from Pierson-Moskowitz - ! spectrum (Bouws, 1998) + + ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) hm0 = 0.0246 *u10**2 - ! + ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * GV%g_Earth / tmp - ! + fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp + ! mean frequency fm = fm_to_fp * fp - ! + ! total Stokes transport (a factor r_loss is applied to account ! for the effect of directional spreading, multidirectional waves ! and the use of PM peak frequency and PM significant wave height @@ -2129,7 +2110,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & "An overall nondimensional scaling factor for v*. \n"// & "Making this larger decreases the PBL diffusivity.", & - units="nondim", default=1.0) + units="nondim", default=1.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & "A nondimensional scaling factor controlling the inhibition \n"// & "of the diffusive length scale by rotation. Making this larger \n"//& @@ -2149,11 +2130,11 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & "The tolerance for the iteratively determined mixed \n"// & "layer depth. This is only used with USE_MLD_ITERATION.", & - units="meter", default=1.0) + units="meter", default=1.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used \n"//& "by ePBL. The default (0) does not set a minimum.", & - units="meter", default=0.0) + units="meter", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & "If true, the ePBL code uses the original form of the \n"// & "potential energy change code. Otherwise, the newer \n"// & @@ -2227,13 +2208,13 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) units="nondim", default=0.95) endif ! This gives a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) - call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min, & + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) + call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*GV%Z_to_m, & "The (tiny) minimum friction velocity used within the \n"//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & - Time, 'Surface boundary layer depth', 'm', & + Time, 'Surface boundary layer depth', 'm', conversion=GV%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') @@ -2251,17 +2232,17 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm') + Time, 'Surface region thickness that is used', 'm', conversion=GV%m_to_Z) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & - Time, 'Mixing Length that is used', 'm') + Time, 'Mixing Length that is used', 'm', conversion=GV%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & - Time, 'Velocity Scale that is used.', 'm s-1') + Time, 'Velocity Scale that is used.', 'm s-1', conversion=GV%Z_to_m) CS%id_LT_enhancement = register_diag_field('ocean_model', 'LT_Enhancement', diag%axesT1, & Time, 'LT enhancement that is used.', 'nondim') CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'MSTAR that is used.', 'nondim') CS%id_OSBL = register_diag_field('ocean_model', 'ePBL_OSBL', diag%axesT1, & - Time, 'ePBL Surface Boundary layer depth.', 'm') + Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=GV%m_to_Z) ! BGR (9/21/2017) Note that ePBL_OSBL is the guess for iteration step while ePBL_h_ML is ! result from iteration step. CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 03d01ba201..4ddde1060c 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -73,10 +73,10 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & ! At least one of the two following arguments must be present. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers, - !! in m2 s-1. + !! in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces, - !! in m2 s-1. + !! in Z2 s-1. ! This subroutine calculates ea and eb, the rates at which a layer entrains ! from the layers above and below. The entrainment rates are proportional to @@ -171,7 +171,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface, in kg m-3. - real :: g_2dt ! 0.5 * G_Earth / dt, in m s-3. + real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors, in m3 H-2 s-3. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface, in Pa. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -194,7 +194,6 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & real :: h1 ! The layer thickness after entrainment through the ! interface below is taken into account, in H. real :: Idt ! The inverse of the time step, in s-1. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. logical :: do_any logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density @@ -204,7 +203,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & integer :: kb_min_act ! The minimum active value of kb in the current j-row. integer :: is1, ie1 ! The minimum and maximum active values of i in the current j-row. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H h_neglect = GV%H_subroundoff if (.not. associated(CS)) call MOM_error(FATAL, & @@ -224,9 +223,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & &and a linear equation of state to drive the model.") endif - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H - tolerance = m_to_H * CS%Tolerance_Ent - g_2dt = 0.5 * GV%g_Earth / dt + tolerance = CS%Tolerance_Ent kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 if (.not. CS%bulkmixedlayer) then @@ -252,7 +249,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_Lay,G,GV,dt,Kd_int,CS,h,tv, & !$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, & !$OMP ea,eb,correct_density,Kd_eff,diff_work, & -!$OMP g_2dt, kb_out, m_to_H, H_to_m) & +!$OMP g_2dt, kb_out) & !$OMP firstprivate(kb,ds_dsp1,dsp1_ds,pres,kb_min) & !$OMP private(dtKd,dtKd_int,do_i,Ent_bl,dtKd_kb,h_bl, & !$OMP I2p2dsp1_ds,grats,htot,max_eakb,I_dSkbp1, & @@ -270,23 +267,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & if (present(Kd_Lay)) then do k=1,nz ; do i=is,ie - dtKd(i,k) = m_to_H**2 * (dt*Kd_Lay(i,j,k)) + dtKd(i,k) = GV%Z_to_H**2 * (dt*Kd_lay(i,j,k)) enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (dt*Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K)) enddo ; enddo else do K=2,nz ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (0.5*dt*(Kd_Lay(i,j,k-1) + Kd_Lay(i,j,k))) + dtKd_int(i,K) = GV%Z_to_H**2 * (0.5*dt*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k))) enddo ; enddo endif else ! Kd_int must be present, or there already would have been an error. do k=1,nz ; do i=is,ie - dtKd(i,k) = m_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1))) + dtKd(i,k) = GV%Z_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1))) enddo ; enddo dO K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (dt*Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K)) enddo ; enddo endif @@ -384,7 +381,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & htot(i) = h(i,j,1) - Angstrom enddo if (associated(fluxes%buoy)) then ; do i=is,ie - maxF(i,1) = (dt*fluxes%buoy(i,j)) / GV%g_prime(2) + maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*GV%m_to_Z) enddo ; endif endif @@ -809,22 +806,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif ! correct_density if (CS%id_Kd > 0) then - Idt = 1.0 / dt + Idt = GV%H_to_Z**2 / dt do k=2,nz-1 ; do i=is,ie if (k 0) then + g_2dt = 0.5 * GV%H_to_Z**2 * (GV%g_Earth / dt) do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then @@ -964,7 +962,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, ea(i,j,k) = ea(i,j,k+1) ! Add the entrainment of the thin interior layers to eb going ! up into the buffer layer. - eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom) + eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom_H) endif endif ; enddo ; enddo k = kmb @@ -972,10 +970,10 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, ! Adjust the previously calculated entrainment from below by the deepest ! buffer layer to account for entrainment of thin interior layers . if (kb(i) > kmb+1) & - eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom) + eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom_H) ! Determine the entrainment from above for each buffer layer. - h1 = (h(i,j,k) - GV%Angstrom) + (eb(i,j,k) - ea(i,j,k+1)) + h1 = (h(i,j,k) - GV%Angstrom_H) + (eb(i,j,k) - ea(i,j,k+1)) ea(i,j,k) = MAX(Ent_bl(i,K), Ent_bl(i,K)-0.5*h1, -h1) endif ; enddo do k=kmb-1,2,-1 ; do i=is,ie ; if (do_i(i)) then @@ -983,7 +981,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, eb(i,j,k) = max(2.0*Ent_bl(i,K+1) - ea(i,j,k+1), 0.0) ! Determine the entrainment from above for each buffer layer. - h1 = (h(i,j,k) - GV%Angstrom) + (eb(i,j,k) - ea(i,j,k+1)) + h1 = (h(i,j,k) - GV%Angstrom_H) + (eb(i,j,k) - ea(i,j,k+1)) ea(i,j,k) = MAX(Ent_bl(i,K), Ent_bl(i,K)-0.5*h1, -h1) ! if (h1 >= 0.0) then ; ea(i,j,k) = Ent_bl(i,K) ! elseif (Ent_bl(i,K)+0.5*h1 >= 0.0) then ; ea(i,j,k) = Ent_bl(i,K)-0.5*h1 @@ -1089,7 +1087,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke -! max_ent = 1.0e14*GV%Angstrom ! This is set to avoid roundoff problems. +! max_ent = 1.0e14*GV%Angstrom_H ! This is set to avoid roundoff problems. max_ent = 1.0e4*GV%m_to_H h_neglect = GV%H_subroundoff @@ -1143,9 +1141,9 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do k=kmb+1,nz ; do i=is,ie ; if (do_i(i)) then if ((k == kb(i)) .and. (S_est(i,kmb) > (GV%Rlay(k) - 1000.0))) then if (4.0*dtKd_int(i,Kmb+1)*frac_rem(i) > & - (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom)) then + (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom_H)) then ! Entrain this layer into the buffer layer and move kb down. - dh = max((h(i,j,k) - GV%Angstrom), 0.0) + dh = max((h(i,j,k) - GV%Angstrom_H), 0.0) if (dh > 0.0) then frac_rem(i) = frac_rem(i) - ((h_bl(i,kmb) + h(i,j,k)) * dh) / & (4.0*dtKd_int(i,Kmb+1)) @@ -1163,7 +1161,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref ! This is where variables are be set up with a different vertical grid ! in which the (newly?) massless layers are taken out. do k=nz,kmb+1,-1 ; do i=is,ie - if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom) + if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom_H) if (k==kb(i)) then h_bl(i,kmb+1) = h(i,j,k) ; Sref(i,kmb+1) = GV%Rlay(k) - 1000.0 elseif (k==kb(i)+1) then @@ -1173,7 +1171,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do i=is,ie ; if (kb(i) >= nz) then h_bl(i,kmb+1) = h(i,j,nz) Sref(i,kmb+1) = GV%Rlay(nz) - 1000.0 - h_bl(i,kmb+2) = GV%Angstrom + h_bl(i,kmb+2) = GV%Angstrom_H Sref(i,kmb+2) = Sref(i,kmb+1) + (GV%Rlay(nz) - GV%Rlay(nz-1)) endif ; enddo @@ -1328,7 +1326,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & endif ! Determine the entrainment from above for each buffer layer. - h1 = (h_bl(i,k) - GV%Angstrom) + (eb(i,k) - ea(i,k+1)) + h1 = (h_bl(i,k) - GV%Angstrom_H) + (eb(i,k) - ea(i,k+1)) if (h1 >= 0.0) then ea(i,k) = Ent_bl(i,K) ; dea_dE(i,k) = 0.0 elseif (Ent_bl(i,K) + 0.5*h1 >= 0.0) then @@ -1411,7 +1409,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & if (present(dSLay)) then dz_drat = 1000.0 ! The limit of large dz_drat the same as choosing a ! Heaviside function. - eps_dSLay = 1.0e-10 ! Should be ~= GV%Angstrom / sqrt(Kd*dt) + eps_dSLay = 1.0e-10 ! Should be ~= GV%Angstrom_H / sqrt(Kd*dt) do i=is,ie ; if (do_i(i)) then dS_kbp1 = Sref(i,kmb+2) - Sref(i,kmb+1) IdS_kbp1 = 1.0 / (Sref(i,kmb+2) - Sref(i,kmb+1)) @@ -1511,7 +1509,7 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & val = dS_kbp1 * F_kb(i) err_min = -val - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent if (present(tol_in)) tolerance = tol_in bisect_next = .true. @@ -1716,7 +1714,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & call MOM_error(FATAL, "determine_Ea_kb should not be called "//& "unless BULKMIXEDLAYER is defined.") endif - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent large_err = GV%m_to_H**2 * 1.0e30 do i=is,ie ; redo_i(i) = do_i(i) ; enddo @@ -1758,7 +1756,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & fa = (1.0 + eL) + dS_kb(i)*I_dSkbp1(i) fk = dtKd_kb(i) * (dS_Lay(i)/dS_kb(i)) fm = (ea_kbp1(i) - h_bl(i,kmb+1)) + eL*2.0*Ent_bl(i,Kmb+1) - if (fm > -GV%Angstrom) fm = fm + GV%Angstrom ! This could be smooth if need be. + if (fm > -GV%Angstrom_H) fm = fm + GV%Angstrom_H ! This could be smooth if need be. err(i) = (fa * Ent(i)**2 - fm * Ent(i)) - fk derror_dE(i) = ((2.0*fa + (ddSkb_dE(i)*I_dSkbp1(i))*Ent(i))*Ent(i) - fm) - & dtKd_kb(i) * (ddSlay_dE(i)*dS_kb(i) - ddSkb_dE(i)*dS_Lay(i))/(dS_kb(i)**2) @@ -1904,7 +1902,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & integer :: i, it, is1, ie1 integer, parameter :: MAXIT = 20 - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent if (present(do_i_in)) then do i=is,ie ; do_i(i) = do_i_in(i) ; enddo @@ -2157,7 +2155,7 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) real :: decay_length, dt, Kd ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_entrain_diffusive" ! This module's name. + character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "entrain_diffusive_init called with an associated "// & @@ -2171,29 +2169,29 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) CS%bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "CORRECT_DENSITY", CS%correct_density, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "CORRECT_DENSITY", CS%correct_density, & "If true, and USE_EOS is true, the layer densities are \n"//& "restored toward their target values by the diapycnal \n"//& "mixing, as described in Hallberg (MWR, 2000).", & default=.true.) - call get_param(param_file, mod, "MAX_ENT_IT", CS%max_ent_it, & + call get_param(param_file, mdl, "MAX_ENT_IT", CS%max_ent_it, & "The maximum number of iterations that may be used to \n"//& "calculate the interior diapycnal entrainment.", default=5) ! In this module, KD is only used to set the default for TOLERANCE_ENT. (m2 s-1) - call get_param(param_file, mod, "KD", Kd, fail_if_missing=.true.) - call get_param(param_file, mod, "DT", dt, & + call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) + call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units = "s", & fail_if_missing=.true.) -! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom,1.0e-4*sqrt(dt*Kd)) ! - call get_param(param_file, mod, "TOLERANCE_ENT", CS%Tolerance_Ent, & +! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom_H,1.0e-4*sqrt(dt*Kd)) ! + call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & - units="m", default=MAX(100.0*GV%Angstrom_Z,1.0e-4*sqrt(dt*Kd))) + units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & - 'Diapycnal diffusivity as applied', 'm2 s-1') + 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & - 'Work actually done by diapycnal diffusion across each interface', 'W m-2') + 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=GV%Z_to_m) end subroutine entrain_diffusive_init diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 75e6cd8570..299c230e0b 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -99,7 +99,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & h_neglect = GV%H_subroundoff kap_dt_x2 = 0.0 if (present(Kddt_convect)) kap_dt_x2 = 2.0*Kddt_convect - mix_len = (1.0e20 * nz) * (GV%max_depth * GV%m_to_H) + mix_len = (1.0e20 * nz) * (G%max_depth * GV%Z_to_H) h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect do j=js,je diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 360c3a791d..c09d85f5b5 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -5,6 +5,7 @@ module MOM_geothermal use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : register_static_field, time_type, diag_ctrl +use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_io, only : MOM_read_data, slasher @@ -44,7 +45,7 @@ module MOM_geothermal !! the partial derivative of the coordinate density with temperature is positive !! or very small, the layers are simply heated in place. Any heat that can not !! be applied to the ocean is returned (WHERE)? -subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) +subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -69,6 +70,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) type(geothermal_CS), pointer :: CS !< The control structure returned by !! a previous call to !! geothermal_init. + integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat (H * degC) @@ -105,6 +107,9 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& "Module must be initialized before it is used.") @@ -112,7 +117,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) nkmb = GV%nk_rho_varies Irho_cp = 1.0 / (GV%H_to_kg_m2 * tv%C_p) - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref @@ -310,7 +315,7 @@ end subroutine geothermal !> Initialize parameters and allocate memory associated with the geothermal heating module. subroutine geothermal_init(Time, G, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< Current model time. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output. @@ -377,6 +382,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) CS%geo_heat(i,j) = G%mask2dT(i,j) * scale enddo ; enddo endif + call pass_var(CS%geo_heat, G%domain) ! post the static geothermal heating field id = register_static_field('ocean_model', 'geo_heat', diag%axesT1, & @@ -400,10 +406,11 @@ end subroutine geothermal_end !> \namespace mom_geothermal !! -!! Geothermal heating can be added either in a layered isopycnal mode, in which the heating raises the density of the layer to the -!! target density of the layer above, and then moves the water into that layer, or in a simple Eulerian mode, in which the bottommost -!! GEOTHERMAL_THICKNESS are heated. Geothermal heating will also provide a buoyant source of bottom TKE that can be used to further -!! mix the near-bottom water. In cold fresh water lakes where heating increases density, water should be moved into deeper layers, but -!! this is not implemented yet. +!! Geothermal heating can be added either in a layered isopycnal mode, in which the heating raises the density +!! of the layer to the target density of the layer above, and then moves the water into that layer, or in a +!! simple Eulerian mode, in which the bottommost GEOTHERMAL_THICKNESS are heated. Geothermal heating will also +!! provide a buoyant source of bottom TKE that can be used to further mix the near-bottom water. In cold fresh +!! water lakes where heating increases density, water should be moved into deeper layers, but this is not +!! implemented yet. end module MOM_geothermal diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 55834769aa..e41cc8cb2b 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -46,7 +46,7 @@ module MOM_int_tide_input type, public :: int_tide_input_type real, allocatable, dimension(:,:) :: & TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. - h2, & !< The squared topographic roughness height, in m2. + h2, & !< The squared topographic roughness height, in Z2. tideamp, & !< The amplitude of the tidal velocities, in m s-1. Nb !< The bottom stratification, in s-1. end type int_tide_input_type @@ -88,8 +88,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - kappa_fill = 1.e-3 ! m2 s-1 - dt_fill = 7200. + kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1. + dt_fill = 7200. !### Dimensionalconstant in s. use_EOS = associated(tv%eqn_of_state) @@ -128,7 +128,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) !! smooth out the values in thin layers, in degC. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f !< Salinity after vertical filtering to !! smooth out the values in thin layers, in PSU. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in m2 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in Z2 type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the @@ -141,19 +141,19 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) Temp_int, & ! The temperature at each interface, in degC. Salin_int, & ! The salinity at each interface, in PSU. drho_bot, & - h_amp, & - hb, & - z_from_bot, & + h_amp, & ! The amplitude of topographic roughness, in Z. + hb, & ! The depth below a layer, in Z. + z_from_bot, & ! The height of a layer center above the bottom, in Z. dRho_dT, & ! The partial derivatives of density with temperature and dRho_dS ! salinity, in kg m-3 degC-1 and kg m-3 PSU-1. - real :: dz_int ! The thickness associated with an interface, in m. + real :: dz_int ! The thickness associated with an interface, in Z. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density, in m4 s-2 kg-1. + ! density, in Z m3 s-2 kg-1. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie @@ -194,7 +194,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) ! Find the bottom boundary layer stratification. do i=is,ie hb(i) = 0.0 ; dRho_bot(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) h_amp(i) = sqrt(h2(i,j)) enddo @@ -202,7 +202,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above hb(i) = hb(i) + dz_int @@ -211,7 +211,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) + hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. @@ -255,8 +255,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, - ! in m. + real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in Z. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then @@ -287,7 +286,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0) + "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -330,7 +329,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1) + call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2) do j=js,je ; do i=is,ie mask_itidal = 1.0 @@ -339,11 +338,12 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. + !### Note the use here of a hard-coded nondimensional constant. itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * itide%h2(i,j) * itide%tideamp(i,j)**2 + kappa_itides * GV%Z_to_m**2*itide%h2(i,j) * itide%tideamp(i,j)**2 enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 0b0ee0a3d7..2ee8a0bdc6 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -50,7 +50,7 @@ module MOM_kappa_shear !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. real :: TKE_bg !< The background level of TKE, in m2 s-2. - real :: kappa_0 !< The background diapycnal diffusivity, in m2 s-1. + real :: kappa_0 !< The background diapycnal diffusivity, in Z2 s-1. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. integer :: nkml !< The number of layers in the mixed layer, as @@ -101,7 +101,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in m2 s-1. Initially this is the + !! (not layer!) in Z2 s-1. Initially this is the !! value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -112,7 +112,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. This discards any + !! (not layer!) in Z2 s-1. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear real, intent(in) :: dt !< Time increment, in s. @@ -126,31 +126,31 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZI_(G),SZK_(GV)+1) :: & - kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. + kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in m. - u0xdz, & ! The initial zonal velocity times dz, in m2 s-1. - v0xdz, & ! The initial meridional velocity times dz, in m2 s-1. - T0xdz, & ! The initial temperature times dz, in C m. - S0xdz ! The initial salinity times dz, in PSU m. + dz, & ! The layer thickness, in Z. + u0xdz, & ! The initial zonal velocity times dz, in Z m s-1. + v0xdz, & ! The initial meridional velocity times dz, in Z m s-1. + T0xdz, & ! The initial temperature times dz, in C Z. + S0xdz ! The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface, in - ! units of m2 s-1. + ! units of Z2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in m2 s-1. + kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in m. - real :: k0dt ! The background diffusivity times the timestep, in m2. - real :: dz_massless ! A layer thickness that is considered massless, in m. + real :: dz_in_lay ! The running sum of the thickness in a layer, in Z. + real :: k0dt ! The background diffusivity times the timestep, in Z2. + real :: dz_massless ! A layer thickness that is considered massless, in Z. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. logical :: new_kappa = .true. ! If true, ignore the value of kappa from the @@ -176,7 +176,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkappa, dtke_norm, & + Ri_k, tke_prev, dtke, dkap, dtke_norm, & ksrc_av ! The average through the iterations of k_src, in s-1. real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 @@ -193,9 +193,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all -! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 - k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) @@ -206,7 +203,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !$OMP tv,G,GV,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do j=js,je do k=1,nz ; do i=is,ie - h_2d(i,k) = h(i,j,k)*GV%H_to_m + h_2d(i,k) = h(i,j,k)*GV%H_to_Z u_2d(i,k) = u_in(i,j,k) ; v_2d(i,k) = v_in(i,j,k) enddo ; enddo if (use_temperature) then ; do k=1,nz ; do i=is,ie @@ -294,7 +291,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = 1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo endif @@ -327,8 +324,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & #ifdef ADD_DIAGNOSTICS I_Ld2_2d(i,1) = 0.0 ; dz_Int_2d(i,1) = dz_Int(1) do K=2,nzc - I_Ld2_2d(i,K) = (N2(K) / CS%lambda**2 + f2) / & - max(TKE(K),1e-30) + I_L2_bdry(K) + I_Ld2_2d(i,K) = I_L2_bdry(K) + & + (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) dz_Int_2d(i,K) = dz_Int(K) enddo I_Ld2_2d(i,nzc+1) = 0.0 ; dz_Int_2d(i,nzc+1) = dz_Int(nzc+1) @@ -360,7 +357,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo ! end of j-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI) + call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2) call hchksum(tke_io, "tke", G%HI) endif @@ -376,7 +373,7 @@ end subroutine Calculate_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in corner columns subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, CS, initialize_all) + kv_io, dt, G, GV, CS, initialize_all) 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(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -396,7 +393,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at !! each interface (not layer!) in m2 s-2. @@ -404,7 +401,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! timestep, which may accelerate the iteration !! toward convergence. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: kv_io !< The vertical viscosity at each interface in m2 s-1. + intent(inout) :: kv_io !< The vertical viscosity at each interface in Z2 s-1. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. @@ -419,33 +416,33 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & - kappa_2d ! Quasi 2-D versions of kappa_io, in m2 s-1. + kappa_2d ! Quasi 2-D versions of kappa_io, in Z2 s-1. real, dimension(SZIB_(G),SZK_(GV)+1) :: & tke_2d ! 2-D version tke_io in m2 s-2. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in m. - u0xdz, & ! The initial zonal velocity times dz, in m2 s-1. - v0xdz, & ! The initial meridional velocity times dz, in m2 s-1. - T0xdz, & ! The initial temperature times dz, in C m. - S0xdz ! The initial salinity times dz, in PSU m. + dz, & ! The layer thickness, in Z. + u0xdz, & ! The initial zonal velocity times dz, in m Z s-1. + v0xdz, & ! The initial meridional velocity times dz, in m Z s-1. + T0xdz, & ! The initial temperature times dz, in C Z. + S0xdz ! The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface, in ! units of m2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in m2 s-1. + kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in m. - real :: k0dt ! The background diffusivity times the timestep, in m2. - real :: dz_massless ! A layer thickness that is considered massless, in m. + real :: dz_in_lay ! The running sum of the thickness in a layer, in Z. + real :: k0dt ! The background diffusivity times the timestep, in Z2. + real :: dz_massless ! A layer thickness that is considered massless, in Z. real :: I_hwt ! The inverse of the masked thickness weights, in H-1. real :: I_Prandtl logical :: use_temperature ! If true, temperature and salinity have been @@ -491,9 +488,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all -! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 - k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb @@ -529,19 +523,19 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ((G%mask2dT(i+1,j) * h(i+1,j,k)) * S_in(i+1,j,k) + & (G%mask2dT(i,j+1) * h(i,j+1,k)) * S_in(i,j+1,k)) ) * I_hwt endif - h_2d(I,k) = GV%H_to_m * ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + & + h_2d(I,k) = GV%H_to_Z * ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + & (G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k)) ) / & ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + & (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) + 1.0e-36 ) -! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))*GV%H_to_m +! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))*GV%H_to_Z ! h_2d(I,k) = ((h(i,j,k)**2 + h(i+1,j+1,k)**2) + & -! (h(i+1,j,k)**2 + h(i,j+1,k)**2))*GV%H_to_m * I_hwt +! (h(i+1,j,k)**2 + h(i,j+1,k)**2))*GV%H_to_Z * I_hwt enddo ; enddo if (.not.use_temperature) then ; do k=1,nz ; do I=IsB,IeB rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = kv_io(I,J,K)*I_Prandtl + kappa_2d(I,K,J2) = kv_io(I,J,K) * I_Prandtl enddo ; enddo ; endif !--------------------------------------- @@ -623,7 +617,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = 1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo endif @@ -656,8 +650,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ #ifdef ADD_DIAGNOSTICS I_Ld2_2d(I,1) = 0.0 ; dz_Int_2d(I,1) = dz_Int(1) do K=2,nzc - I_Ld2_2d(I,K) = (N2(K) / CS%lambda**2 + f2) / & - max(TKE(K),1e-30) + I_L2_bdry(K) + I_Ld2_2d(I,K) = I_L2_bdry(K) + & + (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) dz_Int_2d(I,K) = dz_Int(K) enddo I_Ld2_2d(I,nzc+1) = 0.0 ; dz_Int_2d(I,nzc+1) = dz_Int(nzc+1) @@ -694,7 +688,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ! end of J-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI) + call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2) call Bchksum(tke_io, "tke", G%HI) endif @@ -714,7 +708,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & tke_avg, tv, CS, GV) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZK_(GV)+1), & - intent(inout) :: kappa !< The time-weighted average of kappa, in m2 s-1. + intent(inout) :: kappa !< The time-weighted average of kappa, in Z2 s-1. real, dimension(SZK_(GV)+1), & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface, in units of m2 s-2. @@ -722,17 +716,17 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, intent(in) :: f2 !< The square of the Coriolis parameter, in s-2. real, intent(in) :: surface_pres !< The surface pressure, in Pa. real, dimension(SZK_(GV)), & - intent(in) :: dz !< The layer thickness, in m. + intent(in) :: dz !< The layer thickness, in Z. real, dimension(SZK_(GV)), & - intent(in) :: u0xdz !< The initial zonal velocity times dz, in m2 s-1. + intent(in) :: u0xdz !< The initial zonal velocity times dz, in Z m s-1. real, dimension(SZK_(GV)), & - intent(in) :: v0xdz !< The initial meridional velocity times dz, in m2 s-1. + intent(in) :: v0xdz !< The initial meridional velocity times dz, in Z m s-1. real, dimension(SZK_(GV)), & - intent(in) :: T0xdz !< The initial temperature times dz, in C m. + intent(in) :: T0xdz !< The initial temperature times dz, in C Z. real, dimension(SZK_(GV)), & - intent(in) :: S0xdz !< The initial salinity times dz, in PSU m. + intent(in) :: S0xdz !< The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1), & - intent(out) :: kappa_avg !< The time-weighted average of kappa, in m2 s-1. + intent(out) :: kappa_avg !< The time-weighted average of kappa, in Z2 s-1. real, dimension(SZK_(GV)+1), & intent(out) :: tke_avg !< The time-weighted average of TKE, in m2 s-2. real, intent(in) :: dt !< Time increment, in s. @@ -745,7 +739,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. u_test, v_test, T_test, S_test @@ -753,46 +747,46 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc+1) :: & N2, & ! The squared buoyancy frequency at an interface, in s-2. dz_Int, & ! The extent of a finite-volume space surrounding an interface, - ! as used in calculating kappa and TKE, in m. + ! as used in calculating kappa and TKE, in Z. I_dz_int, & ! The inverse of the distance between velocity & density points - ! above and below an interface, in m-1. This is used to + ! above and below an interface, in Z-1. This is used to ! calculate N2, shear, and fluxes, and it might differ from ! 1/dz_Int, as they have different uses. S2, & ! The squared shear at an interface, in s-2. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, - ! velocity, and density equations, in m s-1 or m. + ! velocity, and density equations, in Z s-1 or Z. c1, & ! c1 is used in the tridiagonal (and similar) solvers. k_src, & ! The shear-dependent source term in the kappa equation, in s-1. kappa_src, & ! The shear-dependent source term in the kappa equation in s-1. - kappa_out, & ! The kappa that results from the kappa equation, in m2 s-1. + kappa_out, & ! The kappa that results from the kappa equation, in Z2 s-1. kappa_mid, & ! The average of the initial and predictor estimates of kappa, - ! in units of m2 s-1. + ! in units of Z2 s-1. tke_pred, & ! The value of TKE from a predictor step, in m2 s-2. - kappa_pred, & ! The value of kappa from a predictor step, in m2 s-1. + kappa_pred, & ! The value of kappa from a predictor step, in Z2 s-1. pressure, & ! The pressure at an interface, in Pa. T_int, & ! The temperature interpolated to an interface, in C. Sal_int, & ! The salinity interpolated to an interface, in psu. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in - dbuoy_dS, & ! temperature and salinity, in m s-2 K-1 and m s-2 psu-1. + dbuoy_dS, & ! temperature and salinity, in Z s-2 K-1 and Z s-2 psu-1. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean - ! distance to the top and bottom boundaries, in m-2. - K_Q, & ! Diffusivity divided by TKE, in s. - K_Q_tmp, & ! Diffusivity divided by TKE, in s. + ! distance to the top and bottom boundaries, in Z-2. + K_Q, & ! Diffusivity divided by TKE, in Z2 m-2 s. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE, in Z2 m-2 s. local_src_avg, & ! The time-integral of the local source, nondim. tol_min, & ! Minimum tolerated ksrc for the corrector step, in s-1. tol_max, & ! Maximum tolerated ksrc for the corrector step, in s-1. tol_chg, & ! The tolerated change integrated in time, nondim. - dist_from_top, & ! The distance from the top surface, in m. + dist_from_top, & ! The distance from the top surface, in Z. local_src ! The sum of all sources of kappa, including kappa_src and ! sources from the elliptic term, in s-1. - real :: dist_from_bot ! The distance from the bottom surface, in m. + real :: dist_from_bot ! The distance from the bottom surface, in Z. real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. real :: gR0 ! Rho_0 times g in kg m-2 s-2. - real :: g_R0 ! g_R0 is g/Rho in m4 kg-1 s-2. - real :: Norm ! A factor that normalizes two weights to 1, in m-2. + real :: g_R0 ! g_R0 is g/Rho in Z m3 kg-1 s-2. + real :: Norm ! A factor that normalizes two weights to 1, in Z-2. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc ! within an iteration. 0 < tol_dksrc_low < 1. @@ -806,7 +800,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: Idtt ! Idtt = 1 / dt_test, in s-1. real :: dt_inc ! An increment to dt_test that is being tested, in s. - real :: k0dt ! The background diffusivity times the timestep, in m2. + real :: k0dt ! The background diffusivity times the timestep, in Z2. logical :: valid_dt ! If true, all levels so far exhibit acceptably small ! changes in k_src. logical :: use_temperature ! If true, temperature and salinity have been @@ -821,7 +815,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & integer :: k, itt, itt_dt Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 + gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z**2)/GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? @@ -846,7 +840,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! layers and applying a time-step of background diffusion. if (nzc > 1) then a1(2) = k0dt*I_dz_int(2) - b1 = 1.0 / (dz(1)+a1(2)) + b1 = 1.0 / (dz(1) + a1(2)) u(1) = b1 * u0xdz(1) ; v(1) = b1 * v0xdz(1) T(1) = b1 * T0xdz(1) ; Sal(1) = b1 * S0xdz(1) c1(2) = a1(2) * b1 ; d1 = dz(1) * b1 ! = 1 - c1 @@ -904,14 +898,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do K=nzc,2,-1 dist_from_bot = dist_from_bot + dz(k) I_L2_bdry(K) = (dist_from_top(K) + dist_from_bot)**2 / & - (dist_from_top(K) * dist_from_bot)**2 + (dist_from_top(K) * dist_from_bot)**2 enddo ! Calculate thermodynamic coefficients and an initial estimate of N2. if (use_temperature) then pressure(1) = surface_pres do K=2,nzc - pressure(K) = pressure(K-1) + gR0*dz(k-1) + pressure(K) = pressure(K-1) + gR0*GV%Z_to_m*dz(k-1) T_int(K) = 0.5*(T(k-1) + T(k)) Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo @@ -968,7 +962,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! This call just calculates N2 and S2. call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2=N2, S2=S2) + u, v, T, Sal, GV, N2=N2, S2=S2) ! ---------------------------------------------------- ! Iterate ! ---------------------------------------------------- @@ -999,7 +993,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q, tke, kappa_out, kappa_src, local_src) + nzc, CS, GV, K_Q, tke, kappa_out, kappa_src, local_src) ! call cpu_clock_end(id_clock_KQ) ! call cpu_clock_begin(id_clock_avg) @@ -1038,7 +1032,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! enough. call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2, S2, & + u_test, v_test, T_test, S_test, GV, N2, S2, & ks_int = ks_kappa, ke_int = ke_kappa) valid_dt = .true. Idtt = 1.0 / dt_test @@ -1065,7 +1059,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do itt_dt=1,dt_refinements call calculate_projected_state(kappa_out, u, v, T, Sal, & 0.5*(dt_test+dt_inc), nzc, dz, I_dz_int, dbuoy_dT, & - dbuoy_dS, u_test, v_test, T_test, S_test, N2, S2, & + dbuoy_dS, u_test, v_test, T_test, S_test, GV, N2, S2, & ks_int = ks_kappa, ke_int = ke_kappa) valid_dt = .true. Idtt = 1.0 / (dt_test+dt_inc) @@ -1119,14 +1113,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2=N2, S2=S2, & + u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, & ks_int = ks_kappa, ke_int = ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) do K=1,nzc+1 ; K_Q_tmp(K) = K_Q(K) ; enddo call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q_tmp, tke_pred, kappa_pred) + nzc, CS, GV, K_Q_tmp, tke_pred, kappa_pred) ! call cpu_clock_end(id_clock_KQ) ks_kappa = GV%ke+1 ; ke_kappa = 0 @@ -1139,13 +1133,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2=N2, S2=S2, & + u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, & ks_int = ks_kappa, ke_int = ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q, tke_pred, kappa_pred) + nzc, CS, GV, K_Q, tke_pred, kappa_pred) ! call cpu_clock_end(id_clock_KQ) ! call cpu_clock_begin(id_clock_avg) @@ -1164,7 +1158,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2, S2) + u, v, T, Sal, GV, N2, S2) ! call cpu_clock_end(id_clock_project) endif @@ -1198,7 +1192,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_k(K) = 1e3 ; if (N2(K) < 1e3 * S2(K)) Ri_k(K) = N2(K) / S2(K) dtke(K) = tke_pred(K) - tke(K) dtke_norm(K) = dtke(K) / (0.5*(tke(K) + tke_pred(K))) - dkappa(K) = kappa_pred(K) - kappa_out(K) + dkap(K) = kappa_pred(K) - kappa_out(K) enddo if (itt <= max_debug_itt) then do k=1,nzc @@ -1215,7 +1209,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (abs(dkappa_it1(K,itt-1)) > 1e-20) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif - dkappa_norm(K,itt) = dkappa(K) / max(0.5*(Kappa_pred(K) + kappa_out(K)), 1e-100) + dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), GV%m_to_Z**2*1e-100) enddo endif #endif @@ -1231,27 +1225,28 @@ end subroutine kappa_shear_column !! may also calculate the projected buoyancy frequency and shear. subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2, S2, ks_int, ke_int) + u, v, T, Sal, GV, N2, S2, ks_int, ke_int) integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, - !! in m2 s-1. + !! in Z2 s-1. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity, in m s-1. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity, in m s-1. real, dimension(nz), intent(in) :: T0 !< The initial temperature, in C. real, dimension(nz), intent(in) :: S0 !< The initial salinity, in PSU. - real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in m. + real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in Z. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses, - !! in m-1. + !! in Z-1. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature, in m s-2 C-1. + !! temperature, in Z s-2 C-1. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity, in m s-2 PSU-1. + !! salinity, in Z s-2 PSU-1. real, intent(in) :: dt !< The time step in s. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: T !< The temperature after dt, in C. real, dimension(nz), intent(inout) :: Sal !< The salinity after dt, in PSU. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(nz+1), optional, & intent(inout) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. @@ -1263,6 +1258,8 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! Local variables real, dimension(nz+1) :: c1 + real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth + ! units squared, in Z2 m-2. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1325,14 +1322,15 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif if (present(S2)) then + L2_to_Z2 = GV%m_to_Z**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & - S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * I_dz_int(ks)**2 + S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * L2_to_Z2*I_dz_int(ks)**2 do K=ks+1,ke - S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * I_dz_int(K)**2 + S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * L2_to_Z2*I_dz_int(K)**2 enddo if (ke This subroutine calculates new, consistent estimates of TKE and kappa. subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & - nz, CS, K_Q, tke, kappa, kappa_src, local_src) + nz, CS, GV, K_Q, tke, kappa, kappa_src, local_src) integer, intent(in) :: nz !< The number of layers to work on. real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces, in s-2. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity, - !! in m2 s-1. - real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces, - !! in m. + !! in Z2 s-1. + real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces, + !! in Z-1. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to !! boundaries, m2. - real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in m-1. + real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in Z-1. real, intent(in) :: f2 !< The squared Coriolis parameter, in s-2. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at !! interfaces, in s. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at !! interfaces, in units of m2 s-2. - real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces, - !! in m2 s-1. + real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces, + !! in Z2 s-1. real, dimension(nz+1), optional, & intent(out) :: kappa_src !< The source term for kappa, in s-1. real, dimension(nz+1), optional, & @@ -1387,16 +1386,16 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! equations, in m s-1. dQdz ! Half the partial derivative of TKE with depth, m s-2. real, dimension(nz+1) :: & - dK, & ! The change in kappa, in m2 s-1. - dQ, & ! The change in TKE, in m2 s-1. + dK, & ! The change in kappa, in Z2 s-1. + dQ, & ! The change in TKE, in m2 s-2. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations, ND. I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale - ! for kappa, in units of m-2. + ! for kappa, in units of Z-2. TKE_decay, & ! The local TKE decay rate in s-1. k_src, & ! The source term in the kappa equation, in s-1. - dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), s. - dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), s-1. + dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), m2 s Z-2. + dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), Z2 m-2 s-1. e1 ! The fractional change in a layer TKE due to a change in the ! TKE of the layer above when all the kappas below are 0. ! e1 is nondimensional, and 0 < e1 < 1. @@ -1404,7 +1403,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! and stratification, in m2 s-3. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) - real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations. + real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations, in Z-1. real :: bd1 ! A term in the denominator of bQ or bK. real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. real :: c_s2 ! The coefficient for the decay of TKE due to @@ -1417,21 +1416,26 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: Ilambda2 ! 1.0 / CS%lambda**2. real :: TKE_min ! The minimum value of shear-driven TKE that can be ! solved for, in m2 s-2. - real :: kappa0 ! The background diapycnal diffusivity, in m2 s-1. + real :: kappa0 ! The background diapycnal diffusivity, in Z2 s-1. real :: max_err ! The maximum value of norm_err in a column, nondim. - real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, m2 s-1. + real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. real :: diffusive_src ! The diffusive source in the kappa equation, in m s-1. real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink, in s-1. - real :: kappa_mean ! A mean value of kappa, in m2 s-1. + real :: kappa_mean ! A mean value of kappa, in Z2 s-1. real :: Newton_test ! The value of relative error that will cause the next ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. - real :: decay_term, I_Q, kap_src, v1, v2 - + real :: decay_term_k ! The decay term in the diffusivity equation + real :: decay_term_Q ! The decay term in the TKE equation + real :: I_Q ! The inverse of TKE, in s2 m-2 + real :: kap_src + real :: v1, v2 + real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length + ! units squared, in m2 Z-2. real :: tol_err ! The tolerance for max_err that determines when to ! stop iterating. real :: Newton_err ! The tolerance for max_err that determines when to @@ -1456,7 +1460,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: K_err_lin, Q_err_lin real, dimension(nz+1) :: & - kappa_prev, & ! The value of kappa at the start of the current iteration, in m2 s-1. + kappa_prev, & ! The value of kappa at the start of the current iteration, in Z2 s-1. TKE_prev ! The value of TKE at the start of the current iteration, in m2 s-2. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. @@ -1471,6 +1475,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20) Ri_crit = CS%Rino_crit Ilambda2 = 1.0 / CS%lambda**2 + Z2_to_L2 = GV%Z_to_m**2 kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER? do_Newton = .false. ; abort_Newton = .false. tol_err = CS%kappa_tol_err @@ -1554,13 +1559,13 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! terms. ke_tke = max(ke_kappa,ke_kappa_prev)+1 - ! aQ is the coupling between adjacent interfaces in m s-1. + ! aQ is the coupling between adjacent interfaces in Z s-1. do k=1,min(ke_tke,nz) - aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) + aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo dQ(1) = -TKE(1) if (tke_noflux_top_BC) then - tke_src = kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 + tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 bd1 = dz_Int(1) * TKE_decay(1) bQ = 1.0 / (bd1 + aQ(1)) tke(1) = bQ * (dz_Int(1)*tke_src) @@ -1570,8 +1575,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,ke_tke-1 dQ(K) = -TKE(K) - tke_src = (kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) - bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*K_Q(K)) + cQcomp*aQ(k-1) + tke_src = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) + bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1) bQ = 1.0 / (bd1 + aQ(k)) tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) cQ(K+1) = aQ(k) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ @@ -1581,7 +1586,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQ(nz+1) = 0.0 else k = ke_tke - tke_src = kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 + tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 if (K == nz+1) then dQ(K) = -TKE(K) bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) @@ -1624,12 +1629,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(1) = 0.0 ! kappa takes boundary values of 0. cK(2) = 0.0 ; cKcomp = 1.0 if (itt == 1) then ; dO K=2,nz - I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) enddo ; endif do K=2,nz dK(K) = -kappa(K) if (itt>1) & - I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) bd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) bK = 1.0 / (bd1 + Idz(k)) @@ -1673,7 +1678,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1) if (tke_noflux_top_BC) then - tke_src = dz_Int(1) * (kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & + tke_src = dz_Int(1) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & aQ(1) * (TKE(1) - TKE(2)) bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1)) @@ -1686,21 +1691,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,nz I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa(K)) + & - Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) + Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) ! Ensure that the pivot is always positive, and that 0 <= cK <= 1. ! Otherwise do not use Newton's method. - decay_term = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K) - if (decay_term < 0.0) then ; abort_Newton = .true. ; exit ; endif - bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term) + decay_term_k = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K) + if (decay_term_k < 0.0) then ; abort_Newton = .true. ; exit ; endif + bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term_k) cK(K+1) = bK * Idz(k) - cKcomp = bK * (Idz(k-1)*cKcomp + decay_term) ! = 1-cK(K+1) + cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - (N2(K)*Ilambda2 + f2)*I_Q**2*kappa(K)) + GV%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. @@ -1714,21 +1719,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Solve for dQ(K)... aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k) - tke_src = dz_Int(K) * ((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k) - & - (TKE(k) - q0)*TKE_decay(k)) - & + tke_src = dz_Int(K) * (Z2_to_L2*((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k)) - & + (TKE(k) - q0)*TKE_decay(k)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) v2 = (v1*dQmdK(K) + dQdz(k-1)*cK(K)) + & - ((dQdz(k-1) - dQdz(k)) + dz_Int(K)*(S2(K) - N2(K))) + ((dQdz(k-1) - dQdz(k)) + Z2_to_L2*dz_Int(K)*(S2(K) - N2(K))) ! Ensure that the pivot is always positive, and that 0 <= cQ <= 1. ! Otherwise do not use Newton's method. - decay_term = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K) - if (decay_term < 0.0) then ; abort_Newton = .true. ; exit ; endif - bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term)) + decay_term_Q = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K) + if (decay_term_Q < 0.0) then ; abort_Newton = .true. ; exit ; endif + bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) cQ(K+1) = aQ(k) * bQ - cQcomp = (cQcomp*aQ(k-1) + decay_term) * bQ + cQcomp = (cQcomp*aQ(k-1) + decay_term_Q) * bQ dQmdK(K+1) = (v2 * cK(K+1) - dQdz(k)) * bQ ! Ensure that TKE+dQ will not drop below 0.5*TKE. @@ -1746,15 +1751,15 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0 if (tke_noflux_bottom_BC) then K = nz+1 - tke_src = dz_Int(K) * (kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & + tke_src = dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & aQ(k-1) * (TKE(K-1) - TKE(K)) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) - decay_term = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K)) - if (decay_term < 0.0) then + decay_term_Q = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K)) + if (decay_term_Q < 0.0) then abort_Newton = .true. else - bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term)) + bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) ! Ensure that TKE+dQ will not drop below 0.5*TKE. dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), & -0.5*TKE(K)) @@ -1772,10 +1777,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (K < nz+1) then ! Ignore this source? aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & - (aQ(k) * (TKE(K) - TKE(K+1)) - & - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & - (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) + tke_src = (dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & + (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & + (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) endif #endif dK(K) = 0.0 @@ -1816,7 +1820,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif #ifdef DEBUG - ! Check these solutions for consistency. + ! Check these solutions for consistency. + ! The unit conversions here have not been carefully tested. do K=2,nz ! In these equations, K_err_lin and Q_err_lin should be at round-off levels ! compared with the dominant terms, perhaps, dz_Int*I_Ld2*kappa and @@ -1824,23 +1829,23 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! been increased to ensure a positive pivot, or 2) negative TKEs have been ! truncated, or 3) small or negative kappas have been rounded toward 0. I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa_prev(K)) + & - (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & - Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) - K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & + (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & + Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) + K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & dz_Int(K)*I_Ld2(K)*dK(K) - kap_src - & - (N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) + GV%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) - tke_src = dz_Int(K) * ((kappa_prev(K) + kappa0)*S2(K) - & - kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & + tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & + Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - & aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) Q_err_lin = (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & - dz_Int(K) * (dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src + dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src enddo #endif endif ! End of the Newton's method solver. @@ -1942,8 +1947,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (present(local_src)) then local_src(1) = 0.0 ; local_src(nz+1) = 0.0 do K=2,nz - diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + & - Idz(k)*(kappa(K+1)-kappa(K)) + diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + Idz(k)*(kappa(K+1)-kappa(K)) chg_by_k0 = kappa0 * ((Idz(k-1)+Idz(k)) / dz_Int(K) + I_Ld2(K)) if (diffusive_src <= 0.0) then local_src(K) = k_src(K) + chg_by_k0 @@ -2023,7 +2027,8 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & "The background diffusivity that is used to smooth the \n"//& "density and shear profiles before solving for the \n"//& - "diffusivities. Defaults to value of KD.", units="m2 s-1", default=KD_normal) + "diffusivities. Defaults to value of KD.", & + units="m2 s-1", default=KD_normal, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the \n"//& "Richardson number in the kappa source term in the \n"//& @@ -2098,14 +2103,14 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) CS%diag => diag CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, & - 'Shear-driven Diapycnal Diffusivity', 'm2 s-1') + 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, & 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') #ifdef ADD_DIAGNOSTICS CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & - 'Inverse kappa decay scale at interfaces', 'm-2') + 'Inverse kappa decay scale at interfaces', 'm-2', conversion=GV%m_to_Z**2) CS%id_dz_Int = register_diag_field('ocean_model','dz_Int_shear',diag%axesTi,Time, & - 'Finite volume thickness of interfaces', 'm') + 'Finite volume thickness of interfaces', 'm', conversion=GV%Z_to_m) #endif end function kappa_shear_init diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 26a23a0f0d..db90deeaca 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -5,7 +5,6 @@ module MOM_opacity use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field -use MOM_time_manager, only : get_time use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase @@ -116,14 +115,14 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif ! Make sure there is no division by 0. - inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_z, & + inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_m, & GV%H_to_m*GV%H_subroundoff) if ( CS%Opacity_scheme == DOUBLE_EXP ) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = inv_sw_pen_scale optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & - 0.1*GV%Angstrom_z,GV%H_to_m*GV%H_subroundoff) + 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) enddo ; enddo ; enddo if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) @@ -225,7 +224,6 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) ! radiation, in W m-2. type(time_type) :: day character(len=128) :: mesg - integer :: days, seconds integer :: i, j, k, n, is, ie, js, je, nz, nbands logical :: multiband_vis_input, multiband_nir_input @@ -271,7 +269,6 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) else ! Only the 2-d surface chlorophyll can be read in from a file. The ! same value is assumed for all layers. - call get_time(CS%Time,seconds,days) call time_interp_external(CS%sbc_chl, CS%Time, chl_data) do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (chl_data(i,j) < 0.0)) then diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 1b9b1ff6ef..5bf74bf66c 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -42,7 +42,7 @@ module MOM_regularize_layers real :: h_def_tol4 !< The value of the relative thickness deficit at which to do !! detrainment from the buffer layers to the interior at full !! force, now 50% of the way from h_def_tol1 to 1. - real :: Hmix_min !< The minimum mixed layer thickness in m. + real :: Hmix_min !< The minimum mixed layer thickness in H. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -337,20 +337,20 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) do K=1,nz_filt ; do i=is,ie ; if (do_i(i)) then if (G%mask2dCu(I,j) <= 0.0) then ; e_e = e(i,j,K) ; else e_e = max(e(i+1,j,K) + min(e(i,j,K) - e(i+1,j,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCu(I-1,j) <= 0.0) then ; e_w = e(i,j,K) ; else e_w = max(e(i-1,j,K) + min(e(i,j,K) - e(i-1,j,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCv(i,J) <= 0.0) then ; e_n = e(i,j,K) ; else e_n = max(e(i,j+1,K) + min(e(i,j,K) - e(i,j+1,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCv(i,J-1) <= 0.0) then ; e_s = e(i,j,K) ; else e_s = max(e(i,j-1,K) + min(e(i,j,K) - e(i,j-1,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif wt = max(0.0, min(1.0, I_dtol*(def_rat_h(i,j)-CS%h_def_tol1))) @@ -386,10 +386,10 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) do k=nkmb+1,nz cols_left = .false. do i=is,ie ; if (more_ent_i(i)) then - if (h_2d(i,k) - GV%Angstrom > h_neglect) then - if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - GV%Angstrom) then - h_add = h_2d(i,k) - GV%Angstrom - h_2d(i,k) = GV%Angstrom + if (h_2d(i,k) - GV%Angstrom_H > h_neglect) then + if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - GV%Angstrom_H) then + h_add = h_2d(i,k) - GV%Angstrom_H + h_2d(i,k) = GV%Angstrom_H else h_add = e_2d(i,nkmb+1)-e_filt(i,nkmb+1) h_2d(i,k) = h_2d(i,k) - h_add @@ -644,7 +644,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) h_predicted = h_2d_init(i,k) + ((d_ea(i,k) - d_eb(i,k-1)) + & (d_eb(i,k) - d_ea(i,k+1))) endif - if (abs(h(i,j,k) - h_predicted) > MAX(1e-9*abs(h_predicted),GV%Angstrom)) & + if (abs(h(i,j,k) - h_predicted) > MAX(1e-9*abs(h_predicted),GV%Angstrom_H)) & call MOM_error(FATAL, "regularize_surface: d_ea mismatch.") endif ; enddo ; enddo do i=is,ie ; if (do_i(i)) then @@ -773,7 +773,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & endif nkmb = GV%nk_rho_varies h_neglect = GV%H_subroundoff - Hmix_min = CS%Hmix_min * GV%m_to_H + Hmix_min = CS%Hmix_min ! Determine which zonal faces are problematic. do j=js,je ; do I=is-1,ie @@ -876,9 +876,10 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & end subroutine find_deficit_ratios !> Initializes the regularize_layers control structure -subroutine regularize_layers_init(Time, G, param_file, diag, CS) +subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< The current model time. 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(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate @@ -916,7 +917,7 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth \n"//& - "is determined dynamically.", units="m", default=0.0) + "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H) call get_param(param_file, mdl, "REG_SFC_DEFICIT_TOLERANCE", CS%h_def_tol1, & "The value of the relative thickness deficit at which \n"//& "to start modifying the layer structure when \n"//& diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8d3206303c..e5e55ec590 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -51,8 +51,7 @@ module MOM_set_diffusivity logical :: debug !< If true, write verbose checksums for debugging. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with - !! GV%nk_rho_varies variable density mixed & buffer - !! layers. + !! GV%nk_rho_varies variable density mixed & buffer layers. real :: FluxRi_max !< The flux Richardson number where the stratification is !! large enough that N2 > omega2. The full expression for !! the Flux Richardson number is usually @@ -69,15 +68,15 @@ module MOM_set_diffusivity !! by bottom drag drives BBL diffusion (nondim) real :: cdrag !< quadratic drag coefficient (nondim) real :: IMax_decay !< inverse of a maximum decay scale for - !! bottom-drag driven turbulence, (1/m) - real :: Kv !< The interior vertical viscosity (m2/s) - real :: Kd !< interior diapycnal diffusivity (m2/s) - real :: Kd_min !< minimum diapycnal diffusivity (m2/s) - real :: Kd_max !< maximum increment for diapycnal diffusivity (m2/s) + !! bottom-drag driven turbulence, (1/Z) + real :: Kv !< The interior vertical viscosity (Z2/s) + real :: Kd !< interior diapycnal diffusivity (Z2/s) + real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) + real :: Kd_max !< maximum increment for diapycnal diffusivity (Z2/s) !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without - !! filtering or scaling (m2/s) - real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + !! filtering or scaling (Z2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness (meter) when !! bulkmixedlayer==.false. @@ -85,11 +84,11 @@ module MOM_set_diffusivity logical :: limit_dissipation !< If enabled, dissipation is limited to be larger !! than the following: - real :: dissip_min !< Minimum dissipation (W/m3) - real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (W/m3) - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (J/m3) - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (W m-3 s2) - real :: dissip_Kd_min !< Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 + real :: dissip_min !< Minimum dissipation (Z2 m-2 W m-3) + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (Z2 m-2 W m-3) + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (Z2 m-2 W m-3 s) + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (Z2 m-2 W m-3 s2) + real :: dissip_Kd_min !< Minimum Kd (Z2/s) with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL @@ -108,7 +107,7 @@ module MOM_set_diffusivity !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence - !! radiated from the base of the mixed layer (m2/s) + !! radiated from the base of the mixed layer (Z2/s) real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below @@ -171,12 +170,12 @@ module MOM_set_diffusivity Kd_BBL => NULL(),& !< BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& !< layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(),& !< energy required to entrain to h_max (m3/s3) - KT_extra => NULL(),& !< double diffusion diffusivity for temp (m2/s) - KS_extra => NULL() !< double diffusion diffusivity for saln (m2/s) + KT_extra => NULL(),& !< double diffusion diffusivity for temp (Z2/s) + KS_extra => NULL() !< double diffusion diffusivity for saln (Z2/s) real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) !! between TKE dissipated within a layer and Kd - !! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 + !! in that layer, in Z2 s-1 / m3 s-3 = Z2 s2 m-3 end type diffusivity_diags @@ -197,7 +196,7 @@ module MOM_set_diffusivity !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via !! visc%Kv_shear subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & - G, GV, CS, Kd, Kd_int) + G, GV, CS, Kd_lay, Kd_int) 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(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -220,7 +219,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, intent(in) :: dt !< Time increment (sec). type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: Kd !< Diapycnal diffusivity of each layer (m2/sec). + intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer (m2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface (m2/sec). @@ -247,11 +246,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZK_(G)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) dRho_int, & !< locally ref potential density difference across interfaces (kg/m3) - KT_extra, & !< double difusion diffusivity of temperature (m2/sec) - KS_extra !< double difusion diffusivity of salinity (m2/sec) + KT_extra, & !< double difusion diffusivity of temperature (Z2/sec) + KS_extra !< double difusion diffusivity of salinity (Z2/sec) real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) - real :: dissip ! local variable for dissipation calculations (W/m3) + real :: dissip ! local variable for dissipation calculations (Z2 W/m5) real :: Omega2 ! squared absolute rotation rate (1/s2) logical :: use_EOS ! If true, compute density from T/S using equation of state. @@ -277,8 +276,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & "Module must be initialized before it is used.") I_Rho0 = 1.0/GV%Rho0 - kappa_fill = 1.e-3 ! m2 s-1 - dt_fill = 7200. + kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1. + dt_fill = 7200. !### Dimensionalconstant in s. Omega2 = CS%Omega*CS%Omega use_EOS = associated(tv%eqn_of_state) @@ -288,9 +287,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call MOM_error(FATAL, "set_diffusivity: both visc%Kd_extra_T and "//& "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") - ! Set Kd, Kd_int and Kv_slow to constant values. + ! Set Kd_lay, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. - Kd(:,:,:) = CS%Kd + Kd_lay(:,:,:) = CS%Kd Kd_int(:,:,:) = CS%Kd if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv @@ -347,15 +346,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call cpu_clock_begin(id_clock_kappaShear) if (CS%Vertex_shear) then call full_convection(G, GV, h, tv, T_adj, S_adj, fluxes%p_surf, & - kappa_fill*dt_fill, halo=1) + GV%Z_to_H**2*kappa_fill*dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear",G%HI) - call Bchksum(visc%Kv_shear, "after calc_KS_vert visc%Kv_shear_Bu",G%HI) - call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb",G%HI) + call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%Z_to_m**2) + call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) endif else ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????) @@ -363,9 +362,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear",G%HI) - call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear",G%HI) - call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb",G%HI) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) + call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) + call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) endif endif call cpu_clock_end(id_clock_kappaShear) @@ -374,19 +373,19 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear",G%HI) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear",G%HI) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled endif - ! Calculate the diffusivity, Kd, for each layer. This would be + ! Calculate the diffusivity, Kd_lay, for each layer. This would be ! the appropriate place to add a depth-dependent parameterization or ! another explicit parameterization of Kd. ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) - call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp) + call sfc_bkgnd_mixing(G, GV, CS%bkgnd_mixing_csp) !$OMP parallel do default(shared) private(dRho_int, N2_lay, N2_int, N2_bot, KT_extra, & !$OMP KS_extra, TKE_to_Kd,maxTKE, dissip, kb) @@ -400,21 +399,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! Add background mixing - call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) + call calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) ! Double-diffusion (old method) if (CS%double_diffusion) then call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = KS_extra(i,K)-KT_extra(i,K) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*KT_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*KT_extra(i,K) + visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = KT_extra(i,K)-KS_extra(i,K) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5**KS_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5**KS_extra(i,K) + visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -442,7 +441,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. @@ -450,15 +449,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & enddo endif do k=1,nz ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then do i=is,ie - Kd_int(i,j,1) = Kd(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 + Kd_int(i,j,1) = Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 enddo do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo endif endif @@ -474,21 +473,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the ML_Rad diffusivity. if (CS%ML_radiation) & - call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) + call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & - N2_lay, N2_int, Kd, Kd_int, CS%Kd_max, visc%Kv_slow) + N2_lay, N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then if (CS%use_LOTW_BBL_diffusivity) then call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, CS, & - Kd, Kd_int, dd%Kd_BBL) + Kd_lay, Kd_int, dd%Kd_BBL) else call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, CS, Kd, Kd_int, dd%Kd_BBL) + maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -502,8 +501,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & dissip = max( CS%dissip_min, & ! Const. floor on dissip. CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri - Kd(i,j,k) = max( Kd(i,j,k) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) + Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) enddo ; enddo if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie @@ -516,61 +515,61 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett CS%dissip_N2 * N2_int(i,K) ) ! Floor of Kd_min*rho0/F_Ri Kd_int(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) enddo ; enddo ; endif endif if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * Kd(i,j,k) * N2_lay(i,k) * & - GV%H_to_m*h(i,j,k) ! Watt m-2 s or kg s-3 + dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**3*Kd_lay(i,j,k) * N2_lay(i,k) * & + GV%H_to_Z*h(i,j,k) ! Watt m-2 s or kg s-3 enddo ; enddo endif enddo ! j-loop if (CS%debug) then - call hchksum(Kd ,"Kd",G%HI,haloshift=0) + call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) - if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) + if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%Z_to_m**2) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & - G%HI, 0, symmetric=.true.) + G%HI, 0, symmetric=.true., scale=GV%Z_to_m**2) endif if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then call uvchksum("BBL bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI, 0, symmetric=.true.) + visc%bbl_thick_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m) endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then - call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true.) + call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m) endif endif if (CS%Kd_add > 0.0) then if (present(Kd_int)) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo else -!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo endif endif if (CS%user_change_diff) then - call user_change_diff(h, tv, G, CS%user_change_diff_CSp, Kd, Kd_int, & + call user_change_diff(h, tv, G, GV, CS%user_change_diff_CSp, Kd_lay, Kd_int, & T_f, S_f, dd%Kd_user) endif @@ -590,7 +589,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%CVMix_ddiff_csp%id_R_rho > 0) & call post_data(CS%CVMix_ddiff_csp%id_R_rho, CS%CVMix_ddiff_csp%R_rho, CS%CVMix_ddiff_csp%diag) - if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd_lay, CS%diag) ! tidal mixing call post_tidal_diagnostics(G,GV,h,CS%tm_csp) @@ -624,21 +623,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) if (CS%id_KT_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KT_extra_z - z_ptrs(num_z_diags)%p => dd%KT_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KT_extra_z + z_ptrs(num_z_diags)%p => dd%KT_extra endif if (CS%id_KS_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KS_extra_z - z_ptrs(num_z_diags)%p => dd%KS_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KS_extra_z + z_ptrs(num_z_diags)%p => dd%KS_extra endif if (CS%id_Kd_BBL_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_BBL_z - z_ptrs(num_z_diags)%p => dd%KS_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_BBL_z + z_ptrs(num_z_diags)%p => dd%Kd_BBL endif if (num_z_diags > 0) & @@ -677,7 +676,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer @@ -694,26 +693,26 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & maxEnt ! maxEnt is the maximum value of entrainment from below (with ! compensating entrainment from above to keep the layer ! density from changing) that will not deplete all of the - ! layers above or below a layer within a timestep (meter) + ! layers above or below a layer within a timestep (Z) real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) + ! integrated thickness in the BBL (Z) mFkb, & ! total thickness in the mixed and buffer layers - ! times ds_dsp1 (meter) + ! times ds_dsp1 (Z) p_ref, & ! array of tv%P_Ref pressures Rcv_kmb, & ! coordinate density in the lowest buffer layer p_0 ! An array of 0 pressures real :: dh_max ! maximum amount of entrainment a layer could ! undergo before entraining all fluid in the layers - ! above or below (meter) + ! above or below (Z) real :: dRho_lay ! density change across a layer (kg/m3) real :: Omega2 ! rotation rate squared (1/s2) real :: G_Rho0 ! gravitation accel divided by Bouss ref density (m4 s-2 kg-1) real :: I_Rho0 ! inverse of Boussinesq reference density (m3/kg) real :: I_dt ! 1/dt (1/sec) real :: H_neglect ! negligibly small thickness (units as h) - real :: hN2pO2 ! h * (N^2 + Omega^2), in m s-2. + real :: hN2pO2 ! h * (N^2 + Omega^2), in m3 s-2 Z-2. logical :: do_i(SZI_(G)) integer :: i, k, is, ie, nz, i_rem, kmb, kb_min @@ -721,16 +720,16 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & I_dt = 1.0/dt Omega2 = CS%Omega**2 - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 H_neglect = GV%H_subroundoff I_Rho0 = 1.0/GV%Rho0 ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = ( GV%H_to_m * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m s-2. + hN2pO2 = GV%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. if (hN2pO2>0.) then - TKE_to_Kd(i,k) = 1./ hN2pO2 ! Units of s2 m-1. + TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. @@ -762,7 +761,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & ! in sigma-0. do k=kb(i)-1,kmb+1,-1 if (rho_0(i,kmb) > rho_0(i,k)) exit - if (h(i,j,k)>2.0*GV%Angstrom) kb(i) = k + if (h(i,j,k)>2.0*GV%Angstrom_H) kb(i) = k enddo enddo @@ -783,32 +782,32 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & if (CS%bulkmixedlayer) then kmb = GV%nk_rho_varies do i=is,ie - htot(i) = GV%H_to_m*h(i,j,kmb) + htot(i) = GV%H_to_Z*h(i,j,kmb) mFkb(i) = 0.0 if (kb(i) < nz) & - mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_m*(h(i,j,kmb) - GV%Angstrom)) + mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_Z*(h(i,j,kmb) - GV%Angstrom_H)) enddo do k=1,kmb-1 ; do i=is,ie - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_m*(h(i,j,k) - GV%Angstrom)) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) + mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H)) enddo ; enddo else do i=is,i - maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_m*(h(i,j,1) - GV%Angstrom) + maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_Z*(h(i,j,1) - GV%Angstrom_H) enddo endif do k=kb_min,nz-1 ; do i=is,ie if (k == kb(i)) then - maxEnt(i,kb(i))= mFkb(i) + maxEnt(i,kb(i)) = mFkb(i) elseif (k > kb(i)) then maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) ! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) ! BITWISE CHG - htot(i) = htot(i) + GV%H_to_m*(h(i,j,k) - GV%Angstrom) + htot(i) = htot(i) + GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H) endif enddo ; enddo do i=is,ie - htot(i) = GV%H_to_m*(h(i,j,nz) - GV%Angstrom) ; maxEnt(i,nz) = 0.0 + htot(i) = GV%H_to_Z*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0 do_i(i) = (G%mask2dT(i,j) > 0.5) enddo do k=nz-1,kb_min,-1 @@ -817,7 +816,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & if (k 0.5) if ( (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation) .and. & @@ -973,7 +973,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above hb(i) = hb(i) + dz_int @@ -982,7 +982,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) + hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. @@ -997,14 +997,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & if (hb(i) > 0.0) then N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) else ; N2_bot(i) = 0.0 ; endif - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) enddo do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above N2_int(i,K) = N2_bot(i) @@ -1052,10 +1052,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). + !! diffusivity for temp (Z2/sec). real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln (m2/sec). + !! diffusivity for saln (Z2/sec). real, dimension(SZI_(G)) :: & dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) @@ -1067,18 +1067,22 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) - real :: Rrho ! vertical density ratio - real :: diff_dd ! factor for double-diffusion - real :: prandtl ! flux ratio for diffusive convection regime + real :: Rrho ! vertical density ratio + real :: diff_dd ! factor for double-diffusion (nondim) + real :: Kd_dd ! The dominant double diffusive diffusivity in Z2/sec + real :: prandtl ! flux ratio for diffusive convection regime - real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio - real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering - real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec) + real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio + real :: dsfmax ! max diffusivity in case of salt fingering (Z2/sec) + real :: Kv_molecular ! molecular viscosity (Z2/sec) integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke if (associated(tv%eqn_of_state)) then + dsfmax = GV%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to (Z2/sec) + Kv_molecular = GV%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to (Z2/sec) + do i=is,ie pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 @@ -1097,18 +1101,18 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k)) if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case - Rrho = min(alpha_dT/beta_dS,Rrho0) + Rrho = min(alpha_dT / beta_dS, Rrho0) diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) - diff_dd = dsfmax*diff_dd*diff_dd*diff_dd - Kd_T_dd(i,K) = 0.7*diff_dd - Kd_S_dd(i,K) = diff_dd + Kd_dd = dsfmax * diff_dd*diff_dd*diff_dd + Kd_T_dd(i,K) = 0.7*Kd_dd + Kd_S_dd(i,K) = Kd_dd elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection - Rrho = alpha_dT/beta_dS - diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) + Rrho = alpha_dT / beta_dS + Kd_dd = Kv_molecular * 0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) prandtl = 0.15*Rrho if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho - Kd_T_dd(i,K) = diff_dd - Kd_S_dd(i,K) = prandtl*diff_dd + Kd_T_dd(i,K) = Kd_dd + Kd_S_dd(i,K) = prandtl*Kd_dd else Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 endif @@ -1120,7 +1124,7 @@ end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL) + maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, Kd_BBL) 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(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1139,16 +1143,16 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1 + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1 + intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1 real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in m2 s-1 ! This routine adds diffusion sustained by flow energy extracted by bottom drag. @@ -1157,25 +1161,25 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & Rint ! coordinate density of an interface (kg/m3) real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) - rho_htot, & ! running integral with depth of density (kg/m2) + ! integrated thickness in the BBL (Z) + rho_htot, & ! running integral with depth of density (Z kg/m3) gh_sum_top, & ! BBL value of g'h that can be supported by ! the local ustar, times R0_g (kg/m2) Rho_top, & ! density at top of the BBL (kg/m3) TKE, & ! turbulent kinetic energy available to drive ! bottom-boundary layer mixing in a layer (m3/s3) - I2decay ! inverse of twice the TKE decay scale (1/m) + I2decay ! inverse of twice the TKE decay scale (1/Z) real :: TKE_to_layer ! TKE used to drive mixing in a layer (m3/s3) real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer (m3/s3) real :: TKE_here ! TKE that goes into mixing in this layer (m3/s3) real :: dRl, dRbot ! temporaries holding density differences (kg/m3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) - real :: ustar_h ! value of ustar at a thickness point (m/s) + real :: ustar_h ! value of ustar at a thickness point (Z/s) real :: absf ! average absolute Coriolis parameter around a thickness point (1/s) - real :: R0_g ! Rho0 / G_Earth (kg s2 m-2) + real :: R0_g ! Rho0 / G_Earth (kg s2 Z-1 m-4) real :: I_rho0 ! 1 / RHO0 - real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (m2/s) + real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (Z2/s) logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities ! defined in visc, on the assumption that this ! extracted energy also drives diapycnal mixing. @@ -1195,7 +1199,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0/GV%Rho0 - R0_g = GV%Rho0/GV%g_Earth + R0_g = GV%Rho0 / (GV%m_to_Z**2*GV%g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1207,7 +1211,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & do i=is,ie ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & - ustar_h = ustar_h + fluxes%ustar_tidal(i,j) + ustar_h = ustar_h + GV%m_to_Z*fluxes%ustar_tidal(i,j) absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then @@ -1218,12 +1222,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & I2decay(i) = 0.5*CS%IMax_decay endif TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * & - exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz))) ) * & + exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))) ) * & visc%TKE_BBL(i,j) if (associated(fluxes%TKE_tidal)) & TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * & - (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz)))) + (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz)))) ! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following ! Killworth & Edwards (1999) and Zilitikevich & Mironov (1996). @@ -1233,16 +1237,16 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & gh_sum_top(i) = R0_g * 400.0 * ustar_h**2 do_i(i) = (G%mask2dT(i,j) > 0.5) - htot(i) = GV%H_to_m*h(i,j,nz) - rho_htot(i) = GV%Rlay(nz)*(GV%H_to_m*h(i,j,nz)) + htot(i) = GV%H_to_Z*h(i,j,nz) + rho_htot(i) = GV%Rlay(nz)*(GV%H_to_Z*h(i,j,nz)) Rho_top(i) = GV%Rlay(1) if (CS%bulkmixedlayer .and. do_i(i)) Rho_top(i) = GV%Rlay(kb(i)-1) enddo do k=nz-1,2,-1 ; domore = .false. do i=is,ie ; if (do_i(i)) then - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_m*h(i,j,k)) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) + rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_Z*h(i,j,k)) if (htot(i)*GV%Rlay(k-1) <= (rho_htot(i) - gh_sum_top(i))) then ! The top of the mixing is in the interface atop the current layer. Rho_top(i) = (rho_htot(i) - gh_sum_top(i)) / htot(i) @@ -1261,7 +1265,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & i_rem = i_rem + 1 ! Count the i-rows that are still being worked on. ! Apply vertical decay of the turbulent energy. This energy is ! simply lost. - TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_m*(h(i,j,k) + h(i,j,k+1)))) + TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_Z*(h(i,j,k) + h(i,j,k+1)))) ! if (maxEnt(i,k) <= 0.0) cycle if (maxTKE(i,k) <= 0.0) cycle @@ -1279,7 +1283,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * GV%Z_to_m * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1292,15 +1296,15 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer - if (Kd(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then - delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd(i,j,k) + if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then + delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd_lay(i,j,k) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then - delta_Kd = CS%Kd_Max - Kd(i,j,k) = Kd(i,j,k) + delta_Kd + delta_Kd = CS%Kd_max + Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else - Kd(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) + Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) endif - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd @@ -1308,12 +1312,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif endif else - if (Kd(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then + if (Kd_lay(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then TKE_here = 0.0 TKE(i) = TKE(i) + TKE_Ray - elseif (Kd(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > & + elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > & maxTKE(i,k)*TKE_to_Kd(i,k)) then - TKE_here = ((TKE_to_layer+TKE_Ray) + Kd(i,j,k)/TKE_to_Kd(i,k)) - & + TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/TKE_to_Kd(i,k) ) - & maxTKE(i,k) TKE(i) = TKE(i) - TKE_here + TKE_Ray else @@ -1323,10 +1327,10 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? if (TKE_here > 0.0) then - delta_Kd = TKE_here*TKE_to_Kd(i,k) + delta_Kd = TKE_here * TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) - Kd(i,j,k) = Kd(i,j,k) + delta_Kd - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd + Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd @@ -1354,7 +1358,7 @@ end subroutine add_drag_diffusivity !! wall turbulent viscosity, up to a BBL height where the energy used for mixing has !! consumed the mechanical TKE input. subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & - G, GV, CS, Kd, Kd_int, Kd_BBL) + G, GV, CS, Kd_lay, Kd_int, Kd_BBL) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1373,7 +1377,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces (s-2) type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< Layer net diffusivity (m2 s-1) + intent(inout) :: Kd_lay !< Layer net diffusivity (m2 s-1) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< Interface net diffusivity (m2 s-1) real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity (m2 s-1) @@ -1386,17 +1390,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: TKE_consumed ! TKE used for mixing in this layer (m3 s-3) real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) - real :: ustar ! value of ustar at a thickness point (m/s) - real :: ustar2 ! square of ustar, for convenience (m2/s2) + real :: ustar ! value of ustar at a thickness point (Z/s) + real :: ustar2 ! square of ustar, for convenience (Z2/s2) real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) - real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (meter) - real :: z ! distance to interface k from bottom (meter) - real :: D_minus_z ! distance to interface k from surface (meter) - real :: total_thickness ! total thickness of water column (meter) - real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/m) - real :: Kd_wall ! Law of the wall diffusivity (m2/s) - real :: Kd_lower ! diffusivity for lower interface (m2/sec) - real :: ustar_D ! u* x D (m2/s) + real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (Z) + real :: z_bot ! distance to interface k from bottom (Z) + real :: D_minus_z ! distance to interface k from surface (Z) + real :: total_thickness ! total thickness of water column (Z) + real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/Z) + real :: Kd_wall ! Law of the wall diffusivity (Z2/s) + real :: Kd_lower ! diffusivity for lower interface (Z2/sec) + real :: ustar_D ! u* x D (Z2/s) real :: I_Rho0 ! 1 / rho0 real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2) logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on @@ -1429,7 +1433,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA - if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) + if (associated(fluxes%ustar_tidal)) ustar = ustar + GV%m_to_Z*fluxes%ustar_tidal(i,j) ! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and ! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter. @@ -1446,20 +1450,21 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column - total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_m ! Total column thickness, in m. + total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_Z ! Total column thickness, in m. ustar_D = ustar * total_thickness - z = 0. + z_bot = 0. Kd_lower = 0. ! Diffusivity on bottom boundary. ! Work upwards from the bottom, accumulating work used until it exceeds the available TKE input ! at the bottom. do k=G%ke,2,-1 - dh = GV%H_to_m * h(i,j,k) ! Thickness of this level in m. + dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level in Z. km1 = max(k-1, 1) - dhm1 = GV%H_to_m * h(i,j,km1) ! Thickness of level above in m. + dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above in Z. ! Add in additional energy input from bottom-drag against slopes (sides) - if (Rayleigh_drag) TKE_remaining = TKE_remaining + 0.5*CS%BBL_effic * G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_remaining = TKE_remaining + & + 0.5*CS%BBL_effic * GV%Z_to_m * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1469,28 +1474,29 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! This is energy loss in addition to work done as mixing, apparently to Joule heating. TKE_remaining = exp(-Idecay*dh) * TKE_remaining - z = z + h(i,j,k)*GV%H_to_m ! Distance between upper interface of layer and the bottom, in m. - D_minus_z = max(total_thickness - z, 0.) ! Thickness above layer, m. + z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom, in Z. + D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer, Z. ! Diffusivity using law of the wall, limited by rotation, at height z, in m2/s. ! This calculation is at the upper interface of the layer - if ( ustar_D + absf * ( z * D_minus_z ) == 0.) then + if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then Kd_wall = 0. else - Kd_wall = ( ( von_karm * ustar2 ) * ( z * D_minus_z ) )/( ustar_D + absf * ( z * D_minus_z ) ) + Kd_wall = ( ( von_karm * ustar2 ) * ( z_bot * D_minus_z ) ) / & + ( ustar_D + absf * ( z_bot * D_minus_z ) ) endif ! TKE associated with Kd_wall, in m3 s-2. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = GV%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. - if (TKE_Kd_wall>0.) then + if (TKE_Kd_wall > 0.) then TKE_consumed = min(TKE_Kd_wall, TKE_remaining) Kd_wall = (TKE_consumed/TKE_Kd_wall) * Kd_wall ! Scale Kd so that only TKE_consumed is used. else ! Either N2=0 or dh = 0. - if (TKE_remaining>0.) then + if (TKE_remaining > 0.) then Kd_wall = CS%Kd_max else Kd_wall = 0. @@ -1502,17 +1508,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_remaining = TKE_remaining - TKE_consumed ! Note this will be non-negative ! Add this BBL diffusivity to the model net diffusivity. - Kd_int(i,j,k) = Kd_int(i,j,k) + Kd_wall - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_wall + Kd_lower) + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. - if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = Kd_wall + if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = Kd_wall enddo ! k enddo ! i end subroutine add_LOTW_BBL_diffusivity !> This routine adds effects of mixed layer radiation to the layer diffusivities. -subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) +subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int) 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)), & @@ -1520,31 +1526,32 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. ! This routine adds effects of mixed layer radiation to the layer diffusivities. - real, dimension(SZI_(G)) :: & - h_ml, & - TKE_ml_flux, & - I_decay, & - Kd_mlr_ml + real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness, in Z. + real, dimension(SZI_(G)) :: TKE_ml_flux + real, dimension(SZI_(G)) :: I_decay ! A decay rate in Z-1. + real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1. - real :: f_sq, h_ml_sq, ustar_sq, Kd_mlr, C1_6 + real :: f_sq, h_ml_sq, ustar_sq + real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation, in Z2 s-1. + real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared (1/s2) real :: z1 ! layer thickness times I_decay (nondim) - real :: dzL ! thickness converted to meter + real :: dzL ! thickness converted to Z real :: I_decay_len2_TKE ! squared inverse decay lengthscale for - ! TKE, as used in the mixed layer code (1/m2) - real :: h_neglect ! negligibly small thickness (meter) + ! TKE, as used in the mixed layer code (1/Z2) + real :: h_neglect ! negligibly small thickness (Z) logical :: do_any, do_i(SZI_(G)) integer :: i, k, is, ie, nz, kml @@ -1553,12 +1560,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) Omega2 = CS%Omega**2 C1_6 = 1.0 / 6.0 kml = GV%nkml - h_neglect = GV%H_subroundoff*GV%H_to_m + h_neglect = GV%H_subroundoff*GV%H_to_Z if (.not.CS%ML_radiation) return do i=is,ie ; h_ml(i) = 0.0 ; do_i(i) = (G%mask2dT(i,j) > 0.5) ; enddo - do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_m*h(i,j,k) ; enddo ; enddo + do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_Z*h(i,j,k) ; enddo ; enddo do i=is,ie ; if (do_i(i)) then if (CS%ML_omega_frac >= 1.0) then @@ -1573,7 +1580,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(ustar_sq*fluxes%ustar(i,j)) - I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) + I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / (GV%m_to_Z**2*ustar_sq)) if (CS%ML_rad_TKE_decay) & TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-h_ml(i) * sqrt(I_decay_len2_TKE)) @@ -1584,7 +1591,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) ! Average the dissipation layer kml+1, using ! a more accurate Taylor series approximations for very thin layers. - z1 = (GV%H_to_m*h(i,j,kml+1)) * I_decay(i) + z1 = (GV%H_to_Z*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & (1.0 - exp(-z1)) @@ -1592,12 +1599,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) endif - Kd_mlr_ml(i) = min(Kd_mlr,CS%ML_rad_kd_max) + Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max) TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) endif ; enddo do k=1,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd(i,j,k) = Kd(i,j,k) + Kd_mlr_ml(i) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr_ml(i) endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then @@ -1611,23 +1618,23 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) do k=kml+2,nz-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dzL = GV%H_to_m*h(i,j,k) ; z1 = dzL*I_decay(i) + dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & - ((1.0 - exp(-z1)) / dzL) + GV%m_to_Z * ((1.0 - exp(-z1)) / dzL) else Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & - (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) + GV%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif - Kd_mlr = min(Kd_mlr,CS%ML_rad_kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_mlr + Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*Omega2) then + if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**3*Omega2) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -1657,21 +1664,21 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) real, dimension(SZI_(G)) :: & htot ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) + ! integrated thickness in the BBL (Z) real, dimension(SZIB_(G)) :: & - uhtot, & ! running integral of u in the BBL (m2/s) - ustar, & ! bottom boundary layer turbulence speed (m/s) + uhtot, & ! running integral of u in the BBL (Z m/s) + ustar, & ! bottom boundary layer turbulence speed (Z/s) u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2) - real :: vhtot(SZI_(G)) ! running integral of v in the BBL (m2/sec) + real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec) real, dimension(SZI_(G),SZJB_(G)) :: & - vstar, & ! ustar at at v-points in 2 j-rows (m/s) + vstar, & ! ustar at at v-points (Z/s) v2_bbl ! square of average meridional velocity in BBL (m2/s2) real :: cdrag_sqrt ! square root of the drag coefficient (nondim) - real :: hvel ! thickness at velocity points (meter) + real :: hvel ! thickness at velocity points (Z) logical :: domore, do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz @@ -1702,14 +1709,14 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = visc%kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo do k=nz,1,-1 domore = .false. do i=is,ie ; if (do_i(i)) then - hvel = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j+1,k)) + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j+1,k)) if ((htot(i) + hvel) >= visc%bbl_thick_v(i,J)) then vhtot(i) = vhtot(i) + (visc%bbl_thick_v(i,J) - htot(i))*v(i,J,k) htot(i) = visc%bbl_thick_v(i,J) @@ -1732,13 +1739,13 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = visc%kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo do k=nz,1,-1 ; domore = .false. do I=is-1,ie ; if (do_i(I)) then - hvel = 0.5*GV%H_to_m*(h(i,j,k) + h(i+1,j,k)) + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i+1,j,k)) if ((htot(I) + hvel) >= visc%bbl_thick_u(I,j)) then uhtot(I) = uhtot(I) + (visc%bbl_thick_u(I,j) - htot(I))*u(I,j,k) htot(I) = visc%bbl_thick_u(I,j) @@ -1763,10 +1770,11 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & + visc%TKE_BBL(i,j) = GV%Z_to_m * & + (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & - G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))))*G%IareaT(i,j)) + G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j)) enddo enddo !$OMP end parallel @@ -1809,7 +1817,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) ! below it (nondimensional) ! (in) rho_0 - layer potential densities relative to surface press (kg/m3) - real :: g_R0 ! g_R0 is g/Rho (m4 kg-1 s-2) + real :: g_R0 ! g_R0 is g/Rho (m5 Z-1 kg-1 s-2) real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures @@ -1892,7 +1900,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) end subroutine set_density_ratios subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp, & - tm_CSp) + tm_CSp, halo_TS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1907,6 +1915,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp !! structure (BDM) type(tidal_mixing_cs), pointer :: tm_csp !< pointer to tidal mixing control !! structure + integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be + !! valid for the calculations in set_diffusivity. ! local variables real :: decay_length @@ -1964,7 +1974,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "length scale.", default=.false.) if (CS%ML_radiation) then ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_subroundoff*GV%H_to_m) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_subroundoff*GV%H_to_m) call get_param(param_file, mdl, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, & "A coefficient that is used to scale the penetration \n"//& @@ -1974,8 +1984,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & "The maximum diapycnal diffusivity due to turbulence \n"//& "radiated from the base of the mixed layer. \n"//& - "This is only used if ML_RADIATION is true.", units="m2 s-1", & - default=1.0e-3) + "This is only used if ML_RADIATION is true.", & + units="m2 s-1", default=1.0e-3, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & "The coefficient which scales MSTAR*USTAR^3 to obtain \n"//& "the energy available for mixing below the base of the \n"//& @@ -2027,10 +2037,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "The maximum decay scale for the BBL diffusion, or 0 \n"//& "to allow the mixing to penetrate as far as \n"//& "stratification and rotation permit. The default is 0. \n"//& - "This is only used if BOTTOMDRAGLAW is true.", units="m", & - default=0.0) + "This is only used if BOTTOMDRAGLAW is true.", & + units="m", default=0.0, scale=GV%m_to_Z) - CS%IMax_decay = 1.0/200.0 + CS%IMax_decay = 1.0 / (200.0*GV%m_to_Z) !### This is inconsistent with the description above. if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the \n"//& @@ -2050,7 +2060,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL endif CS%id_Kd_BBL = register_diag_field('ocean_model','Kd_BBL',diag%axesTi,Time, & - 'Bottom Boundary Layer Diffusivity', 'm2 s-1') + 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & "If true, uses a simple estimate of Kd/TKE that will\n"//& "work for arbitrary vertical coordinates. If false,\n"//& @@ -2064,25 +2074,25 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd) + units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal \n"//& "diffusivity from TKE-based parameterizations, or a \n"//& - "negative value for no limit.", units="m2 s-1", default=-1.0) + "negative value for no limit.", units="m2 s-1", default=-1.0, scale=GV%m_to_Z**2) if (CS%simple_TKE_to_Kd .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added \n"//& "everywhere without any filtering or scaling.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=GV%m_to_Z**2) if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") @@ -2100,7 +2110,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd) + units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& @@ -2116,20 +2126,20 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower \n"//& - "bound of Kd (a floor).", units="W m-3", default=0.0) + "bound of Kd (a floor).", units="W m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression \n"//& "used to set a minimum dissipation by which to determine \n"//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & - units="W m-3", default=0.0) + units="W m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to \n"//& "set a minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0) + units="J m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=GV%m_to_Z**2) CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. & (CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.) @@ -2138,7 +2148,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & - 'Diapycnal diffusivity of layers (as set)', 'm2 s-1') + 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & @@ -2149,7 +2159,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & 'Maximum layer TKE', 'm3 s-3') CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & - 'Convert TKE to Kd', 's2 m') + 'Convert TKE to Kd', 's2 m', conversion=GV%Z_to_m**2) CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency',& @@ -2186,23 +2196,23 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) if (associated(diag_to_Z_CSp)) then vd = var_desc("KT_extra", "m2 s-1", & "Double-Diffusive Temperature Diffusivity, interpolated to z", & z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("KS_extra", "m2 s-1", & "Double-Diffusive Salinity Diffusivity, interpolated to z",& z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("Kd_BBL", "m2 s-1", & "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif endif ! old double-diffusion @@ -2228,6 +2238,11 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%use_CVMix_ddiff) & id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_MODULE) + if (present(halo_TS)) then + halo_TS = 0 + if (CS%Vertex_Shear) halo_TS = 1 + endif + end subroutine set_diffusivity_init !> Clear pointers and dealocate memory diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 035849b37f..d4261b6523 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -18,7 +18,7 @@ module MOM_set_visc use MOM_cvmix_shear, only : cvmix_shear_is_used use MOM_cvmix_conv, only : cvmix_conv_is_used use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_variables, only : thermo_var_ptrs use MOM_variables, only : vertvisc_type @@ -44,15 +44,14 @@ module MOM_set_visc real :: drag_bg_vel !< An assumed unresolved background velocity for !! calculating the bottom drag, in m s-1. real :: BBL_thick_min !< The minimum bottom boundary layer thickness in - !! the same units as thickness (m or kg m-2). + !! the same units as thickness (H, often m or kg m-2). !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. - real :: Htbl_shelf !< A nominal thickness of the surface boundary layer - !! for use in calculating the near-surface velocity, - !! in units of m. - real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in m. - real :: KV_BBL_min !< The minimum viscosities in the bottom and top - real :: KV_TBL_min !< boundary layers, both in m2 s-1. + real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use + !! in calculating the near-surface velocity, in units of H. + real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H. + real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer, in Z2 s-1. + real :: KV_TBL_min !< The minimum viscosity in the top boundary layer, in Z2 s-1. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. The velocity magnitude !! may be an assumed value or it may be based on the @@ -71,7 +70,7 @@ module MOM_set_visc !! thickness of the viscous mixed layer. Nondim. real :: omega !< The Earth's rotation rate, in s-1. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in m s-1. If the value is small enough, + !! problems, in Z s-1. If the value is small enough, !! this should not affect the solution. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE !! decay scale, nondimensional. @@ -160,11 +159,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: Rhtot ! Running sum of thicknesses times the ! layer potential densities in H kg m-3. real, dimension(SZIB_(G),SZJ_(G)) :: & - D_u, & ! Bottom depth interpolated to u points, in m. + D_u, & ! Bottom depth interpolated to u points, in depth units (m). mask_u ! A mask that disables any contributions from u points that ! are land or past open boundary conditions, nondim., 0 or 1. real, dimension(SZI_(G),SZJB_(G)) :: & - D_v, & ! Bottom depth interpolated to v points, in m. + D_v, & ! Bottom depth interpolated to v points, in depth units (m). mask_v ! A mask that disables any contributions from v points that ! are land or past open boundary conditions, nondim., 0 or 1. real, dimension(SZIB_(G),SZK_(G)) :: & @@ -185,6 +184,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. + real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion + ! factor from lateral lengths to vertical depths, in Z m-1. real :: cdrag_sqrt ! Square root of the drag coefficient, nd. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -193,13 +194,14 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) ! the layer, in H kg m-3. real :: Dh ! The increment in layer thickness from ! the present layer, in H. - real :: bbl_thick ! The thickness of the bottom boundary layer in m. + real :: bbl_thick ! The thickness of the bottom boundary layer in H. + real :: bbl_thick_Z ! The thickness of the bottom boundary layer in Z. real :: C2f ! C2f = 2*f at velocity points. real :: U_bg_sq ! The square of an assumed background ! velocity, for calculating the mean ! magnitude near the bottom for use in the - ! quadratic bottom drag, in m2. + ! quadratic bottom drag, in m2 s-2. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude, in H. real :: hutot ! Running sum of thicknesses times the @@ -209,8 +211,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom, in H. real :: v_at_u, u_at_v ! v at a u point or vice versa, m s-1. - real :: Rho0x400_G ! 400*Rho0/G_Earth, in kg s2 m-4. The 400 is a - ! constant proposed by Killworth and Edwards, 1999. + real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. + ! The 400 is a constant proposed by Killworth and Edwards, 1999. real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & Rml ! The mixed layer coordinate density, in kg m-3. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate @@ -256,12 +258,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) ! in roundoff and can be neglected, in H. real :: ustH ! ustar converted to units of H s-1. real :: root ! A temporary variable with units of H s-1. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. real :: Cell_width ! The transverse width of the velocity cell, in m. - real :: Rayleigh ! A nondimensional value that is multiplied by the - ! layer's velocity magnitude to give the Rayleigh - ! drag velocity. + real :: Rayleigh ! A nondimensional value that is multiplied by the layer's + ! velocity magnitude to give the Rayleigh drag velocity, + ! times a lateral to vertical distance conversion factor, in Z L-1. real :: gam ! The ratio of the change in the open interface width ! to the open interface width atop a cell, nondim. real :: BBL_frac ! The fraction of a layer's drag that goes into the @@ -281,9 +282,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H - Vol_quit = 0.9*GV%Angstrom + h_neglect - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H + Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(BBL): "//& @@ -305,11 +305,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) OBC => CS%OBC U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel - cdrag_sqrt=sqrt(CS%cdrag) + cdrag_sqrt = sqrt(CS%cdrag) + cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) ! With a linear drag law, the friction velocity is already known. -! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel +! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel if ((nkml>0) .and. .not.use_BBL_EOS) then do i=Isq,Ieq+1 ; p_ref(i) = tv%P_ref ; enddo @@ -374,20 +375,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (.not.use_BBL_EOS) Rml_vel(:,:) = 0.0 -!$OMP parallel do default(none) shared(u, v, h, tv, visc, G, GV, CS, Rml, is, ie, js, je, & -!$OMP nz, Isq, Ieq, Jsq, Jeq, nkmb, h_neglect, Rho0x400_G,& -!$OMP C2pi_3, U_bg_sq, cdrag_sqrt,K2,use_BBL_EOS,OBC, & -!$OMP maxitt,nkml,m_to_H,H_to_m,Vol_quit,D_u,D_v,mask_u,mask_v) & -!$OMP private(do_i,h_at_vel,htot_vel,hwtot,hutot,Thtot,Shtot, & -!$OMP hweight,v_at_u,u_at_v,ustar,T_EOS,S_EOS,press, & -!$OMP dR_dT, dR_dS,ustarsq,htot,T_vel,S_vel,Rml_vel, & -!$OMP oldfn,Dfn,Dh,Rhtot,C2f,ustH,root,bbl_thick, & -!$OMP D_vel,tmp,Dp,Dm,a_3,a,a_12,slope,Vol_open,Vol_2_reg,& -!$OMP C24_a,apb_4a,Iapb,a2x48_apb3,ax2_3apb,Vol_direct, & -!$OMP L_direct,Ibma_2,L,vol,vol_below,Vol_err,h_vel_pos, & -!$OMP BBL_visc_frac,h_vel,L0,Vol_0,dV_dL2,dVol,L_max, & -!$OMP L_min,Vol_err_min,Vol_err_max,BBL_frac,Cell_width, & -!$OMP gam,Rayleigh, Vol_tol, tmp_val_m1_to_p1) + !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,CS,Rml,is,ie,js,je,nz,nkmb, & + !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, & + !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, & + !$OMP OBC,maxitt,Vol_quit,D_u,D_v,mask_u,mask_v) do j=Jsq,Jeq ; do m=1,2 if (m==1) then @@ -521,7 +512,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (htot_vel>=CS%Hbbl) exit ! terminate the k loop hweight = MIN(CS%Hbbl - htot_vel, h_at_vel(i,k)) - if (hweight < 1.5*GV%Angstrom + h_neglect) cycle + if (hweight < 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -543,9 +534,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) enddo ! end of k loop if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else - ustar(i) = cdrag_sqrt*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif if (use_BBL_EOS) then ; if (hwtot > 0.0) then @@ -555,7 +546,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) endif ; endif endif ; enddo else - do i=is,ie ; ustar(i) = cdrag_sqrt*CS%drag_bg_vel ; enddo + do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo endif ! Not linear_drag if (use_BBL_EOS) then @@ -657,7 +648,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, ! but is not bitwise identical to the current code. - ustH = ustar(i)*m_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) + ustH = ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) if (htot*ustH <= (CS%BBL_thick_min+h_neglect) * (0.5*ustH + root)) then bbl_thick = CS%BBL_thick_min else @@ -665,7 +656,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) endif else bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ & - ((ustar(i)*ustar(i)) * (m_to_H**2) ))) + ((ustar(i)*ustar(i)) * (GV%Z_to_H**2) ))) if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min endif @@ -696,7 +687,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (Dm > Dp) then ; tmp = Dp ; Dp = Dm ; Dm = tmp ; endif ! Convert the D's to the units of thickness. - Dp = m_to_H*Dp ; Dm = m_to_H*Dm ; D_vel = m_to_H*D_vel + Dp = GV%Z_to_H*Dp ; Dm = GV%Z_to_H*Dm ; D_vel = GV%Z_to_H*D_vel a_3 = (Dp + Dm - 2.0*D_vel) ; a = 3.0*a_3 ; a_12 = 0.25*a_3 slope = Dp - Dm @@ -795,18 +786,18 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = (vol-Vol_0) ! dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = max(vol-Vol_0, 0.0) - !### The following code is more robust when GV%Angstrom=0, but it + !### The following code is more robust when GV%Angstrom_H=0, but it !### changes answers. - ! Vol_tol = max(0.5*GV%Angstrom + GV%H_subroundoff, 1e-14*vol) - ! Vol_quit = max(0.9*GV%Angstrom + GV%H_subroundoff, 1e-14*vol) + ! Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) + ! Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) ! if (dVol <= 0.0) then ! L(K) = L0 ! Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol ! elseif (a*a*dVol**3 < Vol_tol*dV_dL2**2 * & ! (dV_dL2*Vol_tol - 2.0*a*L0*dVol)) then - if (a*a*dVol**3 < GV%Angstrom*dV_dL2**2 * & - (0.25*dV_dL2*GV%Angstrom - a*L0*dVol)) then + if (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & + (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol)) then ! One iteration of Newton's method should give an estimate ! that is accurate to within Vol_tol. L(K) = sqrt(L0*L0 + dVol / dV_dL2) @@ -855,9 +846,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (m==1) then ; Cell_width = G%dy_Cu(I,j) else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) - Rayleigh = CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & - (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + m_to_H * & - CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) + Rayleigh = GV%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & + (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & + GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) else ! This layer feels no drag. Rayleigh = 0.0 endif @@ -878,27 +869,27 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) enddo ! k loop to determine L(K). - bbl_thick = bbl_thick * H_to_m + bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & - cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac) - visc%bbl_thick_u(I,j) = bbl_thick + cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) + visc%bbl_thick_u(I,j) = bbl_thick_Z else visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & - cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac) - visc%bbl_thick_v(i,J) = bbl_thick + cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) + visc%bbl_thick_v(i,J) = bbl_thick_Z endif else ! Not Channel_drag. ! Here the near-bottom viscosity is set to a value which will give ! the correct stress when the shear occurs over bbl_thick. - bbl_thick = bbl_thick * H_to_m + bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick) - visc%bbl_thick_u(I,j) = bbl_thick + visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%bbl_thick_u(I,j) = bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick) - visc%bbl_thick_v(i,J) = bbl_thick + visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%bbl_thick_v(i,J) = bbl_thick_Z endif endif endif ; enddo ! end of i loop @@ -920,12 +911,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (CS%debug) then if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI,haloshift=0) + call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI,haloshift=0) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=GV%Z_to_m**2) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI,haloshift=0) + visc%bbl_thick_v, G%HI, haloshift=0, scale=GV%Z_to_m) endif end subroutine set_viscous_BBL @@ -1062,7 +1053,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity, in units ! of kg m-3 psu-1. - ustar, & ! The surface friction velocity under ice shelves, in m s-1. + ustar, & ! The surface friction velocity under ice shelves, in Z s-1. press, & ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. T_EOS, & ! T_EOS and S_EOS are the potential temperature and salnity at which dR_dT and dR_dS S_EOS ! which dR_dT and dR_dS are evaluated, in degC and PSU. @@ -1090,6 +1081,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) ! velocity magnitudes, in H m s-1. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom, in H. + real :: tbl_thick_Z ! The thickness of the top boundary layer in Z. real :: hlay ! The layer thickness at velocity points, in H. real :: I_2hlay ! 1 / 2*hlay, in H-1. @@ -1112,7 +1104,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. - real :: cdrag_sqrt ! Square root of the drag coefficient, nd. + real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion + ! factor from lateral lengths to vertical depths, in Z m-1. + real :: cdrag_sqrt ! Square root of the drag coefficient, ND. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, ! divided by G_Earth, in H kg m-3. @@ -1126,12 +1120,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) real :: h_tiny ! A very small thickness, in H. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points, s-1. - real :: U_star ! The friction velocity at velocity points, in m s-1. + real :: U_star ! The friction velocity at velocity points, in Z s-1. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: Rho0x400_G ! 400*Rho0/G_Earth, in kg s2 m-4. The 400 is a - ! constant proposed by Killworth and Edwards, 1999. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. + real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. + ! The 400 is a constant proposed by Killworth and Edwards, 1999. real :: ustar1 ! ustar in units of H/s real :: h2f2 ! (h*2*f)^2 logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G)) @@ -1151,17 +1144,17 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel - cdrag_sqrt=sqrt(CS%cdrag) + cdrag_sqrt = sqrt(CS%cdrag) + cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) dt_Rho0 = dt/GV%H_to_kg_m2 h_neglect = GV%H_subroundoff - h_tiny = 2.0*GV%Angstrom + h_neglect - g_H_Rho0 = (GV%g_Earth * GV%H_to_m) / GV%Rho0 - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H + h_tiny = 2.0*GV%Angstrom_H + h_neglect + g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / GV%Rho0 if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) & call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//& @@ -1177,7 +1170,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) call safe_alloc_ptr(visc%kv_tbl_shelf_v, G%isd, G%ied, G%JsdB, G%JedB) ! With a linear drag law, the friction velocity is already known. -! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel +! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel endif !$OMP parallel do default(shared) @@ -1208,16 +1201,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) endif enddo ; endif -!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS, & -!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,js,je,OBC, & -!$OMP H_to_m, m_to_H, Isq, Ieq, nz, U_bg_sq,mask_v, & -!$OMP cdrag_sqrt,Rho0x400_G,nkml) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_Star, & -!$OMP Idecay_len_TKE,press,k2,I_2hlay,T_EOS,S_EOS,dR_dT, & -!$OMP dR_dS,hlay,v_at_u,Uh2,T_lay,S_lay,gHprime, & -!$OMP RiBulk,Shtot,Rhtot,absf,do_any_shelf, & -!$OMP h_at_vel,ustar,htot_vel,hwtot,hutot,hweight,ustarsq, & -!$OMP oldfn,Dfn,Dh,Rlay,Rlb,h2f2,ustar1) + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP h_neglect,h_tiny,g_H_Rho0,js,je,OBC,Isq,Ieq,nz, & + !$OMP U_bg_sq,mask_v,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml) do j=js,je ! u-point loop if (CS%dynamic_viscous_ML) then do_any = .false. @@ -1238,8 +1224,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_Star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))) - Idecay_len_TKE(I) = ((absf / U_Star) * CS%TKE_decay) * H_to_m + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))*GV%m_to_Z) + Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1346,7 +1332,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k)) - if (hweight <= 1.5*GV%Angstrom + h_neglect) cycle + if (hweight <= 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -1363,9 +1349,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt*hutot/hwtot + ustar(I) = cdrag_sqrt_Z*hutot/hwtot else - ustar(I) = cdrag_sqrt*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z*CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1435,32 +1421,24 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) htot(i) = htot(i) + h_at_vel(i,nz) endif ! use_EOS - !visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, & + !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & - ! (ustar(i)*m_to_H)**2 )) ) - ustar1 = ustar(i)*m_to_H + ! (ustar(i)*GV%Z_to_H)**2 )) ) + ustar1 = ustar(i)*GV%Z_to_H h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 - visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, & + tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, & - cdrag_sqrt*ustar(I)*visc%tbl_thick_shelf_u(I,j)) + visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z + visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf enddo ! j-loop at u-points -!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS,& -!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,is,ie,OBC, & -!$OMP Jsq,Jeq,nz,U_bg_sq,cdrag_sqrt,Rho0x400_G,nkml, & -!$OMP m_to_H,H_to_m,mask_u) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,vhtot,uhtot,absf,& -!$OMP U_Star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, & -!$OMP S_EOS,dR_dT, dR_dS,hlay,u_at_v,Uh2, & -!$OMP T_lay,S_lay,gHprime,RiBulk,do_any_shelf, & -!$OMP Shtot,Rhtot,ustar,h_at_vel,htot_vel,hwtot, & -!$OMP hutot,hweight,ustarsq,oldfn,Dh,Rlay,Rlb,Dfn, & -!$OMP h2f2,ustar1) + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP h_neglect,h_tiny,g_H_Rho0,is,ie,OBC,Jsq,Jeq,nz, & + !$OMP U_bg_sq,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml,mask_u) do J=Jsq,Jeq ! v-point loop if (CS%dynamic_viscous_ML) then do_any = .false. @@ -1482,8 +1460,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_Star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))) - Idecay_len_TKE(i) = ((absf / U_Star) * CS%TKE_decay) * H_to_m + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))*GV%m_to_Z) + Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1591,7 +1569,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k)) - if (hweight <= 1.5*GV%Angstrom + h_neglect) cycle + if (hweight <= 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -1608,9 +1586,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else - ustar(i) = cdrag_sqrt*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1680,16 +1658,17 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) htot(i) = htot(i) + h_at_vel(i,nz) endif ! use_EOS - !visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, & + !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & - ! (ustar(i)*m_to_H)**2 )) ) - ustar1 = ustar(i)*m_to_H + ! (ustar(i)*GV%Z_to_H)**2 )) ) + ustar1 = ustar(i)*GV%Z_to_H h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 - visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, & + tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, & - cdrag_sqrt*ustar(i)*visc%tbl_thick_shelf_v(i,J)) + visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z + visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + endif ; enddo ! i-loop endif ! do_any_shelf @@ -1716,8 +1695,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities and related fields. !! Allocated here. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL @@ -1801,9 +1779,9 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) end subroutine set_visc_register_restarts !> Initializes the MOM_set_visc control structure -subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) +subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OBC) type(time_type), target, intent(in) :: Time !< The current model time. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. @@ -1813,12 +1791,16 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) !! related fields. Allocated here. type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n + real :: Z_rescale ! A rescaling factor for heights from the representation in + ! a reastart fole to the internal representation in this run. + integer :: i, j, k, is, ie, js, je, n + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz logical :: use_kappa_shear, adiabatic, use_omega logical :: use_CVMix_ddiff, differential_diffusion, use_KPP type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type @@ -1835,10 +1817,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) CS%OBC => OBC + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - CS%diag => diag ! Set default, read and log parameters @@ -1920,7 +1902,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & @@ -1932,7 +1914,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& "the thickness over which near-bottom velocities are \n"//& "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& - "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) + "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) ! Rescaled later if (CS%bottomdraglaw) then call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of \n"//& @@ -1954,16 +1936,19 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The minimum bottom boundary layer thickness that can be \n"//& "used with BOTTOMDRAGLAW. This might be \n"//& "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& - "near-bottom viscosity.", units="m", default=0.0) + "near-bottom viscosity.", units="m", default=0.0) ! Rescaled later call get_param(param_file, mdl, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, & "The minimum top boundary layer thickness that can be \n"//& "used with BOTTOMDRAGLAW. This might be \n"//& "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& - "near-top viscosity.", units="m", default=CS%BBL_thick_min) + "near-top viscosity.", units="m", default=CS%BBL_thick_min, scale=GV%m_to_H) call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, & "The thickness over which near-surface velocities are \n"//& "averaged for the drag law under an ice shelf. By \n"//& - "default this is the same as HBBL", units="m", default=CS%Hbbl) + "default this is the same as HBBL", units="m", default=CS%Hbbl, scale=GV%m_to_H) + ! These unit conversions are out outside the get_param calls because the are also defaults. + CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale + CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale call get_param(param_file, mdl, "KV", Kv_background, & "The background kinematic viscosity in the interior. \n"//& @@ -1990,10 +1975,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & - units="m2 s-1", default=Kv_background) + units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & - units="m2 s-1", default=Kv_background) + units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2) if (CS%Channel_drag) then call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) @@ -2026,21 +2011,21 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) allocate(visc%TKE_bbl(isd:ied,jsd:jed)) ; visc%TKE_bbl = 0.0 CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & - diag%axesCu1, Time, 'BBL thickness at u points', 'm') + diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=GV%Z_to_m) CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & - Time, 'BBL viscosity at u points', 'm2 s-1') + Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & - diag%axesCv1, Time, 'BBL thickness at v points', 'm') + diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=GV%Z_to_m) CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & - Time, 'BBL viscosity at v points', 'm2 s-1') + Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%Z_to_m**2) endif if (CS%Channel_drag) then allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v = 0.0 CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & - Time, 'Rayleigh drag velocity at u points', 'm s-1') + Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=GV%Z_to_m) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & - Time, 'Rayleigh drag velocity at v points', 'm s-1') + Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=GV%Z_to_m) endif if (use_CVMix_ddiff .or. differential_diffusion) then @@ -2057,8 +2042,32 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm') endif - CS%Hbbl = CS%Hbbl * GV%m_to_H - CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H + if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then + Z_rescale = GV%m_to_Z / GV%m_to_Z_restart + if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) + enddo ; enddo ; enddo + endif ; endif + + if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) + enddo ; enddo ; enddo + endif ; endif + + if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) + enddo ; enddo ; enddo + endif ; endif + + if (associated(visc%Kv_slow)) then ; if (query_initialized(visc%Kv_slow, "Kv_slow", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_slow(i,j,k) = Z_rescale**2 * visc%Kv_slow(i,j,k) + enddo ; enddo ; enddo + endif ; endif + endif end subroutine set_visc_init diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 1cf23e9c3e..410a41583a 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -143,12 +143,12 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, min_SW_heating = 2.5e-11 - h_min_heat = 2.0*GV%Angstrom + GV%H_subroundoff + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 TKE_calc = (present(TKE) .and. present(dSV_dT)) - g_Hconv2 = GV%g_Earth * GV%H_to_kg_m2**2 + g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 h_heat(:) = 0.0 if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif @@ -348,7 +348,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & integer :: is, ie, nz, i, k, ks, n SW_Remains = .false. - h_min_heat = 2.0*GV%Angstrom + GV%H_subroundoff + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index d4c5e69ed5..8bb8fa3ef3 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -53,7 +53,7 @@ module MOM_sponge real, pointer :: Rcv_ml_ref(:) => NULL() !< The value toward which the mixed layer !! coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface - !! heights are being damped, in m. + !! heights are being damped, in depth units (Z). type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -63,7 +63,7 @@ module MOM_sponge real, pointer :: Rcv_ml_ref_im(:) => NULL() !! The value toward which the i-mean !< mixed layer coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta_im(:,:) => NULL() !< The value toward which the i-mean - !! interface heights are being damped, in m. + !! interface heights are being damped, in depth units (Z). type(p2d) :: Ref_val_im(MAX_FIELDS_) !< The values toward which the i-means of !! fields are damped. @@ -79,22 +79,23 @@ module MOM_sponge !! positive values of Iresttime and which mask2dT indicates are ocean !! points are included in the sponges. It also stores the target interface !! heights. -subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & +subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & Iresttime_i_mean, int_height_i_mean) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. + intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(in) :: int_height !< The interface heights to damp back toward, in m. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module + intent(in) :: int_height !< The interface heights to damp back toward, in depth units (Z). + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZJ_(G)), & - optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for - !! the zonal mean properties, in s-1. + optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for + !! the zonal mean properties, in s-1. real, dimension(SZJ_(G),SZK_(G)+1), & - optional, intent(in) :: int_height_i_mean !< The interface heights toward which to - !! damp the zonal mean heights, in m. + optional, intent(in) :: int_height_i_mean !< The interface heights toward which to + !! damp the zonal mean heights, in depth units (Z). ! This include declares and sets the variable "version". @@ -334,32 +335,19 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! layer buoyancy, and a variety of tracers for every column where ! there is damping. -! Arguments: h - Layer thickness, in m. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (out) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in H. -! (out) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in H. -! (in) CS - A pointer to the control structure for this module that is -! set by a previous call to initialize_sponge. -! (inout,opt) Rcv_ml - The coordinate density of the mixed layer. - + ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, ! in H. e_D ! Interface heights that are dilated to have a value of 0 - ! at the surface, in m. + ! at the surface, in the same units as G%bathyT (m or Z). real, dimension(SZI_(G), SZJ_(G)) :: & eta_anom, & ! Anomalies in the interface height, relative to the i-mean - ! target value, in m. + ! target value, in depth units (Z). fld_anom ! Anomalies in a tracer concentration, relative to the ! i-mean target value. real, dimension(SZJ_(G), SZK_(G)+1) :: & - eta_mean_anom ! The i-mean interface height anomalies, in m. + eta_mean_anom ! The i-mean interface height anomalies, in Z. real, allocatable, dimension(:,:,:) :: & fld_mean_anom ! THe i-mean tracer concentration anomalies. real, dimension(SZI_(G), SZK_(G)+1) :: & @@ -369,8 +357,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) dilate ! A nondimensional factor by which to dilate layers to ! give 0 at the surface. - real :: e(SZK_(G)+1) ! The interface heights, in m, usually negative. - real :: e0 ! The height of the free surface in m. + real :: e(SZK_(G)+1) ! The interface heights, in Z, usually negative. + real :: e0 ! The height of the free surface in Z. real :: e_str ! A nondimensional amount by which the reference ! profile must be stretched for the free surfaces ! heights in the two profiles to agree. @@ -407,7 +395,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do j=js,je ; do i=is,ie ; e_D(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_m + e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo do j=js,je do i=is,ie @@ -441,15 +429,15 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) h_above(i,1) = 0.0 ; h_below(i,nz+1) = 0.0 enddo do K=nz,1,-1 ; do i=is,ie - h_below(i,K) = h_below(i,K+1) + max(h(i,j,k)-GV%Angstrom, 0.0) + h_below(i,K) = h_below(i,K+1) + max(h(i,j,k)-GV%Angstrom_H, 0.0) enddo ; enddo do K=2,nz+1 ; do i=is,ie - h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom, 0.0) + h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom_H, 0.0) enddo ; enddo do K=2,nz ! w is positive for an upward (lightward) flux of mass, resulting ! in the downward movement of an interface. - w = damp_1pdamp * eta_mean_anom(j,K) * GV%m_to_H + w = damp_1pdamp * eta_mean_anom(j,K) * GV%Z_to_H do i=is,ie if (w > 0.0) then w_int(i,j,K) = min(w, h_below(i,K)) @@ -471,7 +459,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) enddo h(i,j,k) = max(h(i,j,k) + (w_int(i,j,K+1) - w_int(i,j,K)), & - min(h(i,j,k), GV%Angstrom)) + min(h(i,j,k), GV%Angstrom_H)) enddo ; enddo endif ; enddo @@ -487,7 +475,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) e(1) = 0.0 ; e0 = 0.0 do K=1,nz - e(K+1) = e(K) - h(i,j,k)*GV%H_to_m + e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z enddo e_str = e(nz+1) / CS%Ref_eta(nz+1,c) @@ -505,8 +493,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) wpb = 0.0; wb = 0.0 do k=nz,nkmb+1,-1 if (GV%Rlay(k) > Rcv_ml(i,j)) then - w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & - ((wb + h(i,j,k)) - GV%Angstrom)) + w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, & + ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w-ABS(w)) do m=1,CS%fldno CS%var(m)%p(i,j,k) = (h(i,j,k)*CS%var(m)%p(i,j,k) + & @@ -518,7 +506,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) CS%var(m)%p(i,j,k) = I1pdamp * & (CS%var(m)%p(i,j,k) + CS%Ref_val(m)%p(k,c)*damp) enddo - w = wb + (h(i,j,k) - GV%Angstrom) + w = wb + (h(i,j,k) - GV%Angstrom_H) wm = 0.5*(w-ABS(w)) endif eb(i,j,k) = eb(i,j,k) + wpb @@ -530,7 +518,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) if (wb < 0) then do k=nkmb,1,-1 - w = MIN((wb + (h(i,j,k) - GV%Angstrom)),0.0) + w = MIN((wb + (h(i,j,k) - GV%Angstrom_H)),0.0) h(i,j,k) = h(i,j,k) + (wb - w) ea(i,j,k) = ea(i,j,k) - w wb = w @@ -561,8 +549,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) wpb = 0.0 wb = 0.0 do k=nz,1,-1 - w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & - ((wb + h(i,j,k)) - GV%Angstrom)) + w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, & + ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w - ABS(w)) do m=1,CS%fldno CS%var(m)%p(i,j,k) = (h(i,j,k)*CS%var(m)%p(i,j,k) + & @@ -581,9 +569,9 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) if (associated(CS%diag)) then ; if (query_averaging_enabled(CS%diag)) then if (CS%id_w_sponge > 0) then - Idt = 1.0 / dt + Idt = GV%H_to_m / dt do k=1,nz+1 ; do j=js,je ; do i=is,ie - w_int(i,j,K) = w_int(i,j,K) * Idt * GV%H_to_m ! Scale values by clobbering array since it is local + w_int(i,j,K) = w_int(i,j,K) * Idt ! Scale values by clobbering array since it is local enddo ; enddo ; enddo call post_data(CS%id_w_sponge, w_int(:,:,:), CS%diag) endif diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 7c712e8010..fba82d7f5d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -38,9 +38,9 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (m2 s-1) + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (Z2 s-1) Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation (m3 s-3) - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (m2 s-1) + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (Z2 s-1) Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing (W m-2) Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing (W m-2) Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing (W m-2) @@ -50,7 +50,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate (W m-3?) real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes (m2/s) + !! due to propagating low modes (Z2/s) real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes (m3/s3) real, pointer, dimension(:,:) :: & @@ -84,7 +84,7 @@ module MOM_tidal_mixing !! for dissipation of the lee waves. Schemes that are !! currently encoded are St Laurent et al (2002) and !! Polzin (2009). - real :: Int_tide_decay_scale !< decay scale for internal wave TKE (meter) + real :: Int_tide_decay_scale !< decay scale for internal wave TKE (Z) real :: Mu_itides !< efficiency for conversion of dissipation !! to potential energy (nondimensional) @@ -96,7 +96,7 @@ module MOM_tidal_mixing real :: Decay_scale_factor_lee !< Scaling factor for the decay scale of lee !! wave energy dissipation (nondimensional) - real :: min_zbot_itides !< minimum depth for internal tide conversion (meter) + real :: min_zbot_itides !< minimum depth for internal tide conversion (Z) logical :: Lowmode_itidal_dissipation = .false. !< If true, consider mixing due to breaking low !! modes that have been remotely generated using an internal tidal !! dissipation scheme to specify the vertical profile of the energy @@ -115,13 +115,13 @@ module MOM_tidal_mixing !! profile in Polzin formulation should not exceed !! Polzin_decay_scale_max_factor * depth of the ocean (nondimensional). real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation - !! profile in Polzin formulation (meter) + !! profile in Polzin formulation (Z) real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL real :: utide !< constant tidal amplitude (m s-1) used if - real :: kappa_itides !< topographic wavenumber and non-dimensional scaling + real :: kappa_itides !< topographic wavenumber and non-dimensional scaling, in Z-1 real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir !< The directory in which to find input files @@ -205,7 +205,6 @@ module MOM_tidal_mixing !> Initializes internal tidal dissipation scheme for diapycnal mixing logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS) - type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -221,7 +220,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file type(vardesc) :: vd - real :: utide, zbot, hamp, prandtl_tidal + real :: utide, hamp, prandtl_tidal real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -379,7 +378,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "When the Polzin decay profile is used, this is the \n"//& "minimum vertical decay scale for the vertical profile\n"//& "of internal tide dissipation with the Polzin (2009) formulation", & - units="m", default=0.0) + units="m", default=0.0, scale=GV%m_to_Z) endif if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then @@ -387,7 +386,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "The decay scale away from the bottom for tidal TKE with \n"//& "the new coding when INT_TIDE_DISSIPATION is used.", & !units="m", default=0.0) - units="m", default=500.0) ! TODO: confirm this new default + units="m", default=500.0, scale=GV%m_to_Z) ! TODO: confirm this new default call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & "A dimensionless turbulent mixing efficiency used with \n"//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) @@ -398,7 +397,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, units="nondim", default=0.3333) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0) + "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z) endif if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & @@ -412,7 +411,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0)) + units="m-1", default=8.e-4*atan(1.0), scale=GV%Z_to_m) call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -449,22 +448,21 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, fail_if_missing=(.not.CS%use_CVMix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) + call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2) do j=js,je ; do i=is,ie if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - zbot = G%bathyT(i,j) - hamp = sqrt(CS%h2(i,j)) - hamp = min(0.1*zbot,hamp) + !### Note the hard-coded nondimensional constant, and that this could be simplified. + hamp = min(0.1*G%bathyT(i,j),sqrt(CS%h2(i,j))) CS%h2(i,j) = hamp*hamp utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. - CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*& - CS%kappa_itides*CS%h2(i,j)*utide*utide + CS%TKE_itidal(i,j) = 0.5*GV%Z_to_m * CS%kappa_h2_factor*GV%Rho0*& + CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo endif @@ -544,10 +542,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call CVMix_init_tidal(CVmix_tidal_params_user = CS%CVMix_tidal_params, & mix_scheme = CVMix_tidal_scheme_str, & efficiency = CS%Mu_itides, & - vertical_decay_scale = CS%int_tide_decay_scale, & + vertical_decay_scale = CS%int_tide_decay_scale*GV%Z_to_m, & max_coefficient = CS%tidal_max_coef, & local_mixing_frac = CS%Gamma_itides, & - depth_cutoff = CS%min_zbot_itides) + depth_cutoff = CS%min_zbot_itides*GV%Z_to_m) call read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) @@ -561,7 +559,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%Lowmode_itidal_dissipation) then CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1') + 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & @@ -583,7 +581,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, 'Bottom Buoyancy Frequency', 's-1') CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') + 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') @@ -592,12 +590,12 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm', conversion=GV%Z_to_m) CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', & - 'Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Polzin_decay_scale_scaled', diag%axesT1, Time, & 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// & - 'scaled by N2_bot/N2_meanz', 'm') + 'scaled by N2_bot/N2_meanz', 'm', conversion=GV%Z_to_m) CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2') @@ -618,24 +616,24 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1') + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) endif endif ! S%use_CVMix_tidal if (associated(CS%diag_to_Z_CSp)) then vd = var_desc("Kd_itides","m2 s-1", & "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) if (CS%Lee_wave_dissipation) then vd = var_desc("Kd_Nikurashin", "m2 s-1", & "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif if (CS%Lowmode_itidal_dissipation) then vd = var_desc("Kd_lowmode","m2 s-1", & "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& z_grid='z') - CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif endif @@ -648,7 +646,7 @@ end function tidal_mixing_init !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, N2_int, Kd, Kd_int, Kd_max, Kv) + N2_lay, N2_int, Kd_lay, Kd_int, Kd_max, Kv) 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)), & @@ -664,34 +662,34 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, in m2 s-1. + !! diffusivity due to TKE-based processes, in Z2 s-1. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) + call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, Kd, Kd_int, Kd_max) + N2_lay, Kd_lay, Kd_int, Kd_max) endif endif -end subroutine +end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) +subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) integer, intent(in) :: j !< The j-index to work on type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -702,9 +700,9 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusivities in the layers, in m2 s-1 + intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers, in Z2 s-1 real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. ! Local variables real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] @@ -738,7 +736,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) hcorr = 0.0 do k=1,G%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, rescaled to m for use by CVMix. dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -774,13 +772,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) ! Update diffusivity do k=1,G%ke - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. enddo - ! Update viscosity + ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -819,11 +817,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 - h_m = h(i,j,:)*GV%H_to_m do k=1,G%ke + h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix. ! cell center and cell bottom in meters (negative values in the ocean) - dh = h_m(k) ! Nominal thickness to use for increment - dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + dh = h_m(k) + hcorr ! Nominal thickness less the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness cellHeight(k) = iFaceHeight(k) - 0.5 * dh @@ -873,13 +870,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) ! Update diffusivity do k=1,G%ke - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. enddo ! Update viscosity if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -918,7 +915,7 @@ end subroutine calculate_CVMix_tidal !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, Kd, Kd_int, Kd_max) + N2_lay, Kd_lay, Kd_int, Kd_max) 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)), & @@ -932,32 +929,32 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, in m2 s-1. + !! diffusivity due to TKE-based processes, in Z2 s-1. !! Set this to a negative value to have no limit. ! local real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) - htot_WKB, & ! distance from top to bottom (meter) WKB scaled + ! integrated thickness in the BBL (Z) + htot_WKB, & ! distance from top to bottom (Z) WKB scaled TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3) TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3) TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM) Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim) Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim) Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM) - z0_Polzin, & ! TKE decay scale in Polzin formulation (meter) - z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (meter) + z0_Polzin, & ! TKE decay scale in Polzin formulation (Z) + z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (Z) ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz @@ -969,18 +966,18 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim) TKE_frac_top_lowmode, & ! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM) - z_from_bot, & ! distance from bottom (meter) - z_from_bot_WKB ! distance from bottom (meter), WKB scaled + z_from_bot, & ! distance from bottom (Z) + z_from_bot_WKB ! distance from bottom (Z), WKB scaled real :: I_rho0 ! 1 / RHO0, (m3/kg) - real :: Kd_add ! diffusivity to add in a layer (m2/sec) + real :: Kd_add ! diffusivity to add in a layer (Z2/sec) real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) real :: frac_used ! fraction of TKE that can be used in a layer (nondim) - real :: Izeta ! inverse of TKE decay scale (1/meter) - real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/meter) - real :: z0_psl ! temporary variable with units of meter + real :: Izeta ! inverse of TKE decay scale (1/Z) + real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/Z) + real :: z0_psl ! temporary variable with units of Z real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM) logical :: use_Polzin, use_Simmons @@ -996,7 +993,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie ; htot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ;enddo do k=1,nz ; do i=is,ie - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) enddo ; enddo I_Rho0 = 1.0/GV%Rho0 @@ -1011,9 +1008,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Calculate parameters for vertical structure of dissipation ! Simmons: if ( use_Simmons ) then - Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_m) + Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_Z) Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & - GV%H_subroundoff*GV%H_to_m) + GV%H_subroundoff*GV%H_to_Z) do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) @@ -1032,7 +1029,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) endif endif - z_from_bot(i) = GV%H_to_m*h(i,j,nz) + z_from_bot(i) = GV%H_to_Z*h(i,j,nz) enddo endif ! Simmons @@ -1041,10 +1038,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! WKB scaling of the vertical coordinate do i=is,ie ; N2_meanz(i)=0.0 ; enddo do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_m*h(i,j,k) + N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_Z*h(i,j,k) enddo ; enddo do i=is,ie - N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_m) + N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i) enddo @@ -1052,20 +1049,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie ; htot_WKB(i) = htot(i) ; enddo ! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo ! do k=1,nz ; do i=is,ie -! htot_WKB(i) = htot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) +! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) ! enddo ; enddo ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) + !### In the code below 1.0e-14 is a dimensional constant in s-3 if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then - z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & z0_polzin(i) = CS%Polzin_min_decay_scale - if (N2_meanz(i) > 1.0e-14 ) then + if (N2_meanz(i) > 1.0e-14 ) then !### Here 1.0e-14 has dimensions of s-2. z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) else z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) @@ -1086,30 +1084,29 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 endif endif if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif - z_from_bot(i) = GV%H_to_m*h(i,j,nz) - ! Use the new formulation for WKB scaling. N2 is referenced to its - ! vertical mean. - if (N2_meanz(i) > 1.0e-14 ) then - z_from_bot_WKB(i) = GV%H_to_m*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) + z_from_bot(i) = GV%H_to_Z*h(i,j,nz) + ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. + if (N2_meanz(i) > 1.0e-14 ) then !### Avoid using this dimensional constant. + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif enddo endif ! Polzin @@ -1153,7 +1150,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, if ( use_Simmons ) then do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle - z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k) + z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) ! Fraction of bottom flux predicted to reach top of this layer TKE_frac_top(i) = Inv_int(i) * exp(-Izeta * z_from_bot(i)) @@ -1168,10 +1165,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Actual power expended may be less than predicted if stratification is weak; adjust if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then - frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - TKE_itide_lay = frac_used * TKE_itide_lay - TKE_Niku_lay = frac_used * TKE_Niku_lay - TKE_lowmode_lay = frac_used * TKE_lowmode_lay + frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + TKE_itide_lay = frac_used * TKE_itide_lay + TKE_Niku_lay = frac_used * TKE_Niku_lay + TKE_lowmode_lay = frac_used * TKE_lowmode_lay endif ! Calculate vertical flux available to bottom of layer above @@ -1183,7 +1180,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add @@ -1234,9 +1231,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, if ( use_Polzin ) then do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle - z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k) + z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) if (N2_meanz(i) > 1.0e-14 ) then - z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) + z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif ! Fraction of bottom flux predicted to reach top of this layer @@ -1270,7 +1267,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add @@ -1500,10 +1497,10 @@ end subroutine post_tidal_diagnostics ! TODO: move this subroutine to MOM_internal_tide_input module (?) !> This subroutine read tidal energy inputs from a file. subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read - character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read + character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs + type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local integer :: isd, ied, jsd, jed, nz real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) @@ -1571,6 +1568,7 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) + !### THE USE OF WHERE STTAEMENTS IS STRONGLY DISCOURAGED IN MOM6! where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 tidal_qo1(:,:) = p33 @@ -1584,7 +1582,8 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! input cell thickness CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2 ! form tidal_qe_3d_in from weighted tidal constituents - where ( (z_t(k)*1e-2) <= G%bathyT(:,:) .and. (z_w(k)*1e-2) > CS%tidal_diss_lim_tc) + !### THE USE OF WHERE STATEMENTS IS STRONGLY DISCOURAGED IN MOM6! + where (((z_t(k)*1e-2) <= G%bathyT(:,:)*G%Zd_to_m) .and. (z_w(k)*1e-2 > CS%tidal_diss_lim_tc)) CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) endwhere @@ -1598,7 +1597,7 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! do k=50,nz_in(1) ! write(1905,*) i,j,k ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc + ! write(1905,*) z_t(k), G%bathyT(i,j)*G%Zd_to_m, z_w(k),CS%tidal_diss_lim_tc ! end do ! endif ! enddo @@ -1607,13 +1606,13 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! test if qE is positive if (any(CS%tidal_qe_3d_in<0.0)) then - call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") + call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") endif !! collapse 3D q*E to 2D q*E !CS%tidal_qe_2d = 0.0 !do k=1,nz_in(1) - ! where (z_t(k) <= G%bathyT(:,:)) + ! where (z_t(k) <= G%bathyT(:,:)*G%Zd_to_m) ! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k) ! endwhere !enddo diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 88da20bb4d..57bf5a3ab6 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -31,9 +31,9 @@ module MOM_vert_friction !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private - real :: Hmix !< The mixed layer thickness in m. + real :: Hmix !< The mixed layer thickness in thickness units (H). real :: Hmix_stress !< The mixed layer thickness over which the wind - !! stress is applied with direct_stress, in m. + !! stress is applied with direct_stress, in H. real :: Kvml !< The mixed layer vertical viscosity in m2 s-1. real :: Kv !< The interior vertical viscosity in m2 s-1. real :: Hbbl !< The static bottom boundary layer thickness, in m. @@ -60,11 +60,11 @@ module MOM_vert_friction type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u !< The u-drag coefficient across an interface, in m s-1. + a_u !< The u-drag coefficient across an interface, in Z s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points, m or kg m-2. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & - a_v !< The v-drag coefficient across an interface, in m s-1. + a_v !< The v-drag coefficient across an interface, in Z s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points, m or kg m-2. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under @@ -172,7 +172,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. c1 is nondimensional, ! while b1 has units of inverse thickness. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in m s-1 + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in Z s-1 real :: b_denom_1 ! The first term in the denominator of b1, in H. real :: Hmix ! The mixed layer thickness over which stress @@ -184,7 +184,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! density, in s m3 kg-1. real :: Rho0 ! A density used to convert drag laws into stress in ! Pa, in kg m-3. - real :: dt_m_to_H ! The time step times the conversion from m to the + real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - either s or s m3 kg-1. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m or kg m-2. @@ -207,24 +207,22 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & "Module must be initialized before it is used.") if (CS%direct_stress) then - Hmix = CS%Hmix_stress*GV%m_to_H + Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix endif dt_Rho0 = dt/GV%H_to_kg_m2 - dt_m_to_H = dt*GV%m_to_H + dt_Z_to_H = dt*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff Idt = 1.0 / dt !Check if Stokes mixing allowed if requested (present and associated) + DoStokesMixing=.false. if (CS%StokesMixing) then - DoStokesMixing=(present(Waves) .and. associated(Waves)) - if (.not.DoStokesMixing) then + if (present(Waves)) DoStokesMixing = associated(Waves) + if (.not. DoStokesMixing) & call MOM_error(FATAL,"Stokes Mixing called without allocated"//& - "Waves Control Structure") - endif - else - DoStokesMixing=.false. + "Waves Control Structure") endif do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -232,17 +230,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! Update the zonal velocity component using a modification of a standard ! tridagonal solver. - ! When mixing down Eulerian current + Stokes drift add before calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq - if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) - enddo ; enddo ; enddo ; endif - !$OMP parallel do default(shared) firstprivate(Ray) & !$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & !$OMP b_denom_1,b1,d1,c1) do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo + ! When mixing down Eulerian current + Stokes drift add before calling solver + if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) + enddo ; enddo ; endif + if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = u(I,j,k) enddo ; enddo ; endif @@ -276,9 +274,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! and the superdiagonal as c_k. The right-hand side terms are d_k. ! ! ignoring the rayleigh drag contribution, - ! we have a_k = -dt_m_to_H * a_u(k) - ! b_k = h_u(k) + dt_m_to_H * (a_u(k) + a_u(k+1)) - ! c_k = -dt_m_to_H * a_u(k+1) + ! we have a_k = -dt_Z_to_H * a_u(k) + ! b_k = h_u(k) + dt_Z_to_H * (a_u(k) + a_u(k+1)) + ! c_k = -dt_Z_to_H * a_u(k+1) ! ! for forward elimination, we want to: ! calculate c'_k = - c_k / (b_k + a_k c'_(k-1)) @@ -294,18 +292,18 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! and the right-hand-side is destructively updated to be d'_k ! do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) + dt_m_to_H * (Ray(I,1) + CS%a_u(I,j,1)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_u(I,j,2)) + b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) u(I,j,1) = b1(I) * (CS%h_u(I,j,1) * u(I,j,1) + surface_stress(I)) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_m_to_H * CS%a_u(I,j,K) * b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_m_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_u(I,j,K+1)) + c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1)) d1(I) = b_denom_1 * b1(I) u(I,j,k) = (CS%h_u(I,j,k) * u(I,j,k) + & - dt_m_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) + dt_Z_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) endif ; enddo ; enddo ! back substitute to solve for the new velocities @@ -330,19 +328,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif - enddo ! end u-component j loop - ! When mixing down Eulerian current + Stokes drift subtract after calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq - if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) - enddo ; enddo ; enddo ; endif + ! When mixing down Eulerian current + Stokes drift subtract after calling solver + if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) + enddo ; enddo ; endif + + enddo ! end u-component j loop ! Now work on the meridional velocity component. - ! When mixing down Eulerian current + Stokes drift add before calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=Jsq,Jeq ; do I=Is,Ie - if (G%mask2dCv(I,j) > 0) & - v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) - enddo ; enddo ; enddo ; endif !$OMP parallel do default(shared) firstprivate(Ray) & !$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & @@ -350,6 +344,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo + ! When mixing down Eulerian current + Stokes drift add before calling solver + if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie + if (do_i(i)) v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) + enddo ; enddo ; endif + if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = v(i,J,k) enddo ; enddo ; endif @@ -378,18 +377,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) + dt_m_to_H * (Ray(i,1) + CS%a_v(i,J,1)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_v(i,J,2)) + b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) v(i,J,1) = b1(i) * (CS%h_v(i,J,1) * v(i,J,1) + surface_stress(i)) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_m_to_H * CS%a_v(i,J,K) * b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_m_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_v(i,J,K+1)) + c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) - v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_m_to_H * & - CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) + v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) @@ -411,12 +409,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif - enddo ! end of v-component J loop - ! When mixing down Eulerian current + Stokes drift subtract after calling solver - if (DoStokesMixing) then ; do k=1,nz ; do J=Jsq,Jeq ; do i=Is,Ie - if (G%mask2dCv(i,J) > 0) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) - enddo ; enddo ; enddo ; endif + ! When mixing down Eulerian current + Stokes drift subtract after calling solver + if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie + if (do_i(i)) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) + enddo ; enddo ; endif + + enddo ! end of v-component J loop call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) @@ -479,7 +478,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the ! time step, in m. real :: b_denom_1 ! The first term in the denominator of b1, in m or kg m-2. - real :: dt_m_to_H ! The time step times the conversion from m to the + real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - either s or s m3 kg-1. logical :: do_i(SZIB_(G)) @@ -490,12 +489,12 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") - dt_m_to_H = dt*GV%m_to_H + dt_Z_to_H = dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo ! Find the zonal viscous using a modification of a standard tridagonal solver. -!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_m_to_H,visc_rem_u) & +!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_Z_to_H,visc_rem_u) & !$OMP firstprivate(Ray) & !$OMP private(do_i,b_denom_1,b1,d1,c1) do j=G%jsc,G%jec @@ -506,17 +505,17 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) enddo ; enddo ; endif do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) + dt_m_to_H * (Ray(I,1) + CS%a_u(I,j,1)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_u(I,j,2)) + b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) visc_rem_u(I,j,1) = b1(I) * CS%h_u(I,j,1) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_m_to_H * CS%a_u(I,j,K)*b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_m_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_u(I,j,K+1)) + c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K)*b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1)) d1(I) = b_denom_1 * b1(I) - visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_m_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I) + visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_Z_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I) endif ; enddo ; enddo do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then visc_rem_u(I,j,k) = visc_rem_u(I,j,k) + c1(I,k+1)*visc_rem_u(I,j,k+1) @@ -526,7 +525,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) enddo ! end u-component j loop ! Now find the meridional viscous using a modification. -!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_m_to_H,visc_rem_v,nz) & +!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_Z_to_H,visc_rem_v,nz) & !$OMP firstprivate(Ray) & !$OMP private(do_i,b_denom_1,b1,d1,c1) do J=Jsq,Jeq @@ -537,17 +536,17 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) + dt_m_to_H * (Ray(i,1) + CS%a_v(i,J,1)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_v(i,J,2)) + b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) visc_rem_v(i,J,1) = b1(i) * CS%h_v(i,J,1) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_m_to_H * CS%a_v(i,J,K)*b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_m_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_v(i,J,K+1)) + c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K)*b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) - visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_m_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) + visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then visc_rem_v(i,J,k) = visc_rem_v(i,J,k) + c1(i,k+1)*visc_rem_v(i,J,k+1) @@ -593,14 +592,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) hvel, & ! hvel is the thickness used at a velocity grid point, in H. hvel_shelf ! The equivalent of hvel under shelves, in H. real, dimension(SZIB_(G),SZK_(G)+1) :: & - a, & ! The drag coefficients across interfaces, in m s-1. a times + a_cpl, & ! The drag coefficients across interfaces, in Z s-1. a_cpl times ! the velocity difference gives the stress across an interface. a_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves, in m s-1. + ! ice shelves, in Z s-1. z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity in m2 s-1. + kv_bbl, & ! The bottom boundary layer viscosity in Z2 s-1. bbl_thick, & ! The bottom boundary layer thickness in m or kg m-2. I_Hbbl, & ! The inverse of the bottom boundary layer thickness, in units ! of H-1 (i.e., m-1 or m2 kg-1). @@ -614,10 +613,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) zh, & ! An estimate of the interface's distance from the bottom ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. - real, allocatable, dimension(:,:) :: hML_u, hML_v - real, allocatable, dimension(:,:,:) :: Kv_v, & !< Total vertical viscosity at u-points - Kv_u !< Total vertical viscosity at v-points - real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. + real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points, in m. + real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points, in m. + real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points, in m2 s-1. + real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points, in m2 s-1. + real :: zcol(SZI_(G)) ! The height of an interface at h-points, in H (m or kg m-2). real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. real :: topfn ! A function which goes from 1 at the top to 0 much more @@ -625,9 +625,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim. real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. real :: z_clear ! The clearance of an interface above the surrounding topography, in H. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. - real :: H_to_m, m_to_H ! Unit conversion factors. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected, in H. real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum @@ -645,8 +644,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) "Module must be initialized before it is used.") h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H - I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) + I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val if (CS%id_Kv_u > 0) then @@ -673,15 +671,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 endif - !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,ieq,nz,u,h,forces,hML_u, & - !$OMP OBC,h_neglect,dt,m_to_H,I_valBL,Kv_u) & + !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & + !$OMP OBC,h_neglect,dt,I_valBL,Kv_u) & !$OMP firstprivate(i_hbbl) do j=G%Jsc,G%Jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%bottomdraglaw) then ; do I=Isq,Ieq kv_bbl(I) = visc%kv_bbl_u(I,j) - bbl_thick(I) = visc%bbl_thick_u(I,j) * m_to_H + bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -691,7 +689,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(I,k) = h(i+1,j,k) - h(i,j,k) endif ; enddo ; enddo do I=Isq,Ieq - Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * m_to_H + Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * GV%Z_to_H zi_dir(I) = 0 enddo @@ -700,11 +698,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do I=Isq,Ieq ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * m_to_H + Dmin(I) = G%bathyT(i,j) * GV%Z_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then do k=1,nz ; h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i+1,j) * m_to_H + Dmin(I) = G%bathyT(i+1,j) * GV%Z_to_H zi_dir(I) = 1 endif endif ; enddo @@ -727,7 +725,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo ; enddo ! i & k loops else ! Not harmonic_visc do I=Isq,Ieq ; zh(I) = 0.0 ; z_i(I,nz+1) = 0.0 ; enddo - do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * m_to_H ; enddo + do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * GV%Z_to_H ; enddo do k=nz,1,-1 do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + h(i,j,k) ; enddo do I=Isq,Ieq ; if (do_i(I)) then @@ -756,7 +754,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) enddo ! k loop endif - call find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u=.true., OBC=OBC) if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo @@ -778,7 +776,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do I=Isq,Ieq ; if (do_i_shelf(I)) then zh(I) = 0.0 ; Ztop_min(I) = min(zcol(i), zcol(i+1)) - I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*m_to_H + h_neglect) + I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%Z_to_H + h_neglect) endif ; enddo do k=1,nz do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - h(i,j,k) ; enddo @@ -810,12 +808,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i_shelf(I)) then CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * a_shelf(I,K) + & - (1.0-forces%frac_shelf_u(I,j)) * a(I,K) + (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH -! CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a(I,K)) + & -! (1.0-forces%frac_shelf_u(I,j)) * a(I,K) +! CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a_cpl(I,K)) + & +! (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K) elseif (do_i(I)) then - CS%a_u(I,j,K) = a(I,K) + CS%a_u(I,j,K) = a_cpl(I,K) endif ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i_shelf(I)) then ! Should we instead take the inverse of the average of the inverses? @@ -825,14 +823,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) CS%h_u(I,j,k) = hvel(I,k) endif ; enddo ; enddo else - do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = a(I,K) ; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = a_cpl(I,K) ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) ; enddo ; enddo endif ! Diagnose total Kv at u-points if (CS%id_Kv_u > 0) then do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif @@ -841,14 +839,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Now work on v-points. !$OMP parallel do default(private) shared(G,GV,CS,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, & - !$OMP OBC,h_neglect,dt,m_to_H,I_valBL,Kv_v) & + !$OMP OBC,h_neglect,dt,I_valBL,Kv_v) & !$OMP firstprivate(i_hbbl) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%bottomdraglaw) then ; do i=is,ie kv_bbl(i) = visc%kv_bbl_v(i,J) - bbl_thick(i) = visc%bbl_thick_v(i,J) * m_to_H + bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -858,7 +856,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(i,k) = h(i,j+1,k) - h(i,j,k) endif ; enddo ; enddo do i=is,ie - Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * m_to_H + Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * GV%Z_to_H zi_dir(i) = 0 enddo @@ -867,11 +865,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * m_to_H + Dmin(I) = G%bathyT(i,j) * GV%Z_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then do k=1,nz ; h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. ; enddo - Dmin(i) = G%bathyT(i,j+1) * m_to_H + Dmin(i) = G%bathyT(i,j+1) * GV%Z_to_H zi_dir(i) = 1 endif endif ; enddo @@ -896,8 +894,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) else ! Not harmonic_visc do i=is,ie zh(i) = 0.0 ; z_i(i,nz+1) = 0.0 - zcol1(i) = -G%bathyT(i,j) * m_to_H - zcol2(i) = -G%bathyT(i,j+1) * m_to_H + zcol1(i) = -G%bathyT(i,j) * GV%Z_to_H + zcol2(i) = -G%bathyT(i,j+1) * GV%Z_to_H enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then zh(i) = zh(i) + h_harm(i,k) @@ -925,7 +923,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo ; enddo ! i & k loops endif - call find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u=.false., OBC=OBC) if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo @@ -946,7 +944,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do i=is,ie ; if (do_i_shelf(i)) then zh(i) = 0.0 ; Ztop_min(I) = min(zcol1(i), zcol2(i)) - I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*m_to_H + h_neglect) + I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%Z_to_H + h_neglect) endif ; enddo do k=1,nz do i=is,ie ; if (do_i_shelf(i)) then @@ -978,12 +976,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do i=is,ie ; if (do_i_shelf(i)) then CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * a_shelf(i,k) + & - (1.0-forces%frac_shelf_v(i,J)) * a(i,K) + (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH -! CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a(i,K)) + & -! (1.0-forces%frac_shelf_v(i,J)) * a(i,K) +! CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a_cpl(i,K)) + & +! (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K) elseif (do_i(i)) then - CS%a_v(i,J,K) = a(i,K) + CS%a_v(i,J,K) = a_cpl(i,K) endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i_shelf(i)) then ! Should we instead take the inverse of the average of the inverses? @@ -993,14 +991,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) CS%h_v(i,J,k) = hvel(i,k) endif ; enddo ; enddo else - do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a(i,K) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a_cpl(i,K) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) ; enddo ; enddo endif ! Diagnose total Kv at v-points if (CS%id_Kv_v > 0) then do k=1,nz ; do i=is,ie - if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) + if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif @@ -1010,7 +1008,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m) call uvchksum("vertvisc_coef a_[uv]", CS%a_u, & - CS%a_v, G%HI, haloshift=0) + CS%a_v, G%HI, haloshift=0, scale=GV%Z_to_m) if (allocated(hML_u) .and. allocated(hML_v)) & call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, & G%HI, haloshift=0, scale=GV%H_to_m) @@ -1035,12 +1033,12 @@ end subroutine vertvisc_coef !> Calculate the 'coupling coefficient' (a[k]) at the !! interfaces. If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the !! adjacent layer thicknesses are used to calculate a[k] near the bottom. -subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & +subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u, OBC, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZIB_(G),SZK_(GV)+1), & - intent(out) :: a !< Coupling coefficient across interfaces, in m s-1 + intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1 real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points, in H logical, dimension(SZIB_(G)), & @@ -1049,7 +1047,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity !! grid point, in H real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in m2 s-1 + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in Z2 s-1 real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness @@ -1068,29 +1066,27 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m ! Local variables real, dimension(SZIB_(G)) :: & - u_star, & ! ustar at a velocity point, in m s-1. + u_star, & ! ustar at a velocity point, in Z s-1. absf, & ! The average of the neighboring absolute values of f, in s-1. ! h_ml, & ! The mixed layer depth, in m or kg m-2. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized - ! by Hmix, in m or nondimensional. - kv_tbl, & + ! by Hmix, in H or nondimensional. + kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & - Kv_add ! A viscosity to add, in m2 s-1. - real :: h_shear ! The distance over which shears occur, m or kg m-2. - real :: r ! A thickness to compare with Hbbl, in m or kg m-2. - real :: visc_ml ! The mixed layer viscosity, in m2 s-1. - real :: I_Hmix ! The inverse of the mixed layer thickness, in m-1 or m2 kg-1. + Kv_add ! A viscosity to add, in Z2 s-1. + real :: h_shear ! The distance over which shears occur, H. + real :: r ! A thickness to compare with Hbbl, in H. + real :: visc_ml ! The mixed layer viscosity, in Z2 s-1. + real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. - real :: temp1 ! A temporary variable in m2 s-1. + real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1.??? + real :: temp1 ! A temporary variable in H Z real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: dz_neglect ! A thickness in m that is so small it is usually lost - ! in roundoff and can be neglected, in m. real :: z2 ! A copy of z_i, nondim. - real :: H_to_m, m_to_H ! Unit conversion factors. real :: topfn real :: a_top logical :: do_shelf, do_OBCs @@ -1098,14 +1094,17 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m integer :: nz real :: botfn - a(:,:) = 0.0 + a_cpl(:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif nz = G%ke h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H - dz_neglect = GV%H_subroundoff*GV%H_to_m + + ! The maximum coupling coefficent was originally introduced to avoid + ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 + ! sets the maximum coupling coefficient increment to 1e10 m per timestep. + I_amax = (1.0e-10*GV%Z_to_m) * dt do_shelf = .false. ; if (present(shelf)) do_shelf = shelf do_OBCs = .false. @@ -1114,15 +1113,15 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m ! The following loop calculates the vertical average velocity and ! surface mixed layer contributions to the vertical viscosity. - do i=is,ie ; a(i,1) = 0.0 ; enddo + do i=is,ie ; a_cpl(i,1) = 0.0 ; enddo if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie - if (do_i(i)) a(i,K) = 2.0*CS%Kv + if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv enddo ; enddo ; else - I_Hmix = 1.0 / (CS%Hmix * m_to_H + h_neglect) + I_Hmix = 1.0 / (CS%Hmix + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix - a(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & + a_cpl(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & (1.0 + 0.09*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i))) endif ; enddo ; enddo endif @@ -1131,12 +1130,12 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (CS%bottomdraglaw) then r = hvel(i,nz)*0.5 if (r < bbl_thick(i)) then - a(i,nz+1) = 1.0*kv_bbl(i) / (1e-10*dt*kv_bbl(i) + r*H_to_m) + a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) else - a(i,nz+1) = 1.0*kv_bbl(i) / (1e-10*dt*kv_bbl(i) + bbl_thick(i)*H_to_m) + a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else - a(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*H_to_m + 2.0e-10*dt*CS%Kvbbl) + a_cpl(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax*CS%Kvbbl) endif endif ; enddo @@ -1159,7 +1158,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1175,7 +1174,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1183,11 +1182,11 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a(I,K) = a(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1209,12 +1208,13 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) endif ; enddo ; enddo + !### I am pretty sure that this is double counting here! - RWH if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then @@ -1225,7 +1225,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1237,7 +1237,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a(i,K) = a(i,K) + 2.0*(kv_bbl(i)-CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i) - CS%Kv)*botfn r = (hvel(i,k)+hvel(i,k-1)) if (r > 2.0*bbl_thick(i)) then h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) @@ -1245,15 +1245,12 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m h_shear = r endif else - a(i,K) = a(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect endif - ! Up to this point a has units of m2 s-1, but now is converted to m s-1. - ! The term including 1e-10 in the denominators is here to avoid - ! truncation error problems in the tridiagonal solver. Effectively, this - ! sets the maximum coupling coefficient at 1e10 m. - a(i,K) = a(i,K) / (h_shear*H_to_m + 1.0e-10*dt*a(i,K)) + ! Up to this point a_cpl has had units of Z2 s-1, but now is converted to Z s-1. + a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) endif ; enddo ; enddo ! i & k loops if (do_shelf) then @@ -1261,18 +1258,18 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m do i=is,ie ; if (do_i(i)) then if (work_on_u) then kv_tbl(i) = visc%kv_tbl_shelf_u(I,j) - tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H else kv_tbl(i) = visc%kv_tbl_shelf_v(i,J) - tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H endif z_t(i) = 0.0 - ! If a(i,1) were not already 0, it would be added here. + ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a(i,1) = kv_tbl(i) / (tbl_thick(i) *H_to_m + (1.0e-10*dt)*kv_tbl(i)) + a_cpl(i,1) = kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*kv_tbl(i)) else - a(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*H_to_m + (1.0e-10*dt)*kv_tbl(i)) + a_cpl(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_tbl(i)) endif endif ; enddo @@ -1286,22 +1283,20 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m else h_shear = r endif - ! The term including 1e-10 in the denominators is here to avoid - ! truncation error problems in the tridiagonal solver. Effectively, this - ! sets the maximum coupling coefficient increment to 1e10 m. + a_top = 2.0 * topfn * kv_tbl(i) - a(i,K) = a(i,K) + a_top / (h_shear*H_to_m + 1.0e-10*dt*a_top) + a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then max_nk = 0 do i=is,ie ; if (do_i(i)) then if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then - u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star(I) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else - u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star(i) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif @@ -1312,16 +1307,16 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (do_OBCS) then ; if (work_on_u) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & - u_star(I) = forces%ustar(i,j) + u_star(I) = GV%m_to_Z*forces%ustar(i,j) if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & - u_star(I) = forces%ustar(i+1,j) + u_star(I) = GV%m_to_Z*forces%ustar(i+1,j) endif ; enddo else do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & - u_star(i) = forces%ustar(i,j) + u_star(i) = GV%m_to_Z*forces%ustar(i,j) if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & - u_star(i) = forces%ustar(i,j+1) + u_star(i) = GV%m_to_Z*forces%ustar(i,j+1) endif ; enddo endif ; endif @@ -1336,16 +1331,15 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m do K=2,max_nk ; do i=is,ie ; if (do_i(i)) then ; if (k < nk_visc(i)) then ! Set the viscosity at the interfaces. z_t(i) = z_t(i) + hvel(i,k-1) - temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i)) * H_to_m - ! This viscosity is set to go to 0 at the mixed layer top and bottom - ! (in a log-layer) and be further limited by rotation to give the - ! natural Ekman length. + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z + ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) + ! and be further limited by rotation to give the natural Ekman length. visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / & (absf(i)*temp1 + h_ml(i)*u_star(i)) - a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * H_to_m + & - 2.0e-10*dt*visc_ml) + a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + & + 2.0*I_amax* visc_ml) ! Choose the largest estimate of a. - if (a_ml > a(i,K)) a(i,K) = a_ml + if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml endif ; endif ; enddo ; enddo endif @@ -1387,7 +1381,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) maxvel = CS%maxvel truncvel = 0.9*maxvel - H_report = 6.0 * GV%Angstrom + H_report = 6.0 * GV%Angstrom_H dt_Rho0 = dt / GV%Rho0 if (len_trim(CS%u_trunc_file) > 0) then @@ -1582,6 +1576,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ! Local variables real :: hmix_str_dflt + real :: Kv_dflt ! A default viscosity in m2 s-1. + real :: Hmix_m ! A boundary layer thickness, in m. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1648,16 +1644,17 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& - "mixed layer is not used.", units="m", fail_if_missing=.true.) + "mixed layer is not used.", units="m", scale=GV%m_to_H, & + unscaled=Hmix_m, fail_if_missing=.true.) if (CS%direct_stress) then if (GV%nkml < 1) then call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if \n"//& - "DIRECT_STRESS is true.", units="m", default=CS%Hmix) + "DIRECT_STRESS is true.", units="m", default=Hmix_m, scale=GV%m_to_H) else call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if \n"//& - "DIRECT_STRESS is true.", units="m", fail_if_missing=.true.) + "DIRECT_STRESS is true.", units="m", fail_if_missing=.true., scale=GV%m_to_H) endif if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // & "HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.") @@ -1665,25 +1662,24 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", fail_if_missing=.true., scale=GV%m_to_Z**2, unscaled=Kv_dflt) -! CS%Kvml = CS%Kv ; CS%Kvbbl = CS%Kv ! Needed? -AJA if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "The kinematic viscosity in the mixed layer. A typical \n"//& "value is ~1e-2 m2 s-1. KVML is not used if \n"//& "BULKMIXEDLAYER is true. The default is set by KV.", & - units="m2 s-1", default=CS%Kv) + units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2) if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & "The kinematic viscosity in the benthic boundary layer. \n"//& "A typical value is ~1e-2 m2 s-1. KVBBL is not used if \n"//& "BOTTOMDRAGLAW is true. The default is set by KV.", & - units="m2 s-1", default=CS%Kv) + units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a \n"//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& "the thickness over which near-bottom velocities are \n"//& "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& - "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) + "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity \n"//& "components are truncated.", units="m s-1", default=3.0e8) @@ -1738,19 +1734,19 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1') + 'Slow varying vertical viscosity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1') + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1') + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1') + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 91b156751f..89393c2c8c 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -15,7 +15,7 @@ module DOME_tracer use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_restart, only : MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface @@ -169,8 +169,9 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & real :: tr_y ! Initial zonally uniform tracer concentrations. real :: dist2 ! The distance squared from a line, in m2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. - real :: e(SZK_(G)+1), e_top, e_bot, d_tr + ! in roundoff and can be neglected, in H. + real :: e(SZK_(G)+1), e_top, e_bot ! Heights in Z. + real :: d_tr ! A change in tracer concentraions, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -215,24 +216,24 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & do j=js,je ; do i=is,ie e(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - e(K) = e(K+1) + h(i,j,k)*GV%H_to_m + e(K) = e(K+1) + h(i,j,k)*GV%H_to_Z do m=7,NTR - e_top = -600.0*real(m-1) + 3000.0 - e_bot = -600.0*real(m-1) + 2700.0 + e_top = (-600.0*real(m-1) + 3000.0) * GV%m_to_Z + e_bot = (-600.0*real(m-1) + 2700.0) * GV%m_to_Z if (e_top < e(K)) then if (e_top < e(K+1)) then ; d_tr = 0.0 elseif (e_bot < e(K+1)) then - d_tr = (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_m) - else ; d_tr = (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_m) + d_tr = 1.0 * (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) + else ; d_tr = 1.0 * (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) endif elseif (e_bot < e(K)) then if (e_bot < e(K+1)) then ; d_tr = 1.0 - else ; d_tr = (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_m) + else ; d_tr = 1.0 * (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) endif else d_tr = 0.0 endif - if (h(i,j,k) < 2.0*GV%Angstrom) d_tr=0.0 + if (h(i,j,k) < 2.0*GV%Angstrom_H) d_tr=0.0 CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + d_tr enddo enddo diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 40e8ef6db5..0707b54fb3 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -20,7 +20,7 @@ module ISOMIP_tracer use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc use MOM_restart, only : MOM_restart_CS use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index e8c3387cea..ebff38508c 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -14,7 +14,7 @@ module MOM_OCMIP2_CFC use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index d06ffe0e2c..ee1f038180 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -35,7 +35,7 @@ module MOM_generic_tracer use MOM_spatial_means, only : global_area_mean use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS - use MOM_time_manager, only : time_type, get_time, set_time + use MOM_time_manager, only : time_type, set_time use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_Z_init, only : tracer_Z_init @@ -498,7 +498,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if (_allocated(g_tracer%trunoff)) then + if (_ALLOCATED(g_tracer%trunoff)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) @@ -519,7 +519,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, !Prepare input arrays for source update ! - rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom + rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom_H do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{ rho_dzt(i,j,k) = GV%H_to_kg_m2 * h_old(i,j,k) enddo ; enddo ; enddo !} diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index ffff913eff..dc616e8a49 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -70,7 +70,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) @@ -294,7 +294,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & call MOM_error(WARNING,"Column integral of uh does not match after "//& "barotropic redistribution") @@ -364,7 +364,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "barotropic redistribution") @@ -400,7 +400,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - min_h = GV%Angstrom*0.1 + min_h = GV%Angstrom_H*0.1 do j=js,je ! Copy over uh and cell volume to working arrays @@ -460,7 +460,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then call MOM_error(WARNING,"Column integral of uh does not match after "//& "upwards redistribution") @@ -498,7 +498,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H do i=is,ie ! Copy over uh and cell volume to working arrays @@ -558,7 +558,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "upwards redistribution") diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 0d90d890fd..8a59f69a61 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -450,7 +450,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) if (CS%id_eta_pre_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom) then + if (h_pre(i,j,k)>GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo @@ -583,7 +583,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) if (CS%id_eta_post_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom) then + if (h_pre(i,j,k)>GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo @@ -1057,7 +1057,7 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) ! Apply masks/factors at T, U, and V points do k=1,nz ; do j=js,je ; do i=is,ie if (CS%G%mask2dT(i,j)<1.0) then - CS%h_end(i,j,k) = CS%GV%Angstrom + CS%h_end(i,j,k) = CS%GV%Angstrom_H endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 0f7c5c1224..7450571500 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -47,7 +47,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) tr_in ! The z-space array of tracer concentrations that is read in. real, allocatable, dimension(:) :: & z_edges, & ! The depths of the cell edges or cell centers (depending on - ! the value of has_edges) in the input z* data. + ! the value of has_edges) in the input z* data, in depth units (Z). tr_1d, & ! A copy of the input tracer concentrations in a column. wt, & ! The fractional weight for each layer in the range between ! k_top and k_bot, nondim. @@ -55,14 +55,14 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) z2 ! of a z-cell that contributes to a layer, relative to the cell ! center and normalized by the cell thickness, nondim. ! Note that -1/2 <= z1 <= z2 <= 1/2. - real :: e(SZK_(G)+1) ! The z-star interface heights in m. + real :: e(SZK_(G)+1) ! The z-star interface heights in Z. real :: landval ! The tracer value to use in land points. real :: sl_tr ! The normalized slope of the tracer ! within the cell, in tracer units. real :: htot(SZI_(G)) ! The vertical sum of h, in m or kg m-2. real :: dilate ! The amount by which the thicknesses are dilated to ! create a z-star coordinate, nondim or in m3 kg-1. - real :: missing ! The missing value for the tracer. + real :: missing ! The missing value for the tracer. logical :: has_edges, use_missing, zero_surface character(len=80) :: loc_msg @@ -81,7 +81,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) ! Find out the number of input levels and read the depth of the edges, ! also modifying their sign convention to be monotonically decreasing. - call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, missing) + call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, & + missing, scale=1.0/G%Zd_to_m) if (nz_in < 1) then tracer_Z_init = .false. return @@ -269,7 +270,7 @@ end function tracer_Z_init !> This subroutine reads the vertical coordinate data for a field from a NetCDF file. !! It also might read the missing value attribute for that same field. subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & - use_missing, missing) + use_missing, missing, scale) character(len=*), intent(in) :: filename !< The name of the file to read from. character(len=*), intent(in) :: tr_name !< The name of the tracer in the file. real, dimension(:), allocatable, & @@ -280,6 +281,7 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & logical, intent(inout) :: use_missing !< If false on input, see whether the tracer has a !! missing value, and if so return true real, intent(inout) :: missing !< The missing value, if one has been found + real, intent(in) :: scale !< A scaling factor for z_edges into new units. ! This subroutine reads the vertical coordinate data for a field from a ! NetCDF file. It also might read the missing value attribute for that same field. @@ -388,6 +390,8 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & if (.not.monotonic) & call MOM_error(WARNING,mdl//" "//trim(dim_msg)//" is not monotonic.") + if (scale /= 1.0) then ; do k=1,nz_edge ; z_edges(k) = scale*z_edges(k) ; enddo ; endif + end subroutine read_Z_edges diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 0370aeaee4..589ad07e19 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -382,7 +382,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & stencil = 1 if (usePPM .and. .not. useHuynh) stencil = 2 - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H h_neglect = GV%H_subroundoff dt=1.0/Idt @@ -711,7 +711,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & stencil = 1 if (usePPM .and. .not. useHuynh) stencil = 2 - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H h_neglect = GV%H_subroundoff dt=1.0/Idt !do i=is,ie ; ts2(i) = 0.0 ; enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 99aa562a60..597b0fc822 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -696,7 +696,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & enddo ; enddo if (PEmax_kRho > nz) PEmax_kRho = nz ! PEmax_kRho could have been nz+1. - h_exclude = 10.0*(GV%Angstrom + GV%H_subroundoff) + h_exclude = 10.0*(GV%Angstrom_H + GV%H_subroundoff) !$OMP parallel default(none) shared(is,ie,js,je,nkmb,G,GV,h,h_exclude,num_srt,k0_srt, & !$OMP rho_srt,h_srt,PEmax_kRho,k_end_srt,rho_coord,max_srt) & !$OMP private(ns,tmp,itmp) diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4ed395bac8..aeb1b3aae9 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -14,7 +14,7 @@ module advection_test_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 7995b712e3..9b785fe41d 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -14,7 +14,7 @@ module boundary_impulse_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index a597b1fc8c..c9a8706e3c 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -14,7 +14,7 @@ module regional_dyes use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init @@ -41,8 +41,8 @@ module regional_dyes real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected (m). - real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected (m). + real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected, in Z. + real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected, in Z. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? @@ -135,18 +135,17 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%dye_source_mindepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINDEPTH", CS%dye_source_mindepth, & "This is the minumum depth at which we inject dyes.", & - fail_if_missing=.true.) - if (minval(CS%dye_source_mindepth(:)) < -1.e29) & + units="m", scale=GV%m_to_Z, fail_if_missing=.true.) + if (minval(CS%dye_source_mindepth(:)) < -1.e29*GV%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINDEPTH") CS%dye_source_maxdepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MAXDEPTH", CS%dye_source_maxdepth, & "This is the maximum depth at which we inject dyes.", & - fail_if_missing=.true.) - if (minval(CS%dye_source_maxdepth(:)) < -1.e29) & + units="m", scale=GV%m_to_Z, fail_if_missing=.true.) + if (minval(CS%dye_source_maxdepth(:)) < -1.e29*GV%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXDEPTH ") - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 do m = 1, CS%ntr @@ -224,12 +223,12 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C G%mask2dT(i,j) > 0.0 ) then z_bot = -G%bathyT(i,j) do k = GV%ke, 1, -1 - z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_m + z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_Z if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 endif - z_bot = z_bot + h(i,j,k)*GV%H_to_m + z_bot = z_bot + h(i,j,k)*GV%H_to_Z enddo endif enddo ; enddo @@ -307,12 +306,12 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS G%mask2dT(i,j) > 0.0 ) then z_bot = -G%bathyT(i,j) do k=nz,1,-1 - z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_m + z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_Z if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 endif - z_bot = z_bot + h_new(i,j,k)*GV%H_to_m + z_bot = z_bot + h_new(i,j,k)*GV%H_to_Z enddo endif enddo ; enddo diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 2102f1cc71..af69a39c52 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -13,7 +13,7 @@ module dyed_obc_tracer use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 1f77bd639e..d7fcb53324 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -14,7 +14,7 @@ module ideal_age_example use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init @@ -317,7 +317,6 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, real :: sfc_val ! The surface value for the tracers. real :: Isecs_per_year ! The number of seconds in a year. real :: year ! The time in years. - integer :: secs, days ! Integer components of the time type. integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -342,8 +341,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, Isecs_per_year = 1.0 / (365.0*86400.0) ! Set the surface value of tracer 1 to increase exponentially ! with a 30 year time scale. - call get_time(CS%Time, secs, days) - year = (86400.0*days + real(secs)) * Isecs_per_year + year = time_type_to_real(CS%Time) * Isecs_per_year do m=1,CS%ntr if (CS%sfc_growth_rate(m) == 0.0) then diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index fd794aff0b..3b98c19a73 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -14,7 +14,7 @@ module oil_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init @@ -334,7 +334,6 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified real :: Isecs_per_year = 1.0 / (365.0*86400.0) real :: year, h_total, ldecay - integer :: secs, days integer :: i, j, k, is, ie, js, je, nz, m, k_max is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -356,10 +355,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS enddo endif - ! Set the surface value of tracer 1 to increase exponentially - ! with a 30 year time scale. - call get_time(CS%Time, secs, days) - year = (86400.0*days + real(secs)) * Isecs_per_year + year = time_type_to_real(CS%Time) * Isecs_per_year ! Decay tracer (limit decay rate to 1/dt - just in case) do m=2,CS%ntr diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index fb0d38d86a..d9f4d3f682 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -16,7 +16,7 @@ module pseudo_salt_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 966fa07410..bf6b504658 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -14,7 +14,7 @@ module USER_tracer_example use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 972c475683..2eda7d2f1d 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -32,7 +32,7 @@ module BFB_initialization subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density. real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m s-2. + !! each interface, in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the @@ -56,9 +56,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then - g_prime(k) = (Rlay(k) - Rlay(k-1))*GV%g_earth/GV%rho0 + g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth/GV%rho0 else - g_prime(k) = GV%g_earth + g_prime(k) = GV%g_Earth endif !Rlay(:) = 0.0 !g_prime(:) = 0.0 @@ -70,24 +70,22 @@ end subroutine BFB_set_coord !> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs !! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. -subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, CSp, h) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as +subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as !! state variables. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure real, dimension(NIMEM_, NJMEM_, NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - !call MOM_error(FATAL, & - ! "BFB_initialization.F90, BFB_initialize_sponges: " // & - ! "Unmodified user routine called - you must edit the routine to use it") + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. + ! Local variables + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z). real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - - real :: H0(SZK_(G)) - real :: min_depth + real :: H0(SZK_(G)) ! Resting layer thickesses in depth units (Z). + real :: min_depth ! The minimum ocean depth in depth units (Z). real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -104,7 +102,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! Set up sponges for DOME configuration call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "SOUTHLAT", slat, & "The southern latitude of the domain.", units="degrees") @@ -137,11 +135,12 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! do k = 1,nz; eta(i,j,k) = H0(k); enddo ! if (G%geoLatT(i,j) > 40.0) then ! do k = 1,nz - ! eta(i,j,k) = -G%Angstrom_z*(k-1) + ! eta(i,j,k) = -G%Angstrom_Z*(k-1) ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then ! do k = 1,nz - ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_z)/20.0, -(k-1)*G%angstrom_z) + ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_Z)/20.0, & + ! -(k-1)*G%Angstrom_Z) ! enddo ! endif eta(i,j,nz+1) = -G%max_depth @@ -153,7 +152,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. ! - call initialize_sponge(Idamp, eta, G, param_file, CSp) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) ! Now register all of the fields which are damped in the sponge. ! ! By default, momentum is advected vertically within the sponge, but ! diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 27168618be..edcdb002cf 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -12,7 +12,7 @@ module BFB_surface_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 474a71d683..7d282bffd5 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -95,10 +95,10 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h @@ -115,7 +115,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - default=1.e-3, do_not_log=.true.) + default=1.e-3, units="m", do_not_log=.true., scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & @@ -143,21 +143,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_LAYER, REGRIDDING_RHO ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom - h(i,j,nz) = GV%m_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom + h(i,j,1:nz-1) = GV%Angstrom_H + h(i,j,nz) = GV%Z_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H endif enddo ; enddo @@ -165,21 +165,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params ! case ( IC_RHO_C ) ! ! do j=js,je ; do i=is,ie - ! eta1D(nz+1) = -1.0*G%bathyT(i,j) + ! eta1D(nz+1) = -G%bathyT(i,j) ! do k=nz,1,-1 ! eta1D(k) = e0(k) ! if (eta1D(k) < (eta1D(k+1) + min_thickness)) then ! eta1D(k) = eta1D(k+1) + min_thickness - ! h(i,j,k) = GV%m_to_H * min_thickness + ! h(i,j,k) = GV%Z_to_H * min_thickness ! else - ! h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + ! h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) ! endif ! enddo ! ! x = G%geoLonT(i,j) / G%len_lon ! if ( x <= dome2d_width_bay ) then - ! h(i,j,1:nz-1) = GV%m_to_H * min_thickness - ! h(i,j,nz) = GV%m_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness) + ! h(i,j,1:nz-1) = GV%Z_to_H * min_thickness + ! h(i,j,nz) = GV%Z_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness) ! endif ! ! enddo ; enddo @@ -187,22 +187,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_ZSTAR ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_SIGMA ) do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / nz - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = GV%Z_to_H*G%bathyT(i,j) / nz enddo ; enddo case default @@ -274,7 +273,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + (GV%H_to_m * h(i,j,k)) / G%max_depth + xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -285,7 +284,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + (GV%H_to_m * h(i,j,k)) / G%max_depth + xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -359,15 +358,16 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO - real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness + real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness, in m. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for thickness real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface + ! positive upward, in Z. + real :: d_eta(SZK_(G)) ! The layer thickness in a column, in Z. real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale real :: dome2d_west_sponge_width, dome2d_east_sponge_width @@ -444,14 +444,14 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) enddo e0(nz+1) = -G%max_depth do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -463,48 +463,48 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) do j=js,je ; do i=is,ie z = -G%bathyT(i,j) do k = nz,1,-1 - z = z + 0.5 * h(i,j,k) ! Position of the center of layer k + z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range - z = z + 0.5 * h(i,j,k) ! Position of the interface k + z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k enddo enddo ; enddo if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T,G,tv%T,ACSp) + call set_up_ALE_sponge_field(T, G, tv%T, ACSp) endif if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S,G,tv%S,ACSp) + call set_up_ALE_sponge_field(S, G, tv%S, ACSp) endif else - ! Construct thicknesses to restore to + ! Construct interface heights to restore toward do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + eta1D(K) = -G%max_depth * real(k-1) / real(nz) + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z + d_eta(k) = GV%Angstrom_Z else - h(i,j,k) = eta1D(k) - eta1D(k+1) + d_eta(k) = (eta1D(K) - eta1D(K+1)) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom - h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom + do k=1,nz-1 ; d_eta(k) = GV%Angstrom_Z ; enddo + d_eta(nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_Z endif eta(i,j,nz+1) = -G%bathyT(i,j) do K=nz,1,-1 - eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) + eta(i,j,K) = eta(i,j,K+1) + d_eta(k) enddo enddo ; enddo - call initialize_sponge(Idamp, eta, G, param_file, CSp) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) endif diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index e4e35d77e5..4315420e9a 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -86,10 +86,10 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually + ! negative because it is positive upward, in depth units (Z). + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward, in depth units (Z). logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz @@ -113,14 +113,14 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -138,8 +138,8 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) 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(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available - !! thermodynamic fields, including potential temperature and - !! salinity or mixed layer density. Absent fields have NULL ptrs. + !! thermodynamic fields, including potential temperature and + !! salinity or mixed layer density. Absent fields have NULL ptrs. type(param_file_type), intent(in) :: PF !< A structure indicating the open file to !! parse for model parameter values. type(sponge_CS), pointer :: CSp !< A pointer that is set to point to the control @@ -149,7 +149,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: H0(SZK_(G)) + real :: H0(SZK_(G)) ! Interface heights in depth units (Z) real :: min_depth real :: damp, e_dense, damp_new character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. @@ -167,10 +167,10 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! Set up sponges for DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) H0(1) = 0.0 - do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth/real(nz-1) ; enddo + do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLonT(i,j) < 100.0) then ; damp = 10.0 elseif (G%geoLonT(i,j) < 200.0) then @@ -190,12 +190,12 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! depth space for Boussinesq or non-Boussinesq models. eta(i,j,1) = 0.0 do k=2,nz -! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j)) +! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) e_dense = -G%bathyT(i,j) if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j)) & - eta(i,j,K) = GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j) + if (eta(i,j,K) < GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) & + eta(i,j,K) = GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j) enddo eta(i,j,nz+1) = -G%bathyT(i,j) @@ -206,7 +206,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. ! - call initialize_sponge(Idamp, eta, G, PF, CSp) + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) ! Now register all of the fields which are damped in the sponge. ! ! By default, momentum is advected vertically within the sponge, but ! @@ -252,9 +252,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. ! The following variables are used to set up the transport in the DOME example. real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 - real :: D_edge ! The thickness in m of the dense fluid at the + real :: D_edge ! The thickness in Z of the dense fluid at the ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers, m s-2. + real :: g_prime_tot ! The reduced gravity across all layers, m2 Z-1 s-2. real :: Def_Rad ! The deformation radius, based on fluid of ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition @@ -271,7 +271,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! The following variables should be transformed into runtime parameters. - D_edge = 300.0 ! The thickness of dense fluid in the inflow. + D_edge = 300.0*GV%m_to_Z ! The thickness of dense fluid in the inflow. Ri_trans = 1.0/3.0 ! The shear Richardson number in the transition region ! region of the specified shear profile. @@ -279,7 +279,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) g_prime_tot = (GV%g_Earth/GV%Rho0)*2.0 Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) - tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%Z_to_H if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index d0b87d518f..621c5046dd 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -130,13 +130,13 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x - real :: delta_h, rho_range + real :: rho_range real :: min_thickness, s_sur, s_bot, t_sur, t_bot, rho_sur, rho_bot logical :: just_read ! If true, just read parameters but set nothing. character(len=256) :: mesg ! The text of an error message @@ -149,8 +149,8 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read) + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & + 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -169,10 +169,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par if (just_read) return ! All run-time parameters have been read, so return. ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) + call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) ! write(mesg,*) 'Surface density is:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot,s_bot,0.0,rho_bot,tv%eqn_of_state) + call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) ! write(mesg,*) 'Bottom density is:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur @@ -192,14 +192,14 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -207,14 +207,14 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -222,8 +222,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo case default @@ -249,7 +248,9 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot - real :: xi0, xi1, dxi, r, S_sur, T_sur, S_bot, T_bot, S_range, T_range + real :: xi0, xi1 ! Heights in depth units (Z). + real :: S_sur, T_sur, S_bot, T_bot + real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. real :: z ! vertical position in z space character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate, density_profile @@ -290,105 +291,96 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, case ( REGRIDDING_RHO, REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_SIGMA ) if (just_read) return ! All run-time parameters have been read, so return. - S_range = s_sur - s_bot - T_range = t_sur - t_bot - ! write(mesg,*) 'S_range,T_range',S_range,T_range - ! call MOM_mesg(mesg,5) - - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -G%bathyT(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth in middle of layer - S(i,j,k) = S_sur + S_range * xi0 - T(i,j,k) = T_sur + T_range * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer + S(i,j,k) = S_sur + dS_dz * xi0 + T(i,j,k) = T_sur + dT_dz * xi0 + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer enddo enddo ; enddo case ( REGRIDDING_LAYER ) - call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & - "If true, accept the prescribed temperature and fit the \n"//& - "salinity; otherwise take salinity and fit temperature.", & - default=.false., do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & - "Partial derivative of density with salinity.", & - units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & - "Partial derivative of density with temperature.", & - units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "T_REF", T_Ref, & - "A reference temperature used in initialization.", & - units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "S_REF", S_Ref, & - "A reference salinity used in initialization.", units="PSU", & - default=35.0, do_not_log=just_read) - if (just_read) return ! All run-time parameters have been read, so return. - - ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 - ! call MOM_mesg(mesg,5) - - S_range = s_bot - s_sur - T_range = t_bot - t_sur - ! write(mesg,*) 'S_range,T_range',S_range,T_range - ! call MOM_mesg(mesg,5) - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz - - do j=js,je ; do i=is,ie - xi0 = 0.0 - do k = 1,nz + call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & + "If true, accept the prescribed temperature and fit the \n"//& + "salinity; otherwise take salinity and fit temperature.", & + default=.false., do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & + "Partial derivative of density with salinity.", & + units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & + "Partial derivative of density with temperature.", & + units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "T_REF", T_Ref, & + "A reference temperature used in initialization.", & + units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_Ref, & + "A reference salinity used in initialization.", units="PSU", & + default=35.0, do_not_log=just_read) + if (just_read) return ! All run-time parameters have been read, so return. + + ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 + ! call MOM_mesg(mesg,5) + + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth + + do j=js,je ; do i=is,ie + xi0 = 0.0 + do k = 1,nz !T0(k) = T_Ref; S0(k) = S_Ref - xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m - S0(k) = S_sur + S_range * xi1 - T0(k) = T_sur + T_range * xi1 - xi0 = xi0 + h(i,j,k) * GV%H_to_m + xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z + S0(k) = S_sur - dS_dz * xi1 + T0(k) = T_sur - dT_dz * xi1 + xi0 = xi0 + h(i,j,k) * GV%H_to_Z ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k ! call MOM_mesg(mesg,5) - enddo - - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) - ! write(mesg,*) 'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) - ! call MOM_mesg(mesg,5) - call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) + enddo - if (fit_salin) then - ! A first guess of the layers' salinity. - do k=nz,1,-1 - S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1) - enddo - ! Refine the guesses for each layer. - do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) - do k=1,nz - S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) - enddo - enddo + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) + ! write(mesg,*) 'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) + ! call MOM_mesg(mesg,5) + call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) + + if (fit_salin) then + ! A first guess of the layers' salinity. + do k=nz,1,-1 + S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1) + enddo + ! Refine the guesses for each layer. + do itt=1,6 + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + do k=1,nz + S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) + enddo + enddo - else - ! A first guess of the layers' temperatures. - do k=nz,1,-1 - T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1 - enddo - - do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) - do k=1,nz - T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) - enddo - enddo - endif + else + ! A first guess of the layers' temperatures. + do k=nz,1,-1 + T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1 + enddo + + do itt=1,6 + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + do k=1,nz + T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) + enddo + enddo + endif - do k=1,nz - T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) - enddo + do k=1,nz + T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) + enddo - enddo ; enddo + enddo ; enddo - case default + case default call MOM_error(FATAL,"isomip_initialize: "// & "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE") @@ -428,18 +420,17 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: TNUDG ! Nudging time scale, days - real :: S_sur, T_sur; ! Surface salinity and temerature in sponge - real :: S_bot, T_bot; ! Bottom salinity and temerature in sponge - real :: t_ref, s_ref ! reference T and S - real :: rho_sur, rho_bot, rho_range, t_range, s_range - - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. - - ! positive upward, in m. - real :: min_depth, dummy1, z, delta_h + real :: S_sur, T_sur ! Surface salinity and temerature in sponge + real :: S_bot, T_bot ! Bottom salinity and temerature in sponge + real :: t_ref, s_ref ! reference T and S + real :: rho_sur, rho_bot, rho_range + real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. + + real :: e0(SZK_(G)+1) ! The resting interface heights, in Z, usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward, in Z. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z. + real :: min_depth, dummy1, z real :: damp, rho_dummy, min_thickness, rho_tmp, xi0 character(len=40) :: verticalCoordinate, filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir @@ -451,6 +442,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call get_param(PF, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) + min_thickness = GV%m_to_Z * min_thickness call get_param(PF, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE) @@ -463,59 +455,56 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) call get_param(PF, mdl, "S_REF", s_ref, 'Reference salinity', default=35.0,& do_not_log=.true.) - call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) - call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) - call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) - call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; RHO(:,:,:) = 0.0 - S_range = s_sur - s_bot - T_range = t_sur - t_bot ! Set up sponges for ISOMIP configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) - if (associated(CSp)) call MOM_error(FATAL, & - "ISOMIP_initialize_sponges called with an associated control structure.") - if (associated(ACSp)) call MOM_error(FATAL, & - "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.") + if (associated(CSp)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges called with an associated control structure.") + if (associated(ACSp)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.") ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! ! wherever there is no sponge, and the subroutines that are called ! ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. - do i=is,ie; do j=js,je - if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then + do i=is,ie; do j=js,je + if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then ! 1 / day - dummy1=(G%geoLonT(i,j)-790.0)/(800.0-790.0) - damp = 1.0/TNUDG * max(0.0,dummy1) + dummy1=(G%geoLonT(i,j)-790.0)/(800.0-790.0) + damp = 1.0/TNUDG * max(0.0,dummy1) - else ; damp=0.0 - endif + else ; damp=0.0 + endif ! convert to 1 / seconds - if (G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 - else ; Idamp(i,j) = 0.0 ; endif - + if (G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 + else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo + enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) - !write (*,*)'Surface density in sponge:', rho_sur + call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) + !write (mesg,*) 'Surface density in sponge:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot,s_bot,0.0,rho_bot,tv%eqn_of_state) - !write (*,*)'Bottom density in sponge:', rho_bot + call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) + !write (mesg,*) 'Bottom density in sponge:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur - !write (*,*)'Density range in sponge:', rho_range + !write (mesg,*) 'Density range in sponge:', rho_range ! call MOM_mesg(mesg,5) if (use_ALE) then @@ -536,56 +525,56 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = min_thickness * GV%Z_to_H else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates - do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = delta_h - enddo ; enddo + do j=js,je ; do i=is,ie + h(i,j,:) = GV%Z_to_H * (G%bathyT(i,j) / dfloat(nz)) + enddo ; enddo case default call MOM_error(FATAL,"ISOMIP_initialize_sponges: "// & "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE") end select + ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. call initialize_ALE_sponge(Idamp, G, PF, ACSp, h, nz) - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -G%bathyT(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) ! Depth in middle of layer - S(i,j,k) = S_sur + S_range * xi0 - T(i,j,k) = T_sur + T_range * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer + S(i,j,k) = S_sur + dS_dz * xi0 + T(i,j,k) = T_sur + dT_dz * xi0 + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer enddo enddo ; enddo ! for debugging @@ -602,57 +591,57 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! The remaining calls to set_up_sponge_field can be in any order. ! if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T,G,tv%T,ACSp) + call set_up_ALE_sponge_field(T, G, tv%T, ACSp) endif if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S,G,tv%S,ACSp) + call set_up_ALE_sponge_field(S, G, tv%S, ACSp) endif else ! layer mode - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - ! GM: get two different files, one with temp and one with salt values - ! this is work around to avoid having wrong values near the surface - ! because of the FIT_SALINITY option. To get salt values right in the - ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can - ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, & - "The name of the file with temps., salts. and interfaces to \n"// & - " damp toward.", fail_if_missing=.true.) - call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, & - "The name of the potential temperature variable in \n"//& - "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & - "The name of the salinity variable in \n"//& - "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & - "The name of the interface height variable in \n"//& - "SPONGE_STATE_FILE.", default="eta") - - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " ISOMIP_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) - call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) - - ! for debugging - !i=G%iec; j=G%jec - !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) - ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& - ! S(i,j,k),rho_tmp,GV%Rlay(k) - ! call MOM_mesg(mesg,5) - !enddo - - ! Set the inverse damping rates so that the model will know where to - ! apply the sponges, along with the interface heights. - call initialize_sponge(Idamp, eta, G, PF, CSp) - ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + ! GM: get two different files, one with temp and one with salt values + ! this is work around to avoid having wrong values near the surface + ! because of the FIT_SALINITY option. To get salt values right in the + ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can + ! combined the *correct* temp and salt values in one file instead. + call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, & + "The name of the file with temps., salts. and interfaces to \n"// & + "damp toward.", fail_if_missing=.true.) + call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, & + "The name of the potential temperature variable in \n"//& + "SPONGE_STATE_FILE.", default="Temp") + call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & + "The name of the salinity variable in \n"//& + "SPONGE_STATE_FILE.", default="Salt") + call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & + "The name of the interface height variable in \n"//& + "SPONGE_STATE_FILE.", default="eta") + + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges: Unable to open "//trim(filename)) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) + call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) + call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) + + ! for debugging + !i=G%iec; j=G%jec + !do k = 1,nz + ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) + ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& + ! S(i,j,k),rho_tmp,GV%Rlay(k) + ! call MOM_mesg(mesg,5) + !enddo + + ! Set the inverse damping rates so that the model will know where to + ! apply the sponges, along with the interface heights. + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) + ! Apply sponge in tracer fields + call set_up_sponge_field(T, tv%T, G, nz, CSp) + call set_up_sponge_field(S, tv%S, G, nz, CSp) endif diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index eeda2e267f..8315833391 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -17,7 +17,7 @@ module Kelvin_initialization use MOM_open_boundary, only : OBC_DIRECTION_S, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_registry_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private @@ -223,11 +223,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(G%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- CS%F_0 * y / cff) segment%eta(I,j) = val2 * cos(CS%omega * time_sec) segment%normal_vel_bt(I,j) = val1 * cff * cosa / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + (0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 else ! Not rotated yet segment%eta(I,j) = 0.0 @@ -255,11 +255,17 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa + !### Problem: val2 & cff could be a functions of space, but are not set in this loop. + !### Problem: Is val2 in the numerator or denominator below? if (CS%mode == 0) then do k=1,nz - segment%tangential_vel(I,J,k) = 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))) * val2 + segment%tangential_vel(I,J,k) = val1 * cff * sina / & + (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 +!### For rotational symmetry, this should be: +! segment%tangential_vel(I,J,k) = val1 * cff * sina / & +! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& +! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 enddo endif enddo ; enddo @@ -273,11 +279,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(G%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) segment%eta(I,j) = val2 * cos(CS%omega * time_sec) - segment%normal_vel_bt(I,j) = val1 * cff * sina / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + segment%normal_vel_bt(I,j) = val1 * cff * sina / & + (0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 else ! Not rotated yet segment%eta(i,J) = 0.0 @@ -303,11 +309,17 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa + !### Problem: val2 & cff could be a functions of space, but are not set in this loop. + !### Problem: Is val2 in the numerator or denominator below? if (CS%mode == 0) then do k=1,nz - segment%tangential_vel(I,J,k) = 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))) * val2 + segment%tangential_vel(I,J,k) = val1 * cff * sina / & + (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 +!### This should be: +! segment%tangential_vel(I,J,k) = val1 * cff * sina / & +! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& +! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 enddo endif enddo ; enddo diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index c361a37176..2034a16bb4 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -18,8 +18,8 @@ module MOM_controlled_forcing use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) -use MOM_time_manager, only : get_time, get_date, set_time, set_date -use MOM_time_manager, only : time_type_to_real +use MOM_time_manager, only : get_date, set_date +use MOM_time_manager, only : time_type_to_real, real_to_time use MOM_variables, only : surface implicit none ; private @@ -121,7 +121,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if (.not.associated(CS)) return if ((CS%num_cycle <= 0) .and. (.not.CS%do_integrated)) return - day_end = day_start + set_time(floor(dt+0.5)) + day_end = day_start + real_to_time(dt) do j=js,je ; do i=is,ie virt_heat(i,j) = 0.0 ; virt_precip(i,j) = 0.0 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 950fe4729d..1a35ebccd2 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -12,8 +12,7 @@ module MOM_wave_interface use MOM_grid, only : ocean_grid_type use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real,real_to_time_type +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_variables, only : thermo_var_ptrs, surface use data_override_mod, only : data_override_init, data_override @@ -526,11 +525,11 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/GV%g_Earth) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth !bgr bug-fix missing g + WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -569,11 +568,11 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/GV%g_Earth) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth + WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -771,7 +770,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) endif NUMBANDS = ID do B = 1,NumBands - CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth + CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) enddo endif @@ -969,7 +968,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * GV%g_Earth / tmp + fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp ! ! mean frequency fm = fm_to_fp * fp @@ -1103,14 +1102,14 @@ subroutine DHH85_mid(GV, ust, zpt, US) !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 6.5 ! ~sqrt(0.2*GV%g_earth*2*pi/0.3) + omega_max = 6.5 ! ~sqrt(0.2*(GV%g_Earth*GV%m_to_Z)*2*pi/0.3) domega=0.05 NOmega = (omega_max-omega_min)/domega ! if (WaveAgePeakFreq) then - omega_peak = GV%G_EARTH/WA/u10 + omega_peak = (GV%g_Earth*GV%m_to_Z)/WA/u10 else - omega_peak = 2. * pi * 0.13 * GV%g_earth / U10 + omega_peak = 2. * pi * 0.13 * (GV%g_Earth*GV%m_to_Z) / U10 endif !/ Ann = 0.006 * WaveAge**(-0.55) @@ -1126,11 +1125,11 @@ subroutine DHH85_mid(GV, ust, zpt, US) do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / Snn**2 / omega_peak**2 ) ! wavespec units = m2s - wavespec = (Ann * GV%g_earth**2 / (omega_peak*omega**4 ) ) & + wavespec = (Ann * (GV%g_Earth*GV%m_to_Z)**2 / (omega_peak*omega**4 ) ) & *exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * zpt/GV%g_earth)/GV%g_earth + exp( 2.0 * omega**2 * zpt/(GV%g_Earth*GV%m_to_Z))/(GV%g_Earth*GV%m_to_Z) US=US+Stokes*domega omega = omega + domega enddo @@ -1291,7 +1290,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) CT=CT+1 u10a = u10 alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/GV%g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess z0=z0sm+z0rough CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 0aa80f3c2e..76d028c6f4 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -37,7 +37,7 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) real :: x, y ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "Neverland_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "Neverland_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed real :: nl_roughness_amp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -45,8 +45,8 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_topography: setting topography", 5) - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "NL_ROUGHNESS_AMP", nl_roughness_amp, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "NL_ROUGHNESS_AMP", nl_roughness_amp, & "Amplitude of wavy signal in bathymetry.", default=0.05) PI = 4.0*atan(1.0) @@ -78,7 +78,7 @@ end subroutine Neverland_initialize_topography ! ----------------------------------------------------------------------------- !> Returns the value of a cosine-bell function evaluated at x/L -real function cosbell(x,L) +real function cosbell(x, L) real , intent(in) :: x !< non-dimensional position real , intent(in) :: L !< non-dimensional width real :: PI !< 3.1415926... calculated as 4*atan(1) @@ -88,7 +88,7 @@ real function cosbell(x,L) end function cosbell !> Returns the value of a sin-spike function evaluated at x/L -real function spike(x,L) +real function spike(x, L) real , intent(in) :: x !< non-dimensional position real , intent(in) :: L !< non-dimensional width @@ -115,20 +115,21 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure in Pa. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (m) - real :: e_interface ! Current interface positoin (m) - character(len=40) :: mod = "Neverland_initialize_thickness" ! This subroutine's name. + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (Z) + real :: e_interface ! Current interface position (m) + character(len=40) :: mdl = "Neverland_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_thickness: setting thickness", 5) - call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & - "Profile of initial layer thicknesses.", units="m", fail_if_missing=.true.) + call get_param(param_file, mdl, "INIT_THICKNESS_PROFILE", h_profile, & + "Profile of initial layer thicknesses.", units="m", scale=GV%m_to_Z, & + fail_if_missing=.true.) -! e0 is the notional position of interfaces + ! e0 is the notional position of interfaces e0(1) = 0. ! The surface do k=1,nz e0(k+1) = e0(k) - h_profile(k) @@ -137,10 +138,9 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ do j=js,je ; do i=is,ie e_interface = -G%bathyT(i,j) do k=nz,1,-1 - h(i,j,k) = max( GV%Angstrom, GV%m_to_H * (e0(k) - e_interface) ) - e_interface = max( e0(k), e_interface - GV%H_to_m * h(i,j,k) ) + h(i,j,k) = max( GV%Angstrom_H, GV%Z_to_H * (e0(k) - e_interface) ) + e_interface = max( e0(k), e_interface - GV%H_to_Z * h(i,j,k) ) enddo - enddo ; enddo end subroutine Neverland_initialize_thickness diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 5267b5585b..580638e415 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -28,7 +28,7 @@ module Phillips_initialization contains -!> Initialize thickness field. +!> Initialize the thickness field for the Phillips model test case. subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -39,10 +39,10 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. + real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces, in depth units (Z). + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in depth units (Z). real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in in depth units (Z). real :: damp_rate, jet_width, jet_height, y_2 real :: half_strat, half_depth logical :: just_read ! If true, just read parameters but set nothing. @@ -65,7 +65,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -82,34 +82,33 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) enddo do K=2,nz ; do j=js,je y_2 = G%geoLatT(is,j) - G%south_lat - 0.5*G%len_lat - eta_im(j,K) = eta0(k) + & - jet_height * tanh(y_2 / jet_width) -! jet_height * atan(y_2 / jet_width) + eta_im(j,K) = eta0(k) + jet_height * tanh(y_2 / jet_width) + ! or ... + jet_height * atan(y_2 / jet_width) if (eta_im(j,K) > 0.0) eta_im(j,K) = 0.0 if (eta_im(j,K) < -G%max_depth) eta_im(j,K) = -G%max_depth enddo ; enddo do j=js,je ; do i=is,ie -! This sets the initial thickness (in m) of the layers. The ! +! This sets the initial thickness (in H) of the layers. The ! ! thicknesses are set to insure that: 1. each layer is at least an ! ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo end subroutine Phillips_initialize_thickness -!> Initialize velocity fields. +!> Initialize the velocity fields for the Phillips model test case subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -140,7 +139,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_param fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -183,12 +182,12 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_param end subroutine Phillips_initialize_velocity -!> Sets up the the inverse restoration time (Idamp), and -! the values towards which the interface heights and an arbitrary -! number of tracers should be restored within each sponge. -subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) +!> Sets up the the inverse restoration time (Idamp), and the values towards which the interface +!! heights and an arbitrary number of tracers should be restored within each sponge for the Phillips +!! model test case +subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - logical, intent(in) :: use_temperature !< Switch for temperature. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and @@ -200,16 +199,21 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. + real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in units of H. + ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. - real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z). + real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in Z. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. - real :: damp_rate, jet_width, jet_height, y_2 - real :: half_strat, half_depth + real :: damp_rate ! The inverse zonal-mean damping rate, in s-1. + real :: jet_width ! The width of the zonal mean jet, in km. + real :: jet_height ! The interface height scale associated with the zonal-mean jet, in Z. + real :: y_2 ! The y-position relative to the channel center, in km. + real :: half_strat ! The fractional depth where the straficiation is centered, ND. + real :: half_depth ! The depth where the stratification is centered, in Z. character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -224,8 +228,8 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, if (first_call) call log_version(param_file, mdl, version) first_call = .false. call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & - "The maximum depth of the ocean.", units="nondim", & - default = 0.5) + "The fractional depth where the stratificaiton is centered.", & + units="nondim", default = 0.5) call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & "The rate at which the zonal-mean sponges damp.", units="s-1", & default = 1.0/(10.0*86400.0)) @@ -235,7 +239,7 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, fail_if_missing=.true.) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.true.) half_depth = G%max_depth*half_strat @@ -251,14 +255,13 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, enddo do K=2,nz ; do j=js,je y_2 = G%geoLatT(is,j) - G%south_lat - 0.5*G%len_lat - eta_im(j,K) = eta0(k) + & - jet_height * tanh(y_2 / jet_width) + eta_im(j,K) = eta0(k) + jet_height * tanh(y_2 / jet_width) ! jet_height * atan(y_2 / jet_width) if (eta_im(j,K) > 0.0) eta_im(j,K) = 0.0 if (eta_im(j,K) < -G%max_depth) eta_im(j,K) = -G%max_depth enddo ; enddo - call initialize_sponge(Idamp, eta, G, param_file, CSp, Idamp_im, eta_im) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV, Idamp_im, eta_im) end subroutine Phillips_initialize_sponges @@ -295,7 +298,7 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth) call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & "The maximum height of the topography.", units="m", & fail_if_missing=.true.) -! Htop=0.375*G%max_depth ! max height of topog. above max_depth +! Htop=0.375*max_depth ! max height of topog. above max_depth Wtop=0.5*G%len_lat ! meridional width of drake and mount Ltop=0.25*G%len_lon ! zonal width of topographic features offset=0.1*G%len_lat ! meridional offset from center diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index b2e4f35881..975b96e866 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -81,7 +81,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz - h(i,j,k) = h0 * GV%m_to_H + h(i,j,k) = h0 * GV%Z_to_H enddo enddo ; enddo @@ -92,7 +92,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz - h(i,j,k) = h0 * GV%m_to_H + h(i,j,k) = h0 * GV%Z_to_H enddo enddo ; enddo @@ -149,7 +149,7 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & zi = 0. do k = 1, nz zi = zi - h(i,j,k) ! Bottom interface position - zc = GV%H_to_m * (zi - 0.5*h(i,j,k)) ! Position of middle of cell + zc = GV%H_to_Z * (zi - 0.5*h(i,j,k)) ! Position of middle of cell zc = min( zc, -Hml(G, G%geoLatT(i,j)) ) ! Bound by depth of mixed layer T(i,j,k) = T_ref + dTdz * zc ! Linear temperature profile enddo @@ -177,9 +177,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea real :: T_range ! Range of salinities and temperatures over the vertical real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f real :: dRho_dT - real :: Dml, zi, zc, zm ! Depths in units of m. + real :: Dml, zi, zc, zm ! Depths in units of Z. real :: f, Ty - real :: hAtU ! Interpolated layer thickness in units of m. + real :: hAtU ! Interpolated layer thickness in units of Z. integer :: i, j, k, is, ie, js, je, nz logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate @@ -207,7 +207,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. do k = 1, nz - hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_m + hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z zi = zi - hAtU ! Bottom interface position zc = zi - 0.5*hAtU ! Position of middle of cell zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer @@ -232,7 +232,8 @@ real function yPseudo( G, lat ) end function yPseudo -!> Analytic prescription of mixed layer depth in 2d Rossby front test +!> Analytic prescription of mixed layer depth in 2d Rossby front test, +!! in the same units as G%max_depth real function Hml( G, lat ) type(ocean_grid_type), intent(in) :: G !< Grid structure real, intent(in) :: lat !< Latitude diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVmix_tests.F90 index 2f2026c848..fca5ffa1d2 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVmix_tests.F90 @@ -8,11 +8,10 @@ module SCM_CVMix_tests use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing, mech_forcing use MOM_grid, only : ocean_grid_type -use MOM_verticalgrid, only: verticalGrid_type +use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real -use MOM_variables, only : thermo_var_ptrs, surface +use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real +use MOM_variables, only : thermo_var_ptrs, surface implicit none ; private #include diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index f688c40ec6..2bb04b30f9 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -10,8 +10,7 @@ module SCM_idealized_hurricane use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real +use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index cd65def7d7..b36b58297c 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -36,10 +36,10 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). real :: x, y, yy, delta_S_strat, dSdz, delta_S, S_ref real :: min_thickness, adjustment_width, adjustment_delta, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym @@ -61,7 +61,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"S_REF",S_ref,fail_if_missing=.true.,do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & - units='m',default=1.0e-3, do_not_log=just_read) + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) ! Parameters specific to this experiment configuration call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & @@ -95,28 +95,29 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par ! vanished and the other thicknesses uniformly distributed, use: ! e0(k) = -G%max_depth * real(k-1) / real(nz-1) - dSdz = -delta_S_strat/G%max_depth + dSdz = -delta_S_strat / G%max_depth select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) if (delta_S_strat /= 0.) then - adjustment_delta = adjustment_deltaS / delta_S_strat * G%max_depth + ! This was previously coded ambiguously. + adjustment_delta = (adjustment_deltaS / delta_S_strat) * G%max_depth do k=1,nz+1 - e0(k) = adjustment_delta-(G%max_depth+2*adjustment_delta) * (real(k-1) / real(nz)) + e0(k) = adjustment_delta - (G%max_depth + 2*adjustment_delta) * (real(k-1) / real(nz)) enddo else adjustment_delta = 2.*G%max_depth do k=1,nz+1 - e0(k) = -(G%max_depth) * (real(k-1) / real(nz)) + e0(k) = -G%max_depth * (real(k-1) / real(nz)) enddo endif - target_values(1) = GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)) - target_values(nz+1) = GV%Rlay(nz)+0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) + target_values(1) = GV%Rlay(1) + 0.5*(GV%Rlay(1)-GV%Rlay(2)) + target_values(nz+1) = GV%Rlay(nz) + 0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) do k = 2,nz target_values(k) = target_values(k-1) + ( GV%Rlay(nz) - GV%Rlay(1) ) / (nz-1) enddo - target_values = target_values - 1000. + target_values(:) = target_values(:) - 1000. do j=js,je ; do i=is,ie if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -140,28 +141,28 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par eta1D(k) = max( eta1D(k), -G%max_depth ) eta1D(k) = min( eta1D(k), 0. ) enddo - eta1D(1)=0.; eta1D(nz+1)=-G%max_depth + eta1D(1) = 0.; eta1D(nz+1) = -G%max_depth do k=nz,1,-1 if (eta1D(k) > 0.) then eta1D(k) = max( eta1D(k+1) + min_thickness, 0. ) - h(i,j,k) = GV%m_to_H * max( eta1D(k) - eta1D(k+1), min_thickness ) + h(i,j,k) = GV%Z_to_H * max( eta1D(k) - eta1D(k+1), min_thickness ) elseif (eta1D(k) <= (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) do k=1,nz+1 - eta1D(k) = -(G%max_depth) * (real(k-1) / real(nz)) - eta1D(k) = max(min(eta1D(k),0.),-G%max_depth) + eta1D(k) = -G%max_depth * (real(k-1) / real(nz)) + eta1D(k) = max(min(eta1D(k), 0.), -G%max_depth) enddo do j=js,je ; do i=is,ie do k=nz,1,-1 - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) enddo enddo ; enddo @@ -174,15 +175,15 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case -subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) +subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file, & + eqn_of_state, just_read_params) 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(out) :: T !< The temperature that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H (m or kg m-2). - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model parameter values. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. @@ -226,7 +227,7 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi call get_param(param_file, mdl,"FRONT_WAVE_AMP", front_wave_amp, default=0., & do_not_log=.true.) call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & - default=0.,do_not_log=.true.) + default=0., do_not_log=.true.) call get_param(param_file, mdl,"FRONT_WAVE_ASYM", front_wave_asym, default=0., & do_not_log=.true.) @@ -239,11 +240,11 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) - dSdz = -delta_S_strat/G%max_depth + dSdz = -delta_S_strat / G%max_depth do j=js,je ; do i=is,ie eta1d(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_m + eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_Z enddo if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -264,8 +265,8 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi x = 1. - min(1., x) T(i,j,k) = x enddo - ! x=sum(T(i,j,:)*h(i,j,:)) - ! T(i,j,:)=T(i,j,:)/x*(G%max_depth*1.5/real(nz)) + ! x = GV%H_to_Z*sum(T(i,j,:)*h(i,j,:)) + ! T(i,j,:) = (T(i,j,:) / x) * (G%max_depth*1.5/real(nz)) enddo ; enddo case ( REGRIDDING_LAYER, REGRIDDING_RHO ) diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 708c412c65..bdcd84aeee 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -21,21 +21,23 @@ module baroclinic_zone_initialization contains !> Reads the parameters unique to this module -subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & +subroutine bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & delta_T, dTdx, L_zone, just_read_params) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle - real, intent(out) :: S_ref !< Reference salinity (ppt) - real, intent(out) :: dSdz !< Salinity stratification (ppt/m) - real, intent(out) :: delta_S !< Salinity difference across baroclinic zone (ppt) - real, intent(out) :: dSdx !< Linear salinity gradient (ppt/m) - real, intent(out) :: T_ref !< Reference temperature (ppt) - real, intent(out) :: dTdz !< Temperature stratification (ppt/m) - real, intent(out) :: delta_T !< Temperature difference across baroclinic zone (ppt) - real, intent(out) :: dTdx !< Linear temperature gradient (ppt/m) - real, intent(out) :: L_zone !< Width of baroclinic zone (m) - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Parameter file handle + real, intent(out) :: S_ref !< Reference salinity (ppt) + real, intent(out) :: dSdz !< Salinity stratification (ppt/Z) + real, intent(out) :: delta_S !< Salinity difference across baroclinic zone (ppt) + real, intent(out) :: dSdx !< Linear salinity gradient (ppt/m) + real, intent(out) :: T_ref !< Reference temperature (ppt) + real, intent(out) :: dTdz !< Temperature stratification (ppt/Z) + real, intent(out) :: delta_T !< Temperature difference across baroclinic zone (ppt) + real, intent(out) :: dTdx !< Linear temperature gradient (ppt/m) + real, intent(out) :: L_zone !< Width of baroclinic zone (m) + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + logical :: just_read ! If true, just read parameters but set nothing. just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -45,16 +47,16 @@ subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & call openParameterBlock(param_file,'BCZIC') call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', units='ppt', & default=35., do_not_log=just_read) - call get_param(param_file, mdl,"DSDZ",dSdz,'Salinity stratification',units='ppt/m', & - default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DSDZ", dSdz, 'Salinity stratification', & + units='ppt/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_S",delta_S,'Salinity difference across baroclinic zone', & units='ppt', default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"DSDX",dSdx,'Meridional salinity difference', & units='ppt/'//trim(G%x_axis_units), default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature',units='C', & default=10., do_not_log=just_read) - call get_param(param_file, mdl,"DTDZ",dTdz,'Temperature stratification',units='C/m', & - default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DTDZ", dTdz, 'Temperature stratification', & + units='C/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_T",delta_T,'Temperature difference across baroclinic zone', & units='C', default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"DTDX",dTdx,'Meridional temperature difference', & @@ -81,14 +83,15 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution real :: L_zone ! Width of baroclinic zone - real :: zc, zi, x, xd, xs, y, yd, fn + real :: zc, zi ! Depths in depth units (Z). + real :: x, xd, xs, y, yd, fn real :: PI ! 3.1415926... calculated as 4*atan(1) logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) + call bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. @@ -110,8 +113,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, fn = xs endif do k = nz, 1, -1 - zc = zi + 0.5*h(i,j,k)*GV%H_to_m ! Position of middle of cell - zi = zi + h(i,j,k)*GV%H_to_m ! Top interface position + zc = zi + 0.5*h(i,j,k)*GV%H_to_Z ! Position of middle of cell + zi = zi + h(i,j,k)*GV%H_to_Z ! Top interface position T(i,j,k) = T_ref + dTdz * zc & ! Linear temperature stratification + dTdx * x & ! Linear gradient + delta_T * fn ! Smooth fn of width L_zone diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index b681843002..8e0e03ad94 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -86,19 +86,19 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive ! - ! upward, in m. ! - real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive upward, + ! in depth units (Z). + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward, in depth units (Z). real :: SST ! The initial sea surface temperature, in deg C. real :: T_int ! The initial temperature of an interface, in deg C. - real :: ML_depth ! The specified initial mixed layer depth, in m. - real :: thermocline_scale ! The e-folding scale of the thermocline, in m. + real :: ML_depth ! The specified initial mixed layer depth, in depth units (Z). + real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units (Z). real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS real :: a_exp ! The fraction of the overall stratification that is exponential. - real :: I_ts, I_md ! Inverse lengthscales in m-1. + real :: I_ts, I_md ! Inverse lengthscales in Z-1. real :: T_frac ! A ratio of the interface temperature to the range ! between SST and the bottom temperature. real :: err, derr_dz ! The error between the profile's temperature and the @@ -118,8 +118,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & k1 = GV%nk_rho_varies + 1 - ML_depth = 50.0 - thermocline_scale = 500.0 + ML_depth = 50.0 * GV%m_to_Z + thermocline_scale = 500.0 * GV%m_to_Z a_exp = 0.9 ! This block calculates T0(k) for the purpose of diagnosing where the @@ -128,8 +128,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & pres(k) = P_Ref ; S0(k) = 35.0 enddo T0(k1) = 29.0 - call calculate_density(T0(k1),S0(k1),pres(k1),rho_guess(k1),eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,k1,1,eqn_of_state) + call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state) ! A first guess of the layers' temperatures. do k=1,nz @@ -138,8 +138,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -156,12 +156,12 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! The remainder of this subroutine should not be changed. ! -! This sets the initial thickness (in m) of the layers. The ! +! This sets the initial thickness (in H) of the layers. The ! ! thicknesses are set to insure that: 1. each layer is at least ! -! Gv%Angstrom_z thick, and 2. the interfaces are where they should be ! +! Gv%Angstrom_m thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,2,-1 T_int = 0.5*(T0(k) + T0(k-1)) @@ -180,12 +180,12 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & if (eta1D(K) > -ML_depth) eta1D(K) = -ML_depth - if (eta1D(K) < eta1D(K+1) + GV%Angstrom_z) & - eta1D(K) = eta1D(K+1) + GV%Angstrom_z + if (eta1D(K) < eta1D(K+1) + GV%Angstrom_Z) & + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = max(GV%m_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom) + h(i,j,k) = max(GV%Z_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom_H) enddo - h(i,j,1) = max(GV%m_to_H * (0.0 - eta1D(2)), GV%Angstrom) + h(i,j,1) = max(GV%Z_to_H * (0.0 - eta1D(2)), GV%Angstrom_H) enddo ; enddo diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 1ff42509c5..f72a6e1830 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -33,10 +33,10 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface + ! positive upward, in in depth units (Z). real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset logical :: just_read ! This include declares and sets the variable "version". @@ -70,14 +70,14 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para ! Uniform thicknesses for base state do j=js,je ; do i=is,ie ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 30625377cc..f1a7bd6492 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -129,7 +129,7 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j zi = 0. do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / G%max_depth + zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) if (zmid < mld) then ! use reference salinity in the mixed layer @@ -139,7 +139,7 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / G%max_depth + zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) enddo enddo enddo @@ -219,9 +219,9 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A if (use_ALE) then ! construct a uniform grid for the sponge do k = 1,nz - e0(k) = -GV%max_depth * (real(k - 1) / real(nz)) + e0(k) = -G%max_depth * (real(k - 1) / real(nz)) enddo - e0(nz+1) = -GV%max_depth + e0(nz+1) = -G%max_depth do j = G%jsc,G%jec do i = G%isc,G%iec @@ -229,12 +229,12 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A do k = nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then ! is this layer vanished? - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo @@ -253,7 +253,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / GV%max_depth + zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) if (x > (1. - east_sponge_width)) then !if (zmid >= 0.9 * sill_height) & @@ -264,7 +264,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / GV%max_depth + zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) enddo enddo enddo diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index de9f88c094..12ca05fded 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -55,12 +55,12 @@ subroutine dumbbell_initialize_topography ( D, G, param_file, max_depth ) dblen=dblen*1.e3 endif - do i=G%isc,G%iec + do i=G%isc,G%iec do j=G%jsc,G%jec ! Compute normalized zonal coordinates (x,y=0 at center of domain) x = ( G%geoLonT(i,j) ) / dblen y = ( G%geoLatT(i,j) ) / G%len_lat - D(i,j)=G%max_depth + D(i,j) = G%max_depth if ((x>=-0.25 .and. x<=0.25) .and. (y <= -0.5*dbfrac .or. y >= 0.5*dbfrac)) then D(i,j) = 0.0 endif @@ -80,10 +80,10 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h @@ -98,10 +98,10 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read) - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) ! WARNING: this routine specifies the interface heights so that the last layer @@ -134,19 +134,20 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range - e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface + ! Force round numbers ... the above expression has irrational factors ... + e0(K) = nint(2048.*GV%Z_to_m*e0(K)) / (2048.*GV%Z_to_m) + e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -154,14 +155,14 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -169,8 +170,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = delta_h + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select @@ -279,9 +279,9 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp units="s", default=0.) call get_param(param_file, mdl, "DUMBBELL_SREF", S_ref, do_not_log=.true.) call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, do_not_log=.true.) - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=.true.) + units='m', default=1.0e-3, do_not_log=.true., scale=GV%m_to_Z) ! no active sponges if (sponge_time_scale <= 0.) return @@ -305,14 +305,14 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp if (use_ALE) then ! construct a uniform grid for the sponge do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 0718ceb09c..d206914e2a 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -162,6 +162,7 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) call get_time(day,isecs,idays) rdays = real(idays) + real(isecs)/8.64e4 + ! This could be: rdays = time_type_to_real(day)/8.64e4 ! Allocate and zero out the forcing arrays, as necessary. call safe_alloc_ptr(fluxes%p_surf, isd, ied, jsd, jed) diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 133b5388cb..cb1b9a6b2f 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -11,7 +11,7 @@ module dyed_channel_initialization use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_open_boundary, only : OBC_registry_type, register_OBC -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : tracer_registry_type, tracer_name_lookup use MOM_tracer_registry, only : tracer_type use MOM_variables, only : thermo_var_ptrs diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 0882eb510f..05a64c6069 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -29,12 +29,8 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)) ! The resting interface heights, in m, usually - ! negative because it is positive upward. - real :: e_pert(SZK_(G)) ! Interface height perturbations, positive - ! upward, in m. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units (Z). real :: ssh_anomaly_height ! Vertical height of ssh anomaly real :: ssh_anomaly_width ! Lateral width of anomaly logical :: just_read ! If true, just read parameters but set nothing. @@ -54,7 +50,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SSH_ANOMALY_HEIGHT", ssh_anomaly_height, & "The vertical displacement of the SSH anomaly. ", units="m", & - fail_if_missing=.not.just_read, do_not_log=just_read) + fail_if_missing=.not.just_read, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl, "SSH_ANOMALY_WIDTH", ssh_anomaly_width, & "The lateral width of the SSH anomaly. ", units="coordinate", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -72,7 +68,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom do k=1,nz - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) enddo enddo ; enddo diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index c3e06391cb..e6dd3ee900 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -57,12 +57,12 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa call get_param(param_file, mdl, "FRONT_DISPLACEMENT", front_displacement, & "The vertical displacement of interfaces across the front. \n"//& "A value larger in magnitude that MAX_DEPTH is truncated,", & - units="m", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m", fail_if_missing=.not.just_read, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl, "THERMOCLINE_THICKNESS", thermocline_thickness, & "The thickness of the thermocline in the lock exchange \n"//& "experiment. A value of zero creates a two layer system \n"//& "with vanished layers in between the two inflated layers.", & - default=0., units="m", do_not_log=just_read) + default=0., units="m", do_not_log=just_read, scale=GV%m_to_Z) if (just_read) return ! All run-time parameters have been read, so return. @@ -71,9 +71,9 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa eta1D(K) = -0.5 * G%max_depth & ! Middle of column - thermocline_thickness * ( (real(k-1))/real(nz) -0.5 ) ! Stratification if (G%geoLonT(i,j)-G%west_lon < 0.5 * G%len_lon) then - eta1D(K)=eta1D(K) + 0.5 * front_displacement + eta1D(K) = eta1D(K) + 0.5 * front_displacement elseif (G%geoLonT(i,j)-G%west_lon > 0.5 * G%len_lon) then - eta1D(K)=eta1D(K) - 0.5 * front_displacement + eta1D(K) = eta1D(K) - 0.5 * front_displacement endif enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom @@ -85,7 +85,7 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_Z ) enddo do k=nz,1,-1 - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) enddo enddo ; enddo diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 131f73ea3e..7ec04ba302 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -87,12 +87,10 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - integer :: i, j, k, is, ie, js, je, nz - real :: x - real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate logical :: just_read ! If true, just read parameters but set nothing. + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -103,7 +101,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read) + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -137,19 +135,20 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range - e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface + ! Force round numbers ... the above expression has irrational factors ... + e0(K) = nint(2048.*GV%Z_to_m*e0(K))/(2048.*GV%Z_to_m) + e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -157,14 +156,14 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -172,8 +171,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select @@ -251,7 +249,7 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + GV%H_to_m * h(i,j,k) / G%max_depth + xi1 = xi0 + GV%H_to_Z * h(i,j,k) / G%max_depth select case ( trim(density_profile) ) case ('linear') !S(i,j,k) = S_surf + S_range * 0.5 * (xi0 + xi1) diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 1640c9ec5a..9207830032 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -11,7 +11,7 @@ module shelfwave_initialization use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_segment_type, register_OBC use MOM_open_boundary, only : OBC_registry_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index a81cf181e6..4340d9dcda 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -39,13 +39,9 @@ subroutine sloshing_initialize_topography ( D, G, param_file, max_depth ) ! Local variables integer :: i, j - do i=G%isc,G%iec - do j=G%jsc,G%jec - - D(i,j) = max_depth - - enddo - enddo + do i=G%isc,G%iec ; do j=G%jsc,G%jec + D(i,j) = max_depth + enddo ; enddo end subroutine sloshing_initialize_topography @@ -68,29 +64,22 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: displ(SZK_(G)+1) - real :: z_unif(SZK_(G)+1) - real :: z_inter(SZK_(G)+1) - real :: x - real :: a0 - real :: deltah - real :: total_height - real :: weight_z - real :: x1, y1, x2, y2 - real :: t - logical :: just_read ! If true, just read parameters but set nothing. - integer :: n + real :: displ(SZK_(G)+1) ! The interface displacement in depth units. + real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights, nondim. + real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. + real :: a0 ! The displacement amplitude in depth units. + real :: weight_z ! A (misused?) depth-space weighting, in inconsistent units. + real :: x1, y1, x2, y2 ! Dimensonless parameters. + real :: x, t ! Dimensionless depth coordinates? + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nx, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! This subroutine has no run-time parameters. - deltah = G%max_depth / nz - ! Define thicknesses do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -100,7 +89,6 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param enddo ! 1. Define stratification - n = 3 do k = 1,nz+1 ! Thin pycnocline in the middle @@ -126,13 +114,14 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param enddo ! 2. Define displacement - a0 = 75.0; ! Displacement amplitude (meters) + a0 = 75.0 * GV%m_to_Z ! 75m Displacement amplitude in depth units. do k = 1,nz+1 - weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1 + weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1.0 x = G%geoLonT(i,j) / G%len_lon - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z + !### Perhaps the '+ weight_z' here should be '* weight_z' - RWH + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * GV%m_to_Z if ( k == 1 ) then displ(k) = 0.0 @@ -148,23 +137,16 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! 3. The last interface must coincide with the seabed z_inter(nz+1) = -G%bathyT(i,j) - - ! Modify interface heights to make sure all thicknesses - ! are strictly positive + ! Modify interface heights to make sure all thicknesses are strictly positive do k = nz,1,-1 - if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then z_inter(k) = z_inter(k+1) + GV%Angstrom_Z endif - enddo ! 4. Define layers - total_height = 0.0 do k = 1,nz - h(i,j,k) = GV%m_to_H * (z_inter(k) - z_inter(k+1)) - - total_height = total_height + h(i,j,k) + h(i,j,k) = GV%Z_to_H * (z_inter(k) - z_inter(k+1)) enddo enddo ; enddo @@ -235,7 +217,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + deltah / G%max_depth + xi1 = xi0 + deltah / G%max_depth ! = xi0 + 1.0 / real(nz) S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -255,6 +237,5 @@ end subroutine sloshing_initialize_temperature_salinity !> \namespace sloshing_initialization !! -!! The module configures the model for the non-rotating sloshing -!! test case. +!! The module configures the model for the non-rotating sloshing test case. end module sloshing_initialization diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index c9e7eec40e..96e7170bb6 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -45,15 +45,15 @@ subroutine soliton_initialize_thickness(h, G, GV) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = 0.771*(val1*val1) + val2 = GV%m_to_Z * 0.771*(val1*val1) do j = G%jsc,G%jec ; do i = G%isc,G%iec do k = 1, nz x = G%geoLonT(i,j)-x0 y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) - val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y)) + val4 = val2 * ( 2.0*val3 / (1.0 + (val3*val3)) )**2 + h(i,j,k) = GV%Z_to_H * (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + G%bathyT(i,j)) enddo enddo ; enddo @@ -87,8 +87,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) y = 0.5*(G%geoLatT(i+1,j)+G%geoLatT(i,j))-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - u(I,j,k) = 0.25*val4*(6.0*y*y-9.0)* & - exp(-0.5*y*y) + u(I,j,k) = 0.25*val4*(6.0*y*y-9.0) * exp(-0.5*y*y) enddo enddo ; enddo do j = G%jsc-1,G%jec+1 ; do I = G%isc,G%iec @@ -97,8 +96,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) y = 0.5*(G%geoLatT(i,j+1)+G%geoLatT(i,j))-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - v(i,J,k) = 2.0*val4*y*(-2.0*val1*tanh(val1*x))* & - exp(-0.5*y*y) + v(i,J,k) = 2.0*val4*y*(-2.0*val1*tanh(val1*x)) * exp(-0.5*y*y) enddo enddo ; enddo diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 6b10664d57..f12378c3d9 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -9,7 +9,7 @@ module supercritical_initialization use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE, OBC_segment_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 7726dbf171..161ad25c11 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -13,7 +13,7 @@ module tidal_bay_initialization use MOM_open_boundary, only : OBC_segment_type, register_OBC use MOM_open_boundary, only : OBC_registry_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index ea15387f64..deec1cd858 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -5,17 +5,17 @@ module user_change_diffusivity use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d -use MOM_EOS, only : calculate_density +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density implicit none ; private #include -public user_change_diff, user_change_diff_init -public user_change_diff_end +public user_change_diff, user_change_diff_init, user_change_diff_end !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private @@ -38,17 +38,18 @@ module user_change_diffusivity !! main code to alter the diffusivities as needed. The specific example !! implemented here augments the diffusivity for a specified range of latitude !! and coordinate potential density. -subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) +subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_add) 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 thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL ptrs. type(user_change_diff_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd !< The diapycnal diffusivity of - !! each layer in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of + !! each layer in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity - !! at each interface in m2 s-1. + !! at each interface in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless !! layers filled in vertically. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless @@ -109,7 +110,7 @@ subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) enddo endif - if (present(Kd)) then + if (present(Kd_lay)) then do k=1,nz ; do i=is,ie if (CS%use_abs_lat) then lat_fn = val_weights(abs(G%geoLatT(i,j)), CS%lat_range) @@ -118,7 +119,7 @@ subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) endif rho_fn = val_weights(Rcv(i,k), CS%rho_range) if (rho_fn * lat_fn > 0.0) & - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add * rho_fn * lat_fn + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2 * CS%Kd_add * rho_fn * lat_fn enddo ; enddo endif if (present(Kd_int)) then @@ -131,7 +132,7 @@ subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) ! rho_int = 0.5*(Rcv(i,k-1) + Rcv(i,k)) rho_fn = val_weights( 0.5*(Rcv(i,k-1) + Rcv(i,k)), CS%rho_range) if (rho_fn * lat_fn > 0.0) then - Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add * rho_fn * lat_fn + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2 * CS%Kd_add * rho_fn * lat_fn if (store_Kd_add) Kd_int_add(i,j,K) = CS%Kd_add * rho_fn * lat_fn endif enddo ; enddo diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index b7e1efe6b1..174cd0ac8f 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -36,7 +36,7 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! structure. real, dimension(:), intent(out) :: Rlay !< Layer potential density. real, dimension(:), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m s-2. + !! each interface, in m2 Z-1 s-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -44,8 +44,8 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! equation of state. call MOM_error(FATAL, & - "USER_initialization.F90, USER_set_coord: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_set_coord: " // & + "Unmodified user routine called - you must edit the routine to use it") Rlay(:) = 0.0 g_prime(:) = 0.0 @@ -62,8 +62,8 @@ subroutine USER_initialize_topography(D, G, param_file, max_depth) real, intent(in) :: max_depth !< Maximum depth of model in m call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_topography: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_topography: " // & + "Unmodified user routine called - you must edit the routine to use it") D(:,:) = 0.0 @@ -85,8 +85,8 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_thickness: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_thickness: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -112,8 +112,8 @@ subroutine USER_initialize_velocity(u, v, G, param_file, just_read_params) logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_velocity: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_velocity: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -137,14 +137,14 @@ subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state, jus !! parameter values. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the !! equation of state. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will only + !! read parameters without changing T & S. logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_init_temperature_salinity: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_init_temperature_salinity: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -158,24 +158,24 @@ subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state, jus end subroutine USER_init_temperature_salinity !> Set up the sponges. -subroutine USER_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - logical, intent(in) :: use_temperature !< Whether to use potential - !! temperature. - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers +subroutine USER_initialize_sponges(G, GV, use_temp, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: use_temp !< If true, temperature and salinity are state variables. + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. - type(param_file_type), intent(in) :: param_file !< A structure indicating the + type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(sponge_CS), pointer :: CSp !< A pointer to the sponge control - !! structure. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thicknesses. + type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses, in units of H (m or kg m-2). call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_sponges: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_sponges: " // & + "Unmodified user routine called - you must edit the routine to use it") if (first_call) call write_user_log(param_file) @@ -207,8 +207,8 @@ subroutine USER_set_rotation(G, param_file) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters call MOM_error(FATAL, & - "USER_initialization.F90, USER_set_rotation: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_set_rotation: " // & + "Unmodified user routine called - you must edit the routine to use it") if (first_call) call write_user_log(param_file) @@ -237,10 +237,10 @@ end subroutine write_user_log !! here are: !! - u - Zonal velocity in m s-1. !! - v - Meridional velocity in m s-1. -!! - h - Layer thickness in m. (Must be positive.) -!! - G%bathyT - Basin depth in m. (Must be positive.) +!! - h - Layer thickness in H. (Must be positive.) +!! - G%bathyT - Basin depth in Z. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. -!! - GV%g_prime - The reduced gravity at each interface, in m s-2. +!! - GV%g_prime - The reduced gravity at each interface, in m2 Z-1 s-2. !! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature in C. diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index f2e381cc4a..d1be729734 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -10,7 +10,7 @@ module user_revise_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data use MOM_restart, only : register_restart_field, MOM_restart_CS -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface