Skip to content

Commit

Permalink
Merge pull request NOAA-EMC#50 from NOAA-GFDL/dev/gfdl
Browse files Browse the repository at this point in the history 
Merge in latest dev/gfdl updates
  • Loading branch information
@wrongkindofdoctor
wrongkindofdoctor authored Feb 26, 2020
2 parents aff2a13 + e19891f commit 7adcc90
Show file tree
Hide file tree
Showing 36 changed files with 898 additions and 776 deletions.
59 changes: 36 additions & 23 deletions config_src/coupled_driver/MOM_surface_forcing_gfdl.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -130,6 +130,8 @@ module MOM_surface_forcing_gfdl
logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover
!! the answers from the end of 2018. Otherwise, use a simpler
!! expression to calculate gustiness.
logical :: fix_ustar_gustless_bug !< If true correct a bug in the time-averaging of the
!! gustless wind friction velocity.
logical :: check_no_land_fluxes !< Return warning if IOB flux over land is non-zero

type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing
Expand Down Expand Up @@ -247,7 +249,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
real :: kg_m2_s_conversion ! A combination of unit conversion factors for rescaling
! mass fluxes [R Z s m2 kg-1 T-1 ~> 1].
real :: rhoXcp ! Reference density times heat capacity times unit scaling
! factors [J T s-1 Z-1 m-2 degC-1 ~> J m-3 degC-1]
! factors [Q R degC-1 ~> J m-3 degC-1]
real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1.

call cpu_clock_begin(id_clock_forcing)
Expand All @@ -261,7 +263,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1

kg_m2_s_conversion = US%kg_m3_to_R*US%m_to_Z*US%T_to_s
if (CS%restore_temp) rhoXcp = US%R_to_kg_m3*US%Z_to_m*US%s_to_T * CS%Rho0 * fluxes%C_p
if (CS%restore_temp) rhoXcp = CS%Rho0 * fluxes%C_p
open_ocn_mask(:,:) = 1.0
pme_adj(:,:) = 0.0
fluxes%vPrecGlobalAdj = 0.0
Expand All @@ -274,8 +276,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
! allocation and initialization if this is the first time that this
! flux type has been used.
if (fluxes%dt_buoy_accum < 0) then
call allocate_forcing_type(G, fluxes, water=.true., heat=.true., &
ustar=.true., press=.true.)
call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., press=.true., &
fix_accum_bug=CS%fix_ustar_gustless_bug)

call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed)
Expand Down Expand Up @@ -339,8 +341,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
fluxes%dt_buoy_accum = US%s_to_T*valid_time

if (CS%allow_flux_adjustments) then
fluxes%heat_added(:,:)=0.0
fluxes%salt_flux_added(:,:)=0.0
fluxes%heat_added(:,:) = 0.0
fluxes%salt_flux_added(:,:) = 0.0
endif

do j=js,je ; do i=is,ie
Expand Down Expand Up @@ -470,67 +472,75 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
endif

if (associated(IOB%runoff_hflx)) then
fluxes%heat_content_lrunoff(i,j) = kg_m2_s_conversion * IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j)
fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j)
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G)
endif

if (associated(IOB%calving_hflx)) then
fluxes%heat_content_frunoff(i,j) = kg_m2_s_conversion * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j)
fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j)
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G)
endif

if (associated(IOB%lw_flux)) then
fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j)
fluxes%LW(i,j) = US%W_m2_to_QRZ_T * IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j)
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux', G)
endif

if (associated(IOB%t_flux)) then
fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j)
fluxes%sens(i,j) = -US%W_m2_to_QRZ_T* IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j)
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux', G)
endif

fluxes%latent(i,j) = 0.0
if (associated(IOB%fprec)) then
fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion
fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion
fluxes%latent(i,j) = fluxes%latent(i,j) - &
IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion
fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion
endif
if (associated(IOB%calving)) then
fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion
fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion
fluxes%latent(i,j) = fluxes%latent(i,j) - &
IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion
fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion
endif
if (associated(IOB%q_flux)) then
fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor
fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor
fluxes%latent(i,j) = fluxes%latent(i,j) - &
IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor
fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_vapor
endif

fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j)

if (associated(IOB%sw_flux_vis_dir)) then
fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0)
fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_vis_dir(i-i0,j-j0)
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir', G)
endif
if (associated(IOB%sw_flux_vis_dif)) then
fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0)
fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_vis_dif(i-i0,j-j0)
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif', G)
endif
if (associated(IOB%sw_flux_nir_dir)) then
fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0)
fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_nir_dir(i-i0,j-j0)
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir', G)
endif
if (associated(IOB%sw_flux_nir_dif)) then
fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0)
fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * IOB%sw_flux_nir_dif(i-i0,j-j0)
if (CS%check_no_land_fluxes) &
call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G)
endif
fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + &
fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j)
if (CS%answers_2018) then
fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + &
fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j)
else
fluxes%sw(i,j) = (fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j)) + &
(fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j))
endif

enddo ; enddo

Expand Down Expand Up @@ -1119,7 +1129,7 @@ subroutine apply_flux_adjustments(G, US, CS, Time, fluxes)
call data_override('OCN', 'hflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h)

if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec
fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j)
fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + US%W_m2_to_QRZ_T*temp_at_h(i,j)* G%mask2dT(i,j)
enddo ; enddo ; endif
! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain)

Expand Down Expand Up @@ -1493,6 +1503,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS)
"If true, use the order of arithmetic and expressions that recover the answers "//&
"from the end of 2018. Otherwise, use a simpler expression to calculate gustiness.", &
default=default_2018_answers)
call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, &
"If true correct a bug in the time-averaging of the gustless wind friction velocity", &
default=.false.)

! See whether sufficiently thick sea ice should be treated as rigid.
call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, &
Expand Down
23 changes: 11 additions & 12 deletions config_src/coupled_driver/ocean_model_MOM.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -271,8 +271,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn)
OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
diag_ptr=OS%diag, count_calls=.true.)
call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, &
use_temp=use_temperature)
OS%fluxes%C_p = OS%C_p
C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature)

! Read all relevant parameters and write them to the model log.
call log_version(param_file, mdl, version, "")
Expand Down Expand Up @@ -788,13 +787,13 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap,
Ocean_sfc%area (isc:iec,jsc:jec), &
Ocean_sfc%frazil (isc:iec,jsc:jec))

Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model
Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models
Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models
Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models
Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav
Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model
Ocean_sfc%area = 0.0
Ocean_sfc%t_surf(:,:) = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model
Ocean_sfc%s_surf(:,:) = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models
Ocean_sfc%u_surf(:,:) = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models
Ocean_sfc%v_surf(:,:) = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models
Ocean_sfc%sea_lev(:,:) = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav
Ocean_sfc%frazil(:,:) = 0.0 ! time accumulated frazil (J/m^2) passed to ice model
Ocean_sfc%area(:,:) = 0.0
Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics

if (present(gas_fields_ocn)) then
Expand Down Expand Up @@ -873,7 +872,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_
enddo ; enddo
endif

if (associated(sfc_state%frazil)) then
if (allocated(sfc_state%frazil)) then
do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd
Ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0)
enddo ; enddo
Expand Down Expand Up @@ -1066,9 +1065,9 @@ subroutine ocean_model_data1D_get(OS, Ocean, name, value)

select case(name)
case('c_p')
value = OS%C_p
value = OS%C_p
case default
call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name)
call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name)
end select

end subroutine ocean_model_data1D_get
Expand Down
Loading

0 comments on commit 7adcc90

Please sign in to comment.