Skip to content

Commit

Permalink
Merge pull request #7 from NOAA-GFDL/dev/gfdl
Browse files Browse the repository at this point in the history 
Latest updates from MOM6
  • Loading branch information
@wrongkindofdoctor
wrongkindofdoctor authored Nov 28, 2018
2 parents b7f50fc + 47a3574 commit 9aa2aae
Show file tree
Hide file tree
Showing 107 changed files with 2,858 additions and 2,348 deletions.
43 changes: 24 additions & 19 deletions config_src/coupled_driver/MOM_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ module MOM_surface_forcing
use MOM_restart, only : restart_init_end, save_restart, restore_state
use MOM_string_functions, only : uppercase
use MOM_spatial_means, only : adjust_area_mean_to_zero
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : surface
use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init
use user_revise_forcing, only : user_revise_forcing_CS
Expand Down Expand Up @@ -194,7 +195,7 @@ module MOM_surface_forcing
!> 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)
subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, 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
Expand All @@ -205,6 +206,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_sta
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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a
!! previous call to surface_forcing_init.
type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the
Expand Down Expand Up @@ -412,7 +414,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_sta
fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j)

if (associated(IOB%ustar_berg)) &
fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j)
fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j)

if (associated(IOB%area_berg)) &
fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j)
Expand Down Expand Up @@ -531,12 +533,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_sta

! 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, &
call extract_IOB_stresses(IOB, index_bounds, Time, G, US, 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)
call extract_IOB_stresses(IOB, index_bounds, Time, G, US, 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)
call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, gustless_ustar=fluxes%ustar_gustless)
endif

if (coupler_type_initialized(fluxes%tr_fluxes) .and. &
Expand All @@ -558,7 +560,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, dt_forcing, reset_avg)
subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, 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
Expand All @@ -567,6 +569,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc
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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a
!! previous call to surface_forcing_init.
real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the
Expand Down Expand Up @@ -678,10 +681,10 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc

! 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, &
call extract_IOB_stresses(IOB, index_bounds, Time, G, US, 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, &
call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux=forces%taux, tauy=forces%tauy, &
ustar=ustar_tmp, tau_halo=1)
do j=js,je ; do i=is,ie
forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j)
Expand Down Expand Up @@ -782,7 +785,7 @@ 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, &
subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, 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
Expand All @@ -791,17 +794,18 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta
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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a
!! previous 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.
optional, intent(inout) :: ustar !< The surface friction velocity, in Z 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.
!! any contributions from gustiness, in Z s-1.
integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default.

! Local variables
Expand All @@ -813,7 +817,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta
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 :: Irho0 ! Inverse of the mean density rescaled to (Z2 m / kg)
real :: taux2, tauy2 ! squared wind stresses (Pa^2)
real :: tau_mag ! magnitude of the wind stress (Pa)

Expand All @@ -827,7 +831,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta
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
Irho0 = US%m_to_Z**2 / CS%Rho0

do_ustar = present(ustar) ; do_gustless = present(gustless_ustar)

Expand Down Expand Up @@ -942,7 +946,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta
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)
gustless_ustar(i,j) = US%m_to_Z * 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
Expand All @@ -959,7 +963,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta
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)
if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0)
!### Change to:
! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag)
enddo ; enddo
Expand All @@ -969,7 +973,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta
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)
if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0)
!### Change to:
! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag)
enddo ; enddo
Expand All @@ -988,7 +992,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta
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)
if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0)
!### Change to:
! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag)
enddo ; enddo
Expand Down Expand Up @@ -1122,9 +1126,10 @@ 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)
subroutine surface_forcing_init(Time, G, US, 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
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
!! diagnostic output
Expand Down Expand Up @@ -1407,7 +1412,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS)
call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, &
"If true, makes available diagnostics of fluxes from icebergs\n"//&
"as seen by MOM6.", default=.false.)
call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, &
call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, &
use_berg_fluxes=iceberg_flux_diags)

call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, &
Expand Down
18 changes: 11 additions & 7 deletions config_src/coupled_driver/ocean_model_MOM.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@ module ocean_model_mod
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_unit_scaling, only : unit_scale_type
use MOM_variables, only : surface
use MOM_verticalGrid, only : verticalGrid_type
use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS
Expand Down Expand Up @@ -190,6 +191,9 @@ module ocean_model_mod
type(verticalGrid_type), pointer :: &
GV => NULL() !< A pointer to a structure containing information
!! about the vertical grid.
type(unit_scale_type), pointer :: &
US => NULL() !< A pointer to a structure containing dimensional
!! unit scaling factors.
type(MOM_control_struct), pointer :: &
MOM_CSp => NULL() !< A pointer to the MOM control structure
type(ice_shelf_CS), pointer :: &
Expand Down Expand Up @@ -266,7 +270,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
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.)
call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, C_p=OS%C_p, &
call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, &
use_temp=use_temperature)
OS%fluxes%C_p = OS%C_p

Expand Down Expand Up @@ -351,7 +355,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, do_integrals=.true., &
gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot)

call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, &
call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, &
OS%forcing_CSp)

if (OS%use_ice_shelf) then
Expand All @@ -367,7 +371,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, &
"If true, enables surface wave modules.", default=.false.)
if (OS%use_waves) then
call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, param_file, OS%Waves, OS%diag)
call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag)
else
call MOM_wave_interface_init_lite(param_file)
endif
Expand Down Expand Up @@ -494,7 +498,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
index_bnds(3), index_bnds(4))

if (do_dyn) then
call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, &
call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, OS%US, &
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)
Expand All @@ -506,7 +510,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
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%grid, OS%US, OS%forcing_CSp, OS%sfc_state)

! Add ice shelf fluxes
if (OS%use_ice_shelf) &
Expand All @@ -528,7 +532,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
! 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%grid, OS%US, OS%forcing_CSp, OS%sfc_state)

if (OS%use_ice_shelf) &
call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp)
Expand All @@ -552,7 +556,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda
! 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)
call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves)
endif

if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model.
Expand Down
Loading

0 comments on commit 9aa2aae

Please sign in to comment.