diff --git a/src/atmos_spectral/driver/solo/idealized_moist_phys.F90 b/src/atmos_spectral/driver/solo/idealized_moist_phys.F90 index 8115c08a2..306a023ff 100644 --- a/src/atmos_spectral/driver/solo/idealized_moist_phys.F90 +++ b/src/atmos_spectral/driver/solo/idealized_moist_phys.F90 @@ -179,6 +179,7 @@ module idealized_moist_phys_mod drag_m, & ! momentum drag coefficient drag_t, & ! heat drag coefficient drag_q, & ! moisture drag coefficient + rho, & ! air density at surface w_atm, & ! wind speed ustar, & ! friction velocity bstar, & ! buoyancy scale @@ -264,6 +265,11 @@ module idealized_moist_phys_mod id_bucket_depth_conv, & ! bucket depth variation induced by convection - RG Add bucket id_bucket_depth_cond, & ! bucket depth variation induced by condensation - RG Add bucket id_bucket_depth_lh, & ! bucket depth variation induced by LH - RG Add bucket + id_w_atm, & ! wind speed - RG Add lh flux breakdown + id_drag_q, & ! moisture drag coefficient - RG Add lh flux breakdown + id_rho, & ! density at surface - RG Add lh flux breakdown + id_q_atm, & ! lowest level specific humidity - RG Add lh flux breakdown + id_q_surf, & ! surface humidity - RG Add lh flux breakdown id_rh, & ! Relative humidity id_diss_heat_ray,& ! Heat dissipated by rayleigh bottom drag if gp_surface=.True. id_z_tg, & ! Relative humidity @@ -445,6 +451,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l allocate(drag_m (is:ie, js:je)) allocate(drag_t (is:ie, js:je)) allocate(drag_q (is:ie, js:je)) +allocate(rho (is:ie, js:je)) allocate(w_atm (is:ie, js:je)) allocate(ustar (is:ie, js:je)) allocate(bstar (is:ie, js:je)) @@ -633,7 +640,20 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l axes(1:2), Time, 'Zonal momentum flux', 'Pa') id_flux_v = register_diag_field(mod_name, 'flux_v', & axes(1:2), Time, 'Meridional momentum flux', 'Pa') - + +if(.not.gp_surface) then + id_w_atm = register_diag_field(mod_name, 'wind_speed', & ! RG Add lh flux breakdown + axes(1:2), Time, 'Lowest level wind speed','m/s') + id_drag_q = register_diag_field(mod_name, 'drag_q', & ! RG Add lh flux breakdown + axes(1:2), Time, 'Moisture drag coefficient','none') + id_rho = register_diag_field(mod_name, 'rho', & ! RG Add lh flux breakdown + axes(1:2), Time, 'Air density at lowest level','kg/m/m/m') + id_q_atm = register_diag_field(mod_name, 'q_atm', & ! RG Add lh flux breakdown + axes(1:2), Time, 'Lowest level specific humidity','kg/kg') + id_q_surf = register_diag_field(mod_name, 'q_surf', & ! RG Add lh flux breakdown + axes(1:2), Time, 'Surface specific humidity','kg/kg') +endif + if(bucket) then id_bucket_depth = register_diag_field(mod_name, 'bucket_depth', & ! RG Add bucket axes(1:2), Time, 'Depth of surface reservoir', 'm') @@ -1012,6 +1032,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg drag_m(:,:), & ! is intent(out) drag_t(:,:), & ! is intent(out) drag_q(:,:), & ! is intent(out) + rho(:,:), & ! is intent(out) w_atm(:,:), & ! is intent(out) ustar(:,:), & ! is intent(out) bstar(:,:), & ! is intent(out) @@ -1036,7 +1057,13 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg land(:,:), & .not.land(:,:), & avail(:,:) ) - + + if(id_w_atm > 0) used = send_data(id_w_atm, w_atm, Time) ! RG Add lh flux breakdown + if(id_drag_q > 0) used = send_data(id_drag_q, drag_q, Time) ! RG Add lh flux breakdown + if(id_rho > 0) used = send_data(id_rho, rho, Time) ! RG Add lh flux breakdown + if(id_q_atm > 0) used = send_data(id_q_atm, grid_tracers(:,:,num_levels,previous,nsphum), Time) ! RG Add lh flux breakdown + if(id_q_surf > 0) used = send_data(id_q_surf, q_surf, Time) ! RG Add lh flux breakdown + if(id_flux_u > 0) used = send_data(id_flux_u, flux_u, Time) if(id_flux_v > 0) used = send_data(id_flux_v, flux_v, Time) diff --git a/src/coupler/surface_flux.F90 b/src/coupler/surface_flux.F90 index 97a207f51..29fa9bbad 100644 --- a/src/coupler/surface_flux.F90 +++ b/src/coupler/surface_flux.F90 @@ -256,6 +256,7 @@ module surface_flux_mod logical :: use_mixing_ratio = .false. real :: gust_const = 1.0 real :: gust_min = 0.0 +real :: w_atm_const = 0.0 logical :: ncar_ocean_flux = .false. logical :: ncar_ocean_flux_orig = .false. ! for backwards compatibility logical :: raoult_sat_vap = .false. @@ -273,6 +274,7 @@ module surface_flux_mod alt_gustiness, & gust_const, & gust_min, & + w_atm_const, & old_dtaudv, & use_mixing_ratio, & ncar_ocean_flux, & @@ -343,7 +345,7 @@ subroutine surface_flux_1d ( & u_surf, v_surf, & rough_mom, rough_heat, rough_moist, rough_scale, gust, & flux_t, flux_q, flux_r, flux_u, flux_v, & - cd_m, cd_t, cd_q, & + cd_m, cd_t, cd_q, rho, & w_atm, u_star, b_star, q_star, & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm, dtaudv_atm, & @@ -367,7 +369,7 @@ subroutine surface_flux_1d ( & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm,dtaudv_atm, & w_atm, u_star, b_star, q_star, & - cd_m, cd_t, cd_q, & + cd_m, cd_t, cd_q, rho, & ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp q_2m, rh_2m ! Add 2m q and RH @@ -391,7 +393,7 @@ subroutine surface_flux_1d ( & thv_atm, th_atm, tv_atm, thv_surf, & e_sat, e_sat1, q_sat, q_sat1, p_ratio, & t_surf0, t_surf1, u_dif, v_dif, & - rho_drag, drag_t, drag_m, drag_q, rho, & + rho_drag, drag_t, drag_m, drag_q, & q_atm, q_surf0, dw_atmdu, dw_atmdv, w_gust, & e_sat_2m, q_sat_2m @@ -569,22 +571,40 @@ subroutine surface_flux_1d ( & ! scale momentum drag coefficient on orographic roughness cd_m = cd_m*(log(z_atm/rough_mom+1)/log(z_atm/rough_scale+1))**2 ! surface layer drag coefficients - drag_t = cd_t * w_atm - drag_q = cd_q * w_atm drag_m = cd_m * w_atm - ! density rho = p_atm / (rdgas * tv_atm) + end where + + + ! RG Add option to fix w_atm in the evaporation and sensible heat equations. + if (w_atm_const > 0.0) then + where (avail) + ! sensible heat flux + drag_t = cd_t * w_atm_const + rho_drag = cp_air * drag_t * rho + flux_t = rho_drag * (t_surf0 - th_atm) ! flux of sensible heat (W/m**2) + dhdt_surf = rho_drag ! d(sensible heat flux)/d(surface temperature) + dhdt_atm = -rho_drag*p_ratio ! d(sensible heat flux)/d(atmos temperature) + + drag_q = cd_q * w_atm_const + rho_drag = drag_q * rho + + end where + else + where (avail) + ! sensible heat flux + drag_t = cd_t * w_atm + rho_drag = cp_air * drag_t * rho + flux_t = rho_drag * (t_surf0 - th_atm) ! flux of sensible heat (W/m**2) + dhdt_surf = rho_drag ! d(sensible heat flux)/d(surface temperature) + dhdt_atm = -rho_drag*p_ratio ! d(sensible heat flux)/d(atmos temperature) + + drag_q = cd_q * w_atm + rho_drag = drag_q * rho + end where + end if - ! sensible heat flux - rho_drag = cp_air * drag_t * rho - flux_t = rho_drag * (t_surf0 - th_atm) ! flux of sensible heat (W/m**2) - dhdt_surf = rho_drag ! d(sensible heat flux)/d(surface temperature) - dhdt_atm = -rho_drag*p_ratio ! d(sensible heat flux)/d(atmos temperature) - - ! evaporation - rho_drag = drag_q * rho - end where !RG Add bucket - if bucket is on evaluate fluxes based on moisture availability. !RG Note changes to avail statements to allow bucket to be switched on or off @@ -648,6 +668,19 @@ subroutine surface_flux_1d ( & !RG end Add bucket changes + +! RG Add option to fix w_atm in the evaporation and sensible heat equations. +if (w_atm_const > 0.0) then + where (avail) + q_surf = q_atm + flux_q / (rho*cd_q*w_atm_const) ! surface specific humidity + end where +else + where (avail) + q_surf = q_atm + flux_q / (rho*cd_q*w_atm) ! surface specific humidity + end where +end if + + where (avail) q_star = flux_q / (u_star * rho) ! moisture scale @@ -730,8 +763,8 @@ subroutine surface_flux_0d ( & dhdt_surf_0, dedt_surf_0, dedq_surf_0, drdt_surf_0, & dhdt_atm_0, dedq_atm_0, dtaudu_atm_0,dtaudv_atm_0, & w_atm_0, u_star_0, b_star_0, q_star_0, & - cd_m_0, cd_t_0, cd_q_0, & - ex_del_m_0, ex_del_h_0, ex_del_q_0, & !mp586 for 10m winds and 2m temp + cd_m_0, cd_t_0, cd_q_0, & + ex_del_m_0, ex_del_h_0, ex_del_q_0, & !mp586 for 10m winds and 2m temp temp_2m_0, u_10m_0, v_10m_0, & !mp586 for 10m winds and 2m temp q_2m_0, rh_2m_0 real, intent(inout) :: q_surf_0 @@ -750,7 +783,7 @@ subroutine surface_flux_0d ( & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm,dtaudv_atm, & w_atm, u_star, b_star, q_star, & - cd_m, cd_t, cd_q, & + cd_m, cd_t, cd_q, rho, & ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp q_2m, rh_2m !Add 2m q and RH @@ -792,7 +825,7 @@ subroutine surface_flux_0d ( & u_surf, v_surf, & rough_mom, rough_heat, rough_moist, rough_scale, gust, & flux_t, flux_q, flux_r, flux_u, flux_v, & - cd_m, cd_t, cd_q, & + cd_m, cd_t, cd_q, rho, & w_atm, u_star, b_star, q_star, & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm, dtaudv_atm, & @@ -841,7 +874,7 @@ subroutine surface_flux_2d ( & u_surf, v_surf, & rough_mom, rough_heat, rough_moist, rough_scale, gust, & flux_t, flux_q, flux_r, flux_u, flux_v, & - cd_m, cd_t, cd_q, & + cd_m, cd_t, cd_q, rho, & w_atm, u_star, b_star, q_star, & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm, dtaudv_atm, & @@ -862,7 +895,7 @@ subroutine surface_flux_2d ( & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm,dtaudv_atm, & w_atm, u_star, b_star, q_star, & - cd_m, cd_t, cd_q, & + cd_m, cd_t, cd_q, rho, & ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp q_2m, rh_2m !Add 2m q and RH @@ -887,7 +920,7 @@ subroutine surface_flux_2d ( & u_surf(:,j), v_surf(:,j), & rough_mom(:,j), rough_heat(:,j), rough_moist(:,j), rough_scale(:,j), gust(:,j), & flux_t(:,j), flux_q(:,j), flux_r(:,j), flux_u(:,j), flux_v(:,j), & - cd_m(:,j), cd_t(:,j), cd_q(:,j), & + cd_m(:,j), cd_t(:,j), cd_q(:,j), rho(:,j), & w_atm(:,j), u_star(:,j), b_star(:,j), q_star(:,j), & dhdt_surf(:,j), dedt_surf(:,j), dedq_surf(:,j), drdt_surf(:,j), & dhdt_atm(:,j), dedq_atm(:,j), dtaudu_atm(:,j), dtaudv_atm(:,j), &