From 3d40d8c0e03a298ae3925564bc4db2f0df5e9437 Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Thu, 13 Nov 2025 15:02:53 -0700 Subject: [PATCH 01/29] Merging up to clubb_release 1632cf12 --- src/physics/cam/clubb_intr.F90 | 816 ++-- src/physics/cam/clubb_mf.F90 | 1324 ++--- src/physics/cam/subcol_SILHS.F90 | 7764 +++++++++++++++--------------- 3 files changed, 4928 insertions(+), 4976 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index d1cfa8efeb..b1aed9d7f1 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -399,7 +399,7 @@ module clubb_intr wp2thlp_idx, & ! w'^2 thl' uprcp_idx, & ! < u' r_c' > vprcp_idx, & ! < v' r_c' > - rc_coef_idx, & ! Coefficient of X'r_c' in Eq. (34) + rc_coef_zm_idx, & ! Coefficient of X'r_c' in Eq. (34) wp4_idx, & ! w'^4 wpup2_idx, & ! w'u'^2 wpvp2_idx, & ! w'v'^2 @@ -573,7 +573,7 @@ subroutine clubb_register_cam( ) call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) - call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp3_idx) + call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), wp3_idx) call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wpthlp_idx) call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wprtp_idx) call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtpthlp_idx) @@ -582,34 +582,34 @@ subroutine clubb_register_cam( ) call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up2_idx) call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx) - call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp3_idx) - call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp3_idx) - call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up3_idx) - call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp3_idx) + call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), rtp3_idx) + call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), thlp3_idx) + call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), up3_idx) + call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), vp3_idx) call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), upwp_idx) call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vpwp_idx) - call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlm_idx) - call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtm_idx) - call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), um_idx) - call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vm_idx) + call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), thlm_idx) + call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), rtm_idx) + call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), um_idx) + call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), vm_idx) call pbuf_add_field('WPTHVP', 'global', dtype_r8, (/pcols,pverp/), wpthvp_idx) - call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,pverp/), wp2thvp_idx) + call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,pver/), wp2thvp_idx) call pbuf_add_field('RTPTHVP', 'global', dtype_r8, (/pcols,pverp/), rtpthvp_idx) call pbuf_add_field('THLPTHVP', 'global', dtype_r8, (/pcols,pverp/), thlpthvp_idx) - call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pverp/), cloud_frac_idx) - call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pverp/), ice_supersat_idx) - call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pverp/), rcm_idx) + call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pver/), cloud_frac_idx) + call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pver/), ice_supersat_idx) + call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pver/), rcm_idx) call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) - call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pverp/), wp2rtp_idx) - call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pverp/), wp2thlp_idx) + call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pver/), wp2rtp_idx) + call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pver/), wp2thlp_idx) call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,pverp/), uprcp_idx) call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,pverp/), vprcp_idx) - call pbuf_add_field('RC_COEF', 'global', dtype_r8, (/pcols,pverp/), rc_coef_idx) + call pbuf_add_field('RC_COEF_ZM', 'global', dtype_r8, (/pcols,pverp/), rc_coef_zm_idx) call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,pverp/), wp4_idx) - call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pverp/), wpup2_idx) - call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pverp/), wpvp2_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pver/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pver/), wpvp2_idx) call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,pverp/), wp2up2_idx) call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,pverp/), wp2vp2_idx) @@ -627,11 +627,11 @@ subroutine clubb_register_cam( ) call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_mc_idx) ! For SILHS microphysical covariance contributions - call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pverp/), rtp2_mc_zt_idx) - call pbuf_add_field('thlp2_mc_zt','global', dtype_r8, (/pcols,pverp/), thlp2_mc_zt_idx) - call pbuf_add_field('wprtp_mc_zt','global', dtype_r8, (/pcols,pverp/), wprtp_mc_zt_idx) - call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pverp/), wpthlp_mc_zt_idx) - call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pverp/), rtpthlp_mc_zt_idx) + call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pver/), rtp2_mc_zt_idx) + call pbuf_add_field('thlp2_mc_zt','global', dtype_r8, (/pcols,pver/), thlp2_mc_zt_idx) + call pbuf_add_field('wprtp_mc_zt','global', dtype_r8, (/pcols,pver/), wprtp_mc_zt_idx) + call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pver/), wpthlp_mc_zt_idx) + call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pver/), rtpthlp_mc_zt_idx) call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_1_idx) call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_2_idx) @@ -1878,11 +1878,11 @@ subroutine clubb_ini_cam(pbuf2d) if (stats_metadata%l_stats) then call stats_init_clubb( .true., dum1, dum2, & - nzm_clubb, nzm_clubb, nzm_clubb, dum3, & + nzm_clubb, nzt_clubb, nzm_clubb, dum3, & stats_zt(:), stats_zm(:), stats_sfc(:), & stats_rad_zt(:), stats_rad_zm(:)) - allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields), stat=ierr) + allocate(out_zt(pcols,pver,stats_zt(1)%num_output_fields), stat=ierr) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zt' ) allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields), stat=ierr) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_zm' ) @@ -1890,7 +1890,7 @@ subroutine clubb_ini_cam(pbuf2d) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_sfc' ) if ( stats_metadata%l_output_rad_files ) then - allocate(out_radzt(pcols,pverp,stats_rad_zt(1)%num_output_fields), stat=ierr) + allocate(out_radzt(pcols,pver,stats_rad_zt(1)%num_output_fields), stat=ierr) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzt' ) allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields), stat=ierr) if( ierr /= 0 ) call endrun( 'clubb_ini_cam: Unable to allocate out_radzm' ) @@ -2022,7 +2022,7 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, wp2thlp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, uprcp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, vprcp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rc_coef_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, rc_coef_zm_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wp4_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wpup2_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wpvp2_idx, 0.0_r8) @@ -2197,13 +2197,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8) :: frac_limit, ic_limit real(r8) :: dtime ! CLUBB time step [s] - real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] + real(r8) :: zt_out(pcols,pver) ! output for the thermo CLUBB grid [m] real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] real(r8) :: ubar ! surface wind [m/s] real(r8) :: ustar ! surface stress [m/s] real(r8) :: z0 ! roughness height [m] real(r8) :: bflx22(pcols) ! Variable for buoyancy flux for pbl [K m/s] - real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2] + real(r8) :: qclvar(pcols,pver) ! cloud water variance [kg^2/kg^2] real(r8) :: zo(pcols) ! roughness height [m] real(r8) :: dz_g(pcols,pver) ! thickness of layer [m] real(r8) :: relvarmax @@ -2211,7 +2211,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8) :: tw_upper_a(pcols), tw_upper_b(pcols), tw_upper_diss(pcols) ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES + ! NOTE: THESE VARIABLES SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol) :: & fcor, & ! Coriolis forcing [s^-1] sfc_elevation, & ! Elevation of ground [m AMSL][m] @@ -2219,6 +2219,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)] upwp_sfc, & ! u'w' at surface [m^2/s^2] vpwp_sfc, & ! v'w' at surface [m^2/s^2] + p_sfc, & ! pressure at surface [Pa] upwp_sfc_pert, & ! perturbed u'w' at surface [m^2/s^2] vpwp_sfc_pert, & ! perturbed v'w' at surface [m^2/s^2] grid_dx, grid_dy ! CAM grid [m] @@ -2229,19 +2230,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,edsclr_dim) :: & wpedsclrp_sfc ! Eddy-scalar flux at surface [{units vary} m/s] + ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES - real(r8), dimension(state%ncol,nzm_clubb) :: & + real(r8), dimension(state%ncol,nzt_clubb) :: & thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] - wprtp_forcing, & - wpthlp_forcing, & - rtp2_forcing, & - thlp2_forcing, & - rtpthlp_forcing, & - wm_zm, & ! w mean wind component on momentum levels [m/s] wm_zt, & ! w mean wind component on thermo. levels [m/s] rtm_ref, & ! Initial profile of rtm [kg/kg] thlm_ref, & ! Initial profile of thlm [K] @@ -2250,141 +2246,160 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ug, & ! U geostrophic wind [m/s] vg, & ! V geostrophic wind [m/s] p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] - rho_zm, & ! Air density on momentum levels [kg/m^3] rho_zt, & ! Air density on thermo levels [kg/m^3] exner, & ! Exner function (thermodynamic levels) [-] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K] rfrzm, & radf, & um_in, & ! meridional wind [m/s] vm_in, & ! zonal wind [m/s] - upwp_in, & ! meridional wind flux [m^2/s^2] - vpwp_in, & ! zonal wind flux [m^2/s^2] - up2_in, & ! meridional wind variance [m^2/s^2] - vp2_in, & ! zonal wind variance [m^2/s^2] up3_in, & ! meridional wind third-order [m^3/s^3] vp3_in, & ! zonal wind third-order [m^3/s^3] thlm_in, & ! liquid water potential temperature (thetal) [K] rvm_in, & ! water vapor mixing ratio [kg/kg] rtm_in, & ! total water mixing ratio [kg/kg] - wprtp_in, & ! turbulent flux of total water [kg/kg m/s] - wpthlp_in, & ! turbulent flux of thetal [K m/s] - wp2_in, & ! vertical velocity variance (CLUBB) [m^2/s^2] wp3_in, & ! third moment vertical velocity [m^3/s^3] - rtp2_in, & ! total water variance [kg^2/kg^2] rtp2_zt, & ! CLUBB R-tot variance on thermo levs thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2] wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2] rtp3_in, & ! total water 3rd order [kg^3/kg^3] - thlp2_in, & ! thetal variance [K^2] thlp3_in, & ! thetal 3rd order [K^3] - rtpthlp_in, & ! covariance of thetal and qt [kg/kg K] rcm_inout, & ! CLUBB output of liquid water mixing ratio [kg/kg] - rcm_out_zm, & cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction] - wpthvp_in, & ! w'th_v' (momentum levels) [m/s K] wp2thvp_in, & ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - rtpthvp_in, & ! r_t'th_v' (momentum levels) [kg/kg K] - thlpthvp_in, & ! th_l'th_v' (momentum levels) [K^2] ice_supersat_frac_inout, & um_pert_inout, & ! Perturbed U wind [m/s] vm_pert_inout, & ! Perturbed V wind [m/s] - upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] - vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] - khzm_out, & ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] khzt_out, & ! eddy diffusivity on thermo grids [m^2/s] - qclvar_out, & ! cloud water variance [kg^2/kg^2] - thlprcp_out, & - wprcp_out, & ! CLUBB output of flux of liquid water [kg/kg m/s] w_up_in_cloud_out, & w_down_in_cloud_out, & cloudy_updraft_frac_out, & cloudy_downdraft_frac_out,& rcm_in_layer_out, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction] + pre_in, & ! input for precip evaporation + qrl_clubb, & + qclvar_out, & ! cloud water variance [kg^2/kg^2] + wp2rtp_inout, & ! w'^2 rt' (thermodynamic levels) + wp2thlp_inout, & ! w'^2 thl' (thermodynamic levels) + wpup2_inout, & ! w'u'^2 (thermodynamic levels) + wpvp2_inout, & ! w'v'^2 (thermodynamic levels) + zt_g ! Thermodynamic grid of CLUBB [m] + + ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api + ! NOTE: THESE VARIABLES SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES + real(r8), dimension(state%ncol,nzm_clubb) :: & + wprtp_forcing, & + wpthlp_forcing, & + rtp2_forcing, & + thlp2_forcing, & + rtpthlp_forcing, & + wm_zm, & ! w mean wind component on momentum levels [m/s] + rho_zm, & ! Air density on momentum levels [kg/m^3] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] + upwp_in, & ! meridional wind flux [m^2/s^2] + vpwp_in, & ! zonal wind flux [m^2/s^2] + up2_in, & ! meridional wind variance [m^2/s^2] + vp2_in, & ! zonal wind variance [m^2/s^2] + wprtp_in, & ! turbulent flux of total water [kg/kg m/s] + wpthlp_in, & ! turbulent flux of thetal [K m/s] + wp2_in, & ! vertical velocity variance (CLUBB) [m^2/s^2] + rtp2_in, & ! total water variance [kg^2/kg^2] + thlp2_in, & ! thetal variance [K^2] + rtpthlp_in, & ! covariance of thetal and qt [kg/kg K] + rcm_out_zm, & + wpthvp_in, & ! w'th_v' (momentum levels) [m/s K] + rtpthvp_in, & ! r_t'th_v' (momentum levels) [kg/kg K] + thlpthvp_in, & ! th_l'th_v' (momentum levels) [K^2] + upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] + vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] + khzm_out, & ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + thlprcp_out, & + wprcp_out, & ! CLUBB output of flux of liquid water [kg/kg m/s] invrs_tau_zm_out, & ! CLUBB output of 1 divided by time-scale [1/s] rtp2_mc_out, & ! total water tendency from rain evap thlp2_mc_out, & ! thetal tendency from rain evap wprtp_mc_out, & wpthlp_mc_out, & rtpthlp_mc_out, & - pre_in, & ! input for precip evaporation - qrl_clubb, & qrl_zm, & - wp2rtp_inout, & ! w'^2 rt' (thermodynamic levels) - wp2thlp_inout, & ! w'^2 thl' (thermodynamic levels) uprcp_inout, & ! < u' r_c' > (momentum levels) vprcp_inout, & ! < v' r_c' > (momentum levels) - rc_coef_inout, & ! Coef. of X'r_c' in Eq. (34) (t-levs.) + rc_coef_zm_inout, & ! Coef. of X'r_c' in Eq. (34) (t-levs.) wp4_inout, & ! w'^4 (momentum levels - wpup2_inout, & ! w'u'^2 (thermodynamic levels) - wpvp2_inout, & ! w'v'^2 (thermodynamic levels) wp2up2_inout, & ! w'^2 u'^2 (momentum levels) wp2vp2_inout, & ! w'^2 v'^2 (momentum levels) - zt_g, & ! Thermodynamic grid of CLUBB [m] zi_g ! Momentum grid of CLUBB [m] - + ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES - real(r8), dimension(state%ncol,nzm_clubb,sclr_dim) :: & + real(r8), dimension(state%ncol,nzt_clubb,sclr_dim) :: & sclrm_forcing, & ! Passive scalar forcing [{units vary}/s] sclrm, & ! Passive scalar mean (thermo. levels) [units vary] + sclrp3 ! sclr'^3 (thermo. levels) [{units vary}^3] + + ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api + ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES + real(r8), dimension(state%ncol,nzm_clubb,sclr_dim) :: & sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2] - sclrp3, & ! sclr'^3 (thermo. levels) [{units vary}^3] sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] sclrpthlp, & ! sclr'thlp' (momentum levels) [{units vary} (K)] wpsclrp, & ! w'sclr' (momentum levels) [{units vary} m/s] sclrpthvp_inout ! sclr'th_v' (momentum levels) [{units vary} (K)] - real(r8), dimension(state%ncol,nzm_clubb,edsclr_dim) :: & + ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api + ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES + real(r8), dimension(state%ncol,nzt_clubb,edsclr_dim) :: & edsclrm_forcing, & ! Eddy passive scalar forcing [{units vary}/s] edsclr_in ! Scalars to be diffused through CLUBB [units vary] ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES - real(r8), dimension(state%ncol,nzm_clubb,hydromet_dim) :: & + real(r8), dimension(state%ncol,nzt_clubb,hydromet_dim) :: & hydromet, & - wphydrometp, & wp2hmp, & rtphmp_zt, & thlphmp_zt + ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api + ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES + real(r8), dimension(state%ncol,nzm_clubb,hydromet_dim) :: & + wphydrometp + ! Variables below are needed to compute energy integrals for conservation ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines real(r8) :: te_a, se_a, ke_a, wv_a, wl_a real(r8) :: te_b, se_b, ke_b, wv_b, wl_b real(r8) :: se_dis(pcols), clubb_s(pcols,pver), eleak(pcols) - real(r8) :: inv_exner_clubb(pcols,pverp) ! Inverse exner function consistent with CLUBB [-] - real(r8) :: inv_exner_clubb_surf(pcols) ! Inverse exner function at the surface + real(r8) :: inv_exner_clubb(pcols,pver) ! Inverse exner function consistent with CLUBB [-] real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2] real(r8) :: wprtp_output(pcols,pverp) ! Total water flux output variable [W/m2] - real(r8) :: wp3_output(pcols,pverp) ! wp3 output [m^3/s^3] + real(r8) :: wp3_output(pcols,pver) ! wp3 output [m^3/s^3] real(r8) :: rtpthlp_output(pcols,pverp) ! rtpthlp ouptut [K kg/kg] real(r8) :: qt_output(pcols,pver) ! Total water mixing ratio for output [kg/kg] real(r8) :: thetal_output(pcols,pver) ! Liquid water potential temperature output [K] real(r8) :: sl_output(pcols,pver) ! Liquid water static energy [J/kg] real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2] real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3] - real(r8) :: thv(pcols,pverp) ! virtual potential temperature [K] - real(r8) :: edsclr_out(pcols,pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] - real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] - real(r8) :: cloud_cover(pcols,pverp) ! CLUBB in-cloud cloud fraction [fraction] + real(r8) :: thv(pcols,pver) ! virtual potential temperature [K] + real(r8) :: edsclr_out(pcols,pver,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] + real(r8) :: rcm_in_layer(pcols,pver) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] + real(r8) :: cloud_cover(pcols,pver) ! CLUBB in-cloud cloud fraction [fraction] real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg] real(r8) :: wpthvp_diag(pcols,pverp) ! CLUBB buoyancy flux [W/m^2] - real(r8) :: rvm(pcols,pverp) - real(r8) :: pdfp_rtp2(pcols, pverp) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] - real(r8) :: rtp2_zt_out(pcols, pverp) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] - real(r8) :: thl2_zt_out(pcols, pverp) ! CLUBB Theta-l variance on thermo levs - real(r8) :: wp2_zt_out(pcols, pverp) + real(r8) :: rvm(pcols,pver) + real(r8) :: pdfp_rtp2(pcols, pver) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] + real(r8) :: rtp2_zt_out(pcols, pver) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] + real(r8) :: thl2_zt_out(pcols, pver) ! CLUBB Theta-l variance on thermo levs + real(r8) :: wp2_zt_out(pcols, pver) real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s] real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s] - real(r8) :: wm_zt_out(pcols, pverp) ! CLUBB mean W on thermo levs output [m/s] + real(r8) :: wm_zt_out(pcols, pver) ! CLUBB mean W on thermo levs output [m/s] real(r8) :: mean_rt ! Calculated R-tot mean from pdf_params (temp) [kg/kg] real(r8) :: dlf2(pcols,pver) ! Detraining cld H20 from shallow convection [kg/kg/day] real(r8) :: eps ! Rv/Rd [-] @@ -2445,7 +2460,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wp2thlp ! w'^2 thl' (thermodynamic levels) real(r8), pointer, dimension(:,:) :: uprcp ! < u' r_c' > (momentum levels) real(r8), pointer, dimension(:,:) :: vprcp ! < v' r_c' > (momentum levels) - real(r8), pointer, dimension(:,:) :: rc_coef ! Coef. of X'r_c' in Eq. (34) (t-levs.) + real(r8), pointer, dimension(:,:) :: rc_coef_zm ! Coef. of X'r_c' in Eq. (34) (t-levs.) real(r8), pointer, dimension(:,:) :: wp4 ! w'^4 (momentum levels real(r8), pointer, dimension(:,:) :: wpup2 ! w'u'^2 (thermodynamic levels) real(r8), pointer, dimension(:,:) :: wpvp2 ! w'v'^2 (thermodynamic levels) @@ -2470,7 +2485,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m] real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2] real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pverp)[fraction] + real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pver)[fraction] real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-] real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-] real(r8), pointer, dimension(:,:) :: naai @@ -2556,13 +2571,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! MF local vars real(r8), dimension(pcols,pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid - dzt, invrs_dzt, & ! thermodynamic grid - invrs_exner_zt,& ! thermodynamic grid - kappa_zt, qc_zt, & ! thermodynamic grid kappa_zm, p_in_Pa_zm, & ! momentum grid invrs_exner_zm ! momentum grid - real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs + real(r8), dimension(pcols,pverp) :: dzt, invrs_dzt, & ! thermodynamic grid + invrs_exner_zt,& ! thermodynamic grid + kappa_zt, qc_zt ! thermodynamic grid + + real(r8) :: temp2d(pcols,pver) ! temporary array for holding scaled outputs real(r8), dimension(pcols,pver) :: & rvmtend_clubb, & @@ -2584,7 +2600,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & character(len=*), parameter :: subr='clubb_tend_cam' real(r8), parameter :: rad2deg=180.0_r8/pi - real(r8) :: tmp_lon1, tmp_lonN + real(r8) :: tmp_lon1, tmp_lonN, invrs_hdtime type(grid) :: gr @@ -2643,7 +2659,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Establish associations between pointers and physics buffer fields call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, wprtp_idx, wprtp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) @@ -2652,10 +2668,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, up2_idx, up2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, vp2_idx, vp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtp3_idx, rtp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, thlp3_idx, thlp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, up3_idx, up3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vp3_idx, vp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, rtp3_idx, rtp3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, thlp3_idx, thlp3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, up3_idx, up3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, vp3_idx, vp3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) call pbuf_get_field(pbuf, upwp_idx, upwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, vpwp_idx, vpwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) @@ -2676,16 +2692,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp) call pbuf_get_field(pbuf, uprcp_idx, uprcp) call pbuf_get_field(pbuf, vprcp_idx, vprcp) - call pbuf_get_field(pbuf, rc_coef_idx, rc_coef) + call pbuf_get_field(pbuf, rc_coef_zm_idx, rc_coef_zm) call pbuf_get_field(pbuf, wp4_idx, wp4) call pbuf_get_field(pbuf, wpup2_idx, wpup2) call pbuf_get_field(pbuf, wpvp2_idx, wpvp2) call pbuf_get_field(pbuf, wp2up2_idx, wp2up2) call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2) - call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) call pbuf_get_field(pbuf, tke_idx, tke) call pbuf_get_field(pbuf, qrl_idx, qrl) @@ -2763,12 +2779,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Allocate pdf_params only if they aren't allocated already. if ( .not. allocated(pdf_params_chnk(lchnk)%mixt_frac) ) then - call init_pdf_params_api( nzm_clubb, ncol, pdf_params_chnk(lchnk) ) + call init_pdf_params_api( nzt_clubb, ncol, pdf_params_chnk(lchnk) ) call init_pdf_params_api( nzm_clubb, ncol, pdf_params_zm_chnk(lchnk) ) end if if ( .not. allocated(pdf_implicit_coefs_terms_chnk(lchnk)%coef_wp4_implicit) ) then - call init_pdf_implicit_coefs_terms_api( nzm_clubb, ncol, sclr_dim, & + call init_pdf_implicit_coefs_terms_api( nzt_clubb, ncol, sclr_dim, & pdf_implicit_coefs_terms_chnk(lchnk) ) end if @@ -2820,6 +2836,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! host time step divided by CLUBB time step nadv = max(hdtime/dtime,1._r8) + ! Precalculte the hdtime inverse + invrs_hdtime = 1._r8 / hdtime + ! Set stats output and increment equal to CLUBB and host dt stats_metadata%stats_tsamp = dtime @@ -2864,7 +2883,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & !$acc pdf_params_zm_chnk(lchnk)%mixt_frac ) & - !$acc copyout( temp2d, temp2dp, rtp2_zt_out, thl2_zt_out, wp2_zt_out, pdfp_rtp2, wm_zt_out, inv_exner_clubb, & + !$acc copyout( temp2d, rtp2_zt_out, thl2_zt_out, wp2_zt_out, pdfp_rtp2, wm_zt_out, inv_exner_clubb, & !$acc rcm, wprcp, rcm_in_layer, cloud_cover, zt_out, zi_out, khzm, qclvar, thv, dz_g, & !$acc clubbtop, se_dis, eleak, clubb_s, wpthvp_clubb, wprcp_clubb ) & !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & @@ -2872,7 +2891,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc up2_in, vp2_in, up3_in, vp3_in, wp2_in, wp3_in, rtp2_in, thlp2_in, rtp3_in, & !$acc thlp3_in, thlm_in, rtm_in, rvm_in, wprtp_in, wpthlp_in, rtpthlp_in, cloud_frac_inout, & !$acc rcm_inout, wp2rtp_inout, wp2thlp_inout, uprcp_inout, vprcp_inout, & - !$acc rc_coef_inout, wp4_inout, wpup2_inout, wpvp2_inout, wp2up2_inout, wp2vp2_inout, & + !$acc rc_coef_zm_inout, wp4_inout, wpup2_inout, wpvp2_inout, wp2up2_inout, wp2vp2_inout, & !$acc ice_supersat_frac_inout, pre_in, kappa_zt, qc_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & !$acc invrs_exner_zm, cloud_cover_out, rcm_in_layer_out, wprcp_out, & !$acc qclvar_out, rtp2_zt, thl2_zt, wp2_zt, w_up_in_cloud_out, cloudy_downdraft_frac_out, & @@ -2883,7 +2902,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, & !$acc radf, wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & - !$acc inv_exner_clubb_surf, thlprcp_out, zi_g, zt_g, qrl_clubb, & + !$acc thlprcp_out, zi_g, zt_g, qrl_clubb, & !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & @@ -2943,14 +2962,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:ACCR') !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pverp + do k = 1, pver do i = 1, pcols rtp2_zt_out(i,k) = 0._r8 thl2_zt_out(i,k) = 0._r8 wp2_zt_out(i,k) = 0._r8 pdfp_rtp2(i,k) = 0._r8 wm_zt_out(i,k) = 0._r8 - temp2dp(i,k) = 0._r8 end do end do @@ -2962,7 +2980,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb + do k = 1, nzt_clubb do i = 1, ncol ! Define forcings from CAM to CLUBB as zero for momentum and thermo, @@ -2981,21 +2999,30 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzt_clubb + do i = 1, ncol + ! Perturbed winds are not used in CAM + um_pert_inout(i,k) = 0.0_r8 + vm_pert_inout(i,k) = 0.0_r8 + + ! Initialize these to prevent crashing behavior + rcm_in_layer_out(i,k) = 0._r8 + cloud_cover_out(i,k) = 0._r8 + khzt_out(i,k) = 0._r8 + end do + end do + !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol ! Perturbed winds are not used in CAM - um_pert_inout(i,k) = 0.0_r8 - vm_pert_inout(i,k) = 0.0_r8 upwp_pert_inout(i,k) = 0.0_r8 vpwp_pert_inout(i,k) = 0.0_r8 ! Initialize these to prevent crashing behavior wprcp_out(i,k) = 0._r8 - rcm_in_layer_out(i,k) = 0._r8 - cloud_cover_out(i,k) = 0._r8 khzm_out(i,k) = 0._r8 - khzt_out(i,k) = 0._r8 end do end do @@ -3015,16 +3042,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! higher order scalar stuff, put to zero !$acc parallel loop gang vector collapse(3) default(present) do sclr = 1, sclr_dim - do k = 1, nzm_clubb + do k = 1, nzt_clubb do i=1, ncol sclrm(i,k,sclr) = 0._r8 + sclrp3(i,k,sclr) = 0._r8 + sclrm_forcing(i,k,sclr) = 0._r8 + end do + end do + end do + + ! higher order scalar stuff, put to zero + !$acc parallel loop gang vector collapse(3) default(present) + do sclr = 1, sclr_dim + do k = 1, nzm_clubb + do i=1, ncol wpsclrp(i,k,sclr) = 0._r8 sclrp2(i,k,sclr) = 0._r8 - sclrp3(i,k,sclr) = 0._r8 sclrprtp(i,k,sclr) = 0._r8 sclrpthlp(i,k,sclr) = 0._r8 sclrpthvp_inout(i,k,sclr) = 0._r8 - sclrm_forcing(i,k,sclr) = 0._r8 end do end do end do @@ -3037,26 +3073,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end if - if ( hydromet_dim > 0 ) then - !$acc parallel loop gang vector collapse(3) default(present) - do ixind=1, hydromet_dim - do k=1, nzm_clubb - do i=1, ncol - hydromet(i,k,ixind) = 0._r8 - wphydrometp(i,k,ixind) = 0._r8 - wp2hmp(i,k,ixind) = 0._r8 - rtphmp_zt(i,k,ixind) = 0._r8 - thlphmp_zt(i,k,ixind) = 0._r8 - end do - end do - end do - end if - if ( edsclr_dim > 0 ) then !$acc parallel loop gang vector collapse(3) default(present) do edsclr = 1, edsclr_dim do i = 1, ncol - do k = 1, nzm_clubb + do k = 1, nzt_clubb edsclrm_forcing(i,k,edsclr) = 0._r8 edsclr_in(i,k,edsclr) = 0._r8 end do @@ -3073,6 +3094,31 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end if + if ( hydromet_dim > 0 ) then + + !$acc parallel loop gang vector collapse(3) default(present) + do ixind=1, hydromet_dim + do k=1, nzt_clubb + do i=1, ncol + hydromet(i,k,ixind) = 0._r8 + wp2hmp(i,k,ixind) = 0._r8 + rtphmp_zt(i,k,ixind) = 0._r8 + thlphmp_zt(i,k,ixind) = 0._r8 + end do + end do + end do + + !$acc parallel loop gang vector collapse(3) default(present) + do ixind=1, hydromet_dim + do k=1, nzm_clubb + do i=1, ncol + wphydrometp(i,k,ixind) = 0._r8 + end do + end do + end do + + end if + ! need to initialize macmic coupling to zero if ( macmic_it == 1 ) then !$acc parallel loop gang vector collapse(2) default(present) @@ -3218,7 +3264,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpthlp(i,pverp) = wpthlp(i,pver) wprtp(i,pverp) = wprtp(i,pver) wp2(i,pverp) = wp2(i,pver) - wp3(i,pverp) = wp3(i,pver) up2(i,pverp) = up2(i,pver) vp2(i,pverp) = vp2(i,pver) end do @@ -3261,18 +3306,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo - !$acc parallel loop gang vector default(present) - do i = 1, ncol - rtm(i,pverp) = rtm(i,pver) - um(i,pverp) = state1%u(i,pver) - vm(i,pverp) = state1%v(i,pver) - thlm(i,pverp) = thlm(i,pver) - - ! Compute exner at the surface for converting the sensible heat fluxes - ! to a flux of potential temperature for use as clubb's boundary conditions - inv_exner_clubb_surf(i) = inv_exner_clubb(i,pver) - end do - ! Compute thermodynamic stuff needed for CLUBB on thermo levels. ! Inputs for the momentum levels are set below setup_clubb core !$acc parallel loop gang vector collapse(2) default(present) @@ -3280,51 +3313,41 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol ! Define the CLUBB thermodynamic grid (in units of m) - zt_g(i,k+1) = state1%zm(i,pver-k+1) - state1%zi(i,pver+1) + zt_g(i,k) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) ! base state (dry) variables - rho_ds_zt(i,k+1) = rga * ( state1%pdeldry(i,pver-k+1) / dz_g(i,pver-k+1) ) - invrs_rho_ds_zt(i,k+1) = 1._r8 / rho_ds_zt(i,k+1) + rho_ds_zt(i,k) = rga*(state1%pdeldry(i,pver-k+1)/dz_g(i,pver-k+1)) + invrs_rho_ds_zt(i,k) = 1._r8/(rho_ds_zt(i,k)) ! full state (moist) variables - p_in_Pa(i,k+1) = state1%pmid(i,pver-k+1) - exner(i,k+1) = 1._r8 / inv_exner_clubb(i,pver-k+1) - thv(i,k+1) = state1%t(i,pver-k+1) * inv_exner_clubb(i,pver-k+1) & - * ( 1._r8 + zvir * state1%q(i,pver-k+1,ixq) - state1%q(i,pver-k+1,ixcldliq) ) - rho_zt(i,k+1) = rga * state1%pdel(i,pver-k+1) / dz_g(i,pver-k+1) + p_in_Pa(i,k) = state1%pmid(i,pver-k+1) + exner(i,k) = 1._r8/inv_exner_clubb(i,pver-k+1) + thv(i,k) = state1%t(i,pver-k+1)*inv_exner_clubb(i,pver-k+1)*(1._r8+zvir*state1%q(i,pver-k+1,ixq) & + -state1%q(i,pver-k+1,ixcldliq)) + rho_zt(i,k) = rga*state1%pdel(i,pver-k+1)/dz_g(i,pver-k+1) ! exception - setting this to moist thv - thv_ds_zt(i,k+1) = thv(i,k+1) + thv_ds_zt(i,k) = thv(i,k) - rfrzm(i,k+1) = state1%q(i,pver-k+1,ixcldice) - radf(i,k+1) = radf_clubb(i,pver-k+1) - qrl_clubb(i,k+1) = qrl(i,pver-k+1) / ( cpairv(i,k,lchnk) * state1%pdeldry(i,pver-k+1) ) + rfrzm(i,k) = state1%q(i,pver-k+1,ixcldice) + radf(i,k) = radf_clubb(i,pver-k+1) + qrl_clubb(i,k) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdeldry(i,pver-k+1)) ! Compute mean w wind on thermo grid, convert from omega to w - wm_zt(i,k+1) = -1._r8 * ( state1%omega(i,pver-k+1) - state1%omega(i,pver) ) & - / ( rho_zt(i,k+1) * gravit ) + wm_zt(i,k) = -1._r8*(state1%omega(i,pver-k+1)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) end do end do - ! Below computes the same stuff for the ghost point. May or may - ! not be needed, just to be safe to avoid NaN's !$acc parallel loop gang vector default(present) do i = 1, ncol - zt_g(i,1) = -1._r8 * zt_g(i,2) - rho_ds_zt(i,1) = rho_ds_zt(i,2) - invrs_rho_ds_zt(i,1) = invrs_rho_ds_zt(i,2) - p_in_Pa(i,1) = p_in_Pa(i,2) - exner(i,1) = exner(i,2) - thv(i,1) = thv(i,2) - rho_zt(i,1) = rho_zt(i,2) - thv_ds_zt(i,1) = thv_ds_zt(i,2) - rfrzm(i,1) = rfrzm(i,2) - radf(i,1) = radf(i,2) - qrl_clubb(i,1) = qrl_clubb(i,2) - wm_zt(i,1) = wm_zt(i,2) + + ! For consistency, set surface pressure to p_in_Pa at the first thermo. + ! level above the surface (according to the CLUBB ascending grid). + p_sfc(i) = p_in_Pa(i,1) ! Set the elevation of the surface sfc_elevation(i) = state1%zi(i,pverp) + end do @@ -3422,27 +3445,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb - do i = 1, ncol - rtp2_forcing(i,k) = rtp2_mc_zt(i,k) - thlp2_forcing(i,k) = thlp2_mc_zt(i,k) - wprtp_forcing(i,k) = wprtp_mc_zt(i,k) - wpthlp_forcing(i,k) = wpthlp_mc_zt(i,k) - rtpthlp_forcing(i,k) = rtpthlp_mc_zt(i,k) - end do - end do - ! Add forcings for SILHS covariance contributions - rtp2_forcing = zt2zm_api( nzm_clubb, ncol, gr, rtp2_forcing ) - thlp2_forcing = zt2zm_api( nzm_clubb, ncol, gr, thlp2_forcing ) - wprtp_forcing = zt2zm_api( nzm_clubb, ncol, gr, wprtp_forcing ) - wpthlp_forcing = zt2zm_api( nzm_clubb, ncol, gr, wpthlp_forcing ) - rtpthlp_forcing = zt2zm_api( nzm_clubb, ncol, gr, rtpthlp_forcing ) + rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt ) + thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt ) + wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt ) + wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt ) + rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt ) ! Zero out SILHS covariance contribution terms !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pverp + do k = 1, pver do i = 1, pcols rtp2_mc_zt(i,k) = 0.0_r8 thlp2_mc_zt(i,k) = 0.0_r8 @@ -3453,17 +3465,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! Compute some inputs from the thermodynamic grid to the momentum grid - rho_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, rho_ds_zt ) - rho_zm = zt2zm_api( nzm_clubb, ncol, gr, rho_zt ) - invrs_rho_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, invrs_rho_ds_zt ) - thv_ds_zm = zt2zm_api( nzm_clubb, ncol, gr, thv_ds_zt ) - wm_zm = zt2zm_api( nzm_clubb, ncol, gr, wm_zt ) + rho_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rho_ds_zt ) + rho_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rho_zt ) + invrs_rho_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, invrs_rho_ds_zt ) + thv_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thv_ds_zt ) + wm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wm_zt ) ! Surface fluxes provided by host model !$acc parallel loop gang vector default(present) do i=1,ncol wpthlp_sfc(i) = cam_in%shf(i)/(cpairv(i,pver,lchnk)*rho_ds_zm(i,1)) ! Sensible heat flux - wpthlp_sfc(i) = wpthlp_sfc(i)*inv_exner_clubb_surf(i) ! Potential temperature flux + wpthlp_sfc(i) = wpthlp_sfc(i)*inv_exner_clubb(i,pver) ! Potential temperature flux wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux end do @@ -3503,51 +3515,54 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:flip-index') - ! Need to flip arrays around for CLUBB core + ! Need to flip zt arrays around for CLUBB core !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb + do k = 1, nzt_clubb do i = 1, ncol + um_in(i,k) = um(i,pver-k+1) + vm_in(i,k) = vm(i,pver-k+1) + wp2thvp_in(i,k) = wp2thvp(i,pver-k+1) + up3_in(i,k) = up3(i,pver-k+1) + vp3_in(i,k) = vp3(i,pver-k+1) + wp3_in(i,k) = wp3(i,pver-k+1) + rtp3_in(i,k) = rtp3(i,pver-k+1) + thlp3_in(i,k) = thlp3(i,pver-k+1) + thlm_in(i,k) = thlm(i,pver-k+1) + rtm_in(i,k) = rtm(i,pver-k+1) + rvm_in(i,k) = rvm(i,pver-k+1) + cloud_frac_inout(i,k) = cloud_frac(i,pver-k+1) + rcm_inout(i,k) = state1%q(i,pver-k+1,ixcldliq) + wp2rtp_inout(i,k) = wp2rtp(i,pver-k+1) + wp2thlp_inout(i,k) = wp2thlp(i,pver-k+1) + wpup2_inout(i,k) = wpup2(i,pver-k+1) + wpvp2_inout(i,k) = wpvp2(i,pver-k+1) + ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,pver-k+1) + end do + end do - um_in(i,k) = um(i,pverp-k+1) - vm_in(i,k) = vm(i,pverp-k+1) + ! Need to flip zm arrays around for CLUBB core + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol upwp_in(i,k) = upwp(i,pverp-k+1) vpwp_in(i,k) = vpwp(i,pverp-k+1) wpthvp_in(i,k) = wpthvp(i,pverp-k+1) - wp2thvp_in(i,k) = wp2thvp(i,pverp-k+1) rtpthvp_in(i,k) = rtpthvp(i,pverp-k+1) thlpthvp_in(i,k)= thlpthvp(i,pverp-k+1) up2_in(i,k) = up2(i,pverp-k+1) vp2_in(i,k) = vp2(i,pverp-k+1) - up3_in(i,k) = up3(i,pverp-k+1) - vp3_in(i,k) = vp3(i,pverp-k+1) wp2_in(i,k) = wp2(i,pverp-k+1) - wp3_in(i,k) = wp3(i,pverp-k+1) rtp2_in(i,k) = rtp2(i,pverp-k+1) thlp2_in(i,k) = thlp2(i,pverp-k+1) - rtp3_in(i,k) = rtp3(i,pverp-k+1) - thlp3_in(i,k) = thlp3(i,pverp-k+1) - thlm_in(i,k) = thlm(i,pverp-k+1) - rtm_in(i,k) = rtm(i,pverp-k+1) - rvm_in(i,k) = rvm(i,pverp-k+1) wprtp_in(i,k) = wprtp(i,pverp-k+1) wpthlp_in(i,k) = wpthlp(i,pverp-k+1) rtpthlp_in(i,k) = rtpthlp(i,pverp-k+1) - cloud_frac_inout(i,k) = cloud_frac(i,pverp-k+1) - if (k>1) then - rcm_inout(i,k) = state1%q(i,pverp-k+1,ixcldliq) - end if - - wp2rtp_inout(i,k) = wp2rtp(i,pverp-k+1) - wp2thlp_inout(i,k) = wp2thlp(i,pverp-k+1) - uprcp_inout(i,k) = uprcp(i,pverp-k+1) - vprcp_inout(i,k) = vprcp(i,pverp-k+1) - rc_coef_inout(i,k) = rc_coef(i,pverp-k+1) - wp4_inout(i,k) = wp4(i,pverp-k+1) - wpup2_inout(i,k) = wpup2(i,pverp-k+1) - wpvp2_inout(i,k) = wpvp2(i,pverp-k+1) - wp2up2_inout(i,k) = wp2up2(i,pverp-k+1) - wp2vp2_inout(i,k) = wp2vp2(i,pverp-k+1) - ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,pverp-k+1) + uprcp_inout(i,k) = uprcp(i,pverp-k+1) + vprcp_inout(i,k) = vprcp(i,pverp-k+1) + rc_coef_zm_inout(i,k) = rc_coef_zm(i,pverp-k+1) + wp4_inout(i,k) = wp4(i,pverp-k+1) + wp2up2_inout(i,k) = wp2up2(i,pverp-k+1) + wp2vp2_inout(i,k) = wp2vp2(i,pverp-k+1) end do end do @@ -3568,36 +3583,24 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if !$acc parallel loop gang vector collapse(2) default(present) - do k=2, nzm_clubb + do k=1, nzt_clubb do i=1,ncol - pre_in(i,k) = prer_evap(i,pverp-k+1) + pre_in(i,k) = prer_evap(i,pver-k+1) end do end do - !$acc parallel loop gang vector default(present) - do i=1,ncol - pre_in(i,1) = pre_in(i,2) - rcm_inout(i,1) = rcm_inout(i,2) - end do - ! pressure,exner on momentum grid needed for mass flux calc. if (do_clubb_mf) then - do k=1,pver + do k=1,nzt_clubb do i=1,ncol - kappa_zt(i,k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) - qc_zt(i,k+1) = state1%q(i,pver-k+1,ixcldliq) - invrs_exner_zt(i,k+1) = inv_exner_clubb(i,pver-k+1) + kappa_zt(i,k) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) + qc_zt(i,k) = state1%q(i,pver-k+1,ixcldliq) + invrs_exner_zt(i,k) = inv_exner_clubb(i,pver-k+1) end do end do - do i=1,ncol - kappa_zt(i,1) = kappa_zt(i,2) - qc_zt(i,1) = qc_zt(i,2) - invrs_exner_zt(i,1) = invrs_exner_zt(i,2) - end do - - kappa_zm(1:ncol,:) = zt2zm_api(nzm_clubb, ncol, gr, kappa_zt(1:ncol,:)) + kappa_zm(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt(1:ncol,:)) do k=1,pverp do i=1,ncol @@ -3611,14 +3614,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (clubb_do_adv) then if (macmic_it == 1) then - wp2_in = zt2zm_api(nzm_clubb, ncol, gr, wp2_in ) - wpthlp_in = zt2zm_api(nzm_clubb, ncol, gr, wpthlp_in ) - wprtp_in = zt2zm_api(nzm_clubb, ncol, gr, wprtp_in ) - up2_in = zt2zm_api(nzm_clubb, ncol, gr, up2_in ) - vp2_in = zt2zm_api(nzm_clubb, ncol, gr, vp2_in ) - thlp2_in = zt2zm_api(nzm_clubb, ncol, gr, thlp2_in ) - rtp2_in = zt2zm_api(nzm_clubb, ncol, gr, rtp2_in ) - rtpthlp_in = zt2zm_api(nzm_clubb, ncol, gr, rtpthlp_in ) + wp2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) + wpthlp_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_in ) + wprtp_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_in ) + up2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, up2_in ) + vp2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, vp2_in ) + thlp2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) + rtp2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_in ) + rtpthlp_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_in ) do k = 1, nzm_clubb do i = 1, ncol @@ -3643,15 +3646,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1,nzt_clubb do i=1,ncol - edsclr_in(i,k+1,icnt) = state1%q(i,pver-k+1,ixind) + edsclr_in(i,k,icnt) = state1%q(i,pver-k+1,ixind) end do end do - !$acc parallel loop gang vector default(present) - do i=1,ncol - edsclr_in(i,1,icnt) = edsclr_in(i,2,icnt) - end do - end if end do @@ -3660,17 +3658,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1,nzt_clubb do i=1, ncol - edsclr_in(i,k+1,icnt+1) = thlm(i,pver-k+1) - edsclr_in(i,k+1,icnt+2) = rtm(i,pver-k+1) + edsclr_in(i,k,icnt+1) = thlm(i,pver-k+1) + edsclr_in(i,k,icnt+2) = rtm(i,pver-k+1) end do end do - !$acc parallel loop gang vector default(present) - do i=1, ncol - edsclr_in(i,1,icnt+1) = edsclr_in(i,2,icnt+1) - edsclr_in(i,1,icnt+2) = edsclr_in(i,2,icnt+2) - end do - endif call t_stopf('clubb_tend_cam:flip-index') @@ -3689,23 +3681,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - do k=2,pverp + do k=1,pver do i=1, ncol - dzt(i,k) = zi_g(i,k) - zi_g(i,k-1) + dzt(i,k) = zi_g(i,k+1) - zi_g(i,k) end do end do do i=1, ncol - dzt(i,1) = dzt(i,2) invrs_dzt(i,:) = 1._r8/dzt(i,:) end do - rtm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, ncol, gr, rtm_in(1:ncol,:) ) - thlm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, ncol, gr, thlm_in(1:ncol,:) ) + rtm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm_in(1:ncol,:) ) + thlm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm_in(1:ncol,:) ) do i=1, ncol - call integrate_mf( pverp, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + call integrate_mf( pverp, pver, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv(i,:), & ! input thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input wpthlp_sfc(i), wprtp_sfc(i), pblh(i), & ! input @@ -3724,18 +3715,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! pass MF turbulent advection term as CLUBB explicit forcing term - do i=1, ncol - rtm_forcing(i,1) = 0._r8 - thlm_forcing(i,1)= 0._r8 - end do - - do k=2,pverp - do i=1, ncol + do k = 1, nzt_clubb + do i = 1, ncol rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & - ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k-1) * mf_qtflx(i,k-1))) + ((rho_ds_zm(i,k+1) * mf_qtflx(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflx(i,k))) thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & - ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k-1) * mf_thlflx(i,k-1))) + ((rho_ds_zm(i,k+1) * mf_thlflx(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflx(i,k))) end do end do call t_stopf('clubb_tend_cam:do_clubb_mf') @@ -3744,7 +3730,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Advance CLUBB CORE one timestep in the future call t_startf('clubb_tend_cam:advance_clubb_core_api') - call advance_clubb_core_api( gr, nzm_clubb, ncol, & + call advance_clubb_core_api( gr, nzm_clubb, nzt_clubb, ncol, & l_implemented, dtime, fcor, sfc_elevation, & hydromet_dim, & sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & @@ -3752,7 +3738,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sclrm_forcing, edsclrm_forcing, wprtp_forcing, & wpthlp_forcing, rtp2_forcing, thlp2_forcing, & rtpthlp_forcing, wm_zm, wm_zt, & - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, p_sfc, & wpsclrp_sfc, wpedsclrp_sfc, & upwp_sfc_pert, vpwp_sfc_pert, & rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, & @@ -3760,7 +3746,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & hydromet, hm_metadata%l_mix_rat_hm, & - rfrzm, radf, & + rfrzm, & wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & grid_dx, grid_dy, & clubb_params, nu_vert_res_dep, lmin, & @@ -3777,7 +3763,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & sclrpthvp_inout, & wp2rtp_inout, wp2thlp_inout, uprcp_inout, & - vprcp_inout, rc_coef_inout, & + vprcp_inout, rc_coef_zm_inout, & wp4_inout, wpup2_inout, wpvp2_inout, & wp2up2_inout, wp2vp2_inout, ice_supersat_frac_inout, & um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & @@ -3807,13 +3793,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if ( do_rainturb ) then call t_startf('clubb_tend_cam:do_rainturb') - do k=1,nzm_clubb + do k=1,nzt_clubb do i=1,ncol rvm_in(i,k) = rtm_in(i,k) - rcm_inout(i,k) end do end do - call update_xp2_mc_api( gr, nzm_clubb, ncol, dtime, cloud_frac_inout, & + call update_xp2_mc_api( gr, nzm_clubb, nzt_clubb, ncol, dtime, cloud_frac_inout, & rcm_inout, rvm_in, thlm_in, wm_zt, & exner, pre_in, pdf_params_chnk(lchnk), & rtp2_mc_out, thlp2_mc_out, & @@ -3838,8 +3824,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_cldcool) then call t_startf('clubb_tend_cam:do_cldcool') - rcm_out_zm = zt2zm_api(nzm_clubb, ncol, gr, rcm_inout ) - qrl_zm = zt2zm_api(nzm_clubb, ncol, gr, qrl_clubb ) + rcm_out_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rcm_inout ) + qrl_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qrl_clubb ) thlp2_rad_out(:,:) = 0._r8 do i=1, ncol @@ -3871,14 +3857,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then - wp2_in = zm2zt_api( nzm_clubb, ncol, gr, wp2_in ) - wpthlp_in = zm2zt_api( nzm_clubb, ncol, gr, wpthlp_in ) - wprtp_in = zm2zt_api( nzm_clubb, ncol, gr, wprtp_in ) - up2_in = zm2zt_api( nzm_clubb, ncol, gr, up2_in ) - vp2_in = zm2zt_api( nzm_clubb, ncol, gr, vp2_in ) - thlp2_in = zm2zt_api( nzm_clubb, ncol, gr, thlp2_in ) - rtp2_in = zm2zt_api( nzm_clubb, ncol, gr, rtp2_in ) - rtpthlp_in = zm2zt_api( nzm_clubb, ncol, gr, rtpthlp_in ) + wp2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) + wpthlp_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_in ) + wprtp_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_in ) + up2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, up2_in ) + vp2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, vp2_in ) + thlp2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) + rtp2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_in ) + rtpthlp_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_in ) do k=1,nzm_clubb do i=1, ncol @@ -3894,79 +3880,85 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if ! Convert RTP2 and THLP2 to thermo grid for output - rtp2_zt = zm2zt_api( nzm_clubb, ncol, gr, rtp2_in ) - thl2_zt = zm2zt_api( nzm_clubb, ncol, gr, thlp2_in ) - wp2_zt = zm2zt_api( nzm_clubb, ncol, gr, wp2_in ) + rtp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_in ) + thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) + wp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) call t_startf('clubb_tend_cam:flip-index') ! Arrays need to be "flipped" to CAM grid + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, nzt_clubb + do i=1, ncol + um(i,pver-k+1) = um_in(i,k) + vm(i,pver-k+1) = vm_in(i,k) + wp2thvp(i,pver-k+1) = wp2thvp_in(i,k) + up3(i,pver-k+1) = up3_in(i,k) + vp3(i,pver-k+1) = vp3_in(i,k) + thlm(i,pver-k+1) = thlm_in(i,k) + rtm(i,pver-k+1) = rtm_in(i,k) + wp3(i,pver-k+1) = wp3_in(i,k) + rtp3(i,pver-k+1) = rtp3_in(i,k) + thlp3(i,pver-k+1) = thlp3_in(i,k) + rcm(i,pver-k+1) = rcm_inout(i,k) + cloud_frac(i,pver-k+1) = min(cloud_frac_inout(i,k),1._r8) + rcm_in_layer(i,pver-k+1) = rcm_in_layer_out(i,k) + cloud_cover(i,pver-k+1) = min(cloud_cover_out(i,k),1._r8) + zt_out(i,pver-k+1) = zt_g(i,k) + wm_zt_out(i,pver-k+1) = wm_zt(i,k) + wp2rtp(i,pver-k+1) = wp2rtp_inout(i,k) + wp2thlp(i,pver-k+1) = wp2thlp_inout(i,k) + wpup2(i,pver-k+1) = wpup2_inout(i,k) + wpvp2(i,pver-k+1) = wpvp2_inout(i,k) + ice_supersat_frac(i,pver-k+1) = ice_supersat_frac_inout(i,k) + qclvar(i,pver-k+1) = min(1._r8,qclvar_out(i,k)) + + rtp2_zt_out(i,pver-k+1) = rtp2_zt(i,k) + thl2_zt_out(i,pver-k+1) = thl2_zt(i,k) + wp2_zt_out(i,pver-k+1) = wp2_zt(i,k) + end do + end do + !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzm_clubb do i=1, ncol - um(i,pverp-k+1) = um_in(i,k) - vm(i,pverp-k+1) = vm_in(i,k) upwp(i,pverp-k+1) = upwp_in(i,k) vpwp(i,pverp-k+1) = vpwp_in(i,k) wpthvp(i,pverp-k+1) = wpthvp_in(i,k) - wp2thvp(i,pverp-k+1) = wp2thvp_in(i,k) rtpthvp(i,pverp-k+1) = rtpthvp_in(i,k) thlpthvp(i,pverp-k+1) = thlpthvp_in(i,k) up2(i,pverp-k+1) = up2_in(i,k) vp2(i,pverp-k+1) = vp2_in(i,k) - up3(i,pverp-k+1) = up3_in(i,k) - vp3(i,pverp-k+1) = vp3_in(i,k) - thlm(i,pverp-k+1) = thlm_in(i,k) - rtm(i,pverp-k+1) = rtm_in(i,k) wprtp(i,pverp-k+1) = wprtp_in(i,k) wpthlp(i,pverp-k+1) = wpthlp_in(i,k) wp2(i,pverp-k+1) = wp2_in(i,k) - wp3(i,pverp-k+1) = wp3_in(i,k) rtp2(i,pverp-k+1) = rtp2_in(i,k) thlp2(i,pverp-k+1) = thlp2_in(i,k) - rtp3(i,pverp-k+1) = rtp3_in(i,k) - thlp3(i,pverp-k+1) = thlp3_in(i,k) rtpthlp(i,pverp-k+1) = rtpthlp_in(i,k) - rcm(i,pverp-k+1) = rcm_inout(i,k) wprcp(i,pverp-k+1) = wprcp_out(i,k) - cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(i,k),1._r8) pdf_zm_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_1(i,k) pdf_zm_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_2(i,k) pdf_zm_varnce_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) pdf_zm_varnce_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) pdf_zm_mixt_frac(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) - rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(i,k) - cloud_cover(i,pverp-k+1) = min(cloud_cover_out(i,k),1._r8) - zt_out(i,pverp-k+1) = zt_g(i,k) zi_out(i,pverp-k+1) = zi_g(i,k) khzm(i,pverp-k+1) = khzm_out(i,k) - qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(i,k)) - wm_zt_out(i,pverp-k+1) = wm_zt(i,k) - wp2rtp(i,pverp-k+1) = wp2rtp_inout(i,k) - wp2thlp(i,pverp-k+1) = wp2thlp_inout(i,k) uprcp(i,pverp-k+1) = uprcp_inout(i,k) vprcp(i,pverp-k+1) = vprcp_inout(i,k) - rc_coef(i,pverp-k+1) = rc_coef_inout(i,k) + rc_coef_zm(i,pverp-k+1) = rc_coef_zm_inout(i,k) wp4(i,pverp-k+1) = wp4_inout(i,k) - wpup2(i,pverp-k+1) = wpup2_inout(i,k) - wpvp2(i,pverp-k+1) = wpvp2_inout(i,k) wp2up2(i,pverp-k+1) = wp2up2_inout(i,k) wp2vp2(i,pverp-k+1) = wp2vp2_inout(i,k) - ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_inout(i,k) - - rtp2_zt_out(i,pverp-k+1) = rtp2_zt(i,k) - thl2_zt_out(i,pverp-k+1) = thl2_zt(i,k) - wp2_zt_out(i,pverp-k+1) = wp2_zt(i,k) - end do end do + if ( edsclr_dim > 0 ) then !$acc parallel loop gang vector collapse(3) default(present) do ixind=1,edsclr_dim - do k=1, nzm_clubb + do k=1, nzt_clubb do i=1, ncol - edsclr_out(i,pverp-k+1,ixind) = edsclr_in(i,k,ixind) + edsclr_out(i,pver-k+1,ixind) = edsclr_in(i,k,ixind) end do end do end do @@ -4005,7 +3997,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzm_clubb + do k=1, nzt_clubb do i=1, ncol mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) & @@ -4013,12 +4005,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & * pdf_params_chnk(lchnk)%rt_2(i,k) - pdfp_rtp2(i,pverp-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & - * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & - + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & - + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & - * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 & - + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) + pdfp_rtp2(i,pver-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) end do end do @@ -4064,13 +4056,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - ! Fill up arrays needed for McICA. Note we do not want the ghost point, - ! thus why the second loop is needed. - !$acc parallel loop gang vector default(present) - do i=1, pcols - zi_out(i,1) = 0._r8 - end do - ! enforce zero tracer tendencies above the top_lev level -- no change icnt=0 do ixind=1,pcnst @@ -4153,7 +4138,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Compute the disbalance of total energy, over depth where CLUBB is active se_dis(i) = ( te_a - te_b ) / ( state1%pint(i,pverp) - state1%pint(i,clubbtop(i)) ) - eleak(i) = ( te_a - te_b ) / hdtime + eleak(i) = ( te_a - te_b ) * invrs_hdtime end do @@ -4202,31 +4187,28 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_init( ptend_loc, state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq ) - ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point - ! for all variables and therefore is never called in this loop - do i=1, ncol - - rtm_integral_vtend(i) = 0._r8 - rtm_integral_ltend(i) = 0._r8 - - do k=1, pver + ! Now compute the tendencies of CLUBB to CAM + rtm_integral_vtend(:) = 0._r8 + rtm_integral_ltend(:) = 0._r8 - ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) / hdtime ! east-west wind - ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) / hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) / hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) / hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) / hdtime ! Tendency of static energy - - rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k) - rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k) + do k=1, pver + do i=1, ncol - end do + ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) * invrs_hdtime ! east-west wind + ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) * invrs_hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) * invrs_hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy - rtm_integral_ltend(i) = rtm_integral_ltend(i)/gravit - rtm_integral_vtend(i) = rtm_integral_vtend(i)/gravit + rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k) + rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k) + end do end do + rtm_integral_ltend(:) = rtm_integral_ltend(:)/gravit + rtm_integral_vtend(:) = rtm_integral_vtend(:)/gravit + ! Accumulate Air Temperature Tendency (TTEND) for Gravity Wave parameterization do k=1, pver do i=1, ncol @@ -4254,25 +4236,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpthlp(i,k) = wpthlp(i,k) + wpthlp_const wprtp(i,k) = wprtp(i,k) + wprtp_const - ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) / hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) / hdtime ! RTP Variance - ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) / hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) / hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) / hdtime ! WPRTP - ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) / hdtime ! WP2 - ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) / hdtime ! WP3 - ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) / hdtime ! UP2 - ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) / hdtime ! VP2 + ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) * invrs_hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) * invrs_hdtime ! RTP Variance + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) * invrs_hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) * invrs_hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) * invrs_hdtime ! WPRTP + ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) * invrs_hdtime ! WP2 + ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) * invrs_hdtime ! WP3 + ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) * invrs_hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) * invrs_hdtime ! VP2 end do end do - ! Add constant to ghost point so that output is not corrupted - wp3(:,pverp) = wp3(:,pverp) + wp3_const - rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const - wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const - wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const - else do k=1, pver @@ -4545,7 +4521,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux wprtp_output(i,k) = (wprtp(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux rtpthlp_output(i,k) = rtpthlp(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output - wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output tke(i,k) = 0.5_r8*(up2(i,k)+vp2(i,k)+wp2(i,k)) ! turbulent kinetic energy if (do_clubb_mf) then mf_thlflx_output(i,k) = mf_thlflx_output(i,k)*rho(i,k)*cpair @@ -4554,6 +4529,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo + do k=1,pver + do i=1,ncol + wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output + enddo + enddo ! --------------------------------------------------------------------------------- ! ! Diagnose some quantities that are computed in macrop_tend here. ! ! These are inputs required for the microphysics calculation. ! @@ -4767,36 +4747,36 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld('TFIX_CLUBB', se_dis, pcols, lchnk) ! Output calls of variables goes here - call outfld( 'RELVAR', relvar, pcols, lchnk ) - call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) - call outfld( 'WP2_CLUBB', wp2, pcols, lchnk ) - call outfld( 'UP2_CLUBB', up2, pcols, lchnk ) - call outfld( 'VP2_CLUBB', vp2, pcols, lchnk ) - call outfld( 'WP3_CLUBB', wp3_output(:,1:pver), pcols, lchnk ) - call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk ) - call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk ) - call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) - call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) - call outfld( 'RTP2_CLUBB', rtp2, pcols, lchnk ) - call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) - call outfld( 'RCM_CLUBB', rcm(:,1:pver), pcols, lchnk ) - call outfld( 'RTM_CLUBB', rtm(:,1:pver), pcols, lchnk ) - call outfld( 'THLM_CLUBB', thlm(:,1:pver), pcols, lchnk ) - call outfld( 'WPRCP_CLUBB', wprcp_clubb, pcols, lchnk ) - call outfld( 'WPTHVP_CLUBB', wpthvp_clubb, pcols, lchnk ) - call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_out(:,1:pver), pcols, lchnk ) - call outfld( 'THLP2_ZT_CLUBB', thl2_zt_out(:,1:pver), pcols, lchnk ) - call outfld( 'WP2_ZT_CLUBB', wp2_zt_out(:,1:pver), pcols, lchnk ) + call outfld( 'RELVAR', relvar, pcols, lchnk ) + call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) + call outfld( 'WP2_CLUBB', wp2, pcols, lchnk ) + call outfld( 'UP2_CLUBB', up2, pcols, lchnk ) + call outfld( 'VP2_CLUBB', vp2, pcols, lchnk ) + call outfld( 'WP3_CLUBB', wp3_output, pcols, lchnk ) + call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk ) + call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk ) + call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) + call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) + call outfld( 'RTP2_CLUBB', rtp2, pcols, lchnk ) + call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) + call outfld( 'RCM_CLUBB', rcm, pcols, lchnk ) + call outfld( 'RTM_CLUBB', rtm, pcols, lchnk ) + call outfld( 'THLM_CLUBB', thlm, pcols, lchnk ) + call outfld( 'WPRCP_CLUBB', wprcp_clubb, pcols, lchnk ) + call outfld( 'WPTHVP_CLUBB', wpthvp_clubb, pcols, lchnk ) + call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_out, pcols, lchnk ) + call outfld( 'THLP2_ZT_CLUBB', thl2_zt_out, pcols, lchnk ) + call outfld( 'WP2_ZT_CLUBB', wp2_zt_out, pcols, lchnk ) call outfld( 'PDFP_RTP2_CLUBB', pdfp_rtp2, pcols, lchnk ) call outfld( 'THLP2_CLUBB', thlp2, pcols, lchnk ) - call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer(:,1:pver), pcols, lchnk ) + call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer, pcols, lchnk ) call outfld( 'CLOUDFRAC_CLUBB', alst, pcols, lchnk ) - call outfld( 'CLOUDCOVER_CLUBB', cloud_frac(:,1:pver), pcols, lchnk ) - call outfld( 'ZT_CLUBB', zt_out(:,1:pver), pcols, lchnk ) + call outfld( 'CLOUDCOVER_CLUBB', cloud_frac, pcols, lchnk ) + call outfld( 'ZT_CLUBB', zt_out, pcols, lchnk ) call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk ) - call outfld( 'UM_CLUBB', um(:,1:pver), pcols, lchnk ) - call outfld( 'VM_CLUBB', vm(:,1:pver), pcols, lchnk ) - call outfld( 'WM_ZT_CLUBB', wm_zt_out(:,1:pver), pcols, lchnk ) + call outfld( 'UM_CLUBB', um, pcols, lchnk ) + call outfld( 'VM_CLUBB', vm, pcols, lchnk ) + call outfld( 'WM_ZT_CLUBB', wm_zt_out, pcols, lchnk ) call outfld( 'CONCLD', concld, pcols, lchnk ) call outfld( 'DP_CLD', deepcu, pcols, lchnk ) call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk ) @@ -5240,7 +5220,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & endif stats_zt(j)%num_output_fields = ntot - stats_zt(j)%kk = nnzp + stats_zt(j)%kk = nnzp - 1 allocate( stats_zt(j)%z( stats_zt(j)%kk ), stat=ierr ) if( ierr /= 0 ) call endrun("stats_init_clubb: Failed to allocate stats_zt%z") @@ -5529,9 +5509,9 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st stats_sfc ! stats_sfc ! Inout variables - real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) + real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pver,stats_zt%num_output_fields) real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) - real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pverp,stats_rad_zt%num_output_fields) + real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pver,stats_rad_zt%num_output_fields) real(r8), intent(inout) :: out_radzm(:,:,:) ! (pcols,pverp,rad_zm%num_output_fields) real(r8), intent(inout) :: out_sfc(:,:,:) ! (pcols,1,sfc%num_output_fields) @@ -5563,7 +5543,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st ! in the vertical level to be the same as CAM output. do i = 1, stats_zt%num_output_fields do k = 1, stats_zt%kk - out_zt(thecol,pverp-k+1,i) = stats_zt%accum_field_values(1,1,k,i) + out_zt(thecol,pver-k+1,i) = stats_zt%accum_field_values(1,1,k,i) if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 enddo enddo @@ -5578,7 +5558,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st if (stats_metadata%l_output_rad_files) then do i = 1, stats_rad_zt%num_output_fields do k = 1, stats_rad_zt%kk - out_radzt(thecol,pverp-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i) + out_radzt(thecol,pver-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i) if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8 enddo enddo diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 898c42004d..4461502d39 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -1,682 +1,684 @@ module clubb_mf -! =============================================================================== ! -! Mass-flux module for use with CLUBB ! -! Together (CLUBB+MF) they comprise a eddy-diffusivity mass-flux approach (EDMF) ! -! =============================================================================== ! - - use shr_kind_mod, only: r8=>shr_kind_r8 - use spmd_utils, only: masterproc - use cam_logfile, only: iulog - - implicit none - private - save - - public :: integrate_mf, & - clubb_mf_readnl, & - do_clubb_mf, & - do_clubb_mf_diag - - real(r8) :: clubb_mf_L0 = 0._r8 - real(r8) :: clubb_mf_ent0 = 0._r8 - integer :: clubb_mf_nup = 0 - logical, protected :: do_clubb_mf = .false. - logical, protected :: do_clubb_mf_diag = .false. - - contains - - subroutine clubb_mf_readnl(nlfile) - ! =============================================================================== ! - ! MF namelists ! + ! Mass-flux module for use with CLUBB ! + ! Together (CLUBB+MF) they comprise a eddy-diffusivity mass-flux approach (EDMF) ! ! =============================================================================== ! - - use namelist_utils, only: find_group_name - use cam_abortutils, only: endrun - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer, mpi_logical - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - character(len=*), parameter :: sub = 'clubb_mf_readnl' - - integer :: iunit, read_status, ierr - - - namelist /clubb_mf_nl/ clubb_mf_L0, clubb_mf_ent0, clubb_mf_nup, do_clubb_mf, do_clubb_mf_diag - - if (masterproc) then - open( newunit=iunit, file=trim(nlfile), status='old' ) - call find_group_name(iunit, 'clubb_mf_nl', status=read_status) - if (read_status == 0) then - read(iunit, clubb_mf_nl, iostat=ierr) - if (ierr /= 0) then - call endrun('clubb_mf_readnl: ERROR reading namelist') - end if + + use shr_kind_mod, only: r8=>shr_kind_r8 + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + + implicit none + private + save + + public :: integrate_mf, & + clubb_mf_readnl, & + do_clubb_mf, & + do_clubb_mf_diag + + real(r8) :: clubb_mf_L0 = 0._r8 + real(r8) :: clubb_mf_ent0 = 0._r8 + integer :: clubb_mf_nup = 0 + logical, protected :: do_clubb_mf = .false. + logical, protected :: do_clubb_mf_diag = .false. + + contains + + subroutine clubb_mf_readnl(nlfile) + + ! =============================================================================== ! + ! MF namelists ! + ! =============================================================================== ! + + use namelist_utils, only: find_group_name + use cam_abortutils, only: endrun + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_real8, mpi_integer, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + character(len=*), parameter :: sub = 'clubb_mf_readnl' + + integer :: iunit, read_status, ierr + + + namelist /clubb_mf_nl/ clubb_mf_L0, clubb_mf_ent0, clubb_mf_nup, do_clubb_mf, do_clubb_mf_diag + + if (masterproc) then + open( newunit=iunit, file=trim(nlfile), status='old' ) + call find_group_name(iunit, 'clubb_mf_nl', status=read_status) + if (read_status == 0) then + read(iunit, clubb_mf_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('clubb_mf_readnl: ERROR reading namelist') + end if + end if + close(iunit) end if - close(iunit) - end if - - call mpi_bcast(clubb_mf_L0, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_L0") - call mpi_bcast(clubb_mf_ent0, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ent0") - call mpi_bcast(clubb_mf_nup, 1, mpi_integer, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_nup") - call mpi_bcast(do_clubb_mf, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf") - call mpi_bcast(do_clubb_mf_diag, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_diag") - - if ((.not. do_clubb_mf) .and. do_clubb_mf_diag ) then - call endrun('clubb_mf_readnl: Error - cannot turn on do_clubb_mf_diag without also turning on do_clubb_mf') - end if - - - end subroutine clubb_mf_readnl - - subroutine integrate_mf( nz, dzt, zm, p_zm, iexner_zm, & ! input - p_zt, iexner_zt, & ! input - u, v, thl, qt, thv, & ! input - thl_zm, qt_zm, & ! input - wthl, wqt, pblh, & ! input - dry_a, moist_a, & ! output - plume diagnostics - dry_w, moist_w, & ! output - plume diagnostics - dry_qt, moist_qt, & ! output - plume diagnostics - dry_thl, moist_thl, & ! output - plume diagnostics - dry_u, moist_u, & ! output - plume diagnostics - dry_v, moist_v, & ! output - plume diagnostics - moist_qc, & ! output - plume diagnostics - ae, aw, & ! output - diagnosed fluxes BEFORE mean field update - awthl, awqt, & ! output - diagnosed fluxes BEFORE mean field update - awql, awqi, & ! output - diagnosed fluxes BEFORE mean field update - awu, awv, & ! output - diagnosed fluxes BEFORE mean field update - thlflx, qtflx ) ! output - variables needed for solver - - ! ================================================================================= ! - ! Mass-flux algorithm ! - ! ! - ! Provides rtm and thl fluxes due to mass flux ensemble, ! - ! which are fed into the mixed explicit/implicit clubb solver as explicit terms ! - ! ! - ! Variables needed for solver ! - ! ae = sum_i (1-a_i) ! - ! aw3 = sum (a_i w_i) ! - ! aws3 = sum (a_i w_i*s_i); s=thl*cp ! - ! aws3,awqv3,awql3,awqi3,awu3,awv3 similar as above except for different variables ! - ! ! - ! Mass flux variables are computed on edges (i.e. momentum grid): ! - ! upa,upw,upqt,... ! - ! dry_a,moist_a,dry_w,moist_w, ... ! - ! ! - ! In CLUBB (unlike CAM) nlevs of momentum grid = nlevs of thermodynamic grid, ! - ! due to a subsurface thermodynamic layer. To avoid confusion, below the variables ! - ! are grouped by the grid they are on. ! - ! ! - ! *note that state on the lowest thermo level is equal to state on the lowest ! - ! momentum level due to state_zt(1) = state_zt(2), and lowest momentum level ! - ! is a weighted combination of the lowest two thermodynamic levels. ! - ! ! - ! ---------------------------------Authors---------------------------------------- ! - ! Marcin Kurowski, JPL ! - ! Modified heavily by Mikael Witte, UCLA/JPL for implementation in CESM2/E3SM ! - ! Additional modifications by Adam Herrington, NCAR ! - ! ================================================================================= ! - - use physconst, only: rair, cpair, gravit, latvap, latice, zvir - - integer, intent(in) :: nz - real(r8), dimension(nz), intent(in) :: u, v, & ! thermodynamic grid - thl, thv, & ! thermodynamic grid - qt, & ! thermodynamic grid - dzt, & ! thermodynamic grid - p_zt, iexner_zt, & ! thermodynamic grid - thl_zm, & ! momentum grid - qt_zm, & ! momentum grid - zm, & ! momentum grid - p_zm, iexner_zm ! momentum grid - - real(r8), intent(in) :: wthl,wqt - real(r8), intent(inout) :: pblh - - real(r8),dimension(nz), intent(out) :: dry_a, moist_a, & ! momentum grid - dry_w, moist_w, & ! momentum grid - dry_qt, moist_qt, & ! momentum grid - dry_thl, moist_thl, & ! momentum grid - dry_u, moist_u, & ! momentum grid - dry_v, moist_v, & ! momentum grid - moist_qc, & ! momentum grid - ae, aw, & ! momentum grid - awthl, awqt, & ! momentum grid - awql, awqi, & ! momentum grid - awu, awv, & ! momentum grid - thlflx, qtflx ! momentum grid - - ! =============================================================================== ! - ! INTERNAL VARIABLES - ! - ! sums over all plumes - real(r8), dimension(nz) :: moist_th, dry_th, & ! momentum grid - awqv, awth ! momentum grid - ! - ! updraft properties - real(r8), dimension(nz,clubb_mf_nup) :: upw, upa, & ! momentum grid - upqt, upqc, & ! momentum grid - upqv, upqs, & ! momentum grid - upql, upqi, & ! momentum grid - upth, upthv, & ! momentum grid - upthl, & ! momentum grid - upu, upv ! momentum grid - ! - ! entrainment profiles - real(r8), dimension(nz,clubb_mf_nup) :: ent, entf ! thermodynamic grid - integer, dimension(nz,clubb_mf_nup) :: enti ! thermodynamic grid - ! - ! other variables - integer :: k,i,ih - real(r8), dimension(clubb_mf_nup) :: zcb - real(r8) :: zcb_unset, & - wthv, & - wstar, qstar, thvstar, & - sigmaw, sigmaqt, sigmathv,& - wmin, wmax, & - wlv, wtv, wp, & - B, & ! thermodynamic grid - entexp, entexpu, entw, & ! thermodynamic grid - thln, thvn, thn, & ! momentum grid - qtn, qsn, & ! momentum grid - qcn, qln, qin, & ! momentum grid - un, vn, wn2, & ! momentum grid - lmixn, & ! momentum grid - supqt, supthl ! thermodynamic grid - ! - ! parameters defining initial conditions for updrafts - real(r8),parameter :: pwmin = 1.5_r8, & - pwmax = 3._r8 - - ! - ! alpha, z-scores after Suselj etal 2019 - real(r8),parameter :: alphw = 0.572_r8, & - alphqt = 2.890_r8, & - alphthv = 2.890_r8 - ! - ! w' covariance after Suselj etal 2019 - real(r8),parameter :: cwqt = 0.32_r8, & - cwthv = 0.58_r8 - ! - ! virtual mass coefficients for w-eqn after Suselj etal 2019 - real(r8),parameter :: wa = 1.0_r8, & - wb = 1.5_r8 - ! - ! min values to avoid singularities - real(r8),parameter :: wstarmin = 1.e-3_r8, & - pblhmin = 100._r8 - ! - ! to condensate or not to condensate - logical :: do_condensation = .true. - ! - ! to precip or not to precip - logical :: do_precip = .false. - ! - ! to debug flag (overides stochastic entrainment) - logical :: debug = .false. - real(r8),parameter :: fixent = 0.004_r8 - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! INITIALIZE OUTPUT VARIABLES - ! set updraft properties to zero - dry_a = 0._r8 - moist_a = 0._r8 - dry_w = 0._r8 - moist_w = 0._r8 - dry_qt = 0._r8 - moist_qt = 0._r8 - dry_thl = 0._r8 - moist_thl = 0._r8 - dry_u = 0._r8 - moist_u = 0._r8 - dry_v = 0._r8 - moist_v = 0._r8 - moist_qc = 0._r8 - ! outputs - variables needed for solver - aw = 0._r8 - awthl = 0._r8 - awqt = 0._r8 - awqv = 0._r8 - awql = 0._r8 - awqi = 0._r8 - awu = 0._r8 - awv = 0._r8 - thlflx = 0._r8 - qtflx = 0._r8 - - ent = 0._r8 - entf = 0._r8 - enti = 0 - - ! this is the environmental area - by default 1. - ae = 1._r8 - - ! START MAIN COMPUTATION - upw = 0._r8 - upthl = 0._r8 - upthv = 0._r8 - upqt = 0._r8 - upa = 0._r8 - upu = 0._r8 - upv = 0._r8 - upqc = 0._r8 - upth = 0._r8 - upql = 0._r8 - upqi = 0._r8 - upqv = 0._r8 - upqs = 0._r8 - - ! unique identifier - zcb_unset = 9999999._r8 - zcb = zcb_unset - - pblh = max(pblh,pblhmin) - wthv = wthl+zvir*thv(1)*wqt - - ! if surface buoyancy is positive then do mass-flux - if ( wthv > 0._r8 ) then - - if (debug) then - ! overide stochastic entrainment with fixent - ent(:,:) = fixent - else - - ! get entrainment coefficient, dz/L0 - do i=1,clubb_mf_nup - do k=1,nz - entf(k,i) = dzt(k) / clubb_mf_L0 + + call mpi_bcast(clubb_mf_L0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_L0") + call mpi_bcast(clubb_mf_ent0, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_ent0") + call mpi_bcast(clubb_mf_nup, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mf_nup") + call mpi_bcast(do_clubb_mf, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf") + call mpi_bcast(do_clubb_mf_diag, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_clubb_mf_diag") + + if ((.not. do_clubb_mf) .and. do_clubb_mf_diag ) then + call endrun('clubb_mf_readnl: Error - cannot turn on do_clubb_mf_diag without also turning on do_clubb_mf') + end if + + + end subroutine clubb_mf_readnl + + subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, & ! input + p_zt, iexner_zt, & ! input + u, v, thl, qt, thv, & ! input + thl_zm, qt_zm, & ! input + wthl, wqt, pblh, & ! input + dry_a, moist_a, & ! output - plume diagnostics + dry_w, moist_w, & ! output - plume diagnostics + dry_qt, moist_qt, & ! output - plume diagnostics + dry_thl, moist_thl, & ! output - plume diagnostics + dry_u, moist_u, & ! output - plume diagnostics + dry_v, moist_v, & ! output - plume diagnostics + moist_qc, & ! output - plume diagnostics + ae, aw, & ! output - diagnosed fluxes BEFORE mean field update + awthl, awqt, & ! output - diagnosed fluxes BEFORE mean field update + awql, awqi, & ! output - diagnosed fluxes BEFORE mean field update + awu, awv, & ! output - diagnosed fluxes BEFORE mean field update + thlflx, qtflx ) ! output - variables needed for solver + + ! ================================================================================= ! + ! Mass-flux algorithm ! + ! ! + ! Provides rtm and thl fluxes due to mass flux ensemble, ! + ! which are fed into the mixed explicit/implicit clubb solver as explicit terms ! + ! ! + ! Variables needed for solver ! + ! ae = sum_i (1-a_i) ! + ! aw3 = sum (a_i w_i) ! + ! aws3 = sum (a_i w_i*s_i); s=thl*cp ! + ! aws3,awqv3,awql3,awqi3,awu3,awv3 similar as above except for different variables ! + ! ! + ! Mass flux variables are computed on edges (i.e. momentum grid): ! + ! upa,upw,upqt,... ! + ! dry_a,moist_a,dry_w,moist_w, ... ! + ! ! + ! In CLUBB (unlike CAM) nlevs of momentum grid = nlevs of thermodynamic grid, ! + ! due to a subsurface thermodynamic layer. To avoid confusion, below the variables ! + ! are grouped by the grid they are on. ! + ! ! + ! *note that state on the lowest thermo level is equal to state on the lowest ! + ! momentum level due to state_zt(1) = state_zt(2), and lowest momentum level ! + ! is a weighted combination of the lowest two thermodynamic levels. ! + ! ! + ! ---------------------------------Authors---------------------------------------- ! + ! Marcin Kurowski, JPL ! + ! Modified heavily by Mikael Witte, UCLA/JPL for implementation in CESM2/E3SM ! + ! Additional modifications by Adam Herrington, NCAR ! + ! ================================================================================= ! + + use physconst, only: rair, cpair, gravit, latvap, latice, zvir + + integer, intent(in) :: nzm, nzt + real(r8), dimension(nzt), intent(in) :: u, v, & ! thermodynamic grid + thl, thv, & ! thermodynamic grid + qt, & ! thermodynamic grid + dzt, & ! thermodynamic grid + p_zt, iexner_zt ! thermodynamic grid + + real(r8), dimension(nzm), intent(in) :: thl_zm, & ! momentum grid + qt_zm, & ! momentum grid + zm, & ! momentum grid + p_zm, iexner_zm ! momentum grid + + real(r8), intent(in) :: wthl,wqt + real(r8), intent(inout) :: pblh + + real(r8),dimension(nzm), intent(out) :: dry_a, moist_a, & ! momentum grid + dry_w, moist_w, & ! momentum grid + dry_qt, moist_qt, & ! momentum grid + dry_thl, moist_thl, & ! momentum grid + dry_u, moist_u, & ! momentum grid + dry_v, moist_v, & ! momentum grid + moist_qc, & ! momentum grid + ae, aw, & ! momentum grid + awthl, awqt, & ! momentum grid + awql, awqi, & ! momentum grid + awu, awv, & ! momentum grid + thlflx, qtflx ! momentum grid + + ! =============================================================================== ! + ! INTERNAL VARIABLES + ! + ! sums over all plumes + real(r8), dimension(nzm) :: moist_th, dry_th, & ! momentum grid + awqv, awth ! momentum grid + ! + ! updraft properties + real(r8), dimension(nzm,clubb_mf_nup) :: upw, upa, & ! momentum grid + upqt, upqc, & ! momentum grid + upqv, upqs, & ! momentum grid + upql, upqi, & ! momentum grid + upth, upthv, & ! momentum grid + upthl, & ! momentum grid + upu, upv ! momentum grid + ! + ! entrainment profiles + real(r8), dimension(nzt,clubb_mf_nup) :: ent, entf ! thermodynamic grid + integer, dimension(nzt,clubb_mf_nup) :: enti ! thermodynamic grid + ! + ! other variables + integer :: k,i,ih + real(r8), dimension(clubb_mf_nup) :: zcb + real(r8) :: zcb_unset, & + wthv, & + wstar, qstar, thvstar, & + sigmaw, sigmaqt, sigmathv,& + wmin, wmax, & + wlv, wtv, wp, & + B, & ! thermodynamic grid + entexp, entexpu, entw, & ! thermodynamic grid + thln, thvn, thn, & ! momentum grid + qtn, qsn, & ! momentum grid + qcn, qln, qin, & ! momentum grid + un, vn, wn2, & ! momentum grid + lmixn, & ! momentum grid + supqt, supthl ! thermodynamic grid + ! + ! parameters defining initial conditions for updrafts + real(r8),parameter :: pwmin = 1.5_r8, & + pwmax = 3._r8 + + ! + ! alpha, z-scores after Suselj etal 2019 + real(r8),parameter :: alphw = 0.572_r8, & + alphqt = 2.890_r8, & + alphthv = 2.890_r8 + ! + ! w' covariance after Suselj etal 2019 + real(r8),parameter :: cwqt = 0.32_r8, & + cwthv = 0.58_r8 + ! + ! virtual mass coefficients for w-eqn after Suselj etal 2019 + real(r8),parameter :: wa = 1.0_r8, & + wb = 1.5_r8 + ! + ! min values to avoid singularities + real(r8),parameter :: wstarmin = 1.e-3_r8, & + pblhmin = 100._r8 + ! + ! to condensate or not to condensate + logical :: do_condensation = .true. + ! + ! to precip or not to precip + logical :: do_precip = .false. + ! + ! to debug flag (overides stochastic entrainment) + logical :: debug = .false. + real(r8),parameter :: fixent = 0.004_r8 + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!! BEGIN CODE !!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! INITIALIZE OUTPUT VARIABLES + ! set updraft properties to zero + dry_a = 0._r8 + moist_a = 0._r8 + dry_w = 0._r8 + moist_w = 0._r8 + dry_qt = 0._r8 + moist_qt = 0._r8 + dry_thl = 0._r8 + moist_thl = 0._r8 + dry_u = 0._r8 + moist_u = 0._r8 + dry_v = 0._r8 + moist_v = 0._r8 + moist_qc = 0._r8 + ! outputs - variables needed for solver + aw = 0._r8 + awthl = 0._r8 + awqt = 0._r8 + awqv = 0._r8 + awql = 0._r8 + awqi = 0._r8 + awu = 0._r8 + awv = 0._r8 + thlflx = 0._r8 + qtflx = 0._r8 + + ent = 0._r8 + entf = 0._r8 + enti = 0 + + ! this is the environmental area - by default 1. + ae = 1._r8 + + ! START MAIN COMPUTATION + upw = 0._r8 + upthl = 0._r8 + upthv = 0._r8 + upqt = 0._r8 + upa = 0._r8 + upu = 0._r8 + upv = 0._r8 + upqc = 0._r8 + upth = 0._r8 + upql = 0._r8 + upqi = 0._r8 + upqv = 0._r8 + upqs = 0._r8 + + ! unique identifier + zcb_unset = 9999999._r8 + zcb = zcb_unset + + pblh = max(pblh,pblhmin) + wthv = wthl+zvir*thv(1)*wqt + + ! if surface buoyancy is positive then do mass-flux + if ( wthv > 0._r8 ) then + + if (debug) then + ! overide stochastic entrainment with fixent + ent(:,:) = fixent + else + + ! get entrainment coefficient, dz/L0 + do i=1,clubb_mf_nup + do k=1,nzt + entf(k,i) = dzt(k) / clubb_mf_L0 + enddo enddo - enddo - - ! get poisson, P(dz/L0) - call poisson( nz, clubb_mf_nup, entf, enti, u(2:5)) - - ! get entrainment, ent=ent0/dz*P(dz/L0) - do i=1,clubb_mf_nup - do k=1,nz - ent(k,i) = real( enti(k,i))*clubb_mf_ent0/dzt(k) + + ! get poisson, P(dz/L0) + call poisson( nzt, clubb_mf_nup, entf, enti, u(1:4)) + + ! get entrainment, ent=ent0/dz*P(dz/L0) + do i=1,clubb_mf_nup + do k=1,nzt + ent(k,i) = real( enti(k,i))*clubb_mf_ent0/dzt(k) + enddo enddo - enddo - - end if - - ! get surface conditions - wstar = max( wstarmin, (gravit/thv(1)*wthv*pblh)**(1._r8/3._r8) ) - qstar = wqt / wstar - thvstar = wthv / wstar - - sigmaw = alphw * wstar - sigmaqt = alphqt * abs(qstar) - sigmathv = alphthv * abs(thvstar) - - wmin = sigmaw * pwmin - wmax = sigmaw * pwmax - - do i=1,clubb_mf_nup - - wlv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * (real(i-1, r8)) - wtv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * real(i,r8) - - upw(1,i) = 0.5_r8 * (wlv+wtv) - upa(1,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & - - 0.5_r8 * erf( wlv/(sqrt(2._r8)*sigmaw) ) - - upu(1,i) = u(1) - upv(1,i) = v(1) - - upqt(1,i) = qt(1) + cwqt * upw(1,i) * sigmaqt/sigmaw - upthv(1,i) = thv(1) + cwthv * upw(1,i) * sigmathv/sigmaw - upthl(1,i) = upthv(1,i) / (1._r8+zvir*upqt(1,i)) - - ! get cloud, lowest momentum level - if (do_condensation) then - call condensation_mf(upqt(1,i), upthl(1,i), p_zm(1), iexner_zm(1), & - thvn, qcn, thn, qln, qin, qsn, lmixn) - upthv(1,i) = thvn - upqc(1,i) = qcn - upql(1,i) = qln - upqi(1,i) = qin - upqs(1,i) = qsn - if (qcn > 0._r8) zcb(i) = zm(1) - else - ! assume no cldliq - upqc(1,i) = 0._r8 + end if - - enddo - - ! get updraft properties - do i=1,clubb_mf_nup - do k=1,nz-1 - - ! get microphysics, autoconversion - if (do_precip .and. upqc(k,i) > 0._r8) then - call precip_mf(upqs(k,i),upqt(k,i),upw(k,i),dzt(k+1),zm(k+1)-zcb(i),supqt) - - supthl = -1._r8*lmixn*supqt*iexner_zt(k+1)/cpair - else - supqt = 0._r8 - supthl = 0._r8 - end if - - ! integrate updraft - entexp = exp(-ent(k+1,i)*dzt(k+1)) - entexpu = exp(-ent(k+1,i)*dzt(k+1)/3._r8) - - qtn = qt(k+1) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt - thln = thl(k+1)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl - un = u(k+1) *(1._r8-entexpu) + upu (k,i)*entexpu - vn = v(k+1) *(1._r8-entexpu) + upv (k,i)*entexpu - - ! get cloud, momentum levels + + ! get surface conditions + wstar = max( wstarmin, (gravit/thv(1)*wthv*pblh)**(1._r8/3._r8) ) + qstar = wqt / wstar + thvstar = wthv / wstar + + sigmaw = alphw * wstar + sigmaqt = alphqt * abs(qstar) + sigmathv = alphthv * abs(thvstar) + + wmin = sigmaw * pwmin + wmax = sigmaw * pwmax + + do i=1,clubb_mf_nup + + wlv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * (real(i-1, r8)) + wtv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * real(i,r8) + + upw(1,i) = 0.5_r8 * (wlv+wtv) + upa(1,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & + - 0.5_r8 * erf( wlv/(sqrt(2._r8)*sigmaw) ) + + upu(1,i) = u(1) + upv(1,i) = v(1) + + upqt(1,i) = qt(1) + cwqt * upw(1,i) * sigmaqt/sigmaw + upthv(1,i) = thv(1) + cwthv * upw(1,i) * sigmathv/sigmaw + upthl(1,i) = upthv(1,i) / (1._r8+zvir*upqt(1,i)) + + ! get cloud, lowest momentum level if (do_condensation) then - call condensation_mf(qtn, thln, p_zm(k+1), iexner_zm(k+1), & + call condensation_mf(upqt(1,i), upthl(1,i), p_zm(1), iexner_zm(1), & thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(k+1) - else - thvn = thln*(1._r8+zvir*qtn) - end if - - ! get buoyancy - B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(k+1)-1._r8) - if (debug) then - if ( masterproc ) then - write(iulog,*) "B(k,i), k, i ", B, k, i - end if - end if - - ! get wn^2 - wp = wb*ent(k+1,i) - if (wp==0._r8) then - wn2 = upw(k,i)**2._r8+2._r8*wa*B*dzt(k+1) - else - entw = exp(-2._r8*wp*dzt(k+1)) - wn2 = entw*upw(k,i)**2._r8+wa*B/(wb*ent(k+1,i))*(1._r8-entw) - end if - - if (wn2>0._r8) then - upw(k+1,i) = sqrt(wn2) - upthv(k+1,i) = thvn - upthl(k+1,i) = thln - upqt(k+1,i) = qtn - upqc(k+1,i) = qcn - upqs(k+1,i) = qsn - upu(k+1,i) = un - upv(k+1,i) = vn - upa(k+1,i) = upa(k,i) - upql(k+1,i) = qln - upqi(k+1,i) = qin - upqv(k+1,i) = qtn - qcn + upthv(1,i) = thvn + upqc(1,i) = qcn + upql(1,i) = qln + upqi(1,i) = qin + upqs(1,i) = qsn + if (qcn > 0._r8) zcb(i) = zm(1) else - exit + ! assume no cldliq + upqc(1,i) = 0._r8 end if + enddo - enddo - - ! writing updraft properties for output - do k=1,nz - - ! first sum over all i-updrafts + + ! get updraft properties do i=1,clubb_mf_nup - if (upqc(k,i)>0._r8) then - moist_a(k) = moist_a(k) + upa(k,i) - moist_w(k) = moist_w(k) + upa(k,i)*upw(k,i) - moist_qt(k) = moist_qt(k) + upa(k,i)*upqt(k,i) - moist_thl(k) = moist_thl(k) + upa(k,i)*upthl(k,i) - moist_u(k) = moist_u(k) + upa(k,i)*upu(k,i) - moist_v(k) = moist_v(k) + upa(k,i)*upv(k,i) - moist_qc(k) = moist_qc(k) + upa(k,i)*upqc(k,i) + do k=1,nzm-1 + + ! get microphysics, autoconversion + if (do_precip .and. upqc(k,i) > 0._r8) then + call precip_mf(upqs(k,i),upqt(k,i),upw(k,i),dzt(k),zm(k+1)-zcb(i),supqt) + + supthl = -1._r8*lmixn*supqt*iexner_zt(k)/cpair + else + supqt = 0._r8 + supthl = 0._r8 + end if + + ! integrate updraft + entexp = exp(-ent(k,i)*dzt(k)) + entexpu = exp(-ent(k,i)*dzt(k)/3._r8) + + qtn = qt(k) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt + thln = thl(k)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl + un = u(k) *(1._r8-entexpu) + upu (k,i)*entexpu + vn = v(k) *(1._r8-entexpu) + upv (k,i)*entexpu + + ! get cloud, momentum levels + if (do_condensation) then + call condensation_mf(qtn, thln, p_zm(k+1), iexner_zm(k+1), & + thvn, qcn, thn, qln, qin, qsn, lmixn) + if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(k+1) + else + thvn = thln*(1._r8+zvir*qtn) + end if + + ! get buoyancy + B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(k)-1._r8) + if (debug) then + if ( masterproc ) then + write(iulog,*) "B(k,i), k, i ", B, k, i + end if + end if + + ! get wn^2 + wp = wb*ent(k,i) + if (wp==0._r8) then + wn2 = upw(k,i)**2._r8+2._r8*wa*B*dzt(k) + else + entw = exp(-2._r8*wp*dzt(k)) + wn2 = entw*upw(k,i)**2._r8+wa*B/(wb*ent(k,i))*(1._r8-entw) + end if + + if (wn2>0._r8) then + upw(k+1,i) = sqrt(wn2) + upthv(k+1,i) = thvn + upthl(k+1,i) = thln + upqt(k+1,i) = qtn + upqc(k+1,i) = qcn + upqs(k+1,i) = qsn + upu(k+1,i) = un + upv(k+1,i) = vn + upa(k+1,i) = upa(k,i) + upql(k+1,i) = qln + upqi(k+1,i) = qin + upqv(k+1,i) = qtn - qcn + else + exit + end if + enddo + enddo + + ! writing updraft properties for output + do k=1,nzm + + ! first sum over all i-updrafts + do i=1,clubb_mf_nup + if (upqc(k,i)>0._r8) then + moist_a(k) = moist_a(k) + upa(k,i) + moist_w(k) = moist_w(k) + upa(k,i)*upw(k,i) + moist_qt(k) = moist_qt(k) + upa(k,i)*upqt(k,i) + moist_thl(k) = moist_thl(k) + upa(k,i)*upthl(k,i) + moist_u(k) = moist_u(k) + upa(k,i)*upu(k,i) + moist_v(k) = moist_v(k) + upa(k,i)*upv(k,i) + moist_qc(k) = moist_qc(k) + upa(k,i)*upqc(k,i) + else + dry_a(k) = dry_a(k) + upa(k,i) + dry_w(k) = dry_w(k) + upa(k,i)*upw(k,i) + dry_qt(k) = dry_qt(k) + upa(k,i)*upqt(k,i) + dry_thl(k) = dry_thl(k) + upa(k,i)*upthl(k,i) + dry_u(k) = dry_u(k) + upa(k,i)*upu(k,i) + dry_v(k) = dry_v(k) + upa(k,i)*upv(k,i) + endif + enddo + + if ( dry_a(k) > 0._r8 ) then + dry_w(k) = dry_w(k) / dry_a(k) + dry_qt(k) = dry_qt(k) / dry_a(k) + dry_thl(k) = dry_thl(k) / dry_a(k) + dry_u(k) = dry_u(k) / dry_a(k) + dry_v(k) = dry_v(k) / dry_a(k) + else + dry_w(k) = 0._r8 + dry_qt(k) = 0._r8 + dry_thl(k) = 0._r8 + dry_u(k) = 0._r8 + dry_v(k) = 0._r8 + endif + + if ( moist_a(k) > 0._r8 ) then + moist_w(k) = moist_w(k) / moist_a(k) + moist_qt(k) = moist_qt(k) / moist_a(k) + moist_thl(k) = moist_thl(k) / moist_a(k) + moist_u(k) = moist_u(k) / moist_a(k) + moist_v(k) = moist_v(k) / moist_a(k) + moist_qc(k) = moist_qc(k) / moist_a(k) else - dry_a(k) = dry_a(k) + upa(k,i) - dry_w(k) = dry_w(k) + upa(k,i)*upw(k,i) - dry_qt(k) = dry_qt(k) + upa(k,i)*upqt(k,i) - dry_thl(k) = dry_thl(k) + upa(k,i)*upthl(k,i) - dry_u(k) = dry_u(k) + upa(k,i)*upu(k,i) - dry_v(k) = dry_v(k) + upa(k,i)*upv(k,i) + moist_w(k) = 0._r8 + moist_qt(k) = 0._r8 + moist_thl(k) = 0._r8 + moist_u(k) = 0._r8 + moist_v(k) = 0._r8 + moist_qc(k) = 0._r8 endif + enddo - - if ( dry_a(k) > 0._r8 ) then - dry_w(k) = dry_w(k) / dry_a(k) - dry_qt(k) = dry_qt(k) / dry_a(k) - dry_thl(k) = dry_thl(k) / dry_a(k) - dry_u(k) = dry_u(k) / dry_a(k) - dry_v(k) = dry_v(k) / dry_a(k) - else - dry_w(k) = 0._r8 - dry_qt(k) = 0._r8 - dry_thl(k) = 0._r8 - dry_u(k) = 0._r8 - dry_v(k) = 0._r8 - endif - - if ( moist_a(k) > 0._r8 ) then - moist_w(k) = moist_w(k) / moist_a(k) - moist_qt(k) = moist_qt(k) / moist_a(k) - moist_thl(k) = moist_thl(k) / moist_a(k) - moist_u(k) = moist_u(k) / moist_a(k) - moist_v(k) = moist_v(k) / moist_a(k) - moist_qc(k) = moist_qc(k) / moist_a(k) - else - moist_w(k) = 0._r8 - moist_qt(k) = 0._r8 - moist_thl(k) = 0._r8 - moist_u(k) = 0._r8 - moist_v(k) = 0._r8 - moist_qc(k) = 0._r8 - endif - - enddo - - do k=1,nz - do i=1,clubb_mf_nup - ae (k) = ae (k) - upa(k,i) - aw (k) = aw (k) + upa(k,i)*upw(k,i) - awu (k) = awu (k) + upa(k,i)*upw(k,i)*upu(k,i) - awv (k) = awv (k) + upa(k,i)*upw(k,i)*upv(k,i) - awthl(k)= awthl(k)+ upa(k,i)*upw(k,i)*upthl(k,i) - awqt(k) = awqt(k) + upa(k,i)*upw(k,i)*upqt(k,i) - awqv(k) = awqv(k) + upa(k,i)*upw(k,i)*upqv(k,i) - awql(k) = awql(k) + upa(k,i)*upw(k,i)*upql(k,i) - awqi(k) = awqi(k) + upa(k,i)*upw(k,i)*upqi(k,i) + + do k=1,nzm + do i=1,clubb_mf_nup + ae (k) = ae (k) - upa(k,i) + aw (k) = aw (k) + upa(k,i)*upw(k,i) + awu (k) = awu (k) + upa(k,i)*upw(k,i)*upu(k,i) + awv (k) = awv (k) + upa(k,i)*upw(k,i)*upv(k,i) + awthl(k)= awthl(k)+ upa(k,i)*upw(k,i)*upthl(k,i) + awqt(k) = awqt(k) + upa(k,i)*upw(k,i)*upqt(k,i) + awqv(k) = awqv(k) + upa(k,i)*upw(k,i)*upqv(k,i) + awql(k) = awql(k) + upa(k,i)*upw(k,i)*upql(k,i) + awqi(k) = awqi(k) + upa(k,i)*upw(k,i)*upqi(k,i) + enddo enddo + + do k=1,nzm + thlflx(k)= awthl(k) - aw(k)*thl_zm(k) + qtflx(k)= awqt(k) - aw(k)*qt_zm(k) + enddo + + end if ! ( wthv > 0.0 ) + + end subroutine integrate_mf + + subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) + ! =============================================================================== ! + ! zero or one condensation for edmf: calculates thv and qc ! + ! =============================================================================== ! + use physconst, only: cpair, zvir, h2otrip + use wv_saturation, only : qsat + + real(r8),intent(in) :: qt,thl,p,iex + real(r8),intent(out):: thv,qc,th,ql,qi,qs,lmix + + !local variables + integer :: niter,i + real(r8) :: diff,t,qstmp,qcold,es,wf + + ! max number of iterations + niter=50 + ! minimum difference + diff=2.e-5_r8 + + qc=0._r8 + t=thl/iex + + !by definition: + ! T = Th*Exner, Exner=(p/p0)^(R/cp) (1) + ! Thl = Th - L/cp*ql/Exner (2) + !so: + ! Th = Thl + L/cp*ql/Exner (3) + ! T = Th*Exner=(Thl+L/cp*ql/Exner)*Exner (4) + ! = Thl*Exner + L/cp*ql + do i=1,niter + wf = get_watf(t) + t = thl/iex+get_alhl(wf)/cpair*qc !as in (4) + + ! qsat, p is in pascal (check!) + call qsat(t,p,es,qstmp) + qcold = qc + qc = max(0.5_r8*qc+0.5_r8*(qt-qstmp),0._r8) + if (abs(qc-qcold) 0.0 ) - - end subroutine integrate_mf - - subroutine condensation_mf( qt, thl, p, iex, thv, qc, th, ql, qi, qs, lmix ) - ! =============================================================================== ! - ! zero or one condensation for edmf: calculates thv and qc ! - ! =============================================================================== ! - use physconst, only: cpair, zvir, h2otrip - use wv_saturation, only : qsat - - real(r8),intent(in) :: qt,thl,p,iex - real(r8),intent(out):: thv,qc,th,ql,qi,qs,lmix - - !local variables - integer :: niter,i - real(r8) :: diff,t,qstmp,qcold,es,wf - - ! max number of iterations - niter=50 - ! minimum difference - diff=2.e-5_r8 - - qc=0._r8 - t=thl/iex - - !by definition: - ! T = Th*Exner, Exner=(p/p0)^(R/cp) (1) - ! Thl = Th - L/cp*ql/Exner (2) - !so: - ! Th = Thl + L/cp*ql/Exner (3) - ! T = Th*Exner=(Thl+L/cp*ql/Exner)*Exner (4) - ! = Thl*Exner + L/cp*ql - do i=1,niter + wf = get_watf(t) - t = thl/iex+get_alhl(wf)/cpair*qc !as in (4) - - ! qsat, p is in pascal (check!) - call qsat(t,p,es,qstmp) - qcold = qc - qc = max(0.5_r8*qc+0.5_r8*(qt-qstmp),0._r8) - if (abs(qc-qcold)tmax) then - get_watf=1._r8 - else if (tc qstar) then - ! get precip efficiency - tauwgt = (dzcld-zmin)/(zmax-zmin) - tauwgt = min(max(tauwgt,0._r8),1._r8) - tau = tauwgt/tau0 - - ! get source for updraft - Supqt = (qstar-qt)*(1._r8 - exp(-1._r8*tau*dz/w)) - else - Supqt = 0._r8 - end if - - end subroutine precip_mf - - subroutine poisson(nz,nup,lambda,poi,state) - !********************************************************************** - ! Set a unique (but reproduceble) seed for the kiss RNG - ! Call Poisson deviate - ! By Adam Herrington - !********************************************************************** - use shr_RandNum_mod, only: ShrKissRandGen - - integer, intent(in) :: nz,nup - real(r8), dimension(4), intent(in) :: state - real(r8), dimension(nz,nup), intent(in) :: lambda - integer, dimension(nz,nup), intent(out) :: poi - integer, dimension(1,4) :: tmpseed - integer :: i,j - type(ShrKissRandGen) :: kiss_gen - - ! Compute seed - tmpseed(1,1) = int((state(1) - int(state(1))) * 1000000000._r8) - tmpseed(1,2) = int((state(2) - int(state(2))) * 1000000000._r8) - tmpseed(1,3) = int((state(3) - int(state(3))) * 1000000000._r8) - tmpseed(1,4) = int((state(4) - int(state(4))) * 1000000000._r8) - - ! Set seed - kiss_gen = ShrKissRandGen(tmpseed) - - do i=1,nz - do j=1,nup - call knuth(kiss_gen,lambda(i,j),poi(i,j)) + t = thl/iex+get_alhl(wf)/cpair*qc + + call qsat(t,p,es,qs) + qc = max(qt-qs,0._r8) + thv = (thl+get_alhl(wf)/cpair*iex*qc)*(1._r8+zvir*(qt-qc)-qc) + lmix = get_alhl(wf) + th = t*iex + qi = qc*(1._r8-wf) + ql = qc*wf + + contains + + function get_watf(t) + real(r8) :: t,get_watf,tc + real(r8), parameter :: & + tmax=-10._r8, & + tmin=-40._r8 + + tc=t-h2otrip + + if (tc>tmax) then + get_watf=1._r8 + else if (tc qstar) then + ! get precip efficiency + tauwgt = (dzcld-zmin)/(zmax-zmin) + tauwgt = min(max(tauwgt,0._r8),1._r8) + tau = tauwgt/tau0 + + ! get source for updraft + Supqt = (qstar-qt)*(1._r8 - exp(-1._r8*tau*dz/w)) + else + Supqt = 0._r8 + end if + + end subroutine precip_mf + + subroutine poisson(nz,nup,lambda,poi,state) + !********************************************************************** + ! Set a unique (but reproduceble) seed for the kiss RNG + ! Call Poisson deviate + ! By Adam Herrington + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + integer, intent(in) :: nz,nup + real(r8), dimension(4), intent(in) :: state + real(r8), dimension(nz,nup), intent(in) :: lambda + integer, dimension(nz,nup), intent(out) :: poi + integer, dimension(1,4) :: tmpseed + integer :: i,j + type(ShrKissRandGen) :: kiss_gen + + ! Compute seed + tmpseed(1,1) = int((state(1) - int(state(1))) * 1000000000._r8) + tmpseed(1,2) = int((state(2) - int(state(2))) * 1000000000._r8) + tmpseed(1,3) = int((state(3) - int(state(3))) * 1000000000._r8) + tmpseed(1,4) = int((state(4) - int(state(4))) * 1000000000._r8) + + ! Set seed + kiss_gen = ShrKissRandGen(tmpseed) + + do i=1,nz + do j=1,nup + call knuth(kiss_gen,lambda(i,j),poi(i,j)) + enddo enddo - enddo - - end subroutine poisson - - subroutine knuth(kiss_gen,lambda,kout) - !********************************************************************** - ! Discrete random poisson from Knuth - ! The Art of Computer Programming, v2, 137-138 - ! By Adam Herrington - !********************************************************************** - use shr_RandNum_mod, only: ShrKissRandGen - - type(ShrKissRandGen), intent(inout) :: kiss_gen - real(r8), intent(in) :: lambda - integer, intent(out) :: kout - - ! Local variables - real(r8), dimension(1,1) :: tmpuni - real(r8) :: puni, explam - integer :: k - - k = 0 - explam = exp(-1._r8*lambda) - puni = 1._r8 - do while (puni > explam) - k = k + 1 - call kiss_gen%random(tmpuni) - puni = puni*tmpuni(1,1) - end do - kout = k - 1 - - end subroutine knuth - -end module clubb_mf + + end subroutine poisson + + subroutine knuth(kiss_gen,lambda,kout) + !********************************************************************** + ! Discrete random poisson from Knuth + ! The Art of Computer Programming, v2, 137-138 + ! By Adam Herrington + !********************************************************************** + use shr_RandNum_mod, only: ShrKissRandGen + + type(ShrKissRandGen), intent(inout) :: kiss_gen + real(r8), intent(in) :: lambda + integer, intent(out) :: kout + + ! Local variables + real(r8), dimension(1,1) :: tmpuni + real(r8) :: puni, explam + integer :: k + + k = 0 + explam = exp(-1._r8*lambda) + puni = 1._r8 + do while (puni > explam) + k = k + 1 + call kiss_gen%random(tmpuni) + puni = puni*tmpuni(1,1) + end do + kout = k - 1 + + end subroutine knuth + + end module clubb_mf + \ No newline at end of file diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 05653b9f03..5892dc7205 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -1,306 +1,306 @@ module subcol_SILHS - !--------------------------------------------------------------------------- - ! Purpose: - ! - ! Implement a subcolumn scheme based on the Subgrid Importance Latin Hypercube - ! Sampling (SILHS) functionality of the CLUBB moist turbulence parameterization. - ! - !--------------------------------------------------------------------------- - - use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 - use physics_types, only: physics_state, physics_tend, physics_ptend - use ppgrid, only: pcols, psubcols, pver, pverp, begchunk, endchunk - use constituents, only: pcnst, cnst_get_ind - use cam_abortutils, only: endrun - use cam_logfile, only: iulog - use cam_history, only: addfld, add_default, outfld, horiz_only - use ref_pres, only: top_lev => trop_cloud_top_lev + !--------------------------------------------------------------------------- + ! Purpose: + ! + ! Implement a subcolumn scheme based on the Subgrid Importance Latin Hypercube + ! Sampling (SILHS) functionality of the CLUBB moist turbulence parameterization. + ! + !--------------------------------------------------------------------------- + + use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 + use physics_types, only: physics_state, physics_tend, physics_ptend + use ppgrid, only: pcols, psubcols, pver, pverp, begchunk, endchunk + use constituents, only: pcnst, cnst_get_ind + use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use cam_history, only: addfld, add_default, outfld, horiz_only + use ref_pres, only: top_lev => trop_cloud_top_lev #ifdef CLUBB_SGS #ifdef SILHS - use clubb_intr, only: & - clubb_config_flags, & - clubb_params_single_col, & - stats_metadata, & - stats_zt, stats_zm, stats_sfc, & - pdf_params_chnk, & - hm_metadata, & - hydromet_dim, & - pdf_dim - - use clubb_api_module, only: & - hmp2_ip_on_hmm2_ip_slope_type, & - hmp2_ip_on_hmm2_ip_intrcpt_type, & - precipitation_fractions, & - stats, & - core_rknd - - use silhs_api_module, only: & - silhs_config_flags_type + use clubb_intr, only: & + clubb_config_flags, & + clubb_params_single_col, & + stats_metadata, & + stats_zt, stats_zm, stats_sfc, & + pdf_params_chnk, & + hm_metadata, & + hydromet_dim, & + pdf_dim + + use clubb_api_module, only: & + hmp2_ip_on_hmm2_ip_slope_type, & + hmp2_ip_on_hmm2_ip_intrcpt_type, & + precipitation_fractions, & + stats, & + core_rknd + + use silhs_api_module, only: & + silhs_config_flags_type #endif #endif - use physconst, only: cpair, gravit, latvap, latice, rair, rga, cappa - - implicit none - private - save - - public :: subcol_register_SILHS ! - public :: subcol_init_SILHS ! Initialize - public :: subcol_gen_SILHS ! Generate subcolumn fields by calling SILHS - public :: subcol_readnl_SILHS ! SILHS namelist reader - public :: subcol_ptend_avg_SILHS - public :: subcol_SILHS_var_covar_driver - public :: subcol_SILHS_fill_holes_conserv - public :: subcol_SILHS_hydromet_conc_tend_lim - public :: init_state_subcol - private :: fill_holes_sedimentation - private :: fill_holes_same_phase_vert + use physconst, only: cpair, gravit, latvap, latice, rair, rga, cappa + + implicit none + private + save + + public :: subcol_register_SILHS ! + public :: subcol_init_SILHS ! Initialize + public :: subcol_gen_SILHS ! Generate subcolumn fields by calling SILHS + public :: subcol_readnl_SILHS ! SILHS namelist reader + public :: subcol_ptend_avg_SILHS + public :: subcol_SILHS_var_covar_driver + public :: subcol_SILHS_fill_holes_conserv + public :: subcol_SILHS_hydromet_conc_tend_lim + public :: init_state_subcol + private :: fill_holes_sedimentation + private :: fill_holes_same_phase_vert #ifdef SILHS - ! Calc subcol mean ! Calc subcol variance - private :: meansc - private :: stdsc - - type (stats), target :: stats_lh_zt, & - stats_lh_sfc - !$omp threadprivate(stats_lh_zt, stats_lh_sfc) - - real( kind = core_rknd ), dimension(:,:), allocatable :: & - corr_array_n_cloud, & - corr_array_n_below + ! Calc subcol mean ! Calc subcol variance + private :: meansc + private :: stdsc + + type (stats), target :: stats_lh_zt, & + stats_lh_sfc + !$omp threadprivate(stats_lh_zt, stats_lh_sfc) + + real( kind = core_rknd ), dimension(:,:), allocatable :: & + corr_array_n_cloud, & + corr_array_n_below #endif - !----- - ! Private module vars - !----- - - ! constituent indicies - integer :: & - ixq = 0, & - ixcldliq = 0, & - ixnumliq = 0, & - ixcldice = 0, & - ixnumice = 0, & - ixrain = 0, & - ixnumrain= 0, & - ixsnow = 0, & - ixnumsnow= 0 - - ! Pbuf indicies - integer :: thlm_idx, rtm_idx, ice_supersat_idx, & - alst_idx, cld_idx, qrain_idx, qsnow_idx, & - nrain_idx, nsnow_idx, ztodt_idx, tke_idx, kvh_idx, & - prec_pcw_idx, snow_pcw_idx, prec_str_idx, snow_str_idx, & - qcsedten_idx, qrsedten_idx, qisedten_idx, qssedten_idx, & - vtrmc_idx, umr_idx, vtrmi_idx, ums_idx, qcsevap_idx, qisevap_idx - - logical :: subcol_SILHS_weight ! if set, sets up weights for averaging subcolumns for SILHS - integer :: subcol_SILHS_numsubcol ! number of subcolumns for this run - logical :: docldfracscaling = .false. ! Weight tendencies by cloud fraction - - character(len=256) :: subcol_SILHS_corr_file_path - character(len=16) :: subcol_SILHS_corr_file_name - - logical :: subcol_SILHS_q_to_micro, & - subcol_SILHS_n_to_micro, & - subcol_SILHS_use_clear_col, & - subcol_SILHS_meanice, & - subcol_SILHS_constrainmn - - logical :: subcol_SILHS_var_covar_src - - real(r8) :: subcol_SILHS_ncnp2_on_ncnm2 - - ! There may or may not be a better place to put this. - real(r8), parameter :: p0_clubb = 100000._r8 + !----- + ! Private module vars + !----- + + ! constituent indicies + integer :: & + ixq = 0, & + ixcldliq = 0, & + ixnumliq = 0, & + ixcldice = 0, & + ixnumice = 0, & + ixrain = 0, & + ixnumrain= 0, & + ixsnow = 0, & + ixnumsnow= 0 + + ! Pbuf indicies + integer :: thlm_idx, rtm_idx, ice_supersat_idx, & + alst_idx, cld_idx, qrain_idx, qsnow_idx, & + nrain_idx, nsnow_idx, ztodt_idx, tke_idx, kvh_idx, & + prec_pcw_idx, snow_pcw_idx, prec_str_idx, snow_str_idx, & + qcsedten_idx, qrsedten_idx, qisedten_idx, qssedten_idx, & + vtrmc_idx, umr_idx, vtrmi_idx, ums_idx, qcsevap_idx, qisevap_idx + + logical :: subcol_SILHS_weight ! if set, sets up weights for averaging subcolumns for SILHS + integer :: subcol_SILHS_numsubcol ! number of subcolumns for this run + logical :: docldfracscaling = .false. ! Weight tendencies by cloud fraction + + character(len=256) :: subcol_SILHS_corr_file_path + character(len=16) :: subcol_SILHS_corr_file_name + + logical :: subcol_SILHS_q_to_micro, & + subcol_SILHS_n_to_micro, & + subcol_SILHS_use_clear_col, & + subcol_SILHS_meanice, & + subcol_SILHS_constrainmn + + logical :: subcol_SILHS_var_covar_src + + real(r8) :: subcol_SILHS_ncnp2_on_ncnm2 + + ! There may or may not be a better place to put this. + real(r8), parameter :: p0_clubb = 100000._r8 ! real(r8) :: subcol_SILHS_c6rt, subcol_SILHS_c7, subcol_SILHS_c8, subcol_SILHS_c11, & ! subcol_SILHS_c11b, subcol_SILHS_gamma_coef, & ! subcol_SILHS_mult_coef, subcol_SILHS_mu - real(r8) :: ztodt ! model timestep + real(r8) :: ztodt ! model timestep #ifdef CLUBB_SGS #ifdef SILHS - type(hmp2_ip_on_hmm2_ip_slope_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_slope - type(hmp2_ip_on_hmm2_ip_intrcpt_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt + type(hmp2_ip_on_hmm2_ip_slope_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_slope + type(hmp2_ip_on_hmm2_ip_intrcpt_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt - type(silhs_config_flags_type) :: silhs_config_flags + type(silhs_config_flags_type) :: silhs_config_flags #endif #endif contains - subroutine subcol_register_SILHS() + subroutine subcol_register_SILHS() - !-------------------------------- - ! Register fields needed by SILHS in the physics buffer - ! Currently, most fields needed by SILHS but calculated by CLUBB are registered - ! by clubb in clubb_intr.F90. - ! - !-------------------------------- + !-------------------------------- + ! Register fields needed by SILHS in the physics buffer + ! Currently, most fields needed by SILHS but calculated by CLUBB are registered + ! by clubb in clubb_intr.F90. + ! + !-------------------------------- #ifdef CLUBB_SGS #ifdef SILHS #endif #endif - end subroutine subcol_register_SILHS + end subroutine subcol_register_SILHS - subroutine subcol_readnl_SILHS(nlfile) + subroutine subcol_readnl_SILHS(nlfile) #ifdef CLUBB_SGS #ifdef SILHS - use namelist_utils, only: find_group_name - use spmd_utils, only: masterproc, masterprocid, mpicom - use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8, iam - use clubb_api_module, only: core_rknd - use silhs_api_module, only: set_default_silhs_config_flags_api, & - initialize_silhs_config_flags_type_api, & - print_silhs_config_flags_api + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, masterprocid, mpicom + use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8, iam + use clubb_api_module, only: core_rknd + use silhs_api_module, only: set_default_silhs_config_flags_api, & + initialize_silhs_config_flags_type_api, & + print_silhs_config_flags_api #endif #endif - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - ! Local variables - integer :: unitn, ierr + ! Local variables + integer :: unitn, ierr #ifdef CLUBB_SGS #ifdef SILHS - integer :: & - cluster_allocation_strategy - - logical :: & - subcol_silhs_l_lh_importance_sampling, & - subcol_silhs_l_Lscale_vert_avg, & - subcol_silhs_l_lh_straight_mc, & - subcol_silhs_l_lh_clustered_sampling, & - subcol_silhs_l_rcm_in_cloud_k_lh_start, & - subcol_silhs_l_random_k_lh_start, & - subcol_silhs_l_max_overlap_in_cloud, & - subcol_silhs_l_lh_instant_var_covar_src, & - subcol_silhs_l_lh_limit_weights, & - subcol_silhs_l_lh_var_frac, & - subcol_silhs_l_lh_normalize_weights - - namelist /subcol_SILHS_nl/ subcol_SILHS_weight, & - subcol_SILHS_numsubcol, & - subcol_SILHS_corr_file_path, & - subcol_SILHS_corr_file_name, & - subcol_SILHS_q_to_micro, & - subcol_SILHS_n_to_micro, & - subcol_SILHS_ncnp2_on_ncnm2, & - subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & - subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt, & - subcol_SILHS_meanice, & - subcol_SILHS_use_clear_col, & - subcol_SILHS_constrainmn, & - subcol_SILHS_var_covar_src + integer :: & + cluster_allocation_strategy + + logical :: & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + + namelist /subcol_SILHS_nl/ subcol_SILHS_weight, & + subcol_SILHS_numsubcol, & + subcol_SILHS_corr_file_path, & + subcol_SILHS_corr_file_name, & + subcol_SILHS_q_to_micro, & + subcol_SILHS_n_to_micro, & + subcol_SILHS_ncnp2_on_ncnm2, & + subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & + subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt, & + subcol_SILHS_meanice, & + subcol_SILHS_use_clear_col, & + subcol_SILHS_constrainmn, & + subcol_SILHS_var_covar_src ! subcol_SILHS_c6rt, subcol_SILHS_c7, & ! subcol_SILHS_c8, subcol_SILHS_c11, subcol_SILHS_c11b, & ! subcol_SILHS_gamma_coef, subcol_SILHS_mult_coef, subcol_SILHS_mu - namelist /silhs_config_flags_nl/ subcol_silhs_l_lh_importance_sampling, & - subcol_silhs_l_Lscale_vert_avg, & - subcol_silhs_l_lh_straight_mc, & - subcol_silhs_l_lh_clustered_sampling, & - subcol_silhs_l_rcm_in_cloud_k_lh_start, & - subcol_silhs_l_random_k_lh_start, & - subcol_silhs_l_max_overlap_in_cloud, & - subcol_silhs_l_lh_instant_var_covar_src, & - subcol_silhs_l_lh_limit_weights, & - subcol_silhs_l_lh_var_frac, & - subcol_silhs_l_lh_normalize_weights - - !----------------------------------------------------------------------------- - ! Set defaults - - ! Eric Raut changed a default. - subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ni = 0.0_core_rknd - subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni = 0.5_core_rknd - - if (masterproc) then - open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'subcol_SILHS_nl', status=ierr) - if (ierr == 0) then - read(unitn, subcol_SILHS_nl, iostat=ierr) - if (ierr /= 0) then - call endrun('subcol_readnl_SILHS: ERROR reading namelist') - end if - end if - close(unitn) - end if - - ! Set default silhs_config_flags entires - call set_default_silhs_config_flags_api( cluster_allocation_strategy, & - subcol_silhs_l_lh_importance_sampling, & - subcol_silhs_l_Lscale_vert_avg, & - subcol_silhs_l_lh_straight_mc, & - subcol_silhs_l_lh_clustered_sampling, & - subcol_silhs_l_rcm_in_cloud_k_lh_start, & - subcol_silhs_l_random_k_lh_start, & - subcol_silhs_l_max_overlap_in_cloud, & - subcol_silhs_l_lh_instant_var_covar_src, & - subcol_silhs_l_lh_limit_weights, & - subcol_silhs_l_lh_var_frac, & - subcol_silhs_l_lh_normalize_weights ) - - ! Get silhs_config_flags entries from namelist - if (masterproc) then + namelist /silhs_config_flags_nl/ subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + + !----------------------------------------------------------------------------- + ! Set defaults + + ! Eric Raut changed a default. + subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ni = 0.0_core_rknd + subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni = 0.5_core_rknd + + if (masterproc) then open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'silhs_config_flags_nl', status=ierr) + call find_group_name(unitn, 'subcol_SILHS_nl', status=ierr) if (ierr == 0) then - read(unitn, silhs_config_flags_nl, iostat=ierr) - if (ierr /= 0) then - call endrun('silhs_config_flags_nl: ERROR reading namelist') - end if + read(unitn, subcol_SILHS_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('subcol_readnl_SILHS: ERROR reading namelist') + end if end if close(unitn) - end if - - ! Save silhs_config_flags entries into module variable silhs_config_flags - call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & - subcol_silhs_l_lh_importance_sampling, & - subcol_silhs_l_Lscale_vert_avg, & - subcol_silhs_l_lh_straight_mc, & - subcol_silhs_l_lh_clustered_sampling, & - subcol_silhs_l_rcm_in_cloud_k_lh_start, & - subcol_silhs_l_random_k_lh_start, & - subcol_silhs_l_max_overlap_in_cloud, & - subcol_silhs_l_lh_instant_var_covar_src, & - subcol_silhs_l_lh_limit_weights, & - subcol_silhs_l_lh_var_frac, & - subcol_silhs_l_lh_normalize_weights, & - silhs_config_flags ) - - ! Print the SILHS configurable flags - call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) + end if + + ! Set default silhs_config_flags entires + call set_default_silhs_config_flags_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights ) + + ! Get silhs_config_flags entries from namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'silhs_config_flags_nl', status=ierr) + if (ierr == 0) then + read(unitn, silhs_config_flags_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('silhs_config_flags_nl: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Save silhs_config_flags entries into module variable silhs_config_flags + call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights, & + silhs_config_flags ) + + ! Print the SILHS configurable flags + call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) #ifdef SPMD - ! Broadcast namelist variables - call mpi_bcast(subcol_SILHS_weight, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_numsubcol, 1, mpi_integer, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_corr_file_path, len(subcol_SILHS_corr_file_path), & - mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_corr_file_name, len(subcol_SILHS_corr_file_name), & - mpi_character, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_use_clear_col, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_constrainmn, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_meanice, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_q_to_micro, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_n_to_micro, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_var_covar_src,1,mpi_logical,masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_ncnp2_on_ncnm2, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%rr, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Nr, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%ri, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ni, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%rs, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ns, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%rr, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Nr, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%ri, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%rs, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ns, 1, mpir8, masterprocid, mpicom, ierr) + ! Broadcast namelist variables + call mpi_bcast(subcol_SILHS_weight, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_numsubcol, 1, mpi_integer, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_corr_file_path, len(subcol_SILHS_corr_file_path), & + mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_corr_file_name, len(subcol_SILHS_corr_file_name), & + mpi_character, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_use_clear_col, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_constrainmn, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_meanice, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_q_to_micro, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_n_to_micro, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_var_covar_src,1,mpi_logical,masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_ncnp2_on_ncnm2, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%rr, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Nr, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%ri, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ni, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%rs, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_slope%Ns, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%rr, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Nr, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%ri, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%rs, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ns, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_c6rt, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_c7, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_c8, 1, mpir8, masterprocid, mpicom, ierr) @@ -309,17 +309,17 @@ subroutine subcol_readnl_SILHS(nlfile) ! call mpi_bcast(subcol_SILHS_gamma_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mult_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mu, 1, mpir8, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_importance_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_Lscale_vert_avg, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_straight_mc, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_clustered_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_rcm_in_cloud_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_random_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_max_overlap_in_cloud, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_instant_var_covar_src, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_limit_weights, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_var_frac, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast(silhs_config_flags%l_lh_normalize_weights, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_importance_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_Lscale_vert_avg, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_straight_mc, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_clustered_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_rcm_in_cloud_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_random_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_max_overlap_in_cloud, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_instant_var_covar_src, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_limit_weights, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_var_frac, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_normalize_weights, 1, mpi_logical, masterprocid, mpicom, ierr) ! SPMD #endif @@ -327,74 +327,74 @@ subroutine subcol_readnl_SILHS(nlfile) #endif ! CLUBB_SGS #endif - end subroutine subcol_readnl_SILHS + end subroutine subcol_readnl_SILHS - subroutine subcol_init_SILHS(pbuf2d) + subroutine subcol_init_SILHS(pbuf2d) - !-------------------------------- - ! Read in parameters and initialize SILHS PDF fields. - ! Set up indexes into Pbuf fields. - ! Register history outputs. - !-------------------------------- + !-------------------------------- + ! Read in parameters and initialize SILHS PDF fields. + ! Set up indexes into Pbuf fields. + ! Register history outputs. + !-------------------------------- - use physics_buffer, only: physics_buffer_desc, pbuf_get_field, & - dtype_r8, pbuf_get_index + use physics_buffer, only: physics_buffer_desc, pbuf_get_field, & + dtype_r8, pbuf_get_index #ifdef CLUBB_SGS #ifdef SILHS - use clubb_api_module, only: core_rknd, & - setup_corr_varnce_array_api, & - init_pdf_hydromet_arrays_api, & - set_clubb_debug_level_api + use clubb_api_module, only: core_rknd, & + setup_corr_varnce_array_api, & + init_pdf_hydromet_arrays_api, & + set_clubb_debug_level_api #endif #endif - type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_buffer_desc), pointer :: pbuf2d(:,:) #ifdef CLUBB_SGS #ifdef SILHS - integer :: iunit = 501 ! Default value, will get iunit from CAM - !character(len=*), parameter :: default_corr_case = "arm_97" - character(len=*), parameter :: & - cloud_file_ext = "_corr_array_cloud.in", & ! File extensions for corr files - below_file_ext = "_corr_array_below.in" - character(len=256) :: corr_file_path_cloud, corr_file_path_below - - ! To set up CLUBB hydromet indices - integer :: & - iirr, & ! Hydrometeor array index for rain water mixing ratio, rr - iirs, & ! Hydrometeor array index for snow mixing ratio, rs - iiri, & ! Hydrometeor array index for ice mixing ratio, ri - iirg, & ! Hydrometeor array index for graupel mixing ratio, rg - iiNr, & ! Hydrometeor array index for rain drop concentration, Nr - iiNs, & ! Hydrometeor array index for snow concentration, Ns - iiNi, & ! Hydrometeor array index for ice concentration, Ni - iiNg ! Hydrometeor array index for graupel concentration, Ng - - integer :: l, ierr=0 ! Loop variable, error check - - ! Set CLUBB's debug level - ! This is called in module clubb_intr; no need to do it here. + integer :: iunit = 501 ! Default value, will get iunit from CAM + !character(len=*), parameter :: default_corr_case = "arm_97" + character(len=*), parameter :: & + cloud_file_ext = "_corr_array_cloud.in", & ! File extensions for corr files + below_file_ext = "_corr_array_below.in" + character(len=256) :: corr_file_path_cloud, corr_file_path_below + + ! To set up CLUBB hydromet indices + integer :: & + iirr, & ! Hydrometeor array index for rain water mixing ratio, rr + iirs, & ! Hydrometeor array index for snow mixing ratio, rs + iiri, & ! Hydrometeor array index for ice mixing ratio, ri + iirg, & ! Hydrometeor array index for graupel mixing ratio, rg + iiNr, & ! Hydrometeor array index for rain drop concentration, Nr + iiNs, & ! Hydrometeor array index for snow concentration, Ns + iiNi, & ! Hydrometeor array index for ice concentration, Ni + iiNg ! Hydrometeor array index for graupel concentration, Ng + + integer :: l, ierr=0 ! Loop variable, error check + + ! Set CLUBB's debug level + ! This is called in module clubb_intr; no need to do it here. ! call set_clubb_debug_level_api( 0 ) - !------------------------------- - ! CLUBB-SILHS Parameters (global module variables) - !------------------------------- - clubb_config_flags%l_fix_w_chi_eta_correlations = .true. - clubb_config_flags%l_diagnose_correlations = .false. - clubb_config_flags%l_calc_w_corr = .false. + !------------------------------- + ! CLUBB-SILHS Parameters (global module variables) + !------------------------------- + clubb_config_flags%l_fix_w_chi_eta_correlations = .true. + clubb_config_flags%l_diagnose_correlations = .false. + clubb_config_flags%l_calc_w_corr = .false. ! l_prescribed_avg_deltaz = .false. - clubb_config_flags%l_use_cloud_cover = .false. - clubb_config_flags%l_const_Nc_in_cloud = .true. + clubb_config_flags%l_use_cloud_cover = .false. + clubb_config_flags%l_const_Nc_in_cloud = .true. - ! Values from the namelist - docldfracscaling = subcol_SILHS_use_clear_col + ! Values from the namelist + docldfracscaling = subcol_SILHS_use_clear_col - ! Namelist "tuning" or set correlations - ! KTC Todo: Move these to a tuning "in" file or into the namelist - ! JHTODO: we might want these on CLUBB's API and ultimatively on a namelist for tuning + ! Namelist "tuning" or set correlations + ! KTC Todo: Move these to a tuning "in" file or into the namelist + ! JHTODO: we might want these on CLUBB's API and ultimatively on a namelist for tuning ! C6rt = subcol_SILHS_c6rt ! C7 = subcol_SILHS_c7 ! to all ice clouds ! C8 = subcol_SILHS_c8 @@ -404,3759 +404,3729 @@ subroutine subcol_init_SILHS(pbuf2d) ! mult_coef = subcol_SILHS_mult_coef ! mu = subcol_SILHS_mu - !call set_clubb_debug_level( 0 ) !#KTCtodo: Add a namelist variable to set debug level - - ! Get constituent indices - call cnst_get_ind('Q', ixq) - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('NUMLIQ', ixnumliq) - call cnst_get_ind('CLDICE', ixcldice) - call cnst_get_ind('NUMICE', ixnumice) - call cnst_get_ind('RAINQM', ixrain, abort=.false.) - call cnst_get_ind('NUMRAI', ixnumrain, abort=.false.) - call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) - call cnst_get_ind('NUMSNO', ixnumsnow, abort=.false.) - - ! Get physics buffer indexes - thlm_idx = pbuf_get_index('THLM') - rtm_idx = pbuf_get_index('RTM') - cld_idx = pbuf_get_index('CLD') - alst_idx = pbuf_get_index('ALST') ! SILHS expects clubb's cloud_frac liq stratus fraction - ztodt_idx = pbuf_get_index('ZTODT') - ice_supersat_idx = pbuf_get_index('ISS_FRAC') - tke_idx = pbuf_get_index('tke') - kvh_idx = pbuf_get_index('kvh') - prec_pcw_idx = pbuf_get_index('PREC_PCW') - snow_pcw_idx = pbuf_get_index('SNOW_PCW') - prec_str_idx = pbuf_get_index('PREC_STR') - snow_str_idx = pbuf_get_index('SNOW_STR') - qcsedten_idx = pbuf_get_index('QCSEDTEN') - qrsedten_idx = pbuf_get_index('QRSEDTEN') - qisedten_idx = pbuf_get_index('QISEDTEN') - qssedten_idx = pbuf_get_index('QSSEDTEN') - vtrmc_idx = pbuf_get_index('VTRMC') - umr_idx = pbuf_get_index('UMR') - vtrmi_idx = pbuf_get_index('VTRMI') - ums_idx = pbuf_get_index('UMS') - qcsevap_idx = pbuf_get_index('QCSEVAP') - qisevap_idx = pbuf_get_index('QISEVAP') - qrain_idx = pbuf_get_index('QRAIN') - qsnow_idx = pbuf_get_index('QSNOW') - nrain_idx = pbuf_get_index('NRAIN') - nsnow_idx = pbuf_get_index('NSNOW') - - !------------------------------- - ! Set up SILHS hydrometeors #KTCtodo: move microphys specification to config time, - ! Steve wants to set up a microphysics query so I can ask the microphysics - ! scheme which hydrometeors to use. For the future. - !------------------------------- - iirr = 1 - iirs = 3 - iiri = 5 - iirg = -1 - - iiNr = 2 - iiNs = 4 - iiNi = 6 - iiNg = -1 - - hydromet_dim = 6 - - ! Set up pdf indices, hydromet indicies, hydromet arrays, and hydromet variance ratios - call init_pdf_hydromet_arrays_api( 1.0_core_rknd, 1.0_core_rknd, hydromet_dim, & ! intent(in) - iirr, iiNr, iiri, iiNi, & ! intent(in) - iirs, iiNs, iirg, iiNg, & ! intent(in) - subcol_SILHS_ncnp2_on_ncnm2, & ! intent(in) - hm_metadata, pdf_dim, & ! intent(out) - subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & ! optional(in) - subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt ) ! optional(in) - - !------------------------------- - ! Set up hydrometeors and correlation arrays for SILHS - !------------------------------- - allocate( corr_array_n_cloud(pdf_dim,pdf_dim), corr_array_n_below(pdf_dim,pdf_dim), stat=ierr) - if( ierr /= 0 ) call endrun(' subcol_init_SILHS: failed to allocate corr_array fields ') - - corr_file_path_cloud = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//cloud_file_ext - corr_file_path_below = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//below_file_ext - - call setup_corr_varnce_array_api( corr_file_path_cloud, corr_file_path_below, & - pdf_dim, hm_metadata, newunit(iunit), & - clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In - corr_array_n_cloud, corr_array_n_below ) - - !------------------------------- - ! Register output fields from SILHS - !------------------------------- - call addfld('SILHS_NCLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & - 'Subcolumn Cloud Number Concentration', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_NRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & - 'Subcolumn Number Concentration of Rain from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_OMEGA_SCOL', (/'psubcols', 'ilev '/), 'I', 'Pa/s', & - 'Subcolumn vertical pressure velocity', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_RCM_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_RICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Ice Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_NICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Cloud Ice Number Conc from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_RRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & - 'Subcolumn Precipitating Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_RT_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg ', & - 'Subcolumn Total Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_THLM_SCOL', (/'psubcols', 'ilev '/), 'I', 'K', & - 'Subcolumn liquid water pot temperature', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_WEIGHT_SCOL', (/'psubcols'/), 'I', 'frac', & - 'Weights for each subcolumn', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - call addfld('SILHS_WM_SCOL', (/'psubcols', 'ilev '/), 'I', 'm/s', & - 'Subcolumn vertical velocity from SILHS', flag_xyfill=.true., fill_value=1.e30_r8, sampled_on_subcycle=.true.) - - call addfld('NR_IN_LH', (/ 'lev' /), 'I', 'm^-3', & - 'Num Rain Conc as input to SILHS', sampled_on_subcycle=.true.) - call addfld('SILHS_RTM', (/ 'ilev' /), 'I', 'kg/kg', & - 'Input total water mixing ratio', sampled_on_subcycle=.true.) - call addfld('SILHS_THLM', (/ 'ilev' /), 'I', 'K', & - 'Input liquid water potential temperature', sampled_on_subcycle=.true.) - call addfld('SILHS_QC_IN', (/ 'lev' /), 'I', 'kg/kg', & - 'Input cloud water mixing ratio', sampled_on_subcycle=.true.) - call addfld('SILHS_QI_IN', (/ 'lev' /), 'I', 'kg/kg', & - 'Input cloud ice mixing ratio', sampled_on_subcycle=.true.) - call addfld('SILHS_NC_IN', (/ 'lev' /), 'I', '#/kg', & - 'Input cloud water number concentration', sampled_on_subcycle=.true.) - call addfld('SILHS_NI_IN', (/ 'lev' /), 'I', '#/kg', & - 'Input cloud ice number concentration', sampled_on_subcycle=.true.) - call addfld('AKM_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & - 'Exact Kessler autoconversion', sampled_on_subcycle=.true.) - call addfld('AKM_LH_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & - 'Monte Carlo estimate of Kessler autoconversion', sampled_on_subcycle=.true.) - call addfld('INVS_EXNER', (/ 'lev' /), 'I', 'none', & - 'inverse EXNER function from state in subcol_SILHS', sampled_on_subcycle=.true.) - call addfld('SILHS_ZTODT', horiz_only, 'I', 's', & - 'Length of Physics timestep (for debugging)', sampled_on_subcycle=.true.) - if ( subcol_SILHS_constrainmn ) then - call addfld('SILHS_MSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean Cloud Ice across subcolumns', sampled_on_subcycle=.true.) - call addfld('SILHS_STDSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of Ice across subcolumns', sampled_on_subcycle=.true.) - if ( ixsnow > 0 ) then - call addfld('SILHS_MSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean Cloud Liquid across subcolumns', sampled_on_subcycle=.true.) - call addfld('SILHS_STDSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of Liquid across subcolumns', sampled_on_subcycle=.true.) - call addfld('SILHS_MSC_Q', (/ 'lev' /), 'A', 'kg/kg', & - 'Mean water vapor across subcolumns', sampled_on_subcycle=.true.) - call addfld('SILHS_STDSC_Q', (/ 'lev' /), 'A', 'kg/kg', & - 'Standard deviation of water vapor across subcolumns', sampled_on_subcycle=.true.) - endif ! ixsnow > 0 - endif ! subcol_SILHS_constrainmn - call addfld('SILHS_EFF_CLDFRAC', (/ 'lev' /), 'A', 'frac', & - 'Calculated cloud fraction from subcolumn liq or ice', sampled_on_subcycle=.true.) - - call addfld('SILHS_CLUBB_PRECIP_FRAC', (/ 'lev' /), 'A', 'frac', & - 'Precipitation fraction from CLUBB (set_up_pdf_params_incl_hydromet)', sampled_on_subcycle=.true.) - call addfld('SILHS_CLUBB_ICE_SS_FRAC', (/ 'lev' /), 'A', 'frac', & - 'Ice supersaturation fraction from CLUBB', sampled_on_subcycle=.true.) - - call addfld ('QVHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Water vapor mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('QCHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('QRHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain water mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('QIHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('QSHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from hole filling', sampled_on_subcycle=.true.) - call addfld ('THFTEN', (/ 'lev' /), 'A', 'K/s', 'Temperature tendency from hole filling', sampled_on_subcycle=.true.) + !call set_clubb_debug_level( 0 ) !#KTCtodo: Add a namelist variable to set debug level + + ! Get constituent indices + call cnst_get_ind('Q', ixq) + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('NUMLIQ', ixnumliq) + call cnst_get_ind('CLDICE', ixcldice) + call cnst_get_ind('NUMICE', ixnumice) + call cnst_get_ind('RAINQM', ixrain, abort=.false.) + call cnst_get_ind('NUMRAI', ixnumrain, abort=.false.) + call cnst_get_ind('SNOWQM', ixsnow, abort=.false.) + call cnst_get_ind('NUMSNO', ixnumsnow, abort=.false.) + + ! Get physics buffer indexes + thlm_idx = pbuf_get_index('THLM') + rtm_idx = pbuf_get_index('RTM') + cld_idx = pbuf_get_index('CLD') + alst_idx = pbuf_get_index('ALST') ! SILHS expects clubb's cloud_frac liq stratus fraction + ztodt_idx = pbuf_get_index('ZTODT') + ice_supersat_idx = pbuf_get_index('ISS_FRAC') + tke_idx = pbuf_get_index('tke') + kvh_idx = pbuf_get_index('kvh') + prec_pcw_idx = pbuf_get_index('PREC_PCW') + snow_pcw_idx = pbuf_get_index('SNOW_PCW') + prec_str_idx = pbuf_get_index('PREC_STR') + snow_str_idx = pbuf_get_index('SNOW_STR') + qcsedten_idx = pbuf_get_index('QCSEDTEN') + qrsedten_idx = pbuf_get_index('QRSEDTEN') + qisedten_idx = pbuf_get_index('QISEDTEN') + qssedten_idx = pbuf_get_index('QSSEDTEN') + vtrmc_idx = pbuf_get_index('VTRMC') + umr_idx = pbuf_get_index('UMR') + vtrmi_idx = pbuf_get_index('VTRMI') + ums_idx = pbuf_get_index('UMS') + qcsevap_idx = pbuf_get_index('QCSEVAP') + qisevap_idx = pbuf_get_index('QISEVAP') + qrain_idx = pbuf_get_index('QRAIN') + qsnow_idx = pbuf_get_index('QSNOW') + nrain_idx = pbuf_get_index('NRAIN') + nsnow_idx = pbuf_get_index('NSNOW') + + !------------------------------- + ! Set up SILHS hydrometeors #KTCtodo: move microphys specification to config time, + ! Steve wants to set up a microphysics query so I can ask the microphysics + ! scheme which hydrometeors to use. For the future. + !------------------------------- + iirr = 1 + iirs = 3 + iiri = 5 + iirg = -1 + + iiNr = 2 + iiNs = 4 + iiNi = 6 + iiNg = -1 + + hydromet_dim = 6 + + ! Set up pdf indices, hydromet indicies, hydromet arrays, and hydromet variance ratios + call init_pdf_hydromet_arrays_api( 1.0_core_rknd, 1.0_core_rknd, hydromet_dim, & ! intent(in) + iirr, iiNr, iiri, iiNi, & ! intent(in) + iirs, iiNs, iirg, iiNg, & ! intent(in) + subcol_SILHS_ncnp2_on_ncnm2, & ! intent(in) + hm_metadata, pdf_dim, & ! intent(out) + subcol_SILHS_hmp2_ip_on_hmm2_ip_slope, & ! optional(in) + subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt ) ! optional(in) + + !------------------------------- + ! Set up hydrometeors and correlation arrays for SILHS + !------------------------------- + allocate( corr_array_n_cloud(pdf_dim,pdf_dim), corr_array_n_below(pdf_dim,pdf_dim), stat=ierr) + if( ierr /= 0 ) call endrun(' subcol_init_SILHS: failed to allocate corr_array fields ') + + corr_file_path_cloud = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//cloud_file_ext + corr_file_path_below = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//below_file_ext + + call setup_corr_varnce_array_api( corr_file_path_cloud, corr_file_path_below, & + pdf_dim, hm_metadata, newunit(iunit), & + clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In + corr_array_n_cloud, corr_array_n_below ) + + !------------------------------- + ! Register output fields from SILHS + !------------------------------- + call addfld('SILHS_NCLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & + 'Subcolumn Cloud Number Concentration', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_NRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & + 'Subcolumn Number Concentration of Rain from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_OMEGA_SCOL', (/'psubcols', 'ilev '/), 'I', 'Pa/s', & + 'Subcolumn vertical pressure velocity', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_RCM_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & + 'Subcolumn Cloud Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_RICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & + 'Subcolumn Cloud Ice Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_NICLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & + 'Subcolumn Cloud Ice Number Conc from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_RRAIN_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg', & + 'Subcolumn Precipitating Liquid Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_RT_SCOL', (/'psubcols', 'ilev '/), 'I', 'kg/kg ', & + 'Subcolumn Total Water from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_THLM_SCOL', (/'psubcols', 'ilev '/), 'I', 'K', & + 'Subcolumn liquid water pot temperature', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_WEIGHT_SCOL', (/'psubcols'/), 'I', 'frac', & + 'Weights for each subcolumn', flag_xyfill=.true., fill_value=1.e30_r8) + call addfld('SILHS_WM_SCOL', (/'psubcols', 'ilev '/), 'I', 'm/s', & + 'Subcolumn vertical velocity from SILHS', flag_xyfill=.true., fill_value=1.e30_r8) + + call addfld('NR_IN_LH', (/ 'lev' /), 'I', 'm^-3', & + 'Num Rain Conc as input to SILHS') + call addfld('SILHS_RTM', (/ 'ilev' /), 'I', 'kg/kg', & + 'Input total water mixing ratio') + call addfld('SILHS_THLM', (/ 'ilev' /), 'I', 'K', & + 'Input liquid water potential temperature') + call addfld('SILHS_QC_IN', (/ 'lev' /), 'I', 'kg/kg', & + 'Input cloud water mixing ratio') + call addfld('SILHS_QI_IN', (/ 'lev' /), 'I', 'kg/kg', & + 'Input cloud ice mixing ratio') + call addfld('SILHS_NC_IN', (/ 'lev' /), 'I', '#/kg', & + 'Input cloud water number concentration') + call addfld('SILHS_NI_IN', (/ 'lev' /), 'I', '#/kg', & + 'Input cloud ice number concentration') + call addfld('AKM_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & + 'Exact Kessler autoconversion') + call addfld('AKM_LH_CLUBB', (/ 'ilev' /), 'I', '(kg/kg)/s', & + 'Monte Carlo estimate of Kessler autoconversion') + call addfld('INVS_EXNER', (/ 'lev' /), 'I', 'none', & + 'inverse EXNER function from state in subcol_SILHS') + call addfld('SILHS_ZTODT', horiz_only, 'I', 's', & + 'Length of Physics timestep (for debugging)') + if ( subcol_SILHS_constrainmn ) then + call addfld('SILHS_MSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & + 'Mean Cloud Ice across subcolumns') + call addfld('SILHS_STDSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & + 'Standard deviation of Ice across subcolumns') + if ( ixsnow > 0 ) then + call addfld('SILHS_MSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & + 'Mean Cloud Liquid across subcolumns') + call addfld('SILHS_STDSC_CLDLIQ', (/ 'lev' /), 'A', 'kg/kg', & + 'Standard deviation of Liquid across subcolumns') + call addfld('SILHS_MSC_Q', (/ 'lev' /), 'A', 'kg/kg', & + 'Mean water vapor across subcolumns') + call addfld('SILHS_STDSC_Q', (/ 'lev' /), 'A', 'kg/kg', & + 'Standard deviation of water vapor across subcolumns') + endif ! ixsnow > 0 + endif ! subcol_SILHS_constrainmn + call addfld('SILHS_EFF_CLDFRAC', (/ 'lev' /), 'A', 'frac', & + 'Calculated cloud fraction from subcolumn liq or ice') + + call addfld('SILHS_CLUBB_PRECIP_FRAC', (/ 'lev' /), 'A', 'frac', & + 'Precipitation fraction from CLUBB (set_up_pdf_params_incl_hydromet)') + call addfld('SILHS_CLUBB_ICE_SS_FRAC', (/ 'lev' /), 'A', 'frac', & + 'Ice supersaturation fraction from CLUBB') + + call addfld ('QVHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Water vapor mixing ratio tendency from hole filling') + call addfld ('QCHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from hole filling') + call addfld ('QRHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain water mixing ratio tendency from hole filling') + call addfld ('QIHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from hole filling') + call addfld ('QSHFTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from hole filling') + call addfld ('THFTEN', (/ 'lev' /), 'A', 'K/s', 'Temperature tendency from hole filling') #endif #endif - end subroutine subcol_init_SILHS + end subroutine subcol_init_SILHS !==============================================================! - subroutine init_state_subcol(state, tend, state_sc, tend_sc) - - use ppgrid, only : pver, pverp, pcols - - use subcol_utils, only : subcol_set_subcols - - implicit none - - type(physics_state), intent(inout) :: state - type(physics_tend), intent(inout) :: tend - type(physics_state), intent(inout) :: state_sc ! sub-column state - type(physics_tend), intent(inout) :: tend_sc ! sub-column tend - - integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct - - numsubcol_arr(:) = 0 ! Start over each chunk - numsubcol_arr(:state%ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns - call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) - - end subroutine init_state_subcol + subroutine init_state_subcol(state, tend, state_sc, tend_sc) + + use ppgrid, only : pver, pverp, pcols + + use subcol_utils, only : subcol_set_subcols + + implicit none + + type(physics_state), intent(inout) :: state + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(inout) :: state_sc ! sub-column state + type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + + integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct + + numsubcol_arr(:) = 0 ! Start over each chunk + numsubcol_arr(:state%ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns + call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + + end subroutine init_state_subcol !==================================================================! - subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) - !------------------------------- - ! This is where the subcolumns are created, and the call to - ! generate_silhs_sample_mod_api - ! goes out. Variables needed to make this call are pulled from the - ! pbuf, from module data, and calculated based on the CAM state. - !------------------------------- - - use physics_buffer, only : physics_buffer_desc, pbuf_get_index, & - pbuf_get_field - use time_manager, only : get_nstep - use subcol_utils, only : subcol_set_subcols, subcol_set_weight - use subcol_pack_mod, only : subcol_pack - use phys_control, only : phys_getopts - use spmd_utils, only : masterproc - use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RHOFW + subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) + !------------------------------- + ! This is where the subcolumns are created, and the call to + ! generate_silhs_sample_mod_api + ! goes out. Variables needed to make this call are pulled from the + ! pbuf, from module data, and calculated based on the CAM state. + !------------------------------- + + use physics_buffer, only : physics_buffer_desc, pbuf_get_index, & + pbuf_get_field + use time_manager, only : get_nstep + use subcol_utils, only : subcol_set_subcols, subcol_set_weight + use subcol_pack_mod, only : subcol_pack + use phys_control, only : phys_getopts + use spmd_utils, only : masterproc + use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RHOFW #ifdef CLUBB_SGS #ifdef SILHS - use clubb_api_module, only : setup_pdf_parameters_api, & + use clubb_api_module, only : setup_pdf_parameters_api, & - zm2zt_api, setup_grid_heights_api, & + zm2zt_api, setup_grid_heights_api, & - core_rknd, & + core_rknd, & - w_tol_sqd, zero_threshold, & - em_min, cloud_frac_min, & ! rc_tol, & + w_tol_sqd, zero_threshold, & + em_min, cloud_frac_min, & ! rc_tol, & - genrand_intg, genrand_init_api, & + genrand_intg, genrand_init_api, & - nparams, ic_K, & - read_parameters_api, & - Cp, Lv, & - grid, setup_grid_api, & - init_precip_fracs_api - - use silhs_api_module, only : generate_silhs_sample_api, & ! Ncn_to_Nc, & - clip_transform_silhs_output_api, & - est_kessler_microphys_api, & - vert_decorr_coef + nparams, ic_K, & + read_parameters_api, & + Cp, Lv, & + grid, setup_grid_api, & + init_precip_fracs_api + + use silhs_api_module, only : generate_silhs_sample_api, & ! Ncn_to_Nc, & + clip_transform_silhs_output_api, & + est_kessler_microphys_api, & + vert_decorr_coef #endif #endif - - ! CAM data structures - type(physics_state), intent(inout) :: state - type(physics_tend), intent(inout) :: tend - type(physics_state), intent(inout) :: state_sc ! sub-column state - type(physics_tend), intent(inout) :: tend_sc ! sub-column tend - type(physics_buffer_desc), pointer :: pbuf(:) + + ! CAM data structures + type(physics_state), intent(inout) :: state + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(inout) :: state_sc ! sub-column state + type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + type(physics_buffer_desc), pointer :: pbuf(:) #ifdef CLUBB_SGS #ifdef SILHS - !---------------- - ! Local variables - !---------------- - logical, parameter :: & - l_implemented = .true. ! Implemented in a host model - logical, parameter :: rx_Nc = .false. ! Use NC calculated based on grid mean effective radius - integer, parameter :: & - grid_type = 3 ! The 3 grid centered on momentum levels - real(r8), parameter :: cldmin = 0.001_r8 ! To use when cld frac = 0.0 to be consistant with micro_mg - real(r8), parameter :: min_num_conc = 1.0e-12_r8 - real(r8), parameter :: qsmall = 1.0e-18_r8 ! Microphysics cut-off for cloud - - integer :: i, j, k, ngrdcol, ncol, lchnk, stncol - real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb - - real(r8), dimension(pverp) :: scfrac ! cloud fraction based on sc distributions - real(r8) :: msc, std, maxcldfrac, maxsccldfrac - real(r8) :: scale = 1.0_r8 - - real(r8) :: c_K ! CLUBB parameter c_K (for eddy diffusivity) - - integer( kind = genrand_intg ) :: & - lh_seed ! Seed used in random number generator that will be different - ! for each column, yet reproducible for a restart run - - !---------------- - ! Required for set_up_pdf_params_incl_hydromet - !---------------- - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: cld_frac_in ! Cloud fraction - - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & - corr_array_1, corr_array_2 ! Correlation matrix for pdf components - - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim) :: & - mu_x_1, mu_x_2, & ! Mean array for PDF components - sigma_x_1, sigma_x_2 ! Std dev arr for PDF components - - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & - corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx - - real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: Nc_in_cloud - real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: ice_supersat_frac_in - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, hydromet_dim) :: hydrometp2 - - - !---------------- - ! Input to generate_silhs_sample - !---------------- - integer :: iter ! CLUBB iteration - integer :: num_subcols ! Number of subcolumns - integer, parameter :: sequence_length = 1 ! Number of timesteps btn subcol calls - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs - real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: delta_zm ! Difference in u wind altitudes - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species - real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Ncm ! Mean cloud droplet concentration, - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: tke ! TKE - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: khzm ! Eddy diffusivity coef - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale ! CLUBB's length scale - - logical, parameter :: & - l_calc_weights_all_levs = .false. ! .false. if all time steps use the same - ! weights at all vertical grid levels - logical :: & - l_calc_weights_all_levs_itime, & ! .true. if we calculate sample weights separately at all - ! grid levels at the current time step - l_rad_itime ! .true. if we calculate radiation at the current time step - - !--------------- - !Output from generate_silhs_sample - !-------------- - real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal - real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: lh_sample_point_weights ! Subcolumn weights - integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: X_mixt_comp_all_levs ! Which Mixture Component - - real(r8), dimension(state%ngrdcol,pverp-top_lev+1, subcol_SILHS_numsubcol) :: & - rc_all_points, & ! Calculate RCM from LH output - rain_all_pts, & ! Calculate Rain from LH output - nrain_all_pts, & ! Calculate Rain Conc from LH - snow_all_pts, & ! Calculate Snow from LH output - nsnow_all_pts, & ! Calculate Snow Conc from LH - w_all_points, & ! Calculate W from LH output - ice_all_pts, & ! Calculate Cld Ice from LH output - nice_all_pts, & ! Calculate Num cld ice from LH - nclw_all_pts ! Calculate Num cld wat from LH - - !---------------- - ! Output from clip_transform_silhs_output_api - !---------------- - real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: & - lh_rt_clipped, & ! rt generated from silhs sample points - lh_thl_clipped, & ! thl generated from silhs sample points - lh_rc_clipped, & ! rc generated from silhs sample points - lh_rv_clipped, & ! rv generated from silhs sample points - lh_Nc_clipped ! Nc generated from silhs sample points - - logical, parameter :: & - l_use_Ncn_to_Nc = .true. ! Whether to call Ncn_to_Nc (.true.) or not (.false.); - ! Ncn_to_Nc might cause problems with the MG microphysics - ! since the changes made here (Nc-tendency) are not fed into - ! the microphysics - + !---------------- + ! Local variables + !---------------- + logical, parameter :: & + l_implemented = .true. ! Implemented in a host model + logical, parameter :: rx_Nc = .false. ! Use NC calculated based on grid mean effective radius + integer, parameter :: & + grid_type = 3 ! The 3 grid centered on momentum levels + real(r8), parameter :: cldmin = 0.001_r8 ! To use when cld frac = 0.0 to be consistant with micro_mg + real(r8), parameter :: min_num_conc = 1.0e-12_r8 + real(r8), parameter :: qsmall = 1.0e-18_r8 ! Microphysics cut-off for cloud + + integer :: i, j, k, ngrdcol, ncol, lchnk, stncol + real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation + + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: zt_g ! Thermo grid for clubb + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: zi_g ! Momentum grid for clubb + + real(r8), dimension(pver) :: scfrac ! cloud fraction based on sc distributions + real(r8) :: msc, std, maxcldfrac, maxsccldfrac + real(r8) :: scale = 1.0_r8 + + real(r8) :: c_K ! CLUBB parameter c_K (for eddy diffusivity) + + integer( kind = genrand_intg ) :: & + lh_seed ! Seed used in random number generator that will be different + ! for each column, yet reproducible for a restart run + + !---------------- + ! Required for set_up_pdf_params_incl_hydromet + !---------------- + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: cld_frac_in ! Cloud fraction + + real(r8), dimension(state%ngrdcol, pver-top_lev+1, pdf_dim, pdf_dim) :: & + corr_array_1, corr_array_2 ! Correlation matrix for pdf components + + real(r8), dimension(state%ngrdcol, pver-top_lev+1, pdf_dim) :: & + mu_x_1, mu_x_2, & ! Mean array for PDF components + sigma_x_1, sigma_x_2 ! Std dev arr for PDF components + + real(r8), dimension(state%ngrdcol, pver-top_lev+1, pdf_dim, pdf_dim) :: & + corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx + + real(r8), dimension(state%ngrdcol, pver-top_lev+1) :: Nc_in_cloud + real(r8), dimension(state%ngrdcol, pver-top_lev+1) :: ice_supersat_frac_in + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, hydromet_dim) :: hydrometp2 + + + !---------------- + ! Input to generate_silhs_sample + !---------------- + integer :: iter ! CLUBB iteration + integer :: num_subcols ! Number of subcolumns + integer, parameter :: sequence_length = 1 ! Number of timesteps btn subcol calls + + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs + real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: delta_zm ! Difference in u wind altitudes + + real(r8), dimension(state%ngrdcol,pver-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species + real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: Ncm ! Mean cloud droplet concentration, + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: tke ! TKE + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: khzm ! Eddy diffusivity coef + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: Lscale ! CLUBB's length scale + + logical, parameter :: & + l_calc_weights_all_levs = .false. ! .false. if all time steps use the same + ! weights at all vertical grid levels + logical :: & + l_calc_weights_all_levs_itime, & ! .true. if we calculate sample weights separately at all + ! grid levels at the current time step + l_rad_itime ! .true. if we calculate radiation at the current time step + + !--------------- + !Output from generate_silhs_sample + !-------------- + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pver-top_lev+1,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pver-top_lev+1) :: lh_sample_point_weights ! Subcolumn weights + integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,pver-top_lev+1) :: X_mixt_comp_all_levs ! Which Mixture Component + + real(r8), dimension(state%ngrdcol,pver-top_lev+1, subcol_SILHS_numsubcol) :: & + rc_all_points, & ! Calculate RCM from LH output + rain_all_pts, & ! Calculate Rain from LH output + nrain_all_pts, & ! Calculate Rain Conc from LH + snow_all_pts, & ! Calculate Snow from LH output + nsnow_all_pts, & ! Calculate Snow Conc from LH + w_all_points, & ! Calculate W from LH output + ice_all_pts, & ! Calculate Cld Ice from LH output + nice_all_pts, & ! Calculate Num cld ice from LH + nclw_all_pts ! Calculate Num cld wat from LH + + !---------------- + ! Output from clip_transform_silhs_output_api + !---------------- + real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pver-top_lev+1) :: & + lh_rt_clipped, & ! rt generated from silhs sample points + lh_thl_clipped, & ! thl generated from silhs sample points + lh_rc_clipped, & ! rc generated from silhs sample points + lh_rv_clipped, & ! rv generated from silhs sample points + lh_Nc_clipped ! Nc generated from silhs sample points + + logical, parameter :: & + l_use_Ncn_to_Nc = .true. ! Whether to call Ncn_to_Nc (.true.) or not (.false.); + ! Ncn_to_Nc might cause problems with the MG microphysics + ! since the changes made here (Nc-tendency) are not fed into + ! the microphysics + + + !---------------- + ! Output to history + !---------------- + ! V. Larson note: These variables are on the zt levels + ! The variables in this paragraph are oriented like CAM variables (k=1 is + ! the model top). + ! They are flipped versions of CLUBB variables, for the entire chunk. + real(r8), dimension(pcols*psubcols, pver) :: RT_lh_out + real(r8), dimension(pcols*psubcols, pver) :: THL_lh_out + real(r8), dimension(pcols*psubcols, pver) :: OMEGA_lh_out + real(r8), dimension(pcols*psubcols, pver) :: WM_lh_out + real(r8), dimension(pcols*psubcols, pver) :: RVM_lh_out + real(r8), dimension(pcols*psubcols, pver) :: RCM_lh_out + real(r8), dimension(pcols*psubcols, pver) :: NCLW_lh_out + real(r8), dimension(pcols*psubcols, pver) :: ICE_lh_out + real(r8), dimension(pcols*psubcols, pver) :: NICE_lh_out + real(r8), dimension(pcols*psubcols, pver) :: RAIN_lh_out + real(r8), dimension(pcols*psubcols, pver) :: NRAIN_lh_out + real(r8), dimension(pcols*psubcols, pver) :: SNOW_lh_out + real(r8), dimension(pcols*psubcols, pver) :: NSNOW_lh_out + + real(r8), dimension(state_sc%psetcols) :: weights ! Subcol weights + + real(r8), dimension(pcols, pver) :: meansc_ice + real(r8), dimension(pcols, pver) :: stdsc_ice + + real(r8), dimension(pcols, pver) :: meansc_liq + real(r8), dimension(pcols, pver) :: stdsc_liq + + real(r8), dimension(pcols, pver) :: meansc_vap + real(r8), dimension(pcols, pver) :: stdsc_vap + real(r8), dimension(pcols, pver) :: grmn_eff_rad + real(r8), dimension(pcols, pver) :: eff_cldfrac + real(r8), dimension(pcols, pver) :: precip_frac_out + + real(r8) :: tmp_mean, diff_mean, rcubed + + !---------------- + ! Output from Est_Kessler_microphys + !---------------- + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKm ! Exact Kessler autoconversion + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc + real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water + real(r8), dimension(pcols,pver) :: lh_AKm_out, AKm_out + + !---------------- + ! Needed to update State + !---------------- + real(r8), dimension(pver) :: Temp_prof ! Subcolumn LWPT converted to Abs Temp + real(r8), dimension(pver) :: SE_prof ! Static Energy calculated from Abs Temp + real(r8), dimension(pver) :: No_cloud = 0.0_r8 ! Clear air condensate profile + real(r8), dimension(pcols, pver) :: invs_exner ! inverse exner sent to conversion codw + ! pcols for output to history + real(r8) :: eff_rad_coef = 1.0_r8/(4.0_r8/3.0_r8*SHR_CONST_RHOFW*SHR_CONST_PI) + + !---------------- + ! Pointers + !---------------- + real(r8), pointer, dimension(:) :: ztodt_ptr + real(r8), pointer, dimension(:,:) :: thlm ! Mean temperature + real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! ice cloud fraction + real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio + real(r8), pointer, dimension(:,:) :: cld ! CAM cloud fraction + real(r8), pointer, dimension(:,:) :: alst ! CLUBB liq cloud fraction + real(r8), pointer, dimension(:,:) :: qrain ! micro_mg rain from previous step + real(r8), pointer, dimension(:,:) :: qsnow + real(r8), pointer, dimension(:,:) :: nrain ! micro_mg rain num conc + real(r8), pointer, dimension(:,:) :: nsnow + + real(r8), pointer, dimension(:,:) :: tke_in ! TKE + real(r8), pointer, dimension(:,:) :: khzm_in ! Eddy diffusivity coef + + logical, parameter :: l_est_kessler_microphys = .false. + logical, parameter :: l_outfld_subcol = .false. + + type(grid) :: gr + + type(precipitation_fractions) :: precip_fracs - !---------------- - ! Output to history - !---------------- - ! V. Larson note: These variables are on the zt (full) levels: why do they - ! have dimension pverp? The pverp level corresponds to the CLUBB - ! below-ground level. - ! The variables in this paragraph are oriented like CAM variables (k=1 is - ! the model top). - ! They are flipped versions of CLUBB variables, for the entire chunk. - real(r8), dimension(pcols*psubcols, pverp) :: RT_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: THL_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: OMEGA_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: WM_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: RVM_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: RCM_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: NCLW_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: ICE_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: NICE_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: RAIN_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: NRAIN_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: SNOW_lh_out - real(r8), dimension(pcols*psubcols, pverp) :: NSNOW_lh_out - - real(r8), dimension(state_sc%psetcols) :: weights ! Subcol weights - - real(r8), dimension(pcols, pver) :: meansc_ice - real(r8), dimension(pcols, pver) :: stdsc_ice - - real(r8), dimension(pcols, pver) :: meansc_liq - real(r8), dimension(pcols, pver) :: stdsc_liq - - real(r8), dimension(pcols, pver) :: meansc_vap - real(r8), dimension(pcols, pver) :: stdsc_vap - real(r8), dimension(pcols, pver) :: grmn_eff_rad - real(r8), dimension(pcols, pver) :: eff_cldfrac - real(r8), dimension(pcols, pver) :: precip_frac_out - - real(r8) :: tmp_mean, diff_mean, rcubed - - !---------------- - ! Output from Est_Kessler_microphys - !---------------- - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm ! Exact Kessler autoconversion - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water - real(r8), dimension(pcols,pverp) :: lh_AKm_out, AKm_out - - !---------------- - ! Needed to update State - !---------------- - real(r8), dimension(pver) :: Temp_prof ! Subcolumn LWPT converted to Abs Temp - real(r8), dimension(pver) :: SE_prof ! Static Energy calculated from Abs Temp - real(r8), dimension(pver) :: No_cloud = 0.0_r8 ! Clear air condensate profile - real(r8), dimension(pcols, pver) :: invs_exner ! inverse exner sent to conversion codw - ! pcols for output to history - real(r8) :: eff_rad_coef = 1.0_r8/(4.0_r8/3.0_r8*SHR_CONST_RHOFW*SHR_CONST_PI) + ! Used as shortcuts to avoid typing hm_metadata%iiPDF_xx + integer :: & + iiPDF_chi, iiPDF_rr, iiPDF_w, iiPDF_Nr, & + iiPDF_ri, iiPDF_Ni, iiPDF_Ncn, iiPDF_rs, iiPDF_Ns, & + iirr, iiNr, iirs, iiri, & + iirg, iiNs, iiNi, iiNg + + !------------------------------------------------ + ! Begin Code + !------------------------------------------------ - !---------------- - ! Pointers - !---------------- - real(r8), pointer, dimension(:) :: ztodt_ptr - real(r8), pointer, dimension(:,:) :: thlm ! Mean temperature - real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! ice cloud fraction - real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio - real(r8), pointer, dimension(:,:) :: cld ! CAM cloud fraction - real(r8), pointer, dimension(:,:) :: alst ! CLUBB liq cloud fraction - real(r8), pointer, dimension(:,:) :: qrain ! micro_mg rain from previous step - real(r8), pointer, dimension(:,:) :: qsnow - real(r8), pointer, dimension(:,:) :: nrain ! micro_mg rain num conc - real(r8), pointer, dimension(:,:) :: nsnow - - real(r8), pointer, dimension(:,:) :: tke_in ! TKE - real(r8), pointer, dimension(:,:) :: khzm_in ! Eddy diffusivity coef - - logical, parameter :: l_est_kessler_microphys = .false. - logical, parameter :: l_outfld_subcol = .false. - - type(grid) :: gr - - type(precipitation_fractions) :: precip_fracs - - ! Used as shortcuts to avoid typing hm_metadata%iiPDF_xx - integer :: & - iiPDF_chi, iiPDF_rr, iiPDF_w, iiPDF_Nr, & - iiPDF_ri, iiPDF_Ni, iiPDF_Ncn, iiPDF_rs, iiPDF_Ns, & - iirr, iiNr, iirs, iiri, & - iirg, iiNs, iiNi, iiNg - - !------------------------------------------------ - ! Begin Code - !------------------------------------------------ - #ifdef SILHS_OPENACC - if ( l_est_kessler_microphys ) then - call endrun('subcol_gen error: compilation with OpenACC requires l_est_kessler_microphys = .false.') - end if - - if ( subcol_SILHS_constrainmn ) then - call endrun('subcol_gen error: compilation with OpenACC requires subcol_SILHS_constrainmn = .false.') - end if - - if ( subcol_SILHS_weight ) then - call endrun('subcol_gen error: Importance sampling is not enabled for SILHS when using OpenACC. Set subcol_SILHS_weight to false.') - end if + if ( l_est_kessler_microphys ) then + call endrun('subcol_gen error: compilation with OpenACC requires l_est_kessler_microphys = .false.') + end if + + if ( subcol_SILHS_constrainmn ) then + call endrun('subcol_gen error: compilation with OpenACC requires subcol_SILHS_constrainmn = .false.') + end if + + if ( subcol_SILHS_weight ) then + call endrun('subcol_gen error: Importance sampling is not enabled for SILHS when using OpenACC. Set subcol_SILHS_weight to false.') + end if #endif - if (.not. allocated(state_sc%lat)) then - call endrun('subcol_gen error: state_sc must be allocated before calling subcol_gen') - end if - - if( rx_Nc ) then - call endrun('subcol_gen_SILHS: rx_Nc not enabled') - endif - - if (subcol_SILHS_meanice) then - call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') - end if - - ! Determine num of columns and which chunk we're working on and what timestep - ngrdcol = state%ngrdcol - ncol = state%ncol - lchnk = state%lchnk - iter = get_nstep() ! #KTCtodo: The model iteration is passed into SILHS without taking - ! substepping into account. I may need to change this in - ! the future. Also, why does SILHS need an iter, but CLUBB - ! does not? - ! #ERDBG: The model iteration number is not used in SILHS unless - ! sequence_length > 1, but nobody runs with that option. - - ! Copy hm_metadata indices to shortcuts - iiPDF_chi = hm_metadata%iiPDF_chi - iiPDF_Ncn = hm_metadata%iiPDF_Ncn - iiPDF_rr = hm_metadata%iiPDF_rr - iiPDF_w = hm_metadata%iiPDF_w - iiPDF_Nr = hm_metadata%iiPDF_Nr - iiPDF_ri = hm_metadata%iiPDF_ri - iiPDF_Ni = hm_metadata%iiPDF_Ni - iiPDF_rs = hm_metadata%iiPDF_rs - iiPDF_Ns = hm_metadata%iiPDF_Ns - iirr = hm_metadata%iirr - iiNr = hm_metadata%iiNr - iirs = hm_metadata%iirs - iiri = hm_metadata%iiri - iirg = hm_metadata%iirg - iiNs = hm_metadata%iiNs - iiNi = hm_metadata%iiNi - iiNg = hm_metadata%iiNg - - !---------------- - ! Establish associations between pointers and physics buffer fields - !---------------- - call pbuf_get_field(pbuf, thlm_idx, thlm) - call pbuf_get_field(pbuf, ztodt_idx, ztodt_ptr) - call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) - call pbuf_get_field(pbuf, rtm_idx, rtm) - call pbuf_get_field(pbuf, alst_idx, alst) - call pbuf_get_field(pbuf, cld_idx, cld) - call pbuf_get_field(pbuf, qrain_idx, qrain) - call pbuf_get_field(pbuf, qsnow_idx, qsnow) - call pbuf_get_field(pbuf, nrain_idx, nrain) - call pbuf_get_field(pbuf, nsnow_idx, nsnow) - call pbuf_get_field(pbuf, tke_idx, tke_in) - call pbuf_get_field(pbuf, kvh_idx, khzm_in) - - ! Pull c_K from clubb parameters. - c_K = clubb_params_single_col(ic_K) - - !---------------- - ! Copy state and populate numbers and values of sub-columns - !---------------- - ztodt = ztodt_ptr(1) - num_subcols = subcol_SILHS_numsubcol - - ! The number of vertical grid levels used in CLUBB is pverp, which is originally - ! set in the call to setup_clubb_core_api from subroutine clubb_ini_cam. This - ! is stored in CLUBB in the object gr%nz. This isn't changed in CLUBB. - ! However, when SILHS is used, SILHS only uses pverp - top_lev + 1 vertical grid - ! levels and also uses the gr%nz object. The value of gr%nz needs to be reset - ! for SILHS here and then set again for CLUBB in subroutine clubb_tend_cam. - gr%nz = pverp - top_lev + 1 - - ! Calculate sample weights separately at all grid levels when - ! radiation is not called - l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs - ! when the weights vary with height. - ! Don't set to true until this is fixed!! + if (.not. allocated(state_sc%lat)) then + call endrun('subcol_gen error: state_sc must be allocated before calling subcol_gen') + end if + + if( rx_Nc ) then + call endrun('subcol_gen_SILHS: rx_Nc not enabled') + endif + + if (subcol_SILHS_meanice) then + call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') + end if + + ! Determine num of columns and which chunk we're working on and what timestep + ngrdcol = state%ngrdcol + ncol = state%ncol + lchnk = state%lchnk + iter = get_nstep() ! #KTCtodo: The model iteration is passed into SILHS without taking + ! substepping into account. I may need to change this in + ! the future. Also, why does SILHS need an iter, but CLUBB + ! does not? + ! #ERDBG: The model iteration number is not used in SILHS unless + ! sequence_length > 1, but nobody runs with that option. + + ! Copy hm_metadata indices to shortcuts + iiPDF_chi = hm_metadata%iiPDF_chi + iiPDF_Ncn = hm_metadata%iiPDF_Ncn + iiPDF_rr = hm_metadata%iiPDF_rr + iiPDF_w = hm_metadata%iiPDF_w + iiPDF_Nr = hm_metadata%iiPDF_Nr + iiPDF_ri = hm_metadata%iiPDF_ri + iiPDF_Ni = hm_metadata%iiPDF_Ni + iiPDF_rs = hm_metadata%iiPDF_rs + iiPDF_Ns = hm_metadata%iiPDF_Ns + iirr = hm_metadata%iirr + iiNr = hm_metadata%iiNr + iirs = hm_metadata%iirs + iiri = hm_metadata%iiri + iirg = hm_metadata%iirg + iiNs = hm_metadata%iiNs + iiNi = hm_metadata%iiNi + iiNg = hm_metadata%iiNg + + !---------------- + ! Establish associations between pointers and physics buffer fields + !---------------- + call pbuf_get_field(pbuf, thlm_idx, thlm) + call pbuf_get_field(pbuf, ztodt_idx, ztodt_ptr) + call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) + call pbuf_get_field(pbuf, rtm_idx, rtm) + call pbuf_get_field(pbuf, alst_idx, alst) + call pbuf_get_field(pbuf, cld_idx, cld) + call pbuf_get_field(pbuf, qrain_idx, qrain) + call pbuf_get_field(pbuf, qsnow_idx, qsnow) + call pbuf_get_field(pbuf, nrain_idx, nrain) + call pbuf_get_field(pbuf, nsnow_idx, nsnow) + call pbuf_get_field(pbuf, tke_idx, tke_in) + call pbuf_get_field(pbuf, kvh_idx, khzm_in) + + ! Pull c_K from clubb parameters. + c_K = clubb_params_single_col(ic_K) + + !---------------- + ! Copy state and populate numbers and values of sub-columns + !---------------- + ztodt = ztodt_ptr(1) + num_subcols = subcol_SILHS_numsubcol + + ! The number of thermodynamic vertical grid levels used in CLUBB is pver, which is + ! originally set in the call to setup_clubb_core_api from subroutine clubb_ini_cam. + ! This is stored in CLUBB in the object gr%nzt. This isn't changed in CLUBB. + ! However, when SILHS is used, SILHS only uses pver - top_lev + 1 vertical grid + ! levels and also uses the gr%nzt object. The value of gr%nzt needs to be reset + ! for SILHS here and then set again for CLUBB in subroutine clubb_tend_cam. + gr%nzm = pverp - top_lev + 1 + gr%nzt = pver - top_lev + 1 + + ! Calculate sample weights separately at all grid levels when + ! radiation is not called + l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs + ! when the weights vary with height. + ! Don't set to true until this is fixed!! - - ! Setup the CLUBB vertical grid object. This must be done for each - ! column as the z-distance between hybrid pressure levels can - ! change easily. - ! Define the CLUBB momentum grid (in height, units of m) - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - zi_g(i,k) = state%zi(i,pverp-k+1)-state%zi(i,pverp) - end do - end do - - - ! Define the CLUBB thermodynamic grid (in units of m) - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - zt_g(i,k+1) = state%zm(i,pver-k+1)-state%zi(i,pverp) - - ! Thermodynamic ghost point is below surface - zt_g(i,1) = -1._r8*zt_g(i,2) - end do - end do - - do i=1, ncol - ! Set the elevation of the surface - sfc_elevation(i) = state%zi(i,pver+1) - end do - - ! Heights need to be set at each timestep. - call setup_grid_api( pverp+1-top_lev, ncol, sfc_elevation(1:ncol), l_implemented, & ! intent(in) - grid_type, zi_g(1:ncol,2), zi_g(1:ncol,1), zi_g(1:ncol,pverp+1-top_lev), & ! intent(in) - zi_g(1:ncol,:), zt_g(1:ncol,:), & ! intent(in) - gr ) - - ! Calculate the distance between grid levels on the host model grid, - ! using host model grid indices. - do k = top_lev, pver - do i = 1, ngrdcol - dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) - end do - end do - ! Inverse delta_zm is required for the 3-level L-scale averaging - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - delta_zm(i,k+1) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) - - ! Handle CLUBB sub-sfc ghost point as done in clubb grid_class.F90 - delta_zm(i,1) = delta_zm(i,2) - end do - end do - - ! Compute dry static density on CLUBB vertical grid - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - rho_ds_zt(i,k+1) = (rga)*state%pdel(i,pverp-k)/dz_g(i,pverp-k) - - ! CLUBB ghost point under the surface - rho_ds_zt(i,1) = rho_ds_zt(i,2) - end do - end do - - ! Set up hydromet array, flipped from CAM vert grid to CLUBB - if ( iirr > 0 ) then - ! If ixrain and family are greater than zero, then MG2 is - ! being used, and rain and snow are part of state. Otherwise, - ! diagnostic rain and snow from MG1 are used in hydromet. - if (ixrain > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iirr) = state%q(i,pver-k+1,ixrain) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iirr) = qrain(i,pver-k+1) - end do - end do - endif - endif - - if ( iiNr > 0 ) then - if (ixnumrain > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNr) = state%q(i,pver-k+1,ixnumrain) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNr) = nrain(i,pver-k+1) - end do - end do - endif - endif - - if ( iirs > 0 ) then - if (ixsnow > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iirs) = state%q(i,pver-k+1,ixsnow) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iirs) = qsnow(i,pver-k+1) - end do - end do - endif - endif - - if ( iiNs > 0 ) then - if (ixnumsnow > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNs) = state%q(i,pver-k+1,ixnumsnow) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNs) = nsnow(i,pver-k+1) - end do - end do - endif - endif - - if ( iiri > 0 ) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiri) = state%q(i,pver-k+1,ixcldice) - end do - end do - endif - - if ( iiNi > 0 ) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k+1,iiNi) = state%q(i,pver-k+1,ixnumice) - end do - end do - endif - - do k = 1, hydromet_dim ! ghost point below the surface - do i = 1, ngrdcol - hydromet(i,1,k) = hydromet(i,2,k) - end do - end do - - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - Ncm(i,k+1) = state%q(i,pver-k+1,ixnumliq) - Ncm(i,1) = Ncm(i,2) + ! Setup the CLUBB vertical grid object. This must be done for each + ! column as the z-distance between hybrid pressure levels can + ! change easily. + ! Define the CLUBB momentum grid (in height, units of m) + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + zi_g(i,k) = state%zi(i,pverp-k+1)-state%zi(i,pverp) end do - end do + end do - ! Convert from CAM vertical grid to CLUBB - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - ice_supersat_frac_in(i,k) = ice_supersat_frac(i,pverp-k+1) - end do - end do - - - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - cld_frac_in(i,k+1) = alst(i,pver-k+1) - cld_frac_in(i,1) = cld_frac_in(i,2) ! Ghost pt below surface - end do - end do - - ! Calculate a clubb-specific exner function - ! (This is grid mean, as pressure levels do not change in - ! the subcolumn state) - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) - end do - end do - ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS - ! Compute Num concentration of cloud nuclei - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - Nc_in_cloud(i,k) = Ncm(i,k) / max( cld_frac_in(i,k), cloud_frac_min ) - end do - end do - - ! The variable wphydrometp is only used when l_calc_w_corr is enabled. - ! The l_calc_w_corr flag is turned off by default, so wphydrometp will - ! simply be set to 0 to simplify matters. - wphydrometp = 0.0_r8 - - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - khzm(i,k) = khzm_in(i,pverp-k+1) - end do - end do - - ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels - call init_precip_fracs_api( pverp-top_lev+1, ngrdcol, & - precip_fracs ) + ! Define the CLUBB thermodynamic grid (in units of m) + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + zt_g(i,k) = state%zm(i,pver-k+1)-state%zi(i,pverp) + end do + end do + + do i=1, ncol + ! Set the elevation of the surface + sfc_elevation(i) = state%zi(i,pver+1) + end do + + ! Heights need to be set at each timestep. + call setup_grid_api( pverp+1-top_lev, ncol, sfc_elevation(1:ncol), l_implemented, & ! intent(in) + grid_type, zi_g(1:ncol,2), zi_g(1:ncol,1), zi_g(1:ncol,pverp+1-top_lev), & ! intent(in) + zi_g(1:ncol,:), zt_g(1:ncol,:), & ! intent(in) + gr ) + + ! Calculate the distance between grid levels on the host model grid, + ! using host model grid indices. + do k = top_lev, pver + do i = 1, ngrdcol + dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) + end do + end do - call setup_pdf_parameters_api( gr, pverp-top_lev+1, ngrdcol, pdf_dim, hydromet_dim, ztodt, & ! In - Nc_in_cloud, cld_frac_in, khzm, & ! In - ice_supersat_frac_in, hydromet, wphydrometp, & ! In - corr_array_n_cloud, corr_array_n_below, & ! In - hm_metadata, & ! In - pdf_params_chnk(lchnk), & ! In - clubb_params_single_col, & ! In - clubb_config_flags%iiPDF_type, & ! In - clubb_config_flags%l_use_precip_frac, & ! In - clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_diagnose_correlations, & ! In - clubb_config_flags%l_calc_w_corr, & ! In - clubb_config_flags%l_const_Nc_in_cloud, & ! In - clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In - stats_metadata, & ! In - stats_zt, stats_zm, stats_sfc, & ! In - hydrometp2, & ! Inout - mu_x_1, mu_x_2, & ! Out - sigma_x_1, sigma_x_2, & ! Out - corr_array_1, corr_array_2, & ! Out - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out - precip_fracs ) ! Inout + ! Inverse delta_zm is required for the 3-level L-scale averaging + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + delta_zm(i,k) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) + end do + end do - ! In order for Lscale to be used properly, it needs to be passed out of - ! advance_clubb_core, saved to the pbuf, and then pulled out of the - ! pbuf for use here. The profile of Lscale is passed into subroutine - ! generate_silhs_sample_api for use in calculating the vertical - ! correlation coefficient. Rather than output Lscale directly, its - ! value can be calculated from other fields that are already output to - ! pbuf. The equation relating Lscale to eddy diffusivity is: - ! - ! Kh = c_K * Lscale * sqrt( TKE ). - ! - ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted - ! from CLUBB's tunable parameters. The equation for Lscale is: - ! - ! Lscale = Kh / ( c_K * sqrt( TKE ) ). - ! - ! Since Kh and TKE are output on momentum (interface) grid levels, the - ! resulting calculation of Lscale is also found on momentum levels. It - ! needs to be interpolated back to thermodynamic (midpoint) grid levels - ! for further use. - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - tke(i,k) = tke_in(i,pverp-k+1) - end do - end do + ! Compute dry static density on CLUBB vertical grid + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + rho_ds_zt(i,k) = (rga)*state%pdel(i,pverp-k)/dz_g(i,pverp-k) + end do + end do - do k = 1, pverp-top_lev+1 - do i = 1, ngrdcol - Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) - end do - end do - - do i = 1, ngrdcol - Lscale(i,1) = Lscale_zm(i,1) + ( Lscale_zm(i,2) - Lscale_zm(i,1) ) & - * ( zt_g(i,1) - zi_g(i,1) ) / ( zi_g(i,2) - zi_g(i,1) ) - end do + ! Set up hydromet array, flipped from CAM vert grid to CLUBB + if ( iirr > 0 ) then + ! If ixrain and family are greater than zero, then MG2 is + ! being used, and rain and snow are part of state. Otherwise, + ! diagnostic rain and snow from MG1 are used in hydromet. + if (ixrain > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iirr) = state%q(i,pver-k+1,ixrain) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iirr) = qrain(i,pver-k+1) + end do + end do + endif + endif - do k = 2, pverp-top_lev+1 - do i = 1, ngrdcol - Lscale(i,k) = Lscale_zm(i,k-1) + ( Lscale_zm(i,k) - Lscale_zm(i,k-1) ) & - * ( zt_g(i,k) - zi_g(i,k-1) ) / ( zi_g(i,k) - zi_g(i,k-1) ) - end do - end do + if ( iiNr > 0 ) then + if (ixnumrain > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iiNr) = state%q(i,pver-k+1,ixnumrain) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iiNr) = nrain(i,pver-k+1) + end do + end do + endif + endif + + if ( iirs > 0 ) then + if (ixsnow > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iirs) = state%q(i,pver-k+1,ixsnow) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iirs) = qsnow(i,pver-k+1) + end do + end do + endif + endif + + if ( iiNs > 0 ) then + if (ixnumsnow > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iiNs) = state%q(i,pver-k+1,ixnumsnow) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iiNs) = nsnow(i,pver-k+1) + end do + end do + endif + endif + + if ( iiri > 0 ) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iiri) = state%q(i,pver-k+1,ixcldice) + end do + end do + endif + + if ( iiNi > 0 ) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k,iiNi) = state%q(i,pver-k+1,ixnumice) + end do + end do + endif - do k = 2, pverp-top_lev+1 - do i = 1, ngrdcol - Lscale(i,:) = max( Lscale(i,:), 0.01_r8 ) - end do + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + Ncm(i,k) = state%q(i,pver-k+1,ixnumliq) end do + end do - !$acc data create( X_mixt_comp_all_levs, X_nl_all_levs, lh_rc_clipped, lh_Nc_clipped, & - !$acc& lh_sample_point_weights, lh_rt_clipped, lh_rt_clipped, & - !$acc& lh_rv_clipped, lh_thl_clipped, THL_lh_out, & - !$acc& RT_lh_out, RCM_lh_out, NCLW_lh_out, ICE_lh_out, & - !$acc& NICE_lh_out, RVM_lh_out, THL_lh_out, RAIN_lh_out, & - !$acc& NRAIN_lh_out, SNOW_lh_out, NSNOW_lh_out, WM_lh_out, & - !$acc& OMEGA_lh_out ) & - !$acc& copyin( state, state%zm, state%phis, rho_ds_zt, invs_exner ) & - !$acc& copyout( state%t, state%s, state%omega, state_sc%q ) - !$acc& async(1) - - ! Set the seed to the random number generator based on a quantity that - ! will be reproducible for restarts. - lh_seed = int( 1.0e4_r8 * rtm(1,pver), kind = genrand_intg ) - - ! Let's generate some subcolumns!!!!! - call generate_silhs_sample_api( & - iter, pdf_dim, num_subcols, sequence_length, pverp-top_lev+1, ngrdcol, & ! In - l_calc_weights_all_levs_itime, & ! In - pdf_params_chnk(lchnk), delta_zm, Lscale, & ! In - lh_seed, hm_metadata, & ! In - rho_ds_zt, & ! In - mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In - precip_fracs, silhs_config_flags, & ! In - vert_decorr_coef, & ! In - stats_metadata, & ! In - stats_lh_zt, stats_lh_sfc, & ! InOut - X_nl_all_levs, X_mixt_comp_all_levs, & ! Out - lh_sample_point_weights) ! Out - - ! Extract clipped variables from subcolumns - call clip_transform_silhs_output_api( gr, pverp-top_lev+1, ngrdcol, num_subcols, & ! In - pdf_dim, hydromet_dim, hm_metadata, & ! In - X_mixt_comp_all_levs, & ! In - X_nl_all_levs, & ! In - pdf_params_chnk(lchnk), & ! In - l_use_Ncn_to_Nc, & ! In - lh_rt_clipped, lh_thl_clipped, & ! Out - lh_rc_clipped, lh_rv_clipped, & ! Out - lh_Nc_clipped ) ! Out - !$acc wait + ! Convert from CAM vertical grid to CLUBB + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + ice_supersat_frac_in(i,k) = ice_supersat_frac(i,pver-k+1) + end do + end do - if ( l_est_kessler_microphys ) then - call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') - end if - - !------------------------------------------------------------------------- - ! Convert from CLUBB vertical grid to CAM grid - !------------------------------------------------------------------------ - ! This kernel is executed in stream 1: - !$acc parallel loop collapse(3) default(present) async(1) - do k = top_lev, pverp - do j = 1, num_subcols - do i = 1, ngrdcol - RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,pverp-k+1) - RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,pverp-k+1) - NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,pverp-k+1) - RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,pverp-k+1) - THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,pverp-k+1) - end do - end do - end do + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + cld_frac_in(i,k) = alst(i,pver-k+1) + end do + end do - ! This kernel is executed in stream 2: - !$acc parallel loop collapse(3) default(present) async(2) - do k = top_lev, pverp - do j = 1, num_subcols - do i = 1, ngrdcol - ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) - NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ni) - RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rr) - NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Nr) - SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rs) - NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ns) - WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_w) - end do - end do - end do + ! Calculate a clubb-specific exner function + ! (This is grid mean, as pressure levels do not change in + ! the subcolumn state) + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) + end do + end do + + ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS + ! Compute Num concentration of cloud nuclei + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + Nc_in_cloud(i,k) = Ncm(i,k) / max( cld_frac_in(i,k), cloud_frac_min ) + end do + end do + + ! The variable wphydrometp is only used when l_calc_w_corr is enabled. + ! The l_calc_w_corr flag is turned off by default, so wphydrometp will + ! simply be set to 0 to simplify matters. + wphydrometp = 0.0_r8 + + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + khzm(i,k) = khzm_in(i,pverp-k+1) + end do + end do - ! This kernel is executed in stream 2 because WM_lh_out comes from stream 2: - !$acc parallel loop collapse(3) default(present) async(2) - do k = top_lev, pverp - do j = 1, num_subcols - do i = 1, ngrdcol - OMEGA_lh_out( num_subcols*(i-1)+j,k ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k) & - * rho_ds_zt(i,pverp-k+1) * gravit - end do - end do - end do + ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels + call init_precip_fracs_api( pver-top_lev+1, ngrdcol, & + precip_fracs ) - if ( l_est_kessler_microphys ) then - do k = top_lev, pverp - do j = 1, num_subcols - do i = 1, ngrdcol - AKm_out(i,k) = AKm(i,pverp-k+1) - lh_AKm_out(i,k) = lh_AKm(i,pverp-k+1) - end do - end do - end do - end if + call setup_pdf_parameters_api( gr, pverp-top_lev+1, pver-top_lev+1, ngrdcol, pdf_dim, & ! In + hydromet_dim, ztodt, Nc_in_cloud, cld_frac_in, khzm, & ! In + ice_supersat_frac_in, hydromet, wphydrometp, & ! In + corr_array_n_cloud, corr_array_n_below, & ! In + hm_metadata, & ! In + pdf_params_chnk(lchnk), & ! In + clubb_params_single_col, & ! In + clubb_config_flags%iiPDF_type, & ! In + clubb_config_flags%l_use_precip_frac, & ! In + clubb_config_flags%l_predict_upwp_vpwp, & ! In + clubb_config_flags%l_diagnose_correlations, & ! In + clubb_config_flags%l_calc_w_corr, & ! In + clubb_config_flags%l_const_Nc_in_cloud, & ! In + clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In + stats_metadata, & ! In + stats_zt, stats_zm, stats_sfc, & ! In + hydrometp2, & ! Inout + mu_x_1, mu_x_2, & ! Out + sigma_x_1, sigma_x_2, & ! Out + corr_array_1, corr_array_2, & ! Out + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out + precip_fracs ) ! Inout + + ! In order for Lscale to be used properly, it needs to be passed out of + ! advance_clubb_core, saved to the pbuf, and then pulled out of the + ! pbuf for use here. The profile of Lscale is passed into subroutine + ! generate_silhs_sample_api for use in calculating the vertical + ! correlation coefficient. Rather than output Lscale directly, its + ! value can be calculated from other fields that are already output to + ! pbuf. The equation relating Lscale to eddy diffusivity is: + ! + ! Kh = c_K * Lscale * sqrt( TKE ). + ! + ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted + ! from CLUBB's tunable parameters. The equation for Lscale is: + ! + ! Lscale = Kh / ( c_K * sqrt( TKE ) ). + ! + ! Since Kh and TKE are output on momentum (interface) grid levels, the + ! resulting calculation of Lscale is also found on momentum levels. It + ! needs to be interpolated back to thermodynamic (midpoint) grid levels + ! for further use. + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + tke(i,k) = tke_in(i,pverp-k+1) + end do + end do + + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) + end do + end do - ! Pack up weights - ! Using grid level 2 always won't work if weights vary with height. - call subcol_pack(lchnk, lh_sample_point_weights(:,:,2), weights ) - call subcol_set_weight(lchnk, weights) - - ! Constrain the sample distribution of cloud water and ice to the same mean - ! as the grid to prevent negative condensate errors - if(subcol_SILHS_constrainmn) then - - do i = 1, ngrdcol - - stncol = num_subcols*(i-1) - - call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) - if ( ixrain > 0 ) & - call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixrain) ) - if ( ixsnow > 0 ) & - call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixsnow) ) - call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) - call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) - call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumice) ) - if ( ixnumrain > 0 ) & - call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumrain) ) - if ( ixnumsnow > 0 ) & - call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumsnow) ) - call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumliq) ) - do k = top_lev, pver - ! Look for exceptionally large values of condensate - if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then - ! Clip the large values - where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) - ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 - NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 - end where - ! Recalculate the weighted subcolumn mean - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixcldice)-tmp_mean - ! Add the difference to each subcolumn - ICE_lh_out(stncol+1:stncol+num_subcols,k) = & - ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - ! Recalculate the weight subcolumn mean for ice num conc - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixnumice)-tmp_mean - ! Add the difference to each subcolumn - if(diff_mean.gt.0.0_r8) then - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - else ! just use the grid mean in each subcolumn - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - state%q(i,k,ixnumice) - end if - ! Test adjusted means for debugging - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixcldice)-tmp_mean - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixnumice)-tmp_mean - endif - end do ! k = top_lev, pver - end do - endif ! subcol_silhs_constrainm - + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + Lscale(i,k) = Lscale_zm(i,k) + ( Lscale_zm(i,k+1) - Lscale_zm(i,k) ) & + * ( zt_g(i,k) - zi_g(i,k) ) / ( zi_g(i,k+1) - zi_g(i,k) ) + end do + end do + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + Lscale(i,:) = max( Lscale(i,:), 0.01_r8 ) + end do + end do + + !$acc data create( X_mixt_comp_all_levs, X_nl_all_levs, lh_rc_clipped, lh_Nc_clipped, & + !$acc& lh_sample_point_weights, lh_rt_clipped, lh_rt_clipped, & + !$acc& lh_rv_clipped, lh_thl_clipped, THL_lh_out, & + !$acc& RT_lh_out, RCM_lh_out, NCLW_lh_out, ICE_lh_out, & + !$acc& NICE_lh_out, RVM_lh_out, THL_lh_out, RAIN_lh_out, & + !$acc& NRAIN_lh_out, SNOW_lh_out, NSNOW_lh_out, WM_lh_out, & + !$acc& OMEGA_lh_out ) & + !$acc& copyin( state, state%zm, state%phis, rho_ds_zt, invs_exner ) & + !$acc& copyout( state%t, state%s, state%omega, state_sc%q ) + !$acc& async(1) + + ! Set the seed to the random number generator based on a quantity that + ! will be reproducible for restarts. + lh_seed = int( 1.0e4_r8 * rtm(1,pver), kind = genrand_intg ) + + ! Let's generate some subcolumns!!!!! + call generate_silhs_sample_api( & + iter, pdf_dim, num_subcols, sequence_length, pver-top_lev+1, ngrdcol, & ! In + l_calc_weights_all_levs_itime, & ! In + pdf_params_chnk(lchnk), delta_zm, Lscale, & ! In + lh_seed, hm_metadata, & ! In + rho_ds_zt, & ! In + mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In + precip_fracs, silhs_config_flags, & ! In + vert_decorr_coef, & ! In + stats_metadata, & ! In + stats_lh_zt, stats_lh_sfc, & ! InOut + X_nl_all_levs, X_mixt_comp_all_levs, & ! Out + lh_sample_point_weights) ! Out + + ! Extract clipped variables from subcolumns + call clip_transform_silhs_output_api( gr, pver-top_lev+1, ngrdcol, num_subcols, & ! In + pdf_dim, hydromet_dim, hm_metadata, & ! In + X_mixt_comp_all_levs, & ! In + X_nl_all_levs, & ! In + pdf_params_chnk(lchnk), & ! In + l_use_Ncn_to_Nc, & ! In + lh_rt_clipped, lh_thl_clipped, & ! Out + lh_rc_clipped, lh_rv_clipped, & ! Out + lh_Nc_clipped ) ! Out + !$acc wait - !--------------------------------------------------- - ! Updating state variables - !--------------------------------------------------- - ! Code to update the state variables for interactive runs - ! This kernel is executed in stream 3, but waits for stream 1 - ! because THL_lh_out and RCM_lh_out come from stream 1: - !$acc parallel loop collapse(3) default(present) wait(1) async(3) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - - state_sc%t(num_subcols*(i-1)+j,k) = THL_lh_out(num_subcols*(i-1)+j,k) * invs_exner(i,k) & - + Lv * RCM_lh_out(num_subcols*(i-1)+j,k) / Cp - - state_sc%s(num_subcols*(i-1)+j,k) = cpair * state_sc%t(num_subcols*(i-1)+j,k) & - + gravit * state%zm(i,k) + state%phis(i) - end do - end do - end do + if ( l_est_kessler_microphys ) then + call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') + end if + + !------------------------------------------------------------------------- + ! Convert from CLUBB vertical grid to CAM grid + !------------------------------------------------------------------------ + ! This kernel is executed in stream 1: + !$acc parallel loop collapse(3) default(present) async(1) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,pver-k+1) + RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,pver-k+1) + NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,pver-k+1) + RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,pver-k+1) + THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,pver-k+1) + end do + end do + end do - ! This kernel is executed in stream 4, but waits for stream 1 and 2 - ! because RVM_lh_out is from stream 1 and OMEGA_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(4) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - ! Vertical Velocity is not part of the energy conservation checks, but - ! we need to be careful here, because the SILHS output VV is noisy. - state_sc%omega(num_subcols*(i-1)+j,k) = OMEGA_lh_out(num_subcols*(i-1)+j,k) - state_sc%q(num_subcols*(i-1)+j,k,ixq) = RVM_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do + ! This kernel is executed in stream 2: + !$acc parallel loop collapse(3) default(present) async(2) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_ri) + NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_Ni) + RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_rr) + NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_Nr) + SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_rs) + NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_Ns) + WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_w) + end do + end do + end do + + ! This kernel is executed in stream 2 because WM_lh_out comes from stream 2: + !$acc parallel loop collapse(3) default(present) async(2) + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + OMEGA_lh_out( num_subcols*(i-1)+j,k ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k) & + * rho_ds_zt(i,pver-k+1) * gravit + end do + end do + end do + + if ( l_est_kessler_microphys ) then + do k = top_lev, pver + do j = 1, num_subcols + do i = 1, ngrdcol + AKm_out(i,k) = AKm(i,pver-k+1) + lh_AKm_out(i,k) = lh_AKm(i,pver-k+1) + end do + end do + end do + end if + ! Pack up weights + ! Using grid level 2 always won't work if weights vary with height. + call subcol_pack(lchnk, lh_sample_point_weights(:,:,2), weights ) + call subcol_set_weight(lchnk, weights) + + ! Constrain the sample distribution of cloud water and ice to the same mean + ! as the grid to prevent negative condensate errors + if(subcol_SILHS_constrainmn) then - if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp - - ! This kernel is executed in stream 5, but waits for stream 1 and 2 - ! because RCM_lh_out is from stream 1 and ICE_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(5) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) - state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = ICE_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - - if (ixrain > 0) then - ! This kernel is executed in stream 6, but waits for stream 2 - ! because RAIN_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(6) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - end if + do i = 1, ngrdcol - if (ixsnow > 0) then - ! This kernel is executed in stream 7, but waits for stream 2 - ! because SNOW_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(7) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - end if + stncol = num_subcols*(i-1) - else - - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) - state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = state%q(i,k,ixcldice) - if (ixrain > 0) then - state_sc%q(num_subcols*(i-1)+j,k,ixrain) = state%q(i,k,ixrain) - end if - if (ixsnow > 0) then - state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = state%q(i,k,ixsnow) - end if - end do - end do - end do - - endif + call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) + if ( ixrain > 0 ) & + call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixrain) ) + if ( ixsnow > 0 ) & + call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixsnow) ) + call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) + call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) + call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumice) ) + if ( ixnumrain > 0 ) & + call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumrain) ) + if ( ixnumsnow > 0 ) & + call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumsnow) ) + call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumliq) ) + do k = top_lev, pver + ! Look for exceptionally large values of condensate + if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then + ! Clip the large values + where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) + ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 + NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 + end where + ! Recalculate the weighted subcolumn mean + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & + weights(stncol+1:stncol+num_subcols), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixcldice)-tmp_mean + ! Add the difference to each subcolumn + ICE_lh_out(stncol+1:stncol+num_subcols,k) = & + ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + ! Recalculate the weight subcolumn mean for ice num conc + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & + weights(stncol+1:stncol+num_subcols), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixnumice)-tmp_mean + ! Add the difference to each subcolumn + if(diff_mean.gt.0.0_r8) then + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + else ! just use the grid mean in each subcolumn + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + state%q(i,k,ixnumice) + end if + ! Test adjusted means for debugging + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & + weights(stncol+1:stncol+num_subcols), & + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixcldice)-tmp_mean + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & + weights(stncol+1:stncol+num_subcols), & + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixnumice)-tmp_mean + endif + end do ! k = top_lev, pver + end do + endif ! subcol_silhs_constrainm + + + !--------------------------------------------------- + ! Updating state variables + !--------------------------------------------------- + ! Code to update the state variables for interactive runs + ! This kernel is executed in stream 3, but waits for stream 1 + ! because THL_lh_out and RCM_lh_out come from stream 1: + !$acc parallel loop collapse(3) default(present) wait(1) async(3) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + + state_sc%t(num_subcols*(i-1)+j,k) = THL_lh_out(num_subcols*(i-1)+j,k) * invs_exner(i,k) & + + Lv * RCM_lh_out(num_subcols*(i-1)+j,k) / Cp + + state_sc%s(num_subcols*(i-1)+j,k) = cpair * state_sc%t(num_subcols*(i-1)+j,k) & + + gravit * state%zm(i,k) + state%phis(i) + end do + end do + end do + + ! This kernel is executed in stream 4, but waits for stream 1 and 2 + ! because RVM_lh_out is from stream 1 and OMEGA_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(4) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + ! Vertical Velocity is not part of the energy conservation checks, but + ! we need to be careful here, because the SILHS output VV is noisy. + state_sc%omega(num_subcols*(i-1)+j,k) = OMEGA_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixq) = RVM_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + - if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp + if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp - ! This kernel is executed in stream 8, but waits for stream 1 and 2 - ! because NCLW_lh_out is from stream 1 and NICE_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(8) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) - state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = NCLW_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - - if (ixnumrain > 0) then - ! This kernel is executed in stream 9, but waits for stream 2 - ! because NRAIN_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(9) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - end if - - if (ixnumsnow > 0) then - ! This kernel is executed in stream 10, but waits for stream 2 - ! because NSNOW_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(10) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) - end do - end do - end do - end if + ! This kernel is executed in stream 5, but waits for stream 1 and 2 + ! because RCM_lh_out is from stream 1 and ICE_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(5) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = ICE_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do - else + if (ixrain > 0) then + ! This kernel is executed in stream 6, but waits for stream 2 + ! because RAIN_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(6) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) - state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = state%q(i,k,ixnumice) - if (ixnumrain > 0) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = state%q(i,k,ixnumrain) - end if - if (ixnumsnow > 0) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = state%q(i,k,ixnumsnow) - end if - end do - end do - end do + if (ixsnow > 0) then + ! This kernel is executed in stream 7, but waits for stream 2 + ! because SNOW_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(7) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if - endif - - ! This kernel is executed in stream 8, because state_sc%q(:,:,ixnumliq) and - ! state_sc%q(:,:,ixnumice) are from stream 8 - !$acc parallel loop collapse(3) default(present) async(8) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) - if (state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) .lt. min_num_conc) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = min_num_conc - end if - - if (state_sc%q(num_subcols*(i-1)+j,k,ixnumice) .lt. min_num_conc) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = min_num_conc - end if - end do - end do - end do + else - if (ixnumrain > 0) then - ! This kernel is executed in stream 9, because state_sc%q(:,:,ixnumrain) is - ! from stream 9 - !$acc parallel loop collapse(3) default(present) async(9) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = min_num_conc - end if - end do - end do - end do - endif + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = state%q(i,k,ixcldice) + if (ixrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = state%q(i,k,ixrain) + end if + if (ixsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = state%q(i,k,ixsnow) + end if + end do + end do + end do + + endif + + if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp + + ! This kernel is executed in stream 8, but waits for stream 1 and 2 + ! because NCLW_lh_out is from stream 1 and NICE_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(8) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = NCLW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (ixnumrain > 0) then + ! This kernel is executed in stream 9, but waits for stream 2 + ! because NRAIN_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(9) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + if (ixnumsnow > 0) then + ! This kernel is executed in stream 10, but waits for stream 2 + ! because NSNOW_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(10) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + else + + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = state%q(i,k,ixnumice) + if (ixnumrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = state%q(i,k,ixnumrain) + end if + if (ixnumsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = state%q(i,k,ixnumsnow) + end if + end do + end do + end do - if (ixnumsnow > 0) then - ! This kernel is executed in stream 10, because state_sc%q(:,:,ixnumsnow) is - ! from stream 10 - !$acc parallel loop collapse(3) default(present) async(10) - do k = 1, pver-top_lev+1 - do j = 1, num_subcols - do i = 1, ngrdcol - if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then - state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = min_num_conc + endif + + ! This kernel is executed in stream 8, because state_sc%q(:,:,ixnumliq) and + ! state_sc%q(:,:,ixnumice) are from stream 8 + !$acc parallel loop collapse(3) default(present) async(8) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = min_num_conc + end if + + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumice) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = min_num_conc + end if + end do + end do + end do + + if (ixnumrain > 0) then + ! This kernel is executed in stream 9, because state_sc%q(:,:,ixnumrain) is + ! from stream 9 + !$acc parallel loop collapse(3) default(present) async(9) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = min_num_conc end if - end do - end do - end do - endif + end do + end do + end do + endif + + if (ixnumsnow > 0) then + ! This kernel is executed in stream 10, because state_sc%q(:,:,ixnumsnow) is + ! from stream 10 + !$acc parallel loop collapse(3) default(present) async(10) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = min_num_conc + end if + end do + end do + end do + endif - if ( l_outfld_subcol ) then - - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - do j = 1, num_subcols + if ( l_outfld_subcol ) then + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + do j = 1, num_subcols + + ! Calc effective cloud fraction for testing + if ( ( lh_rc_clipped(i,j,pver-k+1) .gt. qsmall ) & + .or. ( X_nl_all_levs(i,j,pver-k+1,iiPDF_ri) .gt. qsmall ) ) then + eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,pver-k+1) + else + eff_cldfrac(i,k) = 0.0_r8 + endif - ! Calc effective cloud fraction for testing - if ( ( lh_rc_clipped(i,j,pverp-k+1) .gt. qsmall ) & - .or. ( X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) .gt. qsmall ) ) then - eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,pverp-k+1) - else - eff_cldfrac(i,k) = 0.0_r8 - endif - - end do - - eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) - - end do - end do - - ! Pack precip_frac for output - do k = 2, pverp-top_lev+1 - do i = 1, ngrdcol - precip_frac_out(i,pver-k+2) = precip_fracs%precip_frac(i,k) - end do - end do - - call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) - call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) - call outfld( 'SILHS_RTM', rtm, pcols, lchnk ) - call outfld( 'SILHS_THLM', thlm, pcols, lchnk ) - call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) - call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) - call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) - call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) - if ( l_est_kessler_microphys ) then - call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) - call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) - end if - call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) - call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) - if ( subcol_SILHS_constrainmn ) then - call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) - call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) - if ( ixsnow > 0 ) then - call outfld( 'SILHS_MSC_CLDLIQ', meansc_liq, pcols, lchnk ) - call outfld( 'SILHS_STDSC_CLDLIQ', stdsc_liq, pcols, lchnk ) - call outfld( 'SILHS_MSC_Q', meansc_vap, pcols, lchnk ) - call outfld( 'SILHS_STDSC_Q', stdsc_vap, pcols, lchnk ) - endif ! ixsnow > 0 - endif ! subcol_SILHS_constrainmn - call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) - end if - - !$acc end data - !$acc wait + end do + + eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) + + end do + end do + + ! Pack precip_frac for output + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + precip_frac_out(i,pver-k+2) = precip_fracs%precip_frac(i,k) + end do + end do + + call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) + call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) + call outfld( 'SILHS_RTM', rtm, pcols, lchnk ) + call outfld( 'SILHS_THLM', thlm, pcols, lchnk ) + call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) + call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) + call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) + call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) + if ( l_est_kessler_microphys ) then + call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) + call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) + end if + call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) + call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) + if ( subcol_SILHS_constrainmn ) then + call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) + call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) + if ( ixsnow > 0 ) then + call outfld( 'SILHS_MSC_CLDLIQ', meansc_liq, pcols, lchnk ) + call outfld( 'SILHS_STDSC_CLDLIQ', stdsc_liq, pcols, lchnk ) + call outfld( 'SILHS_MSC_Q', meansc_vap, pcols, lchnk ) + call outfld( 'SILHS_STDSC_Q', stdsc_vap, pcols, lchnk ) + endif ! ixsnow > 0 + endif ! subcol_SILHS_constrainmn + call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) + end if + + !$acc end data + !$acc wait #endif #endif - end subroutine subcol_gen_SILHS + end subroutine subcol_gen_SILHS - subroutine subcol_ptend_avg_SILHS(ptend_sc, ngrdcol, lchnk, ptend) - use physics_buffer, only: physics_buffer_desc - use subcol_utils, only: subcol_ptend_get_firstsubcol, subcol_ptend_avg_shr, & - subcol_get_weight, subcol_get_filter, & - is_filter_set, is_weight_set + subroutine subcol_ptend_avg_SILHS(ptend_sc, ngrdcol, lchnk, ptend) + use physics_buffer, only: physics_buffer_desc + use subcol_utils, only: subcol_ptend_get_firstsubcol, subcol_ptend_avg_shr, & + subcol_get_weight, subcol_get_filter, & + is_filter_set, is_weight_set - !----------------------------------- - ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) - !----------------------------------- + !----------------------------------- + ! Average the subcolumns dimension (pcols*psubcols) to the grid dimension (pcols) + !----------------------------------- - type(physics_ptend), intent(in) :: ptend_sc ! intent in - integer, intent(in) :: ngrdcol ! # grid cols - integer, intent(in) :: lchnk ! chunk index - type(physics_ptend), intent(inout) :: ptend - ! Because we can't get a state passed in here, we might have to use values from the - ! subcolumn generation. This would make any conservation checks invalid if this - ! function is called after another parameterization... hmm. + type(physics_ptend), intent(in) :: ptend_sc ! intent in + integer, intent(in) :: ngrdcol ! # grid cols + integer, intent(in) :: lchnk ! chunk index + type(physics_ptend), intent(inout) :: ptend + ! Because we can't get a state passed in here, we might have to use values from the + ! subcolumn generation. This would make any conservation checks invalid if this + ! function is called after another parameterization... hmm. - call subcol_ptend_avg_shr(ptend_sc, ngrdcol, lchnk, ptend, is_filter_set(), is_weight_set()) + call subcol_ptend_avg_shr(ptend_sc, ngrdcol, lchnk, ptend, is_filter_set(), is_weight_set()) - end subroutine subcol_ptend_avg_SILHS + end subroutine subcol_ptend_avg_SILHS - subroutine subcol_SILHS_var_covar_driver & - ( ztodt, state_sc, ptend_sc, & - pbuf ) + subroutine subcol_SILHS_var_covar_driver & + ( ztodt, state_sc, ptend_sc, & + pbuf ) - ! This subroutine calculates microphysical effects on five variances and - ! covariances: rtp2, thlp2, wprtp, wpthlp, and rtpthlp. - ! - ! This code is experimental!! + ! This subroutine calculates microphysical effects on five variances and + ! covariances: rtp2, thlp2, wprtp, wpthlp, and rtpthlp. + ! + ! This code is experimental!! - use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field + use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field #ifdef CLUBB_SGS #ifdef SILHS - use subcol_utils, only: subcol_get_weight - use subcol_pack_mod, only: subcol_unpack, subcol_get_nsubcol - use clubb_api_module, only: T_in_K2thlm_api, & - init_pdf_params_api, & - copy_multi_pdf_params_to_single,& - pdf_parameter - use silhs_api_module, only: lh_microphys_var_covar_driver_api + use subcol_utils, only: subcol_get_weight + use subcol_pack_mod, only: subcol_unpack, subcol_get_nsubcol + use clubb_api_module, only: T_in_K2thlm_api, & + init_pdf_params_api, & + copy_multi_pdf_params_to_single,& + pdf_parameter + use silhs_api_module, only: lh_microphys_var_covar_driver_api #endif #endif - implicit none + implicit none - ! Parameters - ! This fill value is set to catch errors; it should not be read. - real(r8), parameter :: fillvalue = -999._r8 + ! Parameters + ! This fill value is set to catch errors; it should not be read. + real(r8), parameter :: fillvalue = -999._r8 - ! Input Variables - real(r8), intent(in) :: ztodt ! model time increment - type(physics_state), intent(in) :: state_sc ! state for sub-columns - type(physics_ptend), intent(in) :: ptend_sc ! ptend for sub-columns + ! Input Variables + real(r8), intent(in) :: ztodt ! model time increment + type(physics_state), intent(in) :: state_sc ! state for sub-columns + type(physics_ptend), intent(in) :: ptend_sc ! ptend for sub-columns - ! Pointers - type(physics_buffer_desc), pointer :: pbuf(:) + ! Pointers + type(physics_buffer_desc), pointer :: pbuf(:) #ifdef CLUBB_SGS #ifdef SILHS - ! Local Variables - integer :: lchnk, ngrdcol, igrdcol, isubcol, ns, k - integer, dimension(pcols) :: nsubcol - real(r8), dimension(pcols*psubcols) :: weights_packed - real(r8), dimension(pcols,psubcols) :: weights - real(r8), dimension(pcols,psubcols,pverp) :: rc_all, rv_all, rt_all, w_all, thl_all - real(r8), dimension(pcols,psubcols,pver ) :: s_all, t_all, zm_all, omega_all, pmid_all - real(r8), dimension(pcols,psubcols) :: phis_all - real(r8), dimension(pcols,psubcols,pver ) :: stend, ttend - real(r8), dimension(pcols,psubcols,pverp) :: thltend, qctend, qvtend - - real(r8), dimension(pcols,psubcols,pver) :: dz_g, pdel_all, rho - real(r8), dimension(pcols,psubcols,pverp) :: zi_all - - real(r8), dimension(pcols,psubcols,pver ) :: exner - - ! Inputs to lh_microphys_var_covar_driver - real(r8), dimension(pcols,psubcols,pverp) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & - qctend_clubb, qvtend_clubb, thltend_clubb - real(r8), dimension(pcols,psubcols,pverp-top_lev+1) :: height_depndt_weights - - ! Outputs from lh_microphys_var_covar_driver - real(r8), dimension(:,:), pointer :: rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, & - wpthlp_mc_zt, rtpthlp_mc_zt - - ! pbuf indices - integer :: & - rtp2_mc_zt_idx, & - thlp2_mc_zt_idx, & - wprtp_mc_zt_idx, & - wpthlp_mc_zt_idx, & - rtpthlp_mc_zt_idx - - type(pdf_parameter) :: pdf_params_single_col - - !----- Begin Code ----- - - call init_pdf_params_api( pverp+1-top_lev, 1, pdf_params_single_col ) - - ! Don't do anything if this option isn't enabled. - if ( .not. subcol_SILHS_var_covar_src ) return - - lchnk = state_sc%lchnk - ngrdcol = state_sc%ngrdcol - - ! Obtain indices - rtp2_mc_zt_idx = pbuf_get_index('rtp2_mc_zt') - thlp2_mc_zt_idx = pbuf_get_index('thlp2_mc_zt') - wprtp_mc_zt_idx = pbuf_get_index('wprtp_mc_zt') - wpthlp_mc_zt_idx = pbuf_get_index('wpthlp_mc_zt') - rtpthlp_mc_zt_idx = pbuf_get_index('rtpthlp_mc_zt') - - ! Obtain pbuf fields for output - call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt) - call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt) - call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) - call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) - call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) - - ! Unpack needed tendencies from subcolumn ptends - call subcol_unpack(lchnk, ptend_sc%s(:,:), stend, fillvalue) - call subcol_unpack(lchnk, ptend_sc%q(:,:,ixcldliq), qctend(:,:,1:pver), fillvalue) - call subcol_unpack(lchnk, ptend_sc%q(:,:,ixq), qvtend(:,:,1:pver), fillvalue) - - ! Unpack sample point values from subcolumn states - call subcol_unpack(lchnk, state_sc%q(:,:,ixcldliq), rc_all(:,:,1:pver), fillvalue) - call subcol_unpack(lchnk, state_sc%q(:,:,ixq), rv_all(:,:,1:pver), fillvalue) - call subcol_unpack(lchnk, state_sc%omega(:,:), omega_all (:,:,:), fillvalue) - call subcol_unpack(lchnk, state_sc%s(:,:), s_all, fillvalue) - call subcol_unpack(lchnk, state_sc%zm, zm_all, fillvalue) - call subcol_unpack(lchnk, state_sc%phis, phis_all, fillvalue) - call subcol_unpack(lchnk, state_sc%zi, zi_all, fillvalue) - call subcol_unpack(lchnk, state_sc%pdel, pdel_all, fillvalue) - call subcol_unpack(lchnk, state_sc%pmid, pmid_all, fillvalue) - - ! Initialize fields to fillvalue. - rt_all = fillvalue - thl_all = fillvalue - w_all = fillvalue - qctend = fillvalue - qvtend = fillvalue - thltend = fillvalue - - ! How many subcolumns in each column? - call subcol_get_nsubcol(lchnk, nsubcol) - - do igrdcol = 1, ngrdcol - do isubcol = 1, nsubcol(igrdcol) - - rt_all(igrdcol,isubcol,top_lev:pver) = rc_all(igrdcol,isubcol,top_lev:pver) & - + rv_all(igrdcol,isubcol,top_lev:pver) - - ! Compute dry static density on CLUBB vertical grid - do k = top_lev, pver - dz_g(igrdcol,isubcol,k) = zi_all(igrdcol,isubcol,k) - zi_all(igrdcol,isubcol,k+1) ! thickness - rho(igrdcol,isubcol,k) = (rga)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) - end do - - ! Compute w from omega - w_all(igrdcol,isubcol,top_lev:pver) = -omega_all(igrdcol,isubcol,top_lev:pver) & - / ( rho(igrdcol,isubcol,top_lev:pver) * gravit ) - - ! Convert stend and s_all to ttend and t_all - ! Note 1: With subcolumns, cpair is truly a constant (I think). - ! Note 2: For tendencies, the extra terns zm and phis should - ! not be included in the calculation. - ttend(igrdcol,isubcol,top_lev:pver) = stend(igrdcol,isubcol,top_lev:pver) / cpair - - do k = top_lev, pver - t_all(igrdcol,isubcol,k) = ( s_all(igrdcol,isubcol,k) & - - gravit * zm_all(igrdcol,isubcol,k) & - - phis_all(igrdcol,isubcol) ) / cpair - end do ! k = 1, pver - - ! This formula is taken from earlier in this file. - exner(igrdcol,isubcol,top_lev:pver) & - = ( pmid_all(igrdcol,isubcol,top_lev:pver) / p0_clubb )**(rair/cpair) - - ! Note: all tendencies or all means should be used in the call to - ! T_in_K2thlm_api (with the exception of exner) - do k = top_lev, pver - thltend(igrdcol,isubcol,k) & - = T_in_K2thlm_api( ttend(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & - qctend(igrdcol,isubcol,k) ) - thl_all(igrdcol,isubcol,k) & - = T_in_K2thlm_api( t_all(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & - rc_all(igrdcol,isubcol,k) ) - end do ! k = 1, pver - - ! Add ghost points - rt_all (igrdcol,isubcol,pverp) = rt_all (igrdcol,isubcol,pver) - thl_all(igrdcol,isubcol,pverp) = thl_all(igrdcol,isubcol,pver) - w_all (igrdcol,isubcol,pverp) = w_all (igrdcol,isubcol,pver) - qctend (igrdcol,isubcol,pverp) = qctend (igrdcol,isubcol,pver) - qvtend (igrdcol,isubcol,pverp) = qvtend (igrdcol,isubcol,pver) - thltend(igrdcol,isubcol,pverp) = thltend(igrdcol,isubcol,pver) - - ! Flip inputs to CLUBB's grid. Note the dimension ordering change. - rt_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pverp) ) - thl_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pverp) ) - w_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pverp) ) - qctend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pverp) ) - qvtend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pverp) ) - thltend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pverp) ) - - end do ! isubcol = 1, nsubcol(igrdcol) - end do ! igrdcol = 1, ngrdcol - - ! Obtain weights - call subcol_get_weight(lchnk, weights_packed) - call subcol_unpack(lchnk, weights_packed, weights, fillvalue) - - ! Call lh_microphys_var_covar_driver for each column - do igrdcol=1, ngrdcol - ns = nsubcol(igrdcol) - - ! This code assumes that the weights are height independent. - ! It will have to change once the weights vary with altitude! - ! I'm not sure whether the grid will need to be flipped. - do k = 1, pverp-top_lev+1 - height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) - end do - - ! Copy the igrdcol column from the multicolumn pdf_params_chnk to the single column - ! version of pdf_params_single_col since lh_microphys_var_covar_driver_api only - ! works over 1 column currently - call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), igrdcol, & - pdf_params_single_col ) - - ! Make the call!!!!! - call lh_microphys_var_covar_driver_api & - ( pverp-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:pverp-top_lev+1), & - pdf_params_single_col, & - rt_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thl_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & - w_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), qctend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & - qvtend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thltend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & - silhs_config_flags%l_lh_instant_var_covar_src, & - rtp2_mc_zt(igrdcol,1:pverp-top_lev+1), thlp2_mc_zt(igrdcol,1:pverp-top_lev+1), & - wprtp_mc_zt(igrdcol,1:pverp-top_lev+1), wpthlp_mc_zt(igrdcol,1:pverp-top_lev+1), & - rtpthlp_mc_zt(igrdcol,1:pverp-top_lev+1) ) - - ! The *_mc_zt microphysics tendencies are passed out of SILHS and back - ! to CLUBB without being used at all in the rest of the host model code. - ! The arrays aren't flipped for the *_mc_zt microphysics tendencies, and - ! they don't need to be. - - ! CLUBB used pverp vertical levels, but SILHS only uses - ! pverp - top_lev + 1 vertical levels. - ! Fill the upper levels with 0s when necessary. - if ( pverp > pverp-top_lev+1 ) then - rtp2_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - thlp2_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - wprtp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - wpthlp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - rtpthlp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 - endif ! pverp > pverp-top_lev+1 - - end do ! igrdcol = 1, ngrdcol -#endif -#endif - - return - end subroutine subcol_SILHS_var_covar_driver -#ifdef SILHS - real(r8) function meansc(arr_in, w_in, ns) result(val) - real(r8), intent(in) :: ns ! Length of Array - real(r8), dimension(int(ns)), intent(in) :: arr_in ! Input array - real(r8), dimension(int(ns)), intent(in) :: w_in ! Weights - real(r8) :: acc ! accumulator - integer :: i - acc = 0 - val = 0 - do i=1,ns - acc = acc + arr_in(i)*w_in(i) - end do - val = acc/ns - end function - - real(r8) function stdsc(arr_in, w_in, mn_in, ns) result(val) - real(r8), intent(in) :: ns ! Number of elements (subcolumns) - real(r8), dimension(int(ns)), intent(in) :: arr_in, w_in !Input array and weights - real(r8), intent(in) :: mn_in ! The mean of arr_in - real(r8) :: accvar, var - integer :: i - accvar = 0 - do i=1,ns - accvar = accvar + ((arr_in(i)-mn_in)**2)*w_in(i) - end do - var = accvar/ns - val = sqrt(var) - end function - - subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) - - use clubb_api_module, only : T_in_K2thlm_api - - integer, intent(in) :: nz ! Num vert levels - real(r8), dimension(nz), intent(in) :: ABST_prof ! Abs Temp prof - real(r8), dimension(nz), intent(in) :: ex_prof ! Profile of Exner func - real(r8), dimension(nz), intent(in) :: rcm_prof ! Profile of Cld Wat MR - real(r8), dimension(nz), intent(out) :: THL_prof ! LWPT prof - integer :: i - - do i=1,nz - THL_prof(i) = T_in_K2thlm_api(ABST_prof(i), ex_prof(i), rcm_prof(i)) - end do + ! Local Variables + integer :: lchnk, ngrdcol, igrdcol, isubcol, ns, k + integer, dimension(pcols) :: nsubcol + real(r8), dimension(pcols*psubcols) :: weights_packed + real(r8), dimension(pcols,psubcols) :: weights + real(r8), dimension(pcols,psubcols,pver ) :: rc_all, rv_all, rt_all, w_all, thl_all + real(r8), dimension(pcols,psubcols,pver ) :: s_all, t_all, zm_all, omega_all, pmid_all + real(r8), dimension(pcols,psubcols) :: phis_all + real(r8), dimension(pcols,psubcols,pver ) :: stend, ttend + real(r8), dimension(pcols,psubcols,pver ) :: thltend, qctend, qvtend + + real(r8), dimension(pcols,psubcols,pver) :: dz_g, pdel_all, rho + real(r8), dimension(pcols,psubcols,pverp) :: zi_all + + real(r8), dimension(pcols,psubcols,pver ) :: exner + + ! Inputs to lh_microphys_var_covar_driver + real(r8), dimension(pcols,psubcols,pver) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & + qctend_clubb, qvtend_clubb, thltend_clubb + real(r8), dimension(pcols,psubcols,pver-top_lev+1) :: height_depndt_weights + + ! Outputs from lh_microphys_var_covar_driver + real(r8), dimension(:,:), pointer :: rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, & + wpthlp_mc_zt, rtpthlp_mc_zt + + ! pbuf indices + integer :: & + rtp2_mc_zt_idx, & + thlp2_mc_zt_idx, & + wprtp_mc_zt_idx, & + wpthlp_mc_zt_idx, & + rtpthlp_mc_zt_idx - end subroutine - - subroutine subcol_constrainmn( num_subcols, samples, weights, grid_mean, mean_sc, std_sc ) - - ! Input/Output Variables - integer, intent(in) :: num_subcols - real(r8), dimension(num_subcols, pverp), intent(inout) :: samples - real(r8), dimension(num_subcols), intent(in) :: weights - real(r8), dimension(pverp), intent(in) :: grid_mean - real(r8), dimension(pver), intent(out), optional :: mean_sc, std_sc - - ! Local Variables - real(r8) :: meansc_loc, adj_rat - integer :: k - !------------------------------------------------------------------ - !----- Begin Code ----- - do k=1, pver - meansc_loc = meansc( samples(:,k), weights(:), real(num_subcols, r8) ) - - if (present(mean_sc)) & - mean_sc(k) = meansc_loc - if (present(std_sc)) & - std_sc(k) = stdsc( samples(:,k), weights(:), meansc_loc, & - real(num_subcols, r8) ) - - if ( meansc_loc > 0.0_r8 ) then - adj_rat = grid_mean(k)/meansc_loc - else - ! If the mean is zero, then zero out all subcolumns to avoid - ! negative samples - adj_rat = 0.0_r8 - end if - samples(:,k) = samples(:,k) * adj_rat - end do - end subroutine subcol_constrainmn - - ! =============================================================================== ! - ! ! - ! =============================================================================== ! - function clubb_flip_grid ( profile ) result( profile_flipped ) + type(pdf_parameter) :: pdf_params_single_col - ! Description: - ! Swaps the elements in profile so they are in reverse order. CAM and - ! CLUBB's grids are flipped with respect to each other. - ! - ! Usage: - ! clubb_var = clubb_flip_grid( cam_var ) - ! cam_var = clubb_flip_grid( clubb_var ) + !----- Begin Code ----- + + call init_pdf_params_api( pver+1-top_lev, 1, pdf_params_single_col ) + + ! Don't do anything if this option isn't enabled. + if ( .not. subcol_SILHS_var_covar_src ) return + + lchnk = state_sc%lchnk + ngrdcol = state_sc%ngrdcol + + ! Obtain indices + rtp2_mc_zt_idx = pbuf_get_index('rtp2_mc_zt') + thlp2_mc_zt_idx = pbuf_get_index('thlp2_mc_zt') + wprtp_mc_zt_idx = pbuf_get_index('wprtp_mc_zt') + wpthlp_mc_zt_idx = pbuf_get_index('wpthlp_mc_zt') + rtpthlp_mc_zt_idx = pbuf_get_index('rtpthlp_mc_zt') + + ! Obtain pbuf fields for output + call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt) + call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt) + call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) + call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) + call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) + + ! Unpack needed tendencies from subcolumn ptends + call subcol_unpack(lchnk, ptend_sc%s(:,:), stend, fillvalue) + call subcol_unpack(lchnk, ptend_sc%q(:,:,ixcldliq), qctend(:,:,1:pver), fillvalue) + call subcol_unpack(lchnk, ptend_sc%q(:,:,ixq), qvtend(:,:,1:pver), fillvalue) + + ! Unpack sample point values from subcolumn states + call subcol_unpack(lchnk, state_sc%q(:,:,ixcldliq), rc_all(:,:,1:pver), fillvalue) + call subcol_unpack(lchnk, state_sc%q(:,:,ixq), rv_all(:,:,1:pver), fillvalue) + call subcol_unpack(lchnk, state_sc%omega(:,:), omega_all (:,:,:), fillvalue) + call subcol_unpack(lchnk, state_sc%s(:,:), s_all, fillvalue) + call subcol_unpack(lchnk, state_sc%zm, zm_all, fillvalue) + call subcol_unpack(lchnk, state_sc%phis, phis_all, fillvalue) + call subcol_unpack(lchnk, state_sc%zi, zi_all, fillvalue) + call subcol_unpack(lchnk, state_sc%pdel, pdel_all, fillvalue) + call subcol_unpack(lchnk, state_sc%pmid, pmid_all, fillvalue) + + ! Initialize fields to fillvalue. + rt_all = fillvalue + thl_all = fillvalue + w_all = fillvalue + qctend = fillvalue + qvtend = fillvalue + thltend = fillvalue + + ! How many subcolumns in each column? + call subcol_get_nsubcol(lchnk, nsubcol) + + do igrdcol = 1, ngrdcol + do isubcol = 1, nsubcol(igrdcol) + + rt_all(igrdcol,isubcol,top_lev:pver) = rc_all(igrdcol,isubcol,top_lev:pver) & + + rv_all(igrdcol,isubcol,top_lev:pver) + + ! Compute dry static density on CLUBB vertical grid + do k = top_lev, pver + dz_g(igrdcol,isubcol,k) = zi_all(igrdcol,isubcol,k) - zi_all(igrdcol,isubcol,k+1) ! thickness + rho(igrdcol,isubcol,k) = (rga)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) + end do - implicit none + ! Compute w from omega + w_all(igrdcol,isubcol,top_lev:pver) = -omega_all(igrdcol,isubcol,top_lev:pver) & + / ( rho(igrdcol,isubcol,top_lev:pver) * gravit ) - ! Input Variable - real(r8), dimension(pverp), intent(in) :: profile + ! Convert stend and s_all to ttend and t_all + ! Note 1: With subcolumns, cpair is truly a constant (I think). + ! Note 2: For tendencies, the extra terns zm and phis should + ! not be included in the calculation. + ttend(igrdcol,isubcol,top_lev:pver) = stend(igrdcol,isubcol,top_lev:pver) / cpair - ! Output Variable - real(r8), dimension(pverp) :: profile_flipped + do k = top_lev, pver + t_all(igrdcol,isubcol,k) = ( s_all(igrdcol,isubcol,k) & + - gravit * zm_all(igrdcol,isubcol,k) & + - phis_all(igrdcol,isubcol) ) / cpair + end do ! k = 1, pver - ! Local Variable - integer :: k + ! This formula is taken from earlier in this file. + exner(igrdcol,isubcol,top_lev:pver) & + = ( pmid_all(igrdcol,isubcol,top_lev:pver) / p0_clubb )**(rair/cpair) - do k=1, pverp - profile_flipped(k) = profile(pverp-k+1) - end do ! k=1, pverp + ! Note: all tendencies or all means should be used in the call to + ! T_in_K2thlm_api (with the exception of exner) + do k = top_lev, pver + thltend(igrdcol,isubcol,k) & + = T_in_K2thlm_api( ttend(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & + qctend(igrdcol,isubcol,k) ) + thl_all(igrdcol,isubcol,k) & + = T_in_K2thlm_api( t_all(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & + rc_all(igrdcol,isubcol,k) ) + end do ! k = 1, pver + + ! Flip inputs to CLUBB's grid. Note the dimension ordering change. + rt_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pver) ) + thl_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pver) ) + w_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pver) ) + qctend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pver) ) + qvtend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pver) ) + thltend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pver) ) + + end do ! isubcol = 1, nsubcol(igrdcol) + end do ! igrdcol = 1, ngrdcol + + ! Obtain weights + call subcol_get_weight(lchnk, weights_packed) + call subcol_unpack(lchnk, weights_packed, weights, fillvalue) + + ! Call lh_microphys_var_covar_driver for each column + do igrdcol=1, ngrdcol + ns = nsubcol(igrdcol) + + ! This code assumes that the weights are height independent. + ! It will have to change once the weights vary with altitude! + ! I'm not sure whether the grid will need to be flipped. + do k = 1, pver-top_lev+1 + height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) + end do - return - end function clubb_flip_grid - ! =============================================================================== ! - ! ! - ! =============================================================================== ! + ! Copy the igrdcol column from the multicolumn pdf_params_chnk to the single column + ! version of pdf_params_single_col since lh_microphys_var_covar_driver_api only + ! works over 1 column currently + call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), igrdcol, & + pdf_params_single_col ) + + ! Make the call!!!!! + call lh_microphys_var_covar_driver_api & + ( pver-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:pver-top_lev+1), & + pdf_params_single_col, & + rt_all_clubb(igrdcol,1:ns,1:pver-top_lev+1), thl_all_clubb(igrdcol,1:ns,1:pver-top_lev+1), & + w_all_clubb(igrdcol,1:ns,1:pver-top_lev+1), qctend_clubb(igrdcol,1:ns,1:pver-top_lev+1), & + qvtend_clubb(igrdcol,1:ns,1:pver-top_lev+1), thltend_clubb(igrdcol,1:ns,1:pver-top_lev+1), & + silhs_config_flags%l_lh_instant_var_covar_src, & + rtp2_mc_zt(igrdcol,1:pver-top_lev+1), thlp2_mc_zt(igrdcol,1:pver-top_lev+1), & + wprtp_mc_zt(igrdcol,1:pver-top_lev+1), wpthlp_mc_zt(igrdcol,1:pver-top_lev+1), & + rtpthlp_mc_zt(igrdcol,1:pver-top_lev+1) ) + + ! The *_mc_zt microphysics tendencies are passed out of SILHS and back + ! to CLUBB without being used at all in the rest of the host model code. + ! The arrays aren't flipped for the *_mc_zt microphysics tendencies, and + ! they don't need to be. + + ! CLUBB used pver (thermodynamic) vertical levels, but SILHS only uses + ! pver - top_lev + 1 vertical levels. + ! Fill the upper levels with 0s when necessary. + if ( pver > pver-top_lev+1 ) then + rtp2_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 + thlp2_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 + wprtp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 + wpthlp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 + rtpthlp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 + endif ! pver > pver-top_lev+1 + + end do ! igrdcol = 1, ngrdcol +#endif #endif - !============================================================================ - subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) - - ! The William F. Buckley Jr. Conservative Hole Filler. - - ! Description: - ! Stops holes from forming in a hydrometeor mixing ratio by reducing the - ! microphysics tendency of that hydrometeor mixing ratio which would - ! otherwise cause that hydrometeor mixing ratio to have a negative value - ! once the microphysics tendency is applied. This code is used to prevent - ! holes in water mass, not number concentration. - ! - ! This subroutine is called after microphysics has completed and after - ! microphysics fields from subcolumns have been averaged back to grid - ! columns, but before the grid-column microphysics tendencies have been - ! applied in physics_update. This code is meant for use with the SILHS - ! subcolumn approach. This code needs to be applied to grid columns, not - ! subcolumns. - ! - ! This code adjusts the tendencies (ptend) before they are used to update - ! the grid mean fields (state variables). - ! - ! The column-integrated total water needs to be conserved during - ! microphysics. The conserved amount includes the amount of water that - ! precipitated to the ground from sedimentation during microphysics. - ! The conservation equation for each grid column is: - ! - ! SUM(k=top_lev:pver) ( rv_start(k) + rc_start(k) + rr_start(k) - ! + ri_start(k) + rs_start(k) ) * pdel(k) / g - ! = SUM(k=top_lev:pver) ( rv(k) + rc(k) + rr(k) + ri(k) + rs(k) ) - ! * pdel(k) / g - ! + prect * dt * 1000; - ! - ! where rv_start, rc_start, rr_start, ri_start, and rs_start are water - ! vapor, cloud water, rain water, cloud ice, and snow mixing ratios before - ! microphysics is called; rv, rc, rr, ri, and rs are water vapor, cloud - ! water, rain water, cloud ice, and snow mixing ratios after being updated - ! by microphysics; pdel is the pressure difference between vertical levels, - ! g is gravity, and prect * dt * 1000 is the total amount of water (from - ! all precipitating hydrometeors) that sedimented to the ground during - ! microphysics (dt is the timestep used for microphysics). The units of - ! column-integrated total water are kg (water) / m^2. - ! - ! All the updated hydrometeor fields are related to the hydrometeor fields - ! at the start by: - ! - ! rv(k) = rv_start(k) + rv_tend(k) * dt; - ! rc(k) = rc_start(k) + rc_tend(k) * dt; - ! rr(k) = rr_start(k) + rr_tend(k) * dt; - ! ri(k) = ri_start(k) + ri_tend(k) * dt; and - ! rs(k) = rs_start(k) + rs_tend(k) * dt; - ! - ! where rv_tend, rc_tend, rr_tend, ri_tend, and rs_tend are water vapor, - ! cloud water, rain water, cloud ice, and snow mixing ratio tendencies - ! from microphysics, which includes the sum of microphysics process rates - ! and sedimentation. When these equations are applied to the equation - ! for column-integrated total water, that equation becomes: - ! - ! SUM(k=top_lev:pver) ( rv_tend(k) + rc_tend(k) + rr_tend(k) - ! + ri_tend(k) + rs_tend(k) ) * dt * pdel(k) / g - ! + prect * dt * 1000 = 0. - ! - ! As stated above, the hydrometeor tendencies are the sum of tendencies - ! from microphysics process rates and tendencies from sedimentation: - ! - ! rv_tend(k) = rv_mc_tend(k); - ! rc_tend(k) = rc_mc_tend(k) + rc_sed_tend(k); - ! rr_tend(k) = rr_mc_tend(k) + rr_sed_tend(k); - ! ri_tend(k) = ri_mc_tend(k) + ri_sed_tend(k); and - ! rs_tend(k) = rs_mc_tend(k) + rs_sed_tend(k); - ! - ! where rv_mc_tend, rc_mc_tend, rr_mc_tend, ri_mc_tend, and rs_mc_tend are - ! the tendencies of water vapor, cloud water, rain water, cloud ice, and - ! snow from microphysics process rates, and rc_sed_tend, rr_sed_tend, - ! ri_sed_tend, and rs_sed_tend are the tendencies of cloud water, - ! rain water, cloud ice, and snow from sedimentation. When these equations - ! are applied to the equation for column-integrated total water, that - ! equation becomes: - ! - ! SUM(k=top_lev:pver) ( rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) - ! + ri_mc_tend(k) + rs_mc_tend(k) ) - ! * dt * pdel(k) / g - ! + SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) + ri_sed_tend(k) - ! + rs_sed_tend(k) ) * dt * pdel(k) / g - ! + prect * dt * 1000 = 0. - ! - ! At any vertical level, the tendencies from microphysics process rates - ! (mc_tend variables) must balance: - ! - ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) - ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. - ! - ! The column-integrated total water equation can be applied to - ! sedimentation: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) + ri_sed_tend(k) - ! + rs_sed_tend(k) ) * dt * pdel(k) / g - ! + prect * dt * 1000 = 0. - ! - ! The total precipitation rate, prect, can be split into liquid - ! precipitation rate, precl, and frozen precipitation rate, preci: - ! - ! prect = precl + preci. - ! - ! The microphysics code outputs prect and preci, so precl can be calculated - ! by precl = prect - preci. The column-integrated total water equation can - ! be split into: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + precl * dt * 1000 = 0; and - ! - ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + preci * dt * 1000 = 0. - ! - ! Overall, the conservation methods used in this subroutine are: - ! - ! 1) When adjusting the tendencies from microphysics process rates, - ! conserve: - ! - ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) - ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. - ! - ! 2) When adjusting the tendencies from microphysics process rates, adjust - ! dry static energy appropriately. The change in dry static energy - ! is necessary because of phase changes. This "puts back" the extra dry - ! static energy that was "taken out" when an excessive phase-changing - ! process rate was produced by microphysics. - ! - ! 3) When adjusting the hydrometeor tendency from sedimentation of a - ! liquid hydrometeor (cloud water or rain water), conserve: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + precl * dt * 1000 = 0. - ! - ! 4) When adjusting the hydrometeor tendency from sedimentation of a - ! frozen hydrometeor (cloud ice or snow), conserve: - ! - ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + preci * dt * 1000 = 0. - ! - ! The conservative hole filler works as follows. The total microphysics - ! tendency for each hydrometeor is provided in ptend. This is the sum of - ! the microphysics process rate tendency and sedimentation tendency for - ! each hydrometeor. The sedimentation tendency is provided in pbuf. The - ! sedimentation tendency is subtracted off the total microphysics tendency - ! to produce the microphysics process rate tendency for each hydrometeor. - ! The microphysics process rate tendency is adjusted when necessary so that - ! holes in the hydrometeor are not produced by microphysics process rates. - ! When a hydrometeor's negative microphysics process rate tendency needs to - ! be made smaller in magnitude to avoid a hole, all hydrometeor tendencies - ! that are positive at that grid level are also decreased proportionately - ! to maintain a balance. Dry static energy tendency is also adjusted - ! appropriately when necessary. After this, the vertical integral of each - ! hydrometeor species is greater than or equal to 0. - ! - ! The sedimentation tendency is then added back onto the new microphysics - ! process rate tendency to produce a new total microphysics tendency for - ! each hydrometeor. Since the sedimentation tendency was based on the old - ! value of hydrometeor, before the hole-filling adjustment, it is possible - ! that the new total microphysics tendency may produce holes. When this - ! happens, sedimentation hole filling fills holes in the vertical profile - ! of each hydrometeor. Holes are filled using mass from other vertical - ! levels for the same hydrometeor (or from a same-phase hydrometeor when - ! necessary). Since the vertical integral of sedimentation tendency - ! (including surface precipitation rate) is 0, the vertical integral of the - ! hydrometeor must be greater than or equal to 0, which means that all - ! holes can be filled. The result is that all holes in any hydrometeor - ! mixing ratio are filled completely and conservatively. The value of - ! ptend is updated appropriately so that it can be applied later in - ! physics_update. - - !---------------------------------------------------------------------- - - use physics_buffer, only: & - physics_buffer_desc, & - pbuf_get_field - - use ppgrid, only: & - pcols - - use constituents, only: & - qmin - - use ref_pres, only: & - top_lev => trop_cloud_top_lev - - implicit none - - ! Input Variables - type(physics_state), intent(in) :: state ! Physics state variables - real(r8), intent(in) :: dt ! Time step duration - - ! Input/Output Variables - type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies - type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer - - ! Local Variables - real(r8), dimension(pcols,pver) :: & - rv_start, & ! Water vapor mixing ratio at start of microphysics [kg/kg] - rc_start, & ! Cloud water mixing ratio at start of microphysics [kg/kg] - rr_start, & ! Rain water mixing ratio at start of microphysics [kg/kg] - ri_start, & ! Cloud ice mixing ratio at start of microphysics [kg/kg] - rs_start ! Snow mixing ratio at start of microphysics [kg/kg] - - real(r8), dimension(pcols,pver) :: & - rv_tend, & ! Water vapor mixing ratio tendency [kg/kg/s] - rc_tend, & ! Cloud water mixing ratio tendency [kg/kg/s] - rr_tend, & ! Rain water mixing ratio tendency [kg/kg/s] - ri_tend, & ! Cloud ice mixing ratio tendency [kg/kg/s] - rs_tend, & ! Snow mixing ratio tendency [kg/kg/s] - stend ! Dry static energy tendency [J/kg/s] - - real(r8), dimension(:), pointer :: & - prect, & ! Total microphysics precipitation rate (surface) [m/s] - preci, & ! Ice-phase microphysics precipitation rate (surface) [m/s] - prec_str, & ! Total surface precipitation rate from stratoform [m/s] - snow_str ! Snow surface precipitation rate from stratoform [m/s] - - real(r8), dimension(:,:), pointer :: & - rc_sed_tend, & ! Mean cloud water sedimentation tendency [kg/kg/s] - rr_sed_tend, & ! Mean rain water sedimentation tendency [kg/kg/s] - ri_sed_tend, & ! Mean cloud ice sedimentation tendency [kg/kg/s] - rs_sed_tend, & ! Mean snow sedimentation tendency [kg/kg/s] - vtrmc, & ! Mean cloud water sedimentation velocity [m/s] - umr, & ! Mean rain water sedimentation velocity [m/s] - vtrmi, & ! Mean cloud ice sedimentation velocity [m/s] - ums, & ! Mean snow sedimentation velocity [m/s] - rc_sed_evap, & ! Mean evap of cloud water during sedimentation [kg/kg/s] - ri_sed_subl ! Mean subl of cloud ice during sedimentation [kg/kg/s] - - real(r8), dimension(pcols,pver) :: & - rv_mc_tend, & ! Water vapor mixing ratio microphysics tendency [kg/kg/s] - rc_mc_tend, & ! Cloud water mixing ratio microphysics tendency [kg/kg/s] - rr_mc_tend, & ! Rain water mixing ratio microphysics tendency [kg/kg/s] - ri_mc_tend, & ! Cloud ice mixing ratio microphysics tendency [kg/kg/s] - rs_mc_tend ! Snow mixing ratio microphysics tendency [kg/kg/s] - - real(r8) :: & - rv_curr, & ! Current water vapor mixing ratio [kg/kg] - rc_curr, & ! Current cloud water mixing ratio [kg/kg] - rr_curr, & ! Current rain water mixing ratio [kg/kg] - ri_curr, & ! Current cloud ice mixing ratio [kg/kg] - rs_curr ! Current snow mixing ratio [kg/kg] - - logical :: & - l_pos_rv_mc_tend, & ! Flag for positive water vapor mixing ratio mc tend. - l_pos_rc_mc_tend, & ! Flag for positive cloud water mixing ratio mc tend. - l_pos_rr_mc_tend, & ! Flag for positive rain water mixing ratio mc tend. - l_pos_ri_mc_tend, & ! Flag for positive cloud ice mixing ratio mc tend. - l_pos_rs_mc_tend ! Flag for positive snow mixing ratio mc tend. - - real(r8) :: & - mc_tend_max_mag, & ! Max. allowable mag. of (neg.) mc tend [kg/kg/s] - mc_tend_correction, & ! Amnt. correction necessary to mc tend [kg/kg/s] - total_mc_positive, & ! Total of all positive mc tendencies [kg/kg/s] - mc_correction_ratio ! Ratio: mc_tend_correction/total_mc_positive [-] - - real(r8), dimension(pcols) :: & - precl ! Liquid-phase precipitation rate (surface) [m/s] - - ! Budgeting terms for hole filling. - ! These variables are for use in stats output. - real(r8), dimension(pcols,pver) :: & - rv_hf_tend, & ! Water vapor mixing ratio hole-filling tendency [kg/kg/s] - rc_hf_tend, & ! Cloud water mixing ratio hole-filling tendency [kg/kg/s] - rr_hf_tend, & ! Rain water mixing ratio hole-filling tendency [kg/kg/s] - ri_hf_tend, & ! Cloud ice mixing ratio hole-filling tendency [kg/kg/s] - rs_hf_tend, & ! Snow mixing ratio hole-filling tendency [kg/kg/s] - s_hf_tend ! Dry static energy hole-filling tendency [J/kg/s] - - integer :: ncol ! Number of grid columns - - integer :: icol, k ! Loop indices - - ! Flag to perform hole filling after the original sedimentation tendency - ! is added back on to the new microphysics process tendency. This calls - ! the sedimentation hole filler. - logical, parameter :: & - l_sed_hole_fill = .true. - - logical, parameter :: & - l_check_conservation = .true. ! Flag to perform water conservation check - - ! Vertically-integrated grand total water (rv+rc+rr+ri+rs) [kg/m^2] - real(r8), dimension(pcols) :: & - grand_total_water_column_start, & ! Column integral at start - grand_total_water_column_finish ! Column integral at finish - - ! Vertically-integrated total water energy [J/m^2] - real(r8), dimension(pcols) :: & - total_energy_column_start, & ! Column integral at start - total_energy_column_finish ! Column integral at finish - real(r8), dimension(pcols) :: & - tot_water_rel_err, & ! Relative error: vert-integrated grand total water - tot_energy_rel_err ! Relative error: vert-integrated total energy + return + end subroutine subcol_SILHS_var_covar_driver +#ifdef SILHS + real(r8) function meansc(arr_in, w_in, ns) result(val) + real(r8), intent(in) :: ns ! Length of Array + real(r8), dimension(int(ns)), intent(in) :: arr_in ! Input array + real(r8), dimension(int(ns)), intent(in) :: w_in ! Weights + real(r8) :: acc ! accumulator + integer :: i + acc = 0 + val = 0 + do i=1,ns + acc = acc + arr_in(i)*w_in(i) + end do + val = acc/ns + end function + + real(r8) function stdsc(arr_in, w_in, mn_in, ns) result(val) + real(r8), intent(in) :: ns ! Number of elements (subcolumns) + real(r8), dimension(int(ns)), intent(in) :: arr_in, w_in !Input array and weights + real(r8), intent(in) :: mn_in ! The mean of arr_in + real(r8) :: accvar, var + integer :: i + accvar = 0 + do i=1,ns + accvar = accvar + ((arr_in(i)-mn_in)**2)*w_in(i) + end do + var = accvar/ns + val = sqrt(var) + end function - real(r8), parameter :: & - err_thresh = 1.0e-14_r8 ! Threshold of relative error + subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) + use clubb_api_module, only : T_in_K2thlm_api - ! Get the number of grid columns. - ncol = state%ncol + integer, intent(in) :: nz ! Num vert levels + real(r8), dimension(nz), intent(in) :: ABST_prof ! Abs Temp prof + real(r8), dimension(nz), intent(in) :: ex_prof ! Profile of Exner func + real(r8), dimension(nz), intent(in) :: rcm_prof ! Profile of Cld Wat MR + real(r8), dimension(nz), intent(out) :: THL_prof ! LWPT prof + integer :: i - ! Get fields from the pbuf. - call pbuf_get_field(pbuf, prec_pcw_idx, prect) - call pbuf_get_field(pbuf, snow_pcw_idx, preci) - call pbuf_get_field(pbuf, prec_str_idx, prec_str) - call pbuf_get_field(pbuf, snow_str_idx, snow_str) - call pbuf_get_field(pbuf, qcsedten_idx, rc_sed_tend) - call pbuf_get_field(pbuf, qrsedten_idx, rr_sed_tend) - call pbuf_get_field(pbuf, qisedten_idx, ri_sed_tend) - call pbuf_get_field(pbuf, qssedten_idx, rs_sed_tend) - call pbuf_get_field(pbuf, vtrmc_idx, vtrmc) - call pbuf_get_field(pbuf, umr_idx, umr) - call pbuf_get_field(pbuf, vtrmi_idx, vtrmi) - call pbuf_get_field(pbuf, ums_idx, ums) - call pbuf_get_field(pbuf, qcsevap_idx, rc_sed_evap) - call pbuf_get_field(pbuf, qisevap_idx, ri_sed_subl) - - ! Calculate liquid precipitation rate (precl) from the total precipitation - ! rate (prect) and the frozen preciptation rate (preci). This should never - ! be negative, but just to be safe, threshold at 0. - precl(:ncol) = max( prect(:ncol) - preci(:ncol), 0.0_r8 ) - - ! Perform total water and total energy conservation checks. - if ( l_check_conservation ) then - - ! Calculate total water in each column. - ! This calculation is the vertically-integrated grand total water (where - ! grand total water is the sum of water vapor, cloud water, rain water, - ! cloud ice, and snow, as well as the amount of water that precipitated - ! to the surface) in each grid column after microphysics, but at the - ! start of hole filling. - do icol = 1, ncol - grand_total_water_column_start(icol) = 0.0_r8 - do k = top_lev, pver - grand_total_water_column_start(icol) & - = grand_total_water_column_start(icol) & - + ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt & - + state%q(icol,k,ixcldliq) & - + ptend%q(icol,k,ixcldliq) * dt & - + state%q(icol,k,ixcldice) & - + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) * rga - if ( ixrain > 0 ) then - grand_total_water_column_start(icol) & - = grand_total_water_column_start(icol) & - + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) * rga - endif - if ( ixsnow > 0 ) then - grand_total_water_column_start(icol) & - = grand_total_water_column_start(icol) & - + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) * rga - endif - end do ! k = top_lev, pver - grand_total_water_column_start(icol) & - = grand_total_water_column_start(icol) & - + prect(icol) * dt * 1000.0_r8 - end do ! icol = 1, ncol - - ! Calculate total energy in each column. - ! This calculation is the vertically-integrated total energy in each - ! grid column after microphysics, but at the start of hole filling. - ! Since the microphysics and hole filling code does not directly change - ! kinetic energy, 0.5 * ( u^2 + v^2 ), it can be skipped as part of the - ! energy conservation check. - do icol = 1, ncol - total_energy_column_start(icol) = 0.0_r8 - do k = top_lev, pver - total_energy_column_start(icol) & - = total_energy_column_start(icol) & - + ( state%s(icol,k) + ptend%s(icol,k) * dt & - + ( latvap + latice ) & - * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & - + latice * ( state%q(icol,k,ixcldliq) & - + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) * rga - if ( ixrain > 0 ) then - total_energy_column_start(icol) & - = total_energy_column_start(icol) & - + latice * ( state%q(icol,k,ixrain) & - + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) * rga - endif - end do ! k = top_lev, pver - total_energy_column_start(icol) & - = total_energy_column_start(icol) & - + latice * precl(icol) * dt * 1000.0_r8 - end do ! icol = 1, ncol - - endif ! l_check_conservation - - ! The fields within state haven't been updated yet, since this is before - ! the call to physics_update. - rv_start = state%q(:,:,1) - rc_start = state%q(:,:,ixcldliq) - if ( ixrain > 0 ) then - rr_start = state%q(:,:,ixrain) - endif - ri_start = state%q(:,:,ixcldice) - if ( ixsnow > 0 ) then - rs_start = state%q(:,:,ixsnow) - endif + do i=1,nz + THL_prof(i) = T_in_K2thlm_api(ABST_prof(i), ex_prof(i), rcm_prof(i)) + end do + + end subroutine - ! Unpack the current total tendencies for hydrometeor mixing ratio fields. - rv_tend = ptend%q(:,:,1) - rc_tend = ptend%q(:,:,ixcldliq) - if ( ixrain > 0 ) then - rr_tend = ptend%q(:,:,ixrain) - endif - ri_tend = ptend%q(:,:,ixcldice) - if ( ixsnow > 0 ) then - rs_tend = ptend%q(:,:,ixsnow) - endif + subroutine subcol_constrainmn( num_subcols, samples, weights, grid_mean, mean_sc, std_sc ) - ! Unpack the current tendency for dry static energy. - stend = ptend%s - - ! The total hydrometeor tendencies are the sum of microphysics process - ! rates and sedimentation rates. Calculate the microphysics process - ! tendencies by subtracting the sedimentation tendencies from the overall - ! tendencies. - ! The sedimentation tendencies for cloud water (rc_sed_tend) and cloud ice - ! (ri_sed_tend) include the evaporation of cloud water during sedimentation - ! and the sublimation of cloud ice during sedimentation, respectively. The - ! true sedimentation of cloud water is the sum of rc_sed_tend and - ! rc_sed_evap, and the true sedimentation of cloud ice is the sum of - ! ri_sed_tend and ri_sed_subl. Subtract off only the true sedimentation - ! rates, as evaporation and sublimation need to be included in the - ! microphysics process rates. - rv_mc_tend(:ncol,:) = rv_tend(:ncol,:) - rc_mc_tend(:ncol,:) = rc_tend(:ncol,:) - ( rc_sed_tend(:ncol,:) + rc_sed_evap(:ncol,:) ) - if ( ixrain > 0 ) then - rr_mc_tend(:ncol,:) = rr_tend(:ncol,:) - rr_sed_tend(:ncol,:) - endif - ri_mc_tend(:ncol,:) = ri_tend(:ncol,:) - ( ri_sed_tend(:ncol,:) + ri_sed_subl(:ncol,:) ) - if ( ixsnow > 0 ) then - rs_mc_tend(:ncol,:) = rs_tend(:ncol,:) - rs_sed_tend(:ncol,:) - endif + ! Input/Output Variables + integer, intent(in) :: num_subcols + real(r8), dimension(num_subcols, pver), intent(inout) :: samples + real(r8), dimension(num_subcols), intent(in) :: weights + real(r8), dimension(pver), intent(in) :: grid_mean + real(r8), dimension(pver), intent(out), optional :: mean_sc, std_sc - ! This section adjusts microphysics process rate tendencies so that the - ! resulting values of all hydrometeor mixing ratios are greater than or - ! equal to qmin after this section is complete. Once sedimentation is - ! added back on after this section, some of the hydrometeor mixing ratios - ! may become less than qmin again. - ! - ! This section, which again is concerned only with adjusting microphysics - ! process rates, makes use of the following two principles: - ! - ! 1) When adjusting the tendencies from microphysics process rates, - ! conserve: - ! - ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) - ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. - ! - ! 2) When adjusting the tendencies from microphysics process rates, adjust - ! dry static energy appropriately. The change in dry static energy - ! is necessary because of phase changes. This "puts back" the extra dry - ! static energy that was "taken out" when an excessive phase-changing - ! process rate was produced by microphysics. - - ! Loop over all columns, performing any tendency adjustments one column - ! at a time. - do icol = 1, ncol - - ! Loop over all vertical levels, performing any microphysics process - ! tendency adjustments one level at a time. - do k = top_lev, pver - - ! Find which hydrometeors have positive microphysics process - ! tendencies at this level. - if ( rv_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_rv_mc_tend = .true. - else - l_pos_rv_mc_tend = .false. - endif - if ( rc_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_rc_mc_tend = .true. - else - l_pos_rc_mc_tend = .false. - endif - if ( ixrain > 0 ) then - if ( rr_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_rr_mc_tend = .true. - else - l_pos_rr_mc_tend = .false. - endif - endif - if ( ri_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_ri_mc_tend = .true. - else - l_pos_ri_mc_tend = .false. - endif - if ( ixsnow > 0 ) then - if ( rs_mc_tend(icol,k) >= 0.0_r8 ) then - l_pos_rs_mc_tend = .true. - else - l_pos_rs_mc_tend = .false. - endif - endif + ! Local Variables + real(r8) :: meansc_loc, adj_rat + integer :: k + !------------------------------------------------------------------ + !----- Begin Code ----- + do k=1, pver + meansc_loc = meansc( samples(:,k), weights(:), real(num_subcols, r8) ) + + if (present(mean_sc)) & + mean_sc(k) = meansc_loc + if (present(std_sc)) & + std_sc(k) = stdsc( samples(:,k), weights(:), meansc_loc, & + real(num_subcols, r8) ) + + if ( meansc_loc > 0.0_r8 ) then + adj_rat = grid_mean(k)/meansc_loc + else + ! If the mean is zero, then zero out all subcolumns to avoid + ! negative samples + adj_rat = 0.0_r8 + end if + samples(:,k) = samples(:,k) * adj_rat + end do + end subroutine subcol_constrainmn - !!! Check for holes in water vapor mixing ratio - if ( .not. l_pos_rv_mc_tend ) then - - ! Calculate the water vapor mixing ratio as it would be with the - ! current microphysics process tendency. - rv_curr = rv_start(icol,k) + rv_mc_tend(icol,k) * dt - - if ( rv_curr < qmin(1) ) then - - ! Microphysics processes are causing a hole in water vapor - ! mixing ratio. - - ! Calculate the maximum allowable magnitude of (negative) water - ! vapor microphysics process tendency. - mc_tend_max_mag = ( qmin(1) - rv_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the water vapor mixing ratio microphysics process - ! tendency. This number is positive. - mc_tend_correction = mc_tend_max_mag - rv_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rc_mc_tend ) then - total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) - endif - if ( l_pos_ri_mc_tend ) then - total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative water vapor mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of water vapor). - if ( l_pos_rc_mc_tend ) then - ! Changing cloud water to water vapor cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - latvap * mc_correction_ratio * rc_mc_tend(icol,k) - ! Update cloud water mixing ratio microphysics tendency. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - ! Changing rain water to water vapor cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - latvap * mc_correction_ratio * rr_mc_tend(icol,k) - ! Update rain water mixing ratio microphysics tendency. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_ri_mc_tend ) then - ! Changing cloud ice to water vapor cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - ( latvap + latice ) & - * mc_correction_ratio * ri_mc_tend(icol,k) - ! Update cloud ice mixing ratio microphysics tendency. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - ! Changing snow to water vapor cools and reduces dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - - ( latvap + latice ) & - * mc_correction_ratio * rs_mc_tend(icol,k) - ! Update snow mixing ratio microphysics tendency. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new water vapor mixing ratio microphysics - ! process tendency. This should be equal to the maximum - ! magnitude (negative) amount allowed, mc_tend_max_mag. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! rv_curr < qmin(1) - - endif ! .not. l_pos_rv_mc_tend - - !!! Check for holes in cloud water mixing ratio - if ( .not. l_pos_rc_mc_tend ) then - - ! Calculate the cloud water mixing ratio as it would be with the - ! current microphysics process tendency. - rc_curr = rc_start(icol,k) + rc_mc_tend(icol,k) * dt - - if ( rc_curr < qmin(ixcldliq) ) then - - ! Microphysics processes are causing a hole in cloud water - ! mixing ratio. - - ! Calculate the maximum allowable magnitude of (negative) cloud - ! water microphysics process tendency. - mc_tend_max_mag = ( qmin(ixcldliq) - rc_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the cloud water mixing ratio microphysics process - ! tendency. This number is positive. - mc_tend_correction = mc_tend_max_mag - rc_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rv_mc_tend ) then - total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) - endif - if ( l_pos_ri_mc_tend ) then - total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative cloud water mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of cloud water). - if ( l_pos_rv_mc_tend ) then - ! Changing water vapor to cloud water heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + latvap * mc_correction_ratio * rv_mc_tend(icol,k) - ! Update water vapor mixing ratio microphysics tendency. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - ! Changing rain water to cloud water does not change - ! dry static energy. - ! Update rain water mixing ratio microphysics tendency. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_ri_mc_tend ) then - ! Changing cloud ice to cloud water cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - latice * mc_correction_ratio * ri_mc_tend(icol,k) - ! Update cloud ice mixing ratio microphysics tendency. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - ! Changing snow to cloud water cools and reduces dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - - latice * mc_correction_ratio * rs_mc_tend(icol,k) - ! Update snow mixing ratio microphysics tendency. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new cloud water mixing ratio microphysics - ! process tendency. This should be equal to the maximum - ! magnitude (negative) amount allowed, mc_tend_max_mag. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! rc_curr < qmin(ixcldliq) - - endif ! .not. l_pos_rc_mc_tend - - !!! Check for holes in rain water mixing ratio - if ( ixrain > 0 .and. ( .not. l_pos_rr_mc_tend ) ) then - - ! Calculate the rain water mixing ratio as it would be with the - ! current microphysics process tendency. - rr_curr = rr_start(icol,k) + rr_mc_tend(icol,k) * dt - - if ( rr_curr < qmin(ixrain) ) then - - ! Microphysics processes are causing a hole in rain water - ! mixing ratio. - - ! Calculate the maximum allowable magnitude of (negative) rain - ! water microphysics process tendency. - mc_tend_max_mag = ( qmin(ixrain) - rr_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the rain water mixing ratio microphysics process - ! tendency. This number is positive. - mc_tend_correction = mc_tend_max_mag - rr_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rv_mc_tend ) then - total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) - endif - if ( l_pos_rc_mc_tend ) then - total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) - endif - if ( l_pos_ri_mc_tend ) then - total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative rain water mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of rain water). - if ( l_pos_rv_mc_tend ) then - ! Changing water vapor to rain water heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + latvap * mc_correction_ratio * rv_mc_tend(icol,k) - ! Update water vapor mixing ratio microphysics tendency. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_rc_mc_tend ) then - ! Changing cloud water to rain water does not change - ! dry static energy. - ! Update cloud water mixing ratio microphysics tendency. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_ri_mc_tend ) then - ! Changing cloud ice to rain water cools and reduces - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - - latice * mc_correction_ratio * ri_mc_tend(icol,k) - ! Update cloud ice mixing ratio microphysics tendency. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - ! Changing snow to rain water cools and reduces dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - - latice * mc_correction_ratio * rs_mc_tend(icol,k) - ! Update snow mixing ratio microphysics tendency. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new rain water mixing ratio microphysics - ! process tendency. This should be equal to the maximum - ! magnitude (negative) amount allowed, mc_tend_max_mag. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! rr_curr < qmin(ixrain) - - endif ! ixrain > 0 .and. ( .not. l_pos_rr_mc_tend ) - - !!! Check for holes in cloud ice mixing ratio - if ( .not. l_pos_ri_mc_tend ) then - - ! Calculate the cloud ice mixing ratio as it would be with the - ! current microphysics process tendency. - ri_curr = ri_start(icol,k) + ri_mc_tend(icol,k) * dt - - if ( ri_curr < qmin(ixcldice) ) then - - ! Microphysics processes are causing a hole in cloud ice - ! mixing ratio. - - ! Calculate the maximum allowable magnitude of (negative) cloud - ! ice microphysics process tendency. - mc_tend_max_mag = ( qmin(ixcldice) - ri_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the cloud ice mixing ratio microphysics process - ! tendency. This number is positive. - mc_tend_correction = mc_tend_max_mag - ri_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rv_mc_tend ) then - total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) - endif - if ( l_pos_rc_mc_tend ) then - total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative cloud ice mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of cloud ice). - if ( l_pos_rv_mc_tend ) then - ! Changing water vapor to cloud ice heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + ( latvap + latice ) & - * mc_correction_ratio * rv_mc_tend(icol,k) - ! Update water vapor mixing ratio microphysics tendency. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_rc_mc_tend ) then - ! Changing cloud water to cloud ice heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + latice * mc_correction_ratio * rc_mc_tend(icol,k) - ! Update cloud water mixing ratio microphysics tendency. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - ! Changing rain water to cloud ice heats and increases - ! dry static energy. - stend(icol,k) & - = stend(icol,k) & - + latice * mc_correction_ratio * rr_mc_tend(icol,k) - ! Update rain water mixing ratio microphysics tendency. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then - ! Changing snow to cloud ice does not change dry static - ! energy. - ! Update snow mixing ratio microphysics tendency. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new cloud ice mixing ratio microphysics - ! process tendency. This should be equal to the maximum - ! magnitude (negative) amount allowed, mc_tend_max_mag. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! ri_curr < qmin(ixcldice) - - endif ! .not. l_pos_ri_mc_tend - - !!! Check for holes in snow mixing ratio - if ( ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) ) then - - ! Calculate the snow mixing ratio as it would be with the - ! current microphysics process tendency. - rs_curr = rs_start(icol,k) + rs_mc_tend(icol,k) * dt - - if ( rs_curr < qmin(ixsnow) ) then - - ! Microphysics processes are causing a hole in snow mixing - ! ratio. - - ! Calculate the maximum allowable magnitude of (negative) snow - ! microphysics process tendency. - mc_tend_max_mag = ( qmin(ixsnow) - rs_start(icol,k) ) / dt - - ! Calculate the amount of the correction that needs to be made - ! to the snow mixing ratio microphysics process tendency. - ! This number is positive. - mc_tend_correction = mc_tend_max_mag - rs_mc_tend(icol,k) - - ! Calculate the total amount of positive microphysics process - ! tendencies for all hydrometeor mixing ratios. - total_mc_positive = 0.0_r8 - if ( l_pos_rv_mc_tend ) then - total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) - endif - if ( l_pos_rc_mc_tend ) then - total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) - endif - if ( l_pos_ri_mc_tend ) then - total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) - endif - - ! Calculate the correction ratio. - ! In principle, this should never be greater than 1 outside of - ! numerical round-off errors. This is limited at 1 to be safe. - mc_correction_ratio & - = min( mc_tend_correction & - / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) - - ! Adjust (decrease) the tendencies of all positive hydrometeor - ! mixing ratio tendencies to balance the adjustment (increase) - ! to the excessively negative snow mixing ratio. - ! Transfer dry static energy appropriately (in response to the - ! excessive depletion of snow). - if ( l_pos_rv_mc_tend ) then - ! Changing water vapor to snow heats and increases dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - + ( latvap + latice ) & - * mc_correction_ratio * rv_mc_tend(icol,k) - ! Update water vapor mixing ratio microphysics tendency. - rv_mc_tend(icol,k) & - = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_rc_mc_tend ) then - ! Changing cloud water to snow heats and increases dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - + latice * mc_correction_ratio * rc_mc_tend(icol,k) - ! Update cloud water mixing ratio microphysics tendency. - rc_mc_tend(icol,k) & - = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then - ! Changing rain water to snow heats and increases dry - ! static energy. - stend(icol,k) & - = stend(icol,k) & - + latice * mc_correction_ratio * rr_mc_tend(icol,k) - ! Update rain water mixing ratio microphysics tendency. - rr_mc_tend(icol,k) & - = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - if ( l_pos_ri_mc_tend ) then - ! Changing cloud ice to snow does not change dry static - ! energy. - ! Update cloud ice mixing ratio microphysics tendency. - ri_mc_tend(icol,k) & - = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) - endif - - ! Calculate the new snow mixing ratio microphysics process - ! tendency. This should be equal to the maximum magnitude - ! (negative) amount allowed, mc_tend_max_mag. - rs_mc_tend(icol,k) & - = rs_mc_tend(icol,k) & - + mc_correction_ratio * total_mc_positive - - endif ! rs_curr < qmin(ixsnow) - - endif ! ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) - - end do ! k = top_lev, pver - - end do ! icol = 1, ncol - - ! Calculate the new overall tendencies by adding the sedimentation - ! tendencies back onto the new microphysics process tendencies. - ! For cloud water and cloud ice, the sedimentation tendencies that are - ! added back on are the true sedimentation tendencies. For cloud water, - ! this is the sum of rc_sed_tend and rc_sed_evap, and for cloud ice, this - ! is the sum of ri_sed_tend and ri_sed_subl. - rv_tend(:ncol,:) = rv_mc_tend(:ncol,:) - rc_tend(:ncol,:) = rc_mc_tend(:ncol,:) + ( rc_sed_tend(:ncol,:) + rc_sed_evap(:ncol,:) ) - if ( ixrain > 0 ) then - rr_tend(:ncol,:) = rr_mc_tend(:ncol,:) + rr_sed_tend(:ncol,:) - endif - ri_tend(:ncol,:) = ri_mc_tend(:ncol,:) + ( ri_sed_tend(:ncol,:) + ri_sed_subl(:ncol,:) ) - if ( ixsnow > 0 ) then - rs_tend(:ncol,:) = rs_mc_tend(:ncol,:) + rs_sed_tend(:ncol,:) - endif + ! =============================================================================== ! + ! ! + ! =============================================================================== ! + function clubb_flip_grid ( profile ) result( profile_flipped ) - ! Now that the original sedimentation tendency has been added to the - ! new microphysics process tendency, the new total microphysics tendency - ! can still cause holes to form. After the microphysics process rates were - ! adjusted, the values of the hydrometeor fields were greater than or equal - ! to 0 at all grid levels, which means their vertical integrals were also - ! greater than or equal to 0. Sedimentation by itself has a vertical - ! integral of 0 (including the amount that sedimented to the surface). - ! This means that after the microphysics process rates have been adjusted - ! and sedimentation has been added back on, the resulting hydrometeor - ! fields all still have vertical integrals that are greater than or equal - ! to 0. Holes that develop at any particular grid level can be filled. - ! These holes can be filled conservatively using the sedimentation hole - ! filler. - if ( l_sed_hole_fill ) then - - ! This section makes use of the following principle: - ! - ! 3) When adjusting the hydrometeor tendency from sedimentation of a - ! liquid hydrometeor (cloud water or rain water), conserve: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + precl * dt * 1000 = 0. - - ! Call the sedimentation hole filler for rain water mixing ratio. - ! This can update rr_tend and precl. - if ( ixrain > 0 ) then - call fill_holes_sedimentation( dt, ncol, rr_start, state%pdel, & - umr, state%zi, qmin(ixrain), & - rr_tend, precl ) - endif ! ixrain > 0 - - ! Call the sedimentation hole filler for cloud water mixing ratio. - ! This can update rc_tend and precl. - call fill_holes_sedimentation( dt, ncol, rc_start, state%pdel, & - vtrmc, state%zi, qmin(ixcldliq), & - rc_tend, precl ) - - ! Occasionally, a situation can occur where filling a hole in rain can - ! deplete all the surface liquid-phase precipitation (precl), resulting - ! in not enough water mass in the vertical profile of cloud water to - ! fill a hole in cloud water. When this happens, there must be liquid - ! water found in the vertical profile of rain, so pull the water from - ! rain to fill any remaining holes in cloud water. - if ( ixrain > 0 ) then - call fill_holes_same_phase_vert( dt, ncol, rc_start, rr_start, & - state%pdel, qmin(ixcldliq), & - qmin(ixrain), & - rc_tend, rr_tend ) - endif ! ixrain > 0 - - ! This section makes use of the following principle: - ! - ! 4) When adjusting the hydrometeor tendency from sedimentation of a - ! frozen hydrometeor (cloud ice or snow), conserve: - ! - ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + preci * dt * 1000 = 0. - - ! Call the sedimentation hole filler for snow mixing ratio. - ! This can update rs_tend and preci. - if ( ixsnow > 0 ) then - call fill_holes_sedimentation( dt, ncol, rs_start, state%pdel, & - ums, state%zi, qmin(ixsnow), & - rs_tend, preci ) - endif ! ixsnow > 0 - - ! Call the sedimentation hole filler for cloud ice mixing ratio. - ! This can update ri_tend and preci. - call fill_holes_sedimentation( dt, ncol, ri_start, state%pdel, & - vtrmi, state%zi, qmin(ixcldice), & - ri_tend, preci ) - - ! Occasionally, a situation can occur where filling a hole in snow can - ! deplete all the surface ice-phase precipitation (preci), resulting - ! in not enough water mass in the vertical profile of cloud ice to - ! fill a hole in cloud ice. When this happens, there must be ice-phase - ! water found in the vertical profile of snow, so pull the water from - ! snow to fill any remaining holes in cloud ice. - if ( ixsnow > 0 ) then - call fill_holes_same_phase_vert( dt, ncol, ri_start, rs_start, & - state%pdel, qmin(ixcldice), & - qmin(ixsnow), & - ri_tend, rs_tend ) - endif ! ixsnow > 0 - - ! Update the total precipitation rate (prect) from the updated liquid - ! precipitation rate (precl) and the updated frozen preciptation rate - ! (preci). - prect(:ncol) = precl(:ncol) + preci(:ncol) - - ! The MG code sets prec_str equal to prect (prec_pcw) and snow_str equal - ! to preci (snow_pcw). The prec_str and snow_str variables are used - ! in the calculations for energy and water conservation. Since prect - ! and preci are adjusted here, when necessary, prec_str and snow_str - ! also need to be adjusted. - prec_str(:ncol) = prect(:ncol) - snow_str(:ncol) = preci(:ncol) - - endif ! l_sed_hole_fill - - ! The updated total microphysics tendencies after hole filling have not - ! been used to update ptend yet, so record the budget terms for hole - ! filling first. - rv_hf_tend = rv_tend - ptend%q(:,:,1) - rc_hf_tend = rc_tend - ptend%q(:,:,ixcldliq) - if ( ixrain > 0 ) then - rr_hf_tend = rr_tend - ptend%q(:,:,ixrain) - endif ! ixrain > 0 - ri_hf_tend = ri_tend - ptend%q(:,:,ixcldice) - if ( ixsnow > 0 ) then - rs_hf_tend = rs_tend - ptend%q(:,:,ixsnow) - endif ! ixsnow > 0 - - ! The updated dry static energy tendency after hole filling has not been - ! used to update ptend yet, so record the budget term for hole filling - ! first. - s_hf_tend = stend - ptend%s - - ! Pack the current total tendencies for hydrometeor mixing ratio fields. - ptend%q(:,:,1) = rv_tend - ptend%q(:,:,ixcldliq) = rc_tend - if ( ixrain > 0 ) then - ptend%q(:,:,ixrain) = rr_tend - endif - ptend%q(:,:,ixcldice) = ri_tend - if ( ixsnow > 0 ) then - ptend%q(:,:,ixsnow) = rs_tend - endif + ! Description: + ! Swaps the elements in profile so they are in reverse order. CAM and + ! CLUBB's grids are flipped with respect to each other. + ! + ! Usage: + ! clubb_var = clubb_flip_grid( cam_var ) + ! cam_var = clubb_flip_grid( clubb_var ) - ! Pack the current tendency for dry static energy. - ptend%s = stend - - ! Output stats for hole filling tendencies. - call outfld( 'QVHFTEN', rv_hf_tend, pcols, state%lchnk ) - call outfld( 'QCHFTEN', rc_hf_tend, pcols, state%lchnk ) - call outfld( 'QRHFTEN', rr_hf_tend, pcols, state%lchnk ) - call outfld( 'QIHFTEN', ri_hf_tend, pcols, state%lchnk ) - call outfld( 'QSHFTEN', rs_hf_tend, pcols, state%lchnk ) - call outfld( 'THFTEN', s_hf_tend / cpair, pcols, state%lchnk ) - - ! Perform total water and total energy conservation checks. - if ( l_check_conservation ) then - - ! Calculate total water in each grid column. - ! This calculation is the vertically-integrated grand total water - ! in each grid column updated for all microphysics and hole filling. - ! This includes the amount that precipitated to the surface. - do icol = 1, ncol - grand_total_water_column_finish(icol) = 0.0_r8 - do k = top_lev, pver - grand_total_water_column_finish(icol) & - = grand_total_water_column_finish(icol) & - + ( state%q(icol,k,1) & - + ptend%q(icol,k,1) * dt & - + state%q(icol,k,ixcldliq) & - + ptend%q(icol,k,ixcldliq) * dt & - + state%q(icol,k,ixcldice) & - + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) * rga - if ( ixrain > 0 ) then - grand_total_water_column_finish(icol) & - = grand_total_water_column_finish(icol) & - + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) * rga - endif - if ( ixsnow > 0 ) then - grand_total_water_column_finish(icol) & - = grand_total_water_column_finish(icol) & - + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) * rga - endif - end do ! k = top_lev, pver - grand_total_water_column_finish(icol) & - = grand_total_water_column_finish(icol) & - + prect(icol) * dt * 1000.0_r8 - end do ! icol = 1, ncol - - ! Calculate total energy in each column. - ! This calculation is the vertically-integrated total energy in each - ! grid column updated for all microphysics and hole filling. This - ! includes the amount that precipitated to the surface. Since, the - ! microphysics code does not directly change kinetic energy, - ! 0.5 * ( u^2 + v^2 ), it can be skipped as part of the energy - ! conservation check. - do icol = 1, ncol - total_energy_column_finish(icol) = 0.0_r8 - do k = top_lev, pver - total_energy_column_finish(icol) & - = total_energy_column_finish(icol) & - + ( state%s(icol,k) + ptend%s(icol,k) * dt & - + ( latvap + latice ) & - * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & - + latice * ( state%q(icol,k,ixcldliq) & - + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) * rga - if ( ixrain > 0 ) then - total_energy_column_finish(icol) & - = total_energy_column_finish(icol) & - + latice * ( state%q(icol,k,ixrain) & - + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) * rga - endif - end do ! k = top_lev, pver - total_energy_column_finish(icol) & - = total_energy_column_finish(icol) & - + latice * precl(icol) * dt * 1000.0_r8 - end do ! icol = 1, ncol - - ! Calculate the total relative error in each grid column. - do icol = 1, ncol - - tot_water_rel_err(icol) & - = abs( ( grand_total_water_column_finish(icol) & - - grand_total_water_column_start(icol) ) ) & - / min( grand_total_water_column_finish(icol), & - grand_total_water_column_start(icol) ) - - tot_energy_rel_err(icol) & - = abs( ( total_energy_column_finish(icol) & - - total_energy_column_start(icol) ) ) & - / min( total_energy_column_finish(icol), & - total_energy_column_start(icol) ) - - end do ! icol = 1, ncol - - ! Print an error message if any total water relative error is found to - ! be greater than the threshold. - if ( any( tot_water_rel_err(:ncol) >= err_thresh ) ) then - write(iulog,*) "Water conservation error reported in hole filling" - do icol = 1, ncol - if ( tot_water_rel_err(icol) >= err_thresh ) then - write(iulog,*) "Column = ", icol, & - "Relative error = ", tot_water_rel_err(icol), & - "Column-integrated grand total water at start = ", & - grand_total_water_column_start(icol), & - "Column-integrated grand total water at finish = ", & - grand_total_water_column_finish(icol) - endif ! tot_water_rel_err(icol) >= err_thresh - end do ! icol = 1, ncol - endif ! any( tot_water_rel_err >= err_thresh ) - - ! Print an error message if any total energy relative error is found to - ! be greater than the threshold. - if ( any( tot_energy_rel_err(:ncol) >= err_thresh ) ) then - write(iulog,*) "Energy conservation error reported in hole filling" - do icol = 1, ncol - if ( tot_energy_rel_err(icol) >= err_thresh ) then - write(iulog,*) "Column = ", icol, & - "Relative error = ", tot_energy_rel_err(icol), & - "Column-integrated total energy at start = ", & - total_energy_column_start(icol), & - "Column-integrated total energy at finish = ", & - total_energy_column_finish(icol) - endif ! tot_energy_rel_err(icol) >= err_thresh - end do ! icol = 1, ncol - endif ! any( tot_energy_rel_err >= err_thresh ) - - endif ! l_check_conservation - - - return - - end subroutine subcol_SILHS_fill_holes_conserv - - !============================================================================ - subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & - fallspeed_m_per_s, zi, qmin_hm, & - hm_tend, prec ) - - ! Description: - ! After hydrometeor tendencies from microphysics processes were adjusted - ! so that holes don't form in a hydrometeor field from microphysics - ! processes, the sedimentation tendency was added back on to produce an - ! updated total microphysics tendency. The first-order "up-gravity" - ! sedimentation method that was originally used is positive definite. - ! However, since the microphysics process tendencies were altered so that - ! holes don't form, it is possible that adding the old sedimentation - ! tendencies back onto the new microphysics process tendencies could - ! produce new total microphysics tendencies that cause holes to form. - ! - ! In this subroutine, holes in a hydrometeor field are checked for after - ! the updated microphysics tendency is applied. If any are found, they are - ! filled from positive hydrometeor mass found at grid levels below where - ! the hole is found. The levels that are used to fill are within range - ! based on fallspeed of the hydrometeor. If the level that contains the - ! hole is within proximity to the surface, then the water that sedimented - ! to the surface can be used to fill the hole, as well. - ! - ! If there isn't enough total hydrometeor mass within the fall range to - ! fill the hole, then positive hydrometeor mass from levels below the fall - ! range is to be added to the total available mass to fill the hole. Mass - ! is added one level at a time until enough mass is found to fill the hole - ! or until the surface is reached and the surface precipitation is added to - ! the total available fill mass. - ! - ! After this, if there still isn't enough available mass to fill the hole, - ! then positive hydrometeor mass is added from all levels above the hole to - ! the total mass that is available to fill the hole. + implicit none - !---------------------------------------------------------------------- + ! Input Variable + real(r8), dimension(pver), intent(in) :: profile - use ppgrid, only: & - pcols + ! Output Variable + real(r8), dimension(pver) :: profile_flipped - use ref_pres, only: & - top_lev => trop_cloud_top_lev + ! Local Variable + integer :: k - implicit none + do k=1, pver + profile_flipped(k) = profile(pver-k+1) + end do ! k=1, pver - ! Input Variables - real(r8), intent(in) :: dt ! Time step duration + return + end function clubb_flip_grid + ! =============================================================================== ! + ! ! + ! =============================================================================== ! +#endif + !============================================================================ + subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) + + ! The William F. Buckley Jr. Conservative Hole Filler. + + ! Description: + ! Stops holes from forming in a hydrometeor mixing ratio by reducing the + ! microphysics tendency of that hydrometeor mixing ratio which would + ! otherwise cause that hydrometeor mixing ratio to have a negative value + ! once the microphysics tendency is applied. This code is used to prevent + ! holes in water mass, not number concentration. + ! + ! This subroutine is called after microphysics has completed and after + ! microphysics fields from subcolumns have been averaged back to grid + ! columns, but before the grid-column microphysics tendencies have been + ! applied in physics_update. This code is meant for use with the SILHS + ! subcolumn approach. This code needs to be applied to grid columns, not + ! subcolumns. + ! + ! This code adjusts the tendencies (ptend) before they are used to update + ! the grid mean fields (state variables). + ! + ! The column-integrated total water needs to be conserved during + ! microphysics. The conserved amount includes the amount of water that + ! precipitated to the ground from sedimentation during microphysics. + ! The conservation equation for each grid column is: + ! + ! SUM(k=top_lev:pver) ( rv_start(k) + rc_start(k) + rr_start(k) + ! + ri_start(k) + rs_start(k) ) * pdel(k) / g + ! = SUM(k=top_lev:pver) ( rv(k) + rc(k) + rr(k) + ri(k) + rs(k) ) + ! * pdel(k) / g + ! + prect * dt * 1000; + ! + ! where rv_start, rc_start, rr_start, ri_start, and rs_start are water + ! vapor, cloud water, rain water, cloud ice, and snow mixing ratios before + ! microphysics is called; rv, rc, rr, ri, and rs are water vapor, cloud + ! water, rain water, cloud ice, and snow mixing ratios after being updated + ! by microphysics; pdel is the pressure difference between vertical levels, + ! g is gravity, and prect * dt * 1000 is the total amount of water (from + ! all precipitating hydrometeors) that sedimented to the ground during + ! microphysics (dt is the timestep used for microphysics). The units of + ! column-integrated total water are kg (water) / m^2. + ! + ! All the updated hydrometeor fields are related to the hydrometeor fields + ! at the start by: + ! + ! rv(k) = rv_start(k) + rv_tend(k) * dt; + ! rc(k) = rc_start(k) + rc_tend(k) * dt; + ! rr(k) = rr_start(k) + rr_tend(k) * dt; + ! ri(k) = ri_start(k) + ri_tend(k) * dt; and + ! rs(k) = rs_start(k) + rs_tend(k) * dt; + ! + ! where rv_tend, rc_tend, rr_tend, ri_tend, and rs_tend are water vapor, + ! cloud water, rain water, cloud ice, and snow mixing ratio tendencies + ! from microphysics, which includes the sum of microphysics process rates + ! and sedimentation. When these equations are applied to the equation + ! for column-integrated total water, that equation becomes: + ! + ! SUM(k=top_lev:pver) ( rv_tend(k) + rc_tend(k) + rr_tend(k) + ! + ri_tend(k) + rs_tend(k) ) * dt * pdel(k) / g + ! + prect * dt * 1000 = 0. + ! + ! As stated above, the hydrometeor tendencies are the sum of tendencies + ! from microphysics process rates and tendencies from sedimentation: + ! + ! rv_tend(k) = rv_mc_tend(k); + ! rc_tend(k) = rc_mc_tend(k) + rc_sed_tend(k); + ! rr_tend(k) = rr_mc_tend(k) + rr_sed_tend(k); + ! ri_tend(k) = ri_mc_tend(k) + ri_sed_tend(k); and + ! rs_tend(k) = rs_mc_tend(k) + rs_sed_tend(k); + ! + ! where rv_mc_tend, rc_mc_tend, rr_mc_tend, ri_mc_tend, and rs_mc_tend are + ! the tendencies of water vapor, cloud water, rain water, cloud ice, and + ! snow from microphysics process rates, and rc_sed_tend, rr_sed_tend, + ! ri_sed_tend, and rs_sed_tend are the tendencies of cloud water, + ! rain water, cloud ice, and snow from sedimentation. When these equations + ! are applied to the equation for column-integrated total water, that + ! equation becomes: + ! + ! SUM(k=top_lev:pver) ( rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) + ! + ri_mc_tend(k) + rs_mc_tend(k) ) + ! * dt * pdel(k) / g + ! + SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) + ri_sed_tend(k) + ! + rs_sed_tend(k) ) * dt * pdel(k) / g + ! + prect * dt * 1000 = 0. + ! + ! At any vertical level, the tendencies from microphysics process rates + ! (mc_tend variables) must balance: + ! + ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) + ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. + ! + ! The column-integrated total water equation can be applied to + ! sedimentation: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) + ri_sed_tend(k) + ! + rs_sed_tend(k) ) * dt * pdel(k) / g + ! + prect * dt * 1000 = 0. + ! + ! The total precipitation rate, prect, can be split into liquid + ! precipitation rate, precl, and frozen precipitation rate, preci: + ! + ! prect = precl + preci. + ! + ! The microphysics code outputs prect and preci, so precl can be calculated + ! by precl = prect - preci. The column-integrated total water equation can + ! be split into: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + precl * dt * 1000 = 0; and + ! + ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + preci * dt * 1000 = 0. + ! + ! Overall, the conservation methods used in this subroutine are: + ! + ! 1) When adjusting the tendencies from microphysics process rates, + ! conserve: + ! + ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) + ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. + ! + ! 2) When adjusting the tendencies from microphysics process rates, adjust + ! dry static energy appropriately. The change in dry static energy + ! is necessary because of phase changes. This "puts back" the extra dry + ! static energy that was "taken out" when an excessive phase-changing + ! process rate was produced by microphysics. + ! + ! 3) When adjusting the hydrometeor tendency from sedimentation of a + ! liquid hydrometeor (cloud water or rain water), conserve: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + precl * dt * 1000 = 0. + ! + ! 4) When adjusting the hydrometeor tendency from sedimentation of a + ! frozen hydrometeor (cloud ice or snow), conserve: + ! + ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + preci * dt * 1000 = 0. + ! + ! The conservative hole filler works as follows. The total microphysics + ! tendency for each hydrometeor is provided in ptend. This is the sum of + ! the microphysics process rate tendency and sedimentation tendency for + ! each hydrometeor. The sedimentation tendency is provided in pbuf. The + ! sedimentation tendency is subtracted off the total microphysics tendency + ! to produce the microphysics process rate tendency for each hydrometeor. + ! The microphysics process rate tendency is adjusted when necessary so that + ! holes in the hydrometeor are not produced by microphysics process rates. + ! When a hydrometeor's negative microphysics process rate tendency needs to + ! be made smaller in magnitude to avoid a hole, all hydrometeor tendencies + ! that are positive at that grid level are also decreased proportionately + ! to maintain a balance. Dry static energy tendency is also adjusted + ! appropriately when necessary. After this, the vertical integral of each + ! hydrometeor species is greater than or equal to 0. + ! + ! The sedimentation tendency is then added back onto the new microphysics + ! process rate tendency to produce a new total microphysics tendency for + ! each hydrometeor. Since the sedimentation tendency was based on the old + ! value of hydrometeor, before the hole-filling adjustment, it is possible + ! that the new total microphysics tendency may produce holes. When this + ! happens, sedimentation hole filling fills holes in the vertical profile + ! of each hydrometeor. Holes are filled using mass from other vertical + ! levels for the same hydrometeor (or from a same-phase hydrometeor when + ! necessary). Since the vertical integral of sedimentation tendency + ! (including surface precipitation rate) is 0, the vertical integral of the + ! hydrometeor must be greater than or equal to 0, which means that all + ! holes can be filled. The result is that all holes in any hydrometeor + ! mixing ratio are filled completely and conservatively. The value of + ! ptend is updated appropriately so that it can be applied later in + ! physics_update. + + !---------------------------------------------------------------------- + + use physics_buffer, only: & + physics_buffer_desc, & + pbuf_get_field + + use ppgrid, only: & + pcols + + use constituents, only: & + qmin + + use ref_pres, only: & + top_lev => trop_cloud_top_lev + + implicit none + + ! Input Variables + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! Time step duration + + ! Input/Output Variables + type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer + + ! Local Variables + real(r8), dimension(pcols,pver) :: & + rv_start, & ! Water vapor mixing ratio at start of microphysics [kg/kg] + rc_start, & ! Cloud water mixing ratio at start of microphysics [kg/kg] + rr_start, & ! Rain water mixing ratio at start of microphysics [kg/kg] + ri_start, & ! Cloud ice mixing ratio at start of microphysics [kg/kg] + rs_start ! Snow mixing ratio at start of microphysics [kg/kg] + + real(r8), dimension(pcols,pver) :: & + rv_tend, & ! Water vapor mixing ratio tendency [kg/kg/s] + rc_tend, & ! Cloud water mixing ratio tendency [kg/kg/s] + rr_tend, & ! Rain water mixing ratio tendency [kg/kg/s] + ri_tend, & ! Cloud ice mixing ratio tendency [kg/kg/s] + rs_tend, & ! Snow mixing ratio tendency [kg/kg/s] + stend ! Dry static energy tendency [J/kg/s] + + real(r8), dimension(:), pointer :: & + prect, & ! Total microphysics precipitation rate (surface) [m/s] + preci, & ! Ice-phase microphysics precipitation rate (surface) [m/s] + prec_str, & ! Total surface precipitation rate from stratoform [m/s] + snow_str ! Snow surface precipitation rate from stratoform [m/s] + + real(r8), dimension(:,:), pointer :: & + rc_sed_tend, & ! Mean cloud water sedimentation tendency [kg/kg/s] + rr_sed_tend, & ! Mean rain water sedimentation tendency [kg/kg/s] + ri_sed_tend, & ! Mean cloud ice sedimentation tendency [kg/kg/s] + rs_sed_tend, & ! Mean snow sedimentation tendency [kg/kg/s] + vtrmc, & ! Mean cloud water sedimentation velocity [m/s] + umr, & ! Mean rain water sedimentation velocity [m/s] + vtrmi, & ! Mean cloud ice sedimentation velocity [m/s] + ums, & ! Mean snow sedimentation velocity [m/s] + rc_sed_evap, & ! Mean evap of cloud water during sedimentation [kg/kg/s] + ri_sed_subl ! Mean subl of cloud ice during sedimentation [kg/kg/s] + + real(r8), dimension(pcols,pver) :: & + rv_mc_tend, & ! Water vapor mixing ratio microphysics tendency [kg/kg/s] + rc_mc_tend, & ! Cloud water mixing ratio microphysics tendency [kg/kg/s] + rr_mc_tend, & ! Rain water mixing ratio microphysics tendency [kg/kg/s] + ri_mc_tend, & ! Cloud ice mixing ratio microphysics tendency [kg/kg/s] + rs_mc_tend ! Snow mixing ratio microphysics tendency [kg/kg/s] + + real(r8) :: & + rv_curr, & ! Current water vapor mixing ratio [kg/kg] + rc_curr, & ! Current cloud water mixing ratio [kg/kg] + rr_curr, & ! Current rain water mixing ratio [kg/kg] + ri_curr, & ! Current cloud ice mixing ratio [kg/kg] + rs_curr ! Current snow mixing ratio [kg/kg] + + logical :: & + l_pos_rv_mc_tend, & ! Flag for positive water vapor mixing ratio mc tend. + l_pos_rc_mc_tend, & ! Flag for positive cloud water mixing ratio mc tend. + l_pos_rr_mc_tend, & ! Flag for positive rain water mixing ratio mc tend. + l_pos_ri_mc_tend, & ! Flag for positive cloud ice mixing ratio mc tend. + l_pos_rs_mc_tend ! Flag for positive snow mixing ratio mc tend. + + real(r8) :: & + mc_tend_max_mag, & ! Max. allowable mag. of (neg.) mc tend [kg/kg/s] + mc_tend_correction, & ! Amnt. correction necessary to mc tend [kg/kg/s] + total_mc_positive, & ! Total of all positive mc tendencies [kg/kg/s] + mc_correction_ratio ! Ratio: mc_tend_correction/total_mc_positive [-] + + real(r8), dimension(pcols) :: & + precl ! Liquid-phase precipitation rate (surface) [m/s] + + ! Budgeting terms for hole filling. + ! These variables are for use in stats output. + real(r8), dimension(pcols,pver) :: & + rv_hf_tend, & ! Water vapor mixing ratio hole-filling tendency [kg/kg/s] + rc_hf_tend, & ! Cloud water mixing ratio hole-filling tendency [kg/kg/s] + rr_hf_tend, & ! Rain water mixing ratio hole-filling tendency [kg/kg/s] + ri_hf_tend, & ! Cloud ice mixing ratio hole-filling tendency [kg/kg/s] + rs_hf_tend, & ! Snow mixing ratio hole-filling tendency [kg/kg/s] + s_hf_tend ! Dry static energy hole-filling tendency [J/kg/s] + + integer :: ncol ! Number of grid columns + + integer :: icol, k ! Loop indices + + ! Flag to perform hole filling after the original sedimentation tendency + ! is added back on to the new microphysics process tendency. This calls + ! the sedimentation hole filler. + logical, parameter :: & + l_sed_hole_fill = .true. + + logical, parameter :: & + l_check_conservation = .true. ! Flag to perform water conservation check + + ! Vertically-integrated grand total water (rv+rc+rr+ri+rs) [kg/m^2] + real(r8), dimension(pcols) :: & + grand_total_water_column_start, & ! Column integral at start + grand_total_water_column_finish ! Column integral at finish + + ! Vertically-integrated total water energy [J/m^2] + real(r8), dimension(pcols) :: & + total_energy_column_start, & ! Column integral at start + total_energy_column_finish ! Column integral at finish + + real(r8), dimension(pcols) :: & + tot_water_rel_err, & ! Relative error: vert-integrated grand total water + tot_energy_rel_err ! Relative error: vert-integrated total energy + + real(r8), parameter :: & + err_thresh = 1.0e-14_r8 ! Threshold of relative error + + + ! Get the number of grid columns. + ncol = state%ncol + + ! Get fields from the pbuf. + call pbuf_get_field(pbuf, prec_pcw_idx, prect) + call pbuf_get_field(pbuf, snow_pcw_idx, preci) + call pbuf_get_field(pbuf, prec_str_idx, prec_str) + call pbuf_get_field(pbuf, snow_str_idx, snow_str) + call pbuf_get_field(pbuf, qcsedten_idx, rc_sed_tend) + call pbuf_get_field(pbuf, qrsedten_idx, rr_sed_tend) + call pbuf_get_field(pbuf, qisedten_idx, ri_sed_tend) + call pbuf_get_field(pbuf, qssedten_idx, rs_sed_tend) + call pbuf_get_field(pbuf, vtrmc_idx, vtrmc) + call pbuf_get_field(pbuf, umr_idx, umr) + call pbuf_get_field(pbuf, vtrmi_idx, vtrmi) + call pbuf_get_field(pbuf, ums_idx, ums) + call pbuf_get_field(pbuf, qcsevap_idx, rc_sed_evap) + call pbuf_get_field(pbuf, qisevap_idx, ri_sed_subl) + + ! Calculate liquid precipitation rate (precl) from the total precipitation + ! rate (prect) and the frozen preciptation rate (preci). This should never + ! be negative, but just to be safe, threshold at 0. + precl(:ncol) = max( prect(:ncol) - preci(:ncol), 0.0_r8 ) + + ! Perform total water and total energy conservation checks. + if ( l_check_conservation ) then + + ! Calculate total water in each column. + ! This calculation is the vertically-integrated grand total water (where + ! grand total water is the sum of water vapor, cloud water, rain water, + ! cloud ice, and snow, as well as the amount of water that precipitated + ! to the surface) in each grid column after microphysics, but at the + ! start of hole filling. + do icol = 1, ncol + grand_total_water_column_start(icol) = 0.0_r8 + do k = top_lev, pver + grand_total_water_column_start(icol) & + = grand_total_water_column_start(icol) & + + ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt & + + state%q(icol,k,ixcldliq) & + + ptend%q(icol,k,ixcldliq) * dt & + + state%q(icol,k,ixcldice) & + + ptend%q(icol,k,ixcldice) * dt ) & + * state%pdel(icol,k) * rga + if ( ixrain > 0 ) then + grand_total_water_column_start(icol) & + = grand_total_water_column_start(icol) & + + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & + * state%pdel(icol,k) * rga + endif + if ( ixsnow > 0 ) then + grand_total_water_column_start(icol) & + = grand_total_water_column_start(icol) & + + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & + * state%pdel(icol,k) * rga + endif + end do ! k = top_lev, pver + grand_total_water_column_start(icol) & + = grand_total_water_column_start(icol) & + + prect(icol) * dt * 1000.0_r8 + end do ! icol = 1, ncol + + ! Calculate total energy in each column. + ! This calculation is the vertically-integrated total energy in each + ! grid column after microphysics, but at the start of hole filling. + ! Since the microphysics and hole filling code does not directly change + ! kinetic energy, 0.5 * ( u^2 + v^2 ), it can be skipped as part of the + ! energy conservation check. + do icol = 1, ncol + total_energy_column_start(icol) = 0.0_r8 + do k = top_lev, pver + total_energy_column_start(icol) & + = total_energy_column_start(icol) & + + ( state%s(icol,k) + ptend%s(icol,k) * dt & + + ( latvap + latice ) & + * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + + latice * ( state%q(icol,k,ixcldliq) & + + ptend%q(icol,k,ixcldliq) * dt ) ) & + * state%pdel(icol,k) * rga + if ( ixrain > 0 ) then + total_energy_column_start(icol) & + = total_energy_column_start(icol) & + + latice * ( state%q(icol,k,ixrain) & + + ptend%q(icol,k,ixrain) * dt ) & + * state%pdel(icol,k) * rga + endif + end do ! k = top_lev, pver + total_energy_column_start(icol) & + = total_energy_column_start(icol) & + + latice * precl(icol) * dt * 1000.0_r8 + end do ! icol = 1, ncol + + endif ! l_check_conservation + + ! The fields within state haven't been updated yet, since this is before + ! the call to physics_update. + rv_start = state%q(:,:,1) + rc_start = state%q(:,:,ixcldliq) + if ( ixrain > 0 ) then + rr_start = state%q(:,:,ixrain) + endif + ri_start = state%q(:,:,ixcldice) + if ( ixsnow > 0 ) then + rs_start = state%q(:,:,ixsnow) + endif + + ! Unpack the current total tendencies for hydrometeor mixing ratio fields. + rv_tend = ptend%q(:,:,1) + rc_tend = ptend%q(:,:,ixcldliq) + if ( ixrain > 0 ) then + rr_tend = ptend%q(:,:,ixrain) + endif + ri_tend = ptend%q(:,:,ixcldice) + if ( ixsnow > 0 ) then + rs_tend = ptend%q(:,:,ixsnow) + endif + + ! Unpack the current tendency for dry static energy. + stend = ptend%s + + ! The total hydrometeor tendencies are the sum of microphysics process + ! rates and sedimentation rates. Calculate the microphysics process + ! tendencies by subtracting the sedimentation tendencies from the overall + ! tendencies. + ! The sedimentation tendencies for cloud water (rc_sed_tend) and cloud ice + ! (ri_sed_tend) include the evaporation of cloud water during sedimentation + ! and the sublimation of cloud ice during sedimentation, respectively. The + ! true sedimentation of cloud water is the sum of rc_sed_tend and + ! rc_sed_evap, and the true sedimentation of cloud ice is the sum of + ! ri_sed_tend and ri_sed_subl. Subtract off only the true sedimentation + ! rates, as evaporation and sublimation need to be included in the + ! microphysics process rates. + rv_mc_tend(:ncol,:) = rv_tend(:ncol,:) + rc_mc_tend(:ncol,:) = rc_tend(:ncol,:) - ( rc_sed_tend(:ncol,:) + rc_sed_evap(:ncol,:) ) + if ( ixrain > 0 ) then + rr_mc_tend(:ncol,:) = rr_tend(:ncol,:) - rr_sed_tend(:ncol,:) + endif + ri_mc_tend(:ncol,:) = ri_tend(:ncol,:) - ( ri_sed_tend(:ncol,:) + ri_sed_subl(:ncol,:) ) + if ( ixsnow > 0 ) then + rs_mc_tend(:ncol,:) = rs_tend(:ncol,:) - rs_sed_tend(:ncol,:) + endif + + ! This section adjusts microphysics process rate tendencies so that the + ! resulting values of all hydrometeor mixing ratios are greater than or + ! equal to qmin after this section is complete. Once sedimentation is + ! added back on after this section, some of the hydrometeor mixing ratios + ! may become less than qmin again. + ! + ! This section, which again is concerned only with adjusting microphysics + ! process rates, makes use of the following two principles: + ! + ! 1) When adjusting the tendencies from microphysics process rates, + ! conserve: + ! + ! rv_mc_tend(k) + rc_mc_tend(k) + rr_mc_tend(k) + ! + ri_mc_tend(k) + rs_mc_tend(k) = 0; for all k from top_lev to pver. + ! + ! 2) When adjusting the tendencies from microphysics process rates, adjust + ! dry static energy appropriately. The change in dry static energy + ! is necessary because of phase changes. This "puts back" the extra dry + ! static energy that was "taken out" when an excessive phase-changing + ! process rate was produced by microphysics. + + ! Loop over all columns, performing any tendency adjustments one column + ! at a time. + do icol = 1, ncol + + ! Loop over all vertical levels, performing any microphysics process + ! tendency adjustments one level at a time. + do k = top_lev, pver + + ! Find which hydrometeors have positive microphysics process + ! tendencies at this level. + if ( rv_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_rv_mc_tend = .true. + else + l_pos_rv_mc_tend = .false. + endif + if ( rc_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_rc_mc_tend = .true. + else + l_pos_rc_mc_tend = .false. + endif + if ( ixrain > 0 ) then + if ( rr_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_rr_mc_tend = .true. + else + l_pos_rr_mc_tend = .false. + endif + endif + if ( ri_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_ri_mc_tend = .true. + else + l_pos_ri_mc_tend = .false. + endif + if ( ixsnow > 0 ) then + if ( rs_mc_tend(icol,k) >= 0.0_r8 ) then + l_pos_rs_mc_tend = .true. + else + l_pos_rs_mc_tend = .false. + endif + endif + + !!! Check for holes in water vapor mixing ratio + if ( .not. l_pos_rv_mc_tend ) then + + ! Calculate the water vapor mixing ratio as it would be with the + ! current microphysics process tendency. + rv_curr = rv_start(icol,k) + rv_mc_tend(icol,k) * dt + + if ( rv_curr < qmin(1) ) then + + ! Microphysics processes are causing a hole in water vapor + ! mixing ratio. + + ! Calculate the maximum allowable magnitude of (negative) water + ! vapor microphysics process tendency. + mc_tend_max_mag = ( qmin(1) - rv_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the water vapor mixing ratio microphysics process + ! tendency. This number is positive. + mc_tend_correction = mc_tend_max_mag - rv_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rc_mc_tend ) then + total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) + endif + if ( l_pos_ri_mc_tend ) then + total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative water vapor mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of water vapor). + if ( l_pos_rc_mc_tend ) then + ! Changing cloud water to water vapor cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - latvap * mc_correction_ratio * rc_mc_tend(icol,k) + ! Update cloud water mixing ratio microphysics tendency. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + ! Changing rain water to water vapor cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - latvap * mc_correction_ratio * rr_mc_tend(icol,k) + ! Update rain water mixing ratio microphysics tendency. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_ri_mc_tend ) then + ! Changing cloud ice to water vapor cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - ( latvap + latice ) & + * mc_correction_ratio * ri_mc_tend(icol,k) + ! Update cloud ice mixing ratio microphysics tendency. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + ! Changing snow to water vapor cools and reduces dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + - ( latvap + latice ) & + * mc_correction_ratio * rs_mc_tend(icol,k) + ! Update snow mixing ratio microphysics tendency. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new water vapor mixing ratio microphysics + ! process tendency. This should be equal to the maximum + ! magnitude (negative) amount allowed, mc_tend_max_mag. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! rv_curr < qmin(1) + + endif ! .not. l_pos_rv_mc_tend + + !!! Check for holes in cloud water mixing ratio + if ( .not. l_pos_rc_mc_tend ) then + + ! Calculate the cloud water mixing ratio as it would be with the + ! current microphysics process tendency. + rc_curr = rc_start(icol,k) + rc_mc_tend(icol,k) * dt + + if ( rc_curr < qmin(ixcldliq) ) then + + ! Microphysics processes are causing a hole in cloud water + ! mixing ratio. + + ! Calculate the maximum allowable magnitude of (negative) cloud + ! water microphysics process tendency. + mc_tend_max_mag = ( qmin(ixcldliq) - rc_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the cloud water mixing ratio microphysics process + ! tendency. This number is positive. + mc_tend_correction = mc_tend_max_mag - rc_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rv_mc_tend ) then + total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) + endif + if ( l_pos_ri_mc_tend ) then + total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative cloud water mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of cloud water). + if ( l_pos_rv_mc_tend ) then + ! Changing water vapor to cloud water heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + latvap * mc_correction_ratio * rv_mc_tend(icol,k) + ! Update water vapor mixing ratio microphysics tendency. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + ! Changing rain water to cloud water does not change + ! dry static energy. + ! Update rain water mixing ratio microphysics tendency. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_ri_mc_tend ) then + ! Changing cloud ice to cloud water cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - latice * mc_correction_ratio * ri_mc_tend(icol,k) + ! Update cloud ice mixing ratio microphysics tendency. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + ! Changing snow to cloud water cools and reduces dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + - latice * mc_correction_ratio * rs_mc_tend(icol,k) + ! Update snow mixing ratio microphysics tendency. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new cloud water mixing ratio microphysics + ! process tendency. This should be equal to the maximum + ! magnitude (negative) amount allowed, mc_tend_max_mag. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! rc_curr < qmin(ixcldliq) + + endif ! .not. l_pos_rc_mc_tend + + !!! Check for holes in rain water mixing ratio + if ( ixrain > 0 .and. ( .not. l_pos_rr_mc_tend ) ) then + + ! Calculate the rain water mixing ratio as it would be with the + ! current microphysics process tendency. + rr_curr = rr_start(icol,k) + rr_mc_tend(icol,k) * dt + + if ( rr_curr < qmin(ixrain) ) then + + ! Microphysics processes are causing a hole in rain water + ! mixing ratio. + + ! Calculate the maximum allowable magnitude of (negative) rain + ! water microphysics process tendency. + mc_tend_max_mag = ( qmin(ixrain) - rr_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the rain water mixing ratio microphysics process + ! tendency. This number is positive. + mc_tend_correction = mc_tend_max_mag - rr_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rv_mc_tend ) then + total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) + endif + if ( l_pos_rc_mc_tend ) then + total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) + endif + if ( l_pos_ri_mc_tend ) then + total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative rain water mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of rain water). + if ( l_pos_rv_mc_tend ) then + ! Changing water vapor to rain water heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + latvap * mc_correction_ratio * rv_mc_tend(icol,k) + ! Update water vapor mixing ratio microphysics tendency. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_rc_mc_tend ) then + ! Changing cloud water to rain water does not change + ! dry static energy. + ! Update cloud water mixing ratio microphysics tendency. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_ri_mc_tend ) then + ! Changing cloud ice to rain water cools and reduces + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + - latice * mc_correction_ratio * ri_mc_tend(icol,k) + ! Update cloud ice mixing ratio microphysics tendency. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + ! Changing snow to rain water cools and reduces dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + - latice * mc_correction_ratio * rs_mc_tend(icol,k) + ! Update snow mixing ratio microphysics tendency. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new rain water mixing ratio microphysics + ! process tendency. This should be equal to the maximum + ! magnitude (negative) amount allowed, mc_tend_max_mag. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! rr_curr < qmin(ixrain) + + endif ! ixrain > 0 .and. ( .not. l_pos_rr_mc_tend ) + + !!! Check for holes in cloud ice mixing ratio + if ( .not. l_pos_ri_mc_tend ) then + + ! Calculate the cloud ice mixing ratio as it would be with the + ! current microphysics process tendency. + ri_curr = ri_start(icol,k) + ri_mc_tend(icol,k) * dt + + if ( ri_curr < qmin(ixcldice) ) then + + ! Microphysics processes are causing a hole in cloud ice + ! mixing ratio. + + ! Calculate the maximum allowable magnitude of (negative) cloud + ! ice microphysics process tendency. + mc_tend_max_mag = ( qmin(ixcldice) - ri_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the cloud ice mixing ratio microphysics process + ! tendency. This number is positive. + mc_tend_correction = mc_tend_max_mag - ri_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rv_mc_tend ) then + total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) + endif + if ( l_pos_rc_mc_tend ) then + total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + total_mc_positive = total_mc_positive + rs_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative cloud ice mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of cloud ice). + if ( l_pos_rv_mc_tend ) then + ! Changing water vapor to cloud ice heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + ( latvap + latice ) & + * mc_correction_ratio * rv_mc_tend(icol,k) + ! Update water vapor mixing ratio microphysics tendency. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_rc_mc_tend ) then + ! Changing cloud water to cloud ice heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + latice * mc_correction_ratio * rc_mc_tend(icol,k) + ! Update cloud water mixing ratio microphysics tendency. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + ! Changing rain water to cloud ice heats and increases + ! dry static energy. + stend(icol,k) & + = stend(icol,k) & + + latice * mc_correction_ratio * rr_mc_tend(icol,k) + ! Update rain water mixing ratio microphysics tendency. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixsnow > 0 .and. l_pos_rs_mc_tend ) then + ! Changing snow to cloud ice does not change dry static + ! energy. + ! Update snow mixing ratio microphysics tendency. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new cloud ice mixing ratio microphysics + ! process tendency. This should be equal to the maximum + ! magnitude (negative) amount allowed, mc_tend_max_mag. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! ri_curr < qmin(ixcldice) + + endif ! .not. l_pos_ri_mc_tend + + !!! Check for holes in snow mixing ratio + if ( ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) ) then + + ! Calculate the snow mixing ratio as it would be with the + ! current microphysics process tendency. + rs_curr = rs_start(icol,k) + rs_mc_tend(icol,k) * dt + + if ( rs_curr < qmin(ixsnow) ) then + + ! Microphysics processes are causing a hole in snow mixing + ! ratio. + + ! Calculate the maximum allowable magnitude of (negative) snow + ! microphysics process tendency. + mc_tend_max_mag = ( qmin(ixsnow) - rs_start(icol,k) ) / dt + + ! Calculate the amount of the correction that needs to be made + ! to the snow mixing ratio microphysics process tendency. + ! This number is positive. + mc_tend_correction = mc_tend_max_mag - rs_mc_tend(icol,k) + + ! Calculate the total amount of positive microphysics process + ! tendencies for all hydrometeor mixing ratios. + total_mc_positive = 0.0_r8 + if ( l_pos_rv_mc_tend ) then + total_mc_positive = total_mc_positive + rv_mc_tend(icol,k) + endif + if ( l_pos_rc_mc_tend ) then + total_mc_positive = total_mc_positive + rc_mc_tend(icol,k) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + total_mc_positive = total_mc_positive + rr_mc_tend(icol,k) + endif + if ( l_pos_ri_mc_tend ) then + total_mc_positive = total_mc_positive + ri_mc_tend(icol,k) + endif + + ! Calculate the correction ratio. + ! In principle, this should never be greater than 1 outside of + ! numerical round-off errors. This is limited at 1 to be safe. + mc_correction_ratio & + = min( mc_tend_correction & + / max( total_mc_positive, 1.0e-30_r8 ), 1.0_r8 ) + + ! Adjust (decrease) the tendencies of all positive hydrometeor + ! mixing ratio tendencies to balance the adjustment (increase) + ! to the excessively negative snow mixing ratio. + ! Transfer dry static energy appropriately (in response to the + ! excessive depletion of snow). + if ( l_pos_rv_mc_tend ) then + ! Changing water vapor to snow heats and increases dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + + ( latvap + latice ) & + * mc_correction_ratio * rv_mc_tend(icol,k) + ! Update water vapor mixing ratio microphysics tendency. + rv_mc_tend(icol,k) & + = rv_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_rc_mc_tend ) then + ! Changing cloud water to snow heats and increases dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + + latice * mc_correction_ratio * rc_mc_tend(icol,k) + ! Update cloud water mixing ratio microphysics tendency. + rc_mc_tend(icol,k) & + = rc_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( ixrain > 0 .and. l_pos_rr_mc_tend ) then + ! Changing rain water to snow heats and increases dry + ! static energy. + stend(icol,k) & + = stend(icol,k) & + + latice * mc_correction_ratio * rr_mc_tend(icol,k) + ! Update rain water mixing ratio microphysics tendency. + rr_mc_tend(icol,k) & + = rr_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + if ( l_pos_ri_mc_tend ) then + ! Changing cloud ice to snow does not change dry static + ! energy. + ! Update cloud ice mixing ratio microphysics tendency. + ri_mc_tend(icol,k) & + = ri_mc_tend(icol,k) * ( 1.0_r8 - mc_correction_ratio ) + endif + + ! Calculate the new snow mixing ratio microphysics process + ! tendency. This should be equal to the maximum magnitude + ! (negative) amount allowed, mc_tend_max_mag. + rs_mc_tend(icol,k) & + = rs_mc_tend(icol,k) & + + mc_correction_ratio * total_mc_positive + + endif ! rs_curr < qmin(ixsnow) + + endif ! ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) + + end do ! k = top_lev, pver + + end do ! icol = 1, ncol + + ! Calculate the new overall tendencies by adding the sedimentation + ! tendencies back onto the new microphysics process tendencies. + ! For cloud water and cloud ice, the sedimentation tendencies that are + ! added back on are the true sedimentation tendencies. For cloud water, + ! this is the sum of rc_sed_tend and rc_sed_evap, and for cloud ice, this + ! is the sum of ri_sed_tend and ri_sed_subl. + rv_tend(:ncol,:) = rv_mc_tend(:ncol,:) + rc_tend(:ncol,:) = rc_mc_tend(:ncol,:) + ( rc_sed_tend(:ncol,:) + rc_sed_evap(:ncol,:) ) + if ( ixrain > 0 ) then + rr_tend(:ncol,:) = rr_mc_tend(:ncol,:) + rr_sed_tend(:ncol,:) + endif + ri_tend(:ncol,:) = ri_mc_tend(:ncol,:) + ( ri_sed_tend(:ncol,:) + ri_sed_subl(:ncol,:) ) + if ( ixsnow > 0 ) then + rs_tend(:ncol,:) = rs_mc_tend(:ncol,:) + rs_sed_tend(:ncol,:) + endif + + ! Now that the original sedimentation tendency has been added to the + ! new microphysics process tendency, the new total microphysics tendency + ! can still cause holes to form. After the microphysics process rates were + ! adjusted, the values of the hydrometeor fields were greater than or equal + ! to 0 at all grid levels, which means their vertical integrals were also + ! greater than or equal to 0. Sedimentation by itself has a vertical + ! integral of 0 (including the amount that sedimented to the surface). + ! This means that after the microphysics process rates have been adjusted + ! and sedimentation has been added back on, the resulting hydrometeor + ! fields all still have vertical integrals that are greater than or equal + ! to 0. Holes that develop at any particular grid level can be filled. + ! These holes can be filled conservatively using the sedimentation hole + ! filler. + if ( l_sed_hole_fill ) then + + ! This section makes use of the following principle: + ! + ! 3) When adjusting the hydrometeor tendency from sedimentation of a + ! liquid hydrometeor (cloud water or rain water), conserve: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + precl * dt * 1000 = 0. + + ! Call the sedimentation hole filler for rain water mixing ratio. + ! This can update rr_tend and precl. + if ( ixrain > 0 ) then + call fill_holes_sedimentation( dt, ncol, rr_start, state%pdel, & + umr, state%zi, qmin(ixrain), & + rr_tend, precl ) + endif ! ixrain > 0 + + ! Call the sedimentation hole filler for cloud water mixing ratio. + ! This can update rc_tend and precl. + call fill_holes_sedimentation( dt, ncol, rc_start, state%pdel, & + vtrmc, state%zi, qmin(ixcldliq), & + rc_tend, precl ) + + ! Occasionally, a situation can occur where filling a hole in rain can + ! deplete all the surface liquid-phase precipitation (precl), resulting + ! in not enough water mass in the vertical profile of cloud water to + ! fill a hole in cloud water. When this happens, there must be liquid + ! water found in the vertical profile of rain, so pull the water from + ! rain to fill any remaining holes in cloud water. + if ( ixrain > 0 ) then + call fill_holes_same_phase_vert( dt, ncol, rc_start, rr_start, & + state%pdel, qmin(ixcldliq), & + qmin(ixrain), & + rc_tend, rr_tend ) + endif ! ixrain > 0 + + ! This section makes use of the following principle: + ! + ! 4) When adjusting the hydrometeor tendency from sedimentation of a + ! frozen hydrometeor (cloud ice or snow), conserve: + ! + ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + preci * dt * 1000 = 0. + + ! Call the sedimentation hole filler for snow mixing ratio. + ! This can update rs_tend and preci. + if ( ixsnow > 0 ) then + call fill_holes_sedimentation( dt, ncol, rs_start, state%pdel, & + ums, state%zi, qmin(ixsnow), & + rs_tend, preci ) + endif ! ixsnow > 0 + + ! Call the sedimentation hole filler for cloud ice mixing ratio. + ! This can update ri_tend and preci. + call fill_holes_sedimentation( dt, ncol, ri_start, state%pdel, & + vtrmi, state%zi, qmin(ixcldice), & + ri_tend, preci ) + + ! Occasionally, a situation can occur where filling a hole in snow can + ! deplete all the surface ice-phase precipitation (preci), resulting + ! in not enough water mass in the vertical profile of cloud ice to + ! fill a hole in cloud ice. When this happens, there must be ice-phase + ! water found in the vertical profile of snow, so pull the water from + ! snow to fill any remaining holes in cloud ice. + if ( ixsnow > 0 ) then + call fill_holes_same_phase_vert( dt, ncol, ri_start, rs_start, & + state%pdel, qmin(ixcldice), & + qmin(ixsnow), & + ri_tend, rs_tend ) + endif ! ixsnow > 0 + + ! Update the total precipitation rate (prect) from the updated liquid + ! precipitation rate (precl) and the updated frozen preciptation rate + ! (preci). + prect(:ncol) = precl(:ncol) + preci(:ncol) + + ! The MG code sets prec_str equal to prect (prec_pcw) and snow_str equal + ! to preci (snow_pcw). The prec_str and snow_str variables are used + ! in the calculations for energy and water conservation. Since prect + ! and preci are adjusted here, when necessary, prec_str and snow_str + ! also need to be adjusted. + prec_str(:ncol) = prect(:ncol) + snow_str(:ncol) = preci(:ncol) + + endif ! l_sed_hole_fill + + ! The updated total microphysics tendencies after hole filling have not + ! been used to update ptend yet, so record the budget terms for hole + ! filling first. + rv_hf_tend = rv_tend - ptend%q(:,:,1) + rc_hf_tend = rc_tend - ptend%q(:,:,ixcldliq) + if ( ixrain > 0 ) then + rr_hf_tend = rr_tend - ptend%q(:,:,ixrain) + endif ! ixrain > 0 + ri_hf_tend = ri_tend - ptend%q(:,:,ixcldice) + if ( ixsnow > 0 ) then + rs_hf_tend = rs_tend - ptend%q(:,:,ixsnow) + endif ! ixsnow > 0 + + ! The updated dry static energy tendency after hole filling has not been + ! used to update ptend yet, so record the budget term for hole filling + ! first. + s_hf_tend = stend - ptend%s + + ! Pack the current total tendencies for hydrometeor mixing ratio fields. + ptend%q(:,:,1) = rv_tend + ptend%q(:,:,ixcldliq) = rc_tend + if ( ixrain > 0 ) then + ptend%q(:,:,ixrain) = rr_tend + endif + ptend%q(:,:,ixcldice) = ri_tend + if ( ixsnow > 0 ) then + ptend%q(:,:,ixsnow) = rs_tend + endif + + ! Pack the current tendency for dry static energy. + ptend%s = stend + + ! Output stats for hole filling tendencies. + call outfld( 'QVHFTEN', rv_hf_tend, pcols, state%lchnk ) + call outfld( 'QCHFTEN', rc_hf_tend, pcols, state%lchnk ) + call outfld( 'QRHFTEN', rr_hf_tend, pcols, state%lchnk ) + call outfld( 'QIHFTEN', ri_hf_tend, pcols, state%lchnk ) + call outfld( 'QSHFTEN', rs_hf_tend, pcols, state%lchnk ) + call outfld( 'THFTEN', s_hf_tend / cpair, pcols, state%lchnk ) + + ! Perform total water and total energy conservation checks. + if ( l_check_conservation ) then + + ! Calculate total water in each grid column. + ! This calculation is the vertically-integrated grand total water + ! in each grid column updated for all microphysics and hole filling. + ! This includes the amount that precipitated to the surface. + do icol = 1, ncol + grand_total_water_column_finish(icol) = 0.0_r8 + do k = top_lev, pver + grand_total_water_column_finish(icol) & + = grand_total_water_column_finish(icol) & + + ( state%q(icol,k,1) & + + ptend%q(icol,k,1) * dt & + + state%q(icol,k,ixcldliq) & + + ptend%q(icol,k,ixcldliq) * dt & + + state%q(icol,k,ixcldice) & + + ptend%q(icol,k,ixcldice) * dt ) & + * state%pdel(icol,k) * rga + if ( ixrain > 0 ) then + grand_total_water_column_finish(icol) & + = grand_total_water_column_finish(icol) & + + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & + * state%pdel(icol,k) * rga + endif + if ( ixsnow > 0 ) then + grand_total_water_column_finish(icol) & + = grand_total_water_column_finish(icol) & + + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & + * state%pdel(icol,k) * rga + endif + end do ! k = top_lev, pver + grand_total_water_column_finish(icol) & + = grand_total_water_column_finish(icol) & + + prect(icol) * dt * 1000.0_r8 + end do ! icol = 1, ncol + + ! Calculate total energy in each column. + ! This calculation is the vertically-integrated total energy in each + ! grid column updated for all microphysics and hole filling. This + ! includes the amount that precipitated to the surface. Since, the + ! microphysics code does not directly change kinetic energy, + ! 0.5 * ( u^2 + v^2 ), it can be skipped as part of the energy + ! conservation check. + do icol = 1, ncol + total_energy_column_finish(icol) = 0.0_r8 + do k = top_lev, pver + total_energy_column_finish(icol) & + = total_energy_column_finish(icol) & + + ( state%s(icol,k) + ptend%s(icol,k) * dt & + + ( latvap + latice ) & + * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + + latice * ( state%q(icol,k,ixcldliq) & + + ptend%q(icol,k,ixcldliq) * dt ) ) & + * state%pdel(icol,k) * rga + if ( ixrain > 0 ) then + total_energy_column_finish(icol) & + = total_energy_column_finish(icol) & + + latice * ( state%q(icol,k,ixrain) & + + ptend%q(icol,k,ixrain) * dt ) & + * state%pdel(icol,k) * rga + endif + end do ! k = top_lev, pver + total_energy_column_finish(icol) & + = total_energy_column_finish(icol) & + + latice * precl(icol) * dt * 1000.0_r8 + end do ! icol = 1, ncol + + ! Calculate the total relative error in each grid column. + do icol = 1, ncol + + tot_water_rel_err(icol) & + = abs( ( grand_total_water_column_finish(icol) & + - grand_total_water_column_start(icol) ) ) & + / min( grand_total_water_column_finish(icol), & + grand_total_water_column_start(icol) ) + + tot_energy_rel_err(icol) & + = abs( ( total_energy_column_finish(icol) & + - total_energy_column_start(icol) ) ) & + / min( total_energy_column_finish(icol), & + total_energy_column_start(icol) ) + + end do ! icol = 1, ncol + + ! Print an error message if any total water relative error is found to + ! be greater than the threshold. + if ( any( tot_water_rel_err(:ncol) >= err_thresh ) ) then + write(iulog,*) "Water conservation error reported in hole filling" + do icol = 1, ncol + if ( tot_water_rel_err(icol) >= err_thresh ) then + write(iulog,*) "Column = ", icol, & + "Relative error = ", tot_water_rel_err(icol), & + "Column-integrated grand total water at start = ", & + grand_total_water_column_start(icol), & + "Column-integrated grand total water at finish = ", & + grand_total_water_column_finish(icol) + endif ! tot_water_rel_err(icol) >= err_thresh + end do ! icol = 1, ncol + endif ! any( tot_water_rel_err >= err_thresh ) + + ! Print an error message if any total energy relative error is found to + ! be greater than the threshold. + if ( any( tot_energy_rel_err(:ncol) >= err_thresh ) ) then + write(iulog,*) "Energy conservation error reported in hole filling" + do icol = 1, ncol + if ( tot_energy_rel_err(icol) >= err_thresh ) then + write(iulog,*) "Column = ", icol, & + "Relative error = ", tot_energy_rel_err(icol), & + "Column-integrated total energy at start = ", & + total_energy_column_start(icol), & + "Column-integrated total energy at finish = ", & + total_energy_column_finish(icol) + endif ! tot_energy_rel_err(icol) >= err_thresh + end do ! icol = 1, ncol + endif ! any( tot_energy_rel_err >= err_thresh ) + + endif ! l_check_conservation + + + return + + end subroutine subcol_SILHS_fill_holes_conserv + + !============================================================================ + subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & + fallspeed_m_per_s, zi, qmin_hm, & + hm_tend, prec ) + + ! Description: + ! After hydrometeor tendencies from microphysics processes were adjusted + ! so that holes don't form in a hydrometeor field from microphysics + ! processes, the sedimentation tendency was added back on to produce an + ! updated total microphysics tendency. The first-order "up-gravity" + ! sedimentation method that was originally used is positive definite. + ! However, since the microphysics process tendencies were altered so that + ! holes don't form, it is possible that adding the old sedimentation + ! tendencies back onto the new microphysics process tendencies could + ! produce new total microphysics tendencies that cause holes to form. + ! + ! In this subroutine, holes in a hydrometeor field are checked for after + ! the updated microphysics tendency is applied. If any are found, they are + ! filled from positive hydrometeor mass found at grid levels below where + ! the hole is found. The levels that are used to fill are within range + ! based on fallspeed of the hydrometeor. If the level that contains the + ! hole is within proximity to the surface, then the water that sedimented + ! to the surface can be used to fill the hole, as well. + ! + ! If there isn't enough total hydrometeor mass within the fall range to + ! fill the hole, then positive hydrometeor mass from levels below the fall + ! range is to be added to the total available mass to fill the hole. Mass + ! is added one level at a time until enough mass is found to fill the hole + ! or until the surface is reached and the surface precipitation is added to + ! the total available fill mass. + ! + ! After this, if there still isn't enough available mass to fill the hole, + ! then positive hydrometeor mass is added from all levels above the hole to + ! the total mass that is available to fill the hole. + + !---------------------------------------------------------------------- + + use ppgrid, only: & + pcols + + use ref_pres, only: & + top_lev => trop_cloud_top_lev + + implicit none + + ! Input Variables + real(r8), intent(in) :: dt ! Time step duration + + integer, intent(in) :: ncol ! Number of grid columns + + real(r8), dimension(pcols,pver), intent(in) :: & + hm_start, & ! Hydrometeor mixing ratio at start of microphysics [kg/kg] + pdel ! Pressure difference between grid levels [Pa] + + real(r8), dimension(pcols,pver), intent(in) :: & + fallspeed_m_per_s ! Hydrometeor mixing ratio fall speed [m/s] + + real(r8), dimension(pcols,pverp), intent(in) :: & + zi ! Height of momentum (interface) grid levels [m] + + real(r8), intent(in) :: & + qmin_hm ! Minimum threshold value of hydrometeor mixing ratio [kg/kg] + + ! Input/Output Variables + real(r8), dimension(pcols,pver), intent(inout) :: & + hm_tend ! Hydrometeor mixing ratio tendency [kg/kg/s] + + real(r8), dimension(pcols), intent(inout) :: & + prec ! Precipitation rate (surface) [m/s] + + ! Local Variables + real(r8), dimension(pver) :: & + hm_update, & ! Hydrometeor mixing ratio; start of sed. hole fill [kg/kg] + hm_curr ! Current value of hydrometeor mixing ratio [kg/kg] + + real(r8) :: & + total_hole, & ! Total mass of hole in hydrometeor [kg/m^2] + total_fill_mass, & ! Total mass available to fill hole [kg/m^2] + hole_fillmass_ratio, & ! Ratio: total_hole / total_fill_mass [-] + fallspeed_Pa_per_s, & ! Hydrometeor mixing ratio fall speed [Pa/s] + total_fall_Pa, & ! Pressure "distance" hydrometeor fell [Pa] + sum_pdel ! Sum of pdel over levels [Pa] + + logical, dimension(pver) :: & + l_pos_hm ! Flag for a hydrometeor having a positive (>= qmin_hm) value + + ! Flag for whether surface precipitation mass needs to be included in + ! the total_fill_mass for hole filling. + logical :: l_reached_surface + + ! Flag for whether hydrometeor mass from levels above the hole needs to be + ! included in the total_fill_mass for hole filling. + logical :: l_fill_from_above + + integer :: icol ! Grid column index + + integer :: k, idx ! Vertical grid level indices + + ! Index of the lowest vertical grid level that needs to be included in the + ! total_fill_mass for hole filling. + integer :: lowest_level_idx + + + ! Loop over all columns, performing any adjustments one column at a time. + do icol = 1, ncol + + ! Calculate the updated value of the hydrometeor field based on the + ! updated microphysics tendency. Since the original sedimentation + ! tendency has been added to the updated microphysics process tendency + ! to produce the updated total microphysics tendency (hm_tend), the + ! updated value of the hydrometeor field (hm_update) could be negative. + hm_update = hm_start(icol,:) + hm_tend(icol,:) * dt + hm_curr = hm_update + + ! Check for any holes in the vertical profile + if ( any( hm_curr(top_lev:pver) < qmin_hm ) ) then - integer, intent(in) :: ncol ! Number of grid columns + ! At least one hole is found in this hydrometeor species in this + ! grid column. The holes must be filled conservatively. - real(r8), dimension(pcols,pver), intent(in) :: & - hm_start, & ! Hydrometeor mixing ratio at start of microphysics [kg/kg] - pdel ! Pressure difference between grid levels [Pa] + ! Check which levels have values of the hydrometeor that are at or + ! above the minimum threshold value. + do k = top_lev, pver + if ( hm_curr(k) >= qmin_hm ) then + l_pos_hm(k) = .true. + else ! hm_curr < qmin_hm + l_pos_hm(k) = .false. + endif ! hm_curr >= qmin_hm + end do ! k = top_lev, pver - real(r8), dimension(pcols,pver), intent(in) :: & - fallspeed_m_per_s ! Hydrometeor mixing ratio fall speed [m/s] + do k = pver, top_lev, -1 + + if ( .not. l_pos_hm(k) ) then + + ! A hole is found in the hydrometeor at this grid level. + + ! Calculate the total hydrometeor mass of the hole that needs + ! to be filled. + ! The value of the hydrometeor mixing ratio is negative, but + ! the value of total_hole is positive. + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga + + ! Calculate the total hydrometeor mass available from below + ! to fill the hole. + if ( k == pver ) then + + ! A hole is found at the lowermost level. + ! The only place the hydrometeor could have sedimented + ! to is the surface, so fill from only the surface. + l_reached_surface = .true. + + ! Calculate the available amount of hydrometeor mass to + ! fill the hole. + total_fill_mass = prec(icol) * dt * 1000.0_r8 + + else ! top_lev <= k < pver + + ! Calculate the hydrometeor fallspeed in Pa/s. + ! In MG2, the equation for this is given by: + ! + ! fallspeed([Pa/s]) = g * rho * fallspeed([m/s]). + ! + ! The value of rho is typically calculated from the + ! hydrostatic approximation: + ! + ! rho = - ( 1 / g ) * dp/dz. + ! + ! The equation for fallspeed in Pa/s becomes: + ! + ! fallspeed([Pa/s]) = - dp/dz * fallspeed([m/s]). + fallspeed_Pa_per_s & + = fallspeed_m_per_s(icol,k) & + * pdel(icol,k) / ( zi(icol,k) - zi(icol,k+1) ) + + ! Calculate the fall "distance" in Pa. + total_fall_Pa = fallspeed_Pa_per_s * dt + + ! Find the index of the vertical level that the hydrometeor + ! sedimented to in one timestep. It must sediment at least + ! one level. + sum_pdel = 0.0_r8 + idx = k + 1 + do + ! Update the total pressure difference between the + ! level of origin and the current level. + sum_pdel = sum_pdel + pdel(icol,idx) + if ( sum_pdel >= total_fall_Pa ) then + ! The total pressure difference between the level of + ! origin and the current level exceeds the total + ! hydrometeor fall "distance" (in Pa). + lowest_level_idx = idx + l_reached_surface = .false. + exit + else ! sum_pdel < total_fall_Pa + ! The total hydrometeor fall "distance" (in Pa) + ! exceeds the total pressure difference between the + ! level of origin and the current level. + if ( idx == pver ) then + ! The lowest level of the model has been reached. + ! The hydrometeor sedimented to the surface. + lowest_level_idx = pver + l_reached_surface = .true. + exit + else ! idx < pver + ! Increment idx and keep going. + idx = idx + 1 + endif ! idx == pver + endif ! sum_pdel >= total_fall_Pa + end do + + ! Calculate the available amount of hydrometeor mass to + ! fill the hole. + total_fill_mass = 0.0_r8 + if ( l_reached_surface ) then + ! The hydrometeor sedimented to the surface, so + ! automatically loop down to pver and include the + ! surface mass. + do idx = k+1, pver, 1 + if ( l_pos_hm(idx) ) then + total_fill_mass & + = total_fill_mass & + + ( hm_curr(idx) - qmin_hm ) & + * pdel(icol,idx) * rga + endif ! l_pos_hm(idx) + end do ! idx = k+1, pver, 1 + ! Contribution to total fill mass from the surface. + total_fill_mass & + = total_fill_mass + prec(icol) * dt * 1000.0_r8 + else ! .not. l_reached_surface + ! The hydrometeor sedimented to lowest_level_idx. + idx = k + 1 + do + if ( l_pos_hm(idx) ) then + total_fill_mass & + = total_fill_mass & + + ( hm_curr(idx) - qmin_hm ) & + * pdel(icol,idx) * rga + endif ! l_pos_hm(idx) + if ( idx >= lowest_level_idx ) then + ! Check if enough mass has been gathered in + ! total_fill_mass to fill the hole. + if ( total_fill_mass >= total_hole ) then + ! There has been enough total_fill_mass + ! gathered to completely fill the hole. + lowest_level_idx = idx + exit + else ! total_fill_mass < total_hole + ! Even though lowest_level_idx has been reached, + ! more total_fill_mass needs to be added in + ! order to completely fill the hole, so keep + ! going. + if ( idx == pver ) then + ! The lowest vertical level has already been + ! reached, so go to the surface. + lowest_level_idx = pver + l_reached_surface = .true. + ! Contribution to total fill mass from the + ! surface. + total_fill_mass & + = total_fill_mass & + + prec(icol) * dt * 1000.0_r8 + exit + else ! idx < pver + ! Haven't reached pver yet, so increment + ! and keep going. + idx = idx + 1 + endif ! idx == pver + endif ! total_fill_mass >= total_hole + else ! idx < lowest_level_idx + ! Haven't reached lowest_level_idx yet, so + ! increment and keep going. + idx = idx + 1 + endif ! idx >= lowest_level_idx + end do + endif ! l_reached_surface + + endif ! k == pver + + ! If mass has been added all the way down to the surface and + ! there's still not enough mass to fill the hole, then fill the + ! hole pulling mass from above. + if ( total_fill_mass >= total_hole ) then + l_fill_from_above = .false. + else ! total_fill_mass < total_hole + l_fill_from_above = .true. + do idx = top_lev, k-1, 1 + if ( l_pos_hm(idx) ) then + total_fill_mass & + = total_fill_mass & + + ( hm_curr(idx) - qmin_hm ) & + * pdel(icol,idx) * rga + endif ! l_pos_hm(idx) + end do ! idx = top_lev, k-1, 1 + endif ! total_fill_mass >= total_hole + + ! Calculate the ratio of total hole to total fill mass. This + ! should not exceed 1 except as a result of numerical round-off + ! errors. Use thresholding to be safe. + hole_fillmass_ratio & + = min( total_hole / max( total_fill_mass, 1.0e-30_r8 ), & + 1.0_r8 ) + + if ( k < pver ) then + ! Modify (reduce) the amount of the hydrometeor at levels + ! that were used to fill the hole. + do idx = k+1, lowest_level_idx + if ( l_pos_hm(idx) ) then + ! Since pdel at a grid level does not change and + ! gravit is constant, the only variable that needs to + ! be modified proportionately is hm_curr. + hm_curr(idx) & + = qmin_hm & + + ( hm_curr(idx) - qmin_hm ) & + * ( 1.0_r8 - hole_fillmass_ratio ) + endif ! l_pos_hm(idx) + end do ! idx = k+1, lowest_level_idx + endif ! k < pver + + if ( l_reached_surface ) then + ! Modify (reduce) the amount of surface precipitation in + ! order to fill the hole. Since dt and 1000 are constants, + ! the only variable that needs to be modified + ! proportionately is prec. + prec(icol) = prec(icol) * ( 1.0_r8 - hole_fillmass_ratio ) + endif ! l_reached_surface + + if ( l_fill_from_above ) then + ! Modify (reduce) the amount of the hydrometeor at levels + ! that were used to fill the hole. + do idx = top_lev, k-1 + if ( l_pos_hm(idx) ) then + ! Since pdel at a grid level does not change and + ! gravit is constant, the only variable that needs to + ! be modified proportionately is hm_curr. + hm_curr(idx) & + = qmin_hm & + + ( hm_curr(idx) - qmin_hm ) & + * ( 1.0_r8 - hole_fillmass_ratio ) + endif ! l_pos_hm(idx) + end do ! idx = top_lev, k-1 + endif ! l_fill_from_above + + ! Update the value of the hydrometeor at the level where the + ! hole was found. Mathematically, as long as the available + ! mass was able to fill the entire hole, the new value of the + ! hydrometeor mixing ratio (hm_curr) should be qmin_hm. + hm_curr(k) & + = hm_curr(k) & + + hole_fillmass_ratio * total_fill_mass & + * gravit / pdel(icol,k) + + endif ! .not. l_pos_hm(k) + + end do ! k = pver, top_lev, -1 + + endif ! any( hm_curr(top_lev:pver) < qmin_hm ) + + ! Update the value of total microphysics tendency after hole filling. + hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt + + end do ! icol = 1, ncol + + + return + + end subroutine fill_holes_sedimentation + + !============================================================================ + subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & + pdel, qmin_hm, qmin_hm_filler, & + hm_tend, hm_tend_filler ) + + ! Description: + ! Fills remaining holes in a hydrometeor with mass from the the vertical + ! profile of another hydrometeor of the same phase. Remaining holes in + ! cloud water are filled with rain water and remaining holes in snow are + ! filled with cloud ice. + ! + ! This subroutine, combined with subroutine fill_holes_sedimentation, fill + ! holes making use of the following principles: + ! + ! 3) When adjusting the hydrometeor tendency from sedimentation of a + ! liquid hydrometeor (cloud water or rain water), conserve: + ! + ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + precl * dt * 1000 = 0. + ! + ! 4) When adjusting the hydrometeor tendency from sedimentation of a + ! frozen hydrometeor (cloud ice or snow), conserve: + ! + ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) + ! * dt * pdel(k) / g + ! + preci * dt * 1000 = 0. + ! + ! These two equations (one for liquid-phase hydrometeors and one for + ! ice-phase hydrometeors) could be further split into one equation for + ! each hydrometeor if there was prec output for each hydrometeor. However, + ! there's only prec output for ice-phase precipitation rate and total + ! precipitation rate (liquid preciptation rate is total rate minus + ! ice-phase rate). + ! + ! Since only liquid-phase precipitation rate (precl) and ice-phase + ! precipitation rate (preci) are available, and there are two hydrometeors + ! in each category, one hydrometeor from each category must fill before + ! the other hydrometeor from its category and get priority access to precl + ! or preci. Since a vast majority of liquid precipitation comes from rain + ! rather than sedimenting cloud water, rain is filled before cloud water + ! and gets priority access to precl. Likewise, since a vast majority of + ! frozen precipitation comes from snow rather than sedimenting cloud ice, + ! snow is filled before cloud ice and gets priority access to preci. + ! + ! The order of sedimentation hole filling is as follows. First, a level + ! with a hole in it is identified. The fall distance for the hydrometeor + ! that originated at a level is calculated. Total mass to fill the hole is + ! calculated from all levels within the fall range that have positive + ! values of the hydrometeor. The amount that precipitated to the surface + ! is also included if the hydrometeor fell that far. If that isn't enough + ! mass to fill the hole, then levels that are lower in the profile are + ! included (if the hydrometeor has a positive value) until enough mass is + ! found to fill the hole or until the surface is reached. If there isn't + ! enough mass found in all levels below the hole, including the amount that + ! precipitated to the ground, to fill the hole, then the hydrometeor mass + ! from all levels above the hole (again, where a positive value of the + ! hydrometeor is found) are included in the total available mass to fill + ! the hole. + ! + ! Occasionally, a situation can occur where both hydrometeors in a category + ! contributed to surface precipitation rate, and filling a hole in rain + ! (or snow) can deplete all the surface precl (or preci), resulting in not + ! enough water mass in the vertical profile (including the surface) of + ! cloud water (or cloud ice) to fill a hole in cloud water (or cloud ice). + ! When this happens, there must still be liquid water (or frozen water) + ! found in the vertical profile of rain (or snow), so pull the water from + ! rain (or snow) to fill any remaining holes in cloud water (or cloud ice). + + !---------------------------------------------------------------------- + + use ppgrid, only: & + pcols + + use ref_pres, only: & + top_lev => trop_cloud_top_lev + + implicit none + + ! Input Variables + real(r8), intent(in) :: dt ! Time step duration + + integer, intent(in) :: ncol ! Number of grid columns + + real(r8), dimension(pcols,pver), intent(in) :: & + hm_start, & ! Hydrometeor mixing ratio (microphys start) [kg/kg] + hm_start_filler, & ! Filler hydromet mix ratio (microphys start) [kg/kg] + pdel ! Pressure difference between grid levels [Pa] + + real(r8), intent(in) :: & + qmin_hm, & ! Minimum threshold hydrometeor mixing ratio [kg/kg] + qmin_hm_filler ! Min threshold filler hydromet mixing ratio [kg/kg] + + ! Input/Output Variables + real(r8), dimension(pcols,pver), intent(inout) :: & + hm_tend, & ! Hydrometeor mixing ratio tendency [kg/kg/s] + hm_tend_filler ! Filler hydrometeor mixing ratio tendency [kg/kg/s] + + ! Local Variables + real(r8), dimension(pver) :: & + hm_update, & ! Hydrometeor mixing ratio; start [kg/kg] + hm_update_filler, & ! Filler Hydrometeor mixing ratio; start [kg/kg] + hm_curr, & ! Current hydrometeor mixing ratio [kg/kg] + hm_curr_filler ! Current filler hydrometeor mixing ratio [kg/kg] + + real(r8) :: & + total_hole, & ! Total mass of hole in hydrometeor [kg/m^2] + total_fill_mass, & ! Total mass available to fill hole [kg/m^2] + hole_fillmass_ratio ! Ratio: total_hole / total_fill_mass [-] + + logical, dimension(pver) :: & + l_pos_hm, & ! Flag: hydrometeor has positive (>= qmin_hm) value + l_pos_hm_filler ! Flag: filler hydrometeor has positive value + + integer :: icol ! Grid column index + + integer :: k, idx ! Vertical grid level indices + + + ! Loop over all columns, performing any adjustments one column at a time. + do icol = 1, ncol + + ! Calculate the updated value of the hydrometeor field based on the + ! updated microphysics tendency. + hm_update = hm_start(icol,:) + hm_tend(icol,:) * dt + hm_curr = hm_update + + ! Calculate the updated value of the filler hydrometeor field based on + ! the updated microphysics tendency. + hm_update_filler = hm_start_filler(icol,:) + hm_tend_filler(icol,:) * dt + hm_curr_filler = hm_update_filler + + ! Check for any holes in the vertical profile + if ( any( hm_curr(top_lev:pver) < qmin_hm ) ) then + + ! At least one hole is found in this hydrometeor species in this + ! grid column. The holes must be filled conservatively. + + ! Check which levels have values of the hydrometeor that are at or + ! above the minimum threshold value. + do k = top_lev, pver + ! Check for the hydrometeor that might need to be filled. + if ( hm_curr(k) >= qmin_hm ) then + l_pos_hm(k) = .true. + else ! hm_curr < qmin_hm + l_pos_hm(k) = .false. + endif ! hm_curr >= qmin_hm + ! Check for the filler hydrometeor, as some levels might have + ! numerical round-off level, small negative values. + if ( hm_curr_filler(k) >= qmin_hm_filler ) then + l_pos_hm_filler(k) = .true. + else ! hm_curr_filler < qmin_hm_filler + l_pos_hm_filler(k) = .false. + endif ! hm_curr_filler >= qmin_hm_filler + end do ! k = top_lev, pver - real(r8), dimension(pcols,pverp), intent(in) :: & - zi ! Height of momentum (interface) grid levels [m] + do k = top_lev, pver - real(r8), intent(in) :: & - qmin_hm ! Minimum threshold value of hydrometeor mixing ratio [kg/kg] + if ( .not. l_pos_hm(k) ) then - ! Input/Output Variables - real(r8), dimension(pcols,pver), intent(inout) :: & - hm_tend ! Hydrometeor mixing ratio tendency [kg/kg/s] + ! A hole is found in the hydrometeor at this grid level. - real(r8), dimension(pcols), intent(inout) :: & - prec ! Precipitation rate (surface) [m/s] + ! Calculate the total hydrometeor mass of the hole that needs + ! to be filled. + ! The value of the hydrometeor mixing ratio is negative, but + ! the value of total_hole is positive. + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga - ! Local Variables - real(r8), dimension(pver) :: & - hm_update, & ! Hydrometeor mixing ratio; start of sed. hole fill [kg/kg] - hm_curr ! Current value of hydrometeor mixing ratio [kg/kg] - - real(r8) :: & - total_hole, & ! Total mass of hole in hydrometeor [kg/m^2] - total_fill_mass, & ! Total mass available to fill hole [kg/m^2] - hole_fillmass_ratio, & ! Ratio: total_hole / total_fill_mass [-] - fallspeed_Pa_per_s, & ! Hydrometeor mixing ratio fall speed [Pa/s] - total_fall_Pa, & ! Pressure "distance" hydrometeor fell [Pa] - sum_pdel ! Sum of pdel over levels [Pa] - - logical, dimension(pver) :: & - l_pos_hm ! Flag for a hydrometeor having a positive (>= qmin_hm) value - - ! Flag for whether surface precipitation mass needs to be included in - ! the total_fill_mass for hole filling. - logical :: l_reached_surface - - ! Flag for whether hydrometeor mass from levels above the hole needs to be - ! included in the total_fill_mass for hole filling. - logical :: l_fill_from_above - - integer :: icol ! Grid column index - - integer :: k, idx ! Vertical grid level indices - - ! Index of the lowest vertical grid level that needs to be included in the - ! total_fill_mass for hole filling. - integer :: lowest_level_idx - - - ! Loop over all columns, performing any adjustments one column at a time. - do icol = 1, ncol - - ! Calculate the updated value of the hydrometeor field based on the - ! updated microphysics tendency. Since the original sedimentation - ! tendency has been added to the updated microphysics process tendency - ! to produce the updated total microphysics tendency (hm_tend), the - ! updated value of the hydrometeor field (hm_update) could be negative. - hm_update = hm_start(icol,:) + hm_tend(icol,:) * dt - hm_curr = hm_update - - ! Check for any holes in the vertical profile - if ( any( hm_curr(top_lev:pver) < qmin_hm ) ) then - - ! At least one hole is found in this hydrometeor species in this - ! grid column. The holes must be filled conservatively. - - ! Check which levels have values of the hydrometeor that are at or - ! above the minimum threshold value. - do k = top_lev, pver - if ( hm_curr(k) >= qmin_hm ) then - l_pos_hm(k) = .true. - else ! hm_curr < qmin_hm - l_pos_hm(k) = .false. - endif ! hm_curr >= qmin_hm - end do ! k = top_lev, pver - - do k = pver, top_lev, -1 - - if ( .not. l_pos_hm(k) ) then - - ! A hole is found in the hydrometeor at this grid level. - - ! Calculate the total hydrometeor mass of the hole that needs - ! to be filled. - ! The value of the hydrometeor mixing ratio is negative, but - ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga - - ! Calculate the total hydrometeor mass available from below - ! to fill the hole. - if ( k == pver ) then - - ! A hole is found at the lowermost level. - ! The only place the hydrometeor could have sedimented - ! to is the surface, so fill from only the surface. - l_reached_surface = .true. - - ! Calculate the available amount of hydrometeor mass to - ! fill the hole. - total_fill_mass = prec(icol) * dt * 1000.0_r8 - - else ! top_lev <= k < pver - - ! Calculate the hydrometeor fallspeed in Pa/s. - ! In MG2, the equation for this is given by: - ! - ! fallspeed([Pa/s]) = g * rho * fallspeed([m/s]). - ! - ! The value of rho is typically calculated from the - ! hydrostatic approximation: - ! - ! rho = - ( 1 / g ) * dp/dz. - ! - ! The equation for fallspeed in Pa/s becomes: - ! - ! fallspeed([Pa/s]) = - dp/dz * fallspeed([m/s]). - fallspeed_Pa_per_s & - = fallspeed_m_per_s(icol,k) & - * pdel(icol,k) / ( zi(icol,k) - zi(icol,k+1) ) - - ! Calculate the fall "distance" in Pa. - total_fall_Pa = fallspeed_Pa_per_s * dt - - ! Find the index of the vertical level that the hydrometeor - ! sedimented to in one timestep. It must sediment at least - ! one level. - sum_pdel = 0.0_r8 - idx = k + 1 - do - ! Update the total pressure difference between the - ! level of origin and the current level. - sum_pdel = sum_pdel + pdel(icol,idx) - if ( sum_pdel >= total_fall_Pa ) then - ! The total pressure difference between the level of - ! origin and the current level exceeds the total - ! hydrometeor fall "distance" (in Pa). - lowest_level_idx = idx - l_reached_surface = .false. - exit - else ! sum_pdel < total_fall_Pa - ! The total hydrometeor fall "distance" (in Pa) - ! exceeds the total pressure difference between the - ! level of origin and the current level. - if ( idx == pver ) then - ! The lowest level of the model has been reached. - ! The hydrometeor sedimented to the surface. - lowest_level_idx = pver - l_reached_surface = .true. - exit - else ! idx < pver - ! Increment idx and keep going. - idx = idx + 1 - endif ! idx == pver - endif ! sum_pdel >= total_fall_Pa - end do - - ! Calculate the available amount of hydrometeor mass to - ! fill the hole. - total_fill_mass = 0.0_r8 - if ( l_reached_surface ) then - ! The hydrometeor sedimented to the surface, so - ! automatically loop down to pver and include the - ! surface mass. - do idx = k+1, pver, 1 - if ( l_pos_hm(idx) ) then - total_fill_mass & - = total_fill_mass & - + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) * rga - endif ! l_pos_hm(idx) - end do ! idx = k+1, pver, 1 - ! Contribution to total fill mass from the surface. + ! Calculate the total hydrometeor mass available from the + ! filler hydrometeor to fill the hole. + total_fill_mass = 0.0_r8 + do idx = top_lev, pver, 1 + if ( l_pos_hm_filler(idx) ) then total_fill_mass & - = total_fill_mass + prec(icol) * dt * 1000.0_r8 - else ! .not. l_reached_surface - ! The hydrometeor sedimented to lowest_level_idx. - idx = k + 1 - do - if ( l_pos_hm(idx) ) then - total_fill_mass & - = total_fill_mass & - + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) * rga - endif ! l_pos_hm(idx) - if ( idx >= lowest_level_idx ) then - ! Check if enough mass has been gathered in - ! total_fill_mass to fill the hole. - if ( total_fill_mass >= total_hole ) then - ! There has been enough total_fill_mass - ! gathered to completely fill the hole. - lowest_level_idx = idx - exit - else ! total_fill_mass < total_hole - ! Even though lowest_level_idx has been reached, - ! more total_fill_mass needs to be added in - ! order to completely fill the hole, so keep - ! going. - if ( idx == pver ) then - ! The lowest vertical level has already been - ! reached, so go to the surface. - lowest_level_idx = pver - l_reached_surface = .true. - ! Contribution to total fill mass from the - ! surface. - total_fill_mass & - = total_fill_mass & - + prec(icol) * dt * 1000.0_r8 - exit - else ! idx < pver - ! Haven't reached pver yet, so increment - ! and keep going. - idx = idx + 1 - endif ! idx == pver - endif ! total_fill_mass >= total_hole - else ! idx < lowest_level_idx - ! Haven't reached lowest_level_idx yet, so - ! increment and keep going. - idx = idx + 1 - endif ! idx >= lowest_level_idx - end do - endif ! l_reached_surface - - endif ! k == pver - - ! If mass has been added all the way down to the surface and - ! there's still not enough mass to fill the hole, then fill the - ! hole pulling mass from above. - if ( total_fill_mass >= total_hole ) then - l_fill_from_above = .false. - else ! total_fill_mass < total_hole - l_fill_from_above = .true. - do idx = top_lev, k-1, 1 - if ( l_pos_hm(idx) ) then - total_fill_mass & - = total_fill_mass & - + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) * rga - endif ! l_pos_hm(idx) - end do ! idx = top_lev, k-1, 1 - endif ! total_fill_mass >= total_hole - - ! Calculate the ratio of total hole to total fill mass. This - ! should not exceed 1 except as a result of numerical round-off - ! errors. Use thresholding to be safe. - hole_fillmass_ratio & - = min( total_hole / max( total_fill_mass, 1.0e-30_r8 ), & - 1.0_r8 ) - - if ( k < pver ) then - ! Modify (reduce) the amount of the hydrometeor at levels - ! that were used to fill the hole. - do idx = k+1, lowest_level_idx - if ( l_pos_hm(idx) ) then - ! Since pdel at a grid level does not change and - ! gravit is constant, the only variable that needs to - ! be modified proportionately is hm_curr. - hm_curr(idx) & - = qmin_hm & - + ( hm_curr(idx) - qmin_hm ) & - * ( 1.0_r8 - hole_fillmass_ratio ) - endif ! l_pos_hm(idx) - end do ! idx = k+1, lowest_level_idx - endif ! k < pver - - if ( l_reached_surface ) then - ! Modify (reduce) the amount of surface precipitation in - ! order to fill the hole. Since dt and 1000 are constants, - ! the only variable that needs to be modified - ! proportionately is prec. - prec(icol) = prec(icol) * ( 1.0_r8 - hole_fillmass_ratio ) - endif ! l_reached_surface - - if ( l_fill_from_above ) then - ! Modify (reduce) the amount of the hydrometeor at levels - ! that were used to fill the hole. - do idx = top_lev, k-1 - if ( l_pos_hm(idx) ) then - ! Since pdel at a grid level does not change and - ! gravit is constant, the only variable that needs to - ! be modified proportionately is hm_curr. - hm_curr(idx) & - = qmin_hm & - + ( hm_curr(idx) - qmin_hm ) & - * ( 1.0_r8 - hole_fillmass_ratio ) - endif ! l_pos_hm(idx) - end do ! idx = top_lev, k-1 - endif ! l_fill_from_above - - ! Update the value of the hydrometeor at the level where the - ! hole was found. Mathematically, as long as the available - ! mass was able to fill the entire hole, the new value of the - ! hydrometeor mixing ratio (hm_curr) should be qmin_hm. - hm_curr(k) & - = hm_curr(k) & - + hole_fillmass_ratio * total_fill_mass & - * gravit / pdel(icol,k) - - endif ! .not. l_pos_hm(k) - - end do ! k = pver, top_lev, -1 - - endif ! any( hm_curr(top_lev:pver) < qmin_hm ) - - ! Update the value of total microphysics tendency after hole filling. - hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt - - end do ! icol = 1, ncol - - - return - - end subroutine fill_holes_sedimentation - - !============================================================================ - subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & - pdel, qmin_hm, qmin_hm_filler, & - hm_tend, hm_tend_filler ) - - ! Description: - ! Fills remaining holes in a hydrometeor with mass from the the vertical - ! profile of another hydrometeor of the same phase. Remaining holes in - ! cloud water are filled with rain water and remaining holes in snow are - ! filled with cloud ice. - ! - ! This subroutine, combined with subroutine fill_holes_sedimentation, fill - ! holes making use of the following principles: - ! - ! 3) When adjusting the hydrometeor tendency from sedimentation of a - ! liquid hydrometeor (cloud water or rain water), conserve: - ! - ! SUM(k=top_lev:pver) ( rc_sed_tend(k) + rr_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + precl * dt * 1000 = 0. - ! - ! 4) When adjusting the hydrometeor tendency from sedimentation of a - ! frozen hydrometeor (cloud ice or snow), conserve: - ! - ! SUM(k=top_lev:pver) ( ri_sed_tend(k) + rs_sed_tend(k) ) - ! * dt * pdel(k) / g - ! + preci * dt * 1000 = 0. - ! - ! These two equations (one for liquid-phase hydrometeors and one for - ! ice-phase hydrometeors) could be further split into one equation for - ! each hydrometeor if there was prec output for each hydrometeor. However, - ! there's only prec output for ice-phase precipitation rate and total - ! precipitation rate (liquid preciptation rate is total rate minus - ! ice-phase rate). - ! - ! Since only liquid-phase precipitation rate (precl) and ice-phase - ! precipitation rate (preci) are available, and there are two hydrometeors - ! in each category, one hydrometeor from each category must fill before - ! the other hydrometeor from its category and get priority access to precl - ! or preci. Since a vast majority of liquid precipitation comes from rain - ! rather than sedimenting cloud water, rain is filled before cloud water - ! and gets priority access to precl. Likewise, since a vast majority of - ! frozen precipitation comes from snow rather than sedimenting cloud ice, - ! snow is filled before cloud ice and gets priority access to preci. - ! - ! The order of sedimentation hole filling is as follows. First, a level - ! with a hole in it is identified. The fall distance for the hydrometeor - ! that originated at a level is calculated. Total mass to fill the hole is - ! calculated from all levels within the fall range that have positive - ! values of the hydrometeor. The amount that precipitated to the surface - ! is also included if the hydrometeor fell that far. If that isn't enough - ! mass to fill the hole, then levels that are lower in the profile are - ! included (if the hydrometeor has a positive value) until enough mass is - ! found to fill the hole or until the surface is reached. If there isn't - ! enough mass found in all levels below the hole, including the amount that - ! precipitated to the ground, to fill the hole, then the hydrometeor mass - ! from all levels above the hole (again, where a positive value of the - ! hydrometeor is found) are included in the total available mass to fill - ! the hole. - ! - ! Occasionally, a situation can occur where both hydrometeors in a category - ! contributed to surface precipitation rate, and filling a hole in rain - ! (or snow) can deplete all the surface precl (or preci), resulting in not - ! enough water mass in the vertical profile (including the surface) of - ! cloud water (or cloud ice) to fill a hole in cloud water (or cloud ice). - ! When this happens, there must still be liquid water (or frozen water) - ! found in the vertical profile of rain (or snow), so pull the water from - ! rain (or snow) to fill any remaining holes in cloud water (or cloud ice). + = total_fill_mass & + + ( hm_curr_filler(idx) - qmin_hm_filler ) & + * pdel(icol,idx) * rga + endif ! l_pos_hm_filler(idx) + end do ! idx = top_lev, pver, 1 + + ! Calculate the ratio of total hole to total fill mass. This + ! should not exceed 1 except as a result of numerical round-off + ! errors. Use thresholding to be safe. + hole_fillmass_ratio & + = min( total_hole / max( total_fill_mass, 1.0e-30_r8 ), & + 1.0_r8 ) + + ! Modify (reduce) the amount of the filler hydrometeor. + do idx = top_lev, pver + if ( l_pos_hm_filler(idx) ) then + ! Since pdel at a grid level does not change and gravit + ! is constant, the only variable that needs to be + ! modified proportionately is hm_curr_filler. + hm_curr_filler(idx) & + = qmin_hm_filler & + + ( hm_curr_filler(idx) - qmin_hm_filler ) & + * ( 1.0_r8 - hole_fillmass_ratio ) + endif ! l_pos_hm_filler(idx) + end do ! idx = top_lev, pver + + ! Update the value of the hydrometeor at the level where the + ! hole was found. Mathematically, as long as the available + ! mass was able to fill the entire hole, the new value of the + ! hydrometeor mixing ratio (hm_curr) should be qmin_hm. + hm_curr(k) & + = hm_curr(k) & + + hole_fillmass_ratio * total_fill_mass & + * gravit / pdel(icol,k) + + endif ! .not. l_pos_hm(k) - !---------------------------------------------------------------------- + end do ! k = top_lev, pver - use ppgrid, only: & - pcols + endif ! any( hm_curr(top_lev:pver) < qmin_hm ) - use ref_pres, only: & - top_lev => trop_cloud_top_lev + ! Update the value of total microphysics tendency after hole filling. + hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt - implicit none + ! Update the value of total microphysics tendency after hole filling for + ! the filler hydrometeor. + hm_tend_filler(icol,:) & + = hm_tend_filler(icol,:) + ( hm_curr_filler - hm_update_filler ) / dt - ! Input Variables - real(r8), intent(in) :: dt ! Time step duration + end do ! icol = 1, ncol - integer, intent(in) :: ncol ! Number of grid columns - real(r8), dimension(pcols,pver), intent(in) :: & - hm_start, & ! Hydrometeor mixing ratio (microphys start) [kg/kg] - hm_start_filler, & ! Filler hydromet mix ratio (microphys start) [kg/kg] - pdel ! Pressure difference between grid levels [Pa] + return - real(r8), intent(in) :: & - qmin_hm, & ! Minimum threshold hydrometeor mixing ratio [kg/kg] - qmin_hm_filler ! Min threshold filler hydromet mixing ratio [kg/kg] + end subroutine fill_holes_same_phase_vert - ! Input/Output Variables - real(r8), dimension(pcols,pver), intent(inout) :: & - hm_tend, & ! Hydrometeor mixing ratio tendency [kg/kg/s] - hm_tend_filler ! Filler hydrometeor mixing ratio tendency [kg/kg/s] + !============================================================================ + subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) - ! Local Variables - real(r8), dimension(pver) :: & - hm_update, & ! Hydrometeor mixing ratio; start [kg/kg] - hm_update_filler, & ! Filler Hydrometeor mixing ratio; start [kg/kg] - hm_curr, & ! Current hydrometeor mixing ratio [kg/kg] - hm_curr_filler ! Current filler hydrometeor mixing ratio [kg/kg] - - real(r8) :: & - total_hole, & ! Total mass of hole in hydrometeor [kg/m^2] - total_fill_mass, & ! Total mass available to fill hole [kg/m^2] - hole_fillmass_ratio ! Ratio: total_hole / total_fill_mass [-] - - logical, dimension(pver) :: & - l_pos_hm, & ! Flag: hydrometeor has positive (>= qmin_hm) value - l_pos_hm_filler ! Flag: filler hydrometeor has positive value - - integer :: icol ! Grid column index - - integer :: k, idx ! Vertical grid level indices - - - ! Loop over all columns, performing any adjustments one column at a time. - do icol = 1, ncol - - ! Calculate the updated value of the hydrometeor field based on the - ! updated microphysics tendency. - hm_update = hm_start(icol,:) + hm_tend(icol,:) * dt - hm_curr = hm_update - - ! Calculate the updated value of the filler hydrometeor field based on - ! the updated microphysics tendency. - hm_update_filler = hm_start_filler(icol,:) + hm_tend_filler(icol,:) * dt - hm_curr_filler = hm_update_filler - - ! Check for any holes in the vertical profile - if ( any( hm_curr(top_lev:pver) < qmin_hm ) ) then - - ! At least one hole is found in this hydrometeor species in this - ! grid column. The holes must be filled conservatively. - - ! Check which levels have values of the hydrometeor that are at or - ! above the minimum threshold value. - do k = top_lev, pver - ! Check for the hydrometeor that might need to be filled. - if ( hm_curr(k) >= qmin_hm ) then - l_pos_hm(k) = .true. - else ! hm_curr < qmin_hm - l_pos_hm(k) = .false. - endif ! hm_curr >= qmin_hm - ! Check for the filler hydrometeor, as some levels might have - ! numerical round-off level, small negative values. - if ( hm_curr_filler(k) >= qmin_hm_filler ) then - l_pos_hm_filler(k) = .true. - else ! hm_curr_filler < qmin_hm_filler - l_pos_hm_filler(k) = .false. - endif ! hm_curr_filler >= qmin_hm_filler - end do ! k = top_lev, pver - - do k = top_lev, pver - - if ( .not. l_pos_hm(k) ) then - - ! A hole is found in the hydrometeor at this grid level. - - ! Calculate the total hydrometeor mass of the hole that needs - ! to be filled. - ! The value of the hydrometeor mixing ratio is negative, but - ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga - - ! Calculate the total hydrometeor mass available from the - ! filler hydrometeor to fill the hole. - total_fill_mass = 0.0_r8 - do idx = top_lev, pver, 1 - if ( l_pos_hm_filler(idx) ) then - total_fill_mass & - = total_fill_mass & - + ( hm_curr_filler(idx) - qmin_hm_filler ) & - * pdel(icol,idx) * rga - endif ! l_pos_hm_filler(idx) - end do ! idx = top_lev, pver, 1 - - ! Calculate the ratio of total hole to total fill mass. This - ! should not exceed 1 except as a result of numerical round-off - ! errors. Use thresholding to be safe. - hole_fillmass_ratio & - = min( total_hole / max( total_fill_mass, 1.0e-30_r8 ), & - 1.0_r8 ) - - ! Modify (reduce) the amount of the filler hydrometeor. - do idx = top_lev, pver - if ( l_pos_hm_filler(idx) ) then - ! Since pdel at a grid level does not change and gravit - ! is constant, the only variable that needs to be - ! modified proportionately is hm_curr_filler. - hm_curr_filler(idx) & - = qmin_hm_filler & - + ( hm_curr_filler(idx) - qmin_hm_filler ) & - * ( 1.0_r8 - hole_fillmass_ratio ) - endif ! l_pos_hm_filler(idx) - end do ! idx = top_lev, pver + ! Description: + ! Limits the values of mean hydrometeor concentrations so that the mean + ! drop size for the hydrometeor type remains reasonable and does not become + ! too large. - ! Update the value of the hydrometeor at the level where the - ! hole was found. Mathematically, as long as the available - ! mass was able to fill the entire hole, the new value of the - ! hydrometeor mixing ratio (hm_curr) should be qmin_hm. - hm_curr(k) & - = hm_curr(k) & - + hole_fillmass_ratio * total_fill_mass & - * gravit / pdel(icol,k) + !---------------------------------------------------------------------- - endif ! .not. l_pos_hm(k) + use shr_const_mod, only: & + shr_const_pi, & + shr_const_rhofw - end do ! k = top_lev, pver + use constituents, only: & + qmin - endif ! any( hm_curr(top_lev:pver) < qmin_hm ) + use ref_pres, only: & + top_lev => trop_cloud_top_lev - ! Update the value of total microphysics tendency after hole filling. - hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt + implicit none - ! Update the value of total microphysics tendency after hole filling for - ! the filler hydrometeor. - hm_tend_filler(icol,:) & - = hm_tend_filler(icol,:) + ( hm_curr_filler - hm_update_filler ) / dt + ! Input Variables + type(physics_state), intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! Time step duration - end do ! icol = 1, ncol + ! Input/Output Variable + type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies + ! Local Variables + real( r8 ) :: & + rcm_update, & ! New value of mean cloud water mixing ratio [kg/kg] + rrm_update, & ! New value of mean rain water mixing ratio [kg/kg] + rim_update, & ! New value of mean ice mixing ratio [kg/kg] + rsm_update ! New value of mean snow mixing ratio [kg/kg] - return + real( r8 ) :: & + Nc_tend_min, & ! Minimum value of cloud droplet conc. tendency [num/kg/s] + Nr_tend_min, & ! Minimum value of rain drop conc. tendency [num/kg/s] + Ni_tend_min, & ! Minimum value of ice conc. tendency [num/kg/s] + Ns_tend_min ! Minimum value of snow conc. tendency [num/kg/s] - end subroutine fill_holes_same_phase_vert + real( r8 ), parameter :: & + four_thirds = 4.0_r8/3.0_r8, & ! 4/3 + rho_ice = 917.0_r8, & ! Density of ice [kg/m^3] + rho_lw = shr_const_rhofw, & ! Density of liquid water [kg/m^3] + pi = shr_const_pi ! Pi - !============================================================================ - subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) + real( r8 ), parameter :: & + mvr_cloud_max = 1.6E-5_r8, & ! Max. avg. mean vol. rad. cloud [m] + mvr_rain_max = 5.0E-3_r8, & ! Max. avg. mean vol. rad. rain [m] + mvr_ice_max = 1.3E-4_r8, & ! Max. avg. mean vol. rad. ice [m] + mvr_snow_max = 1.0E-2_r8 ! Max. avg. mean vol. rad. snow [m] - ! Description: - ! Limits the values of mean hydrometeor concentrations so that the mean - ! drop size for the hydrometeor type remains reasonable and does not become - ! too large. + ! Calculate the coefficient for the minimum mean cloud droplet + ! concentration, where |_min = Ncm_min_coef * and has units of + ! 1/kg. + real( r8 ), parameter :: & + Ncm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_lw * mvr_cloud_max**3 ) - !---------------------------------------------------------------------- + ! Calculate the coefficient for the minimum mean rain drop concentration, + ! where |_min = Nrm_min_coef * and has units of 1/kg. + real( r8 ), parameter :: & + Nrm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_lw * mvr_rain_max**3 ) - use shr_const_mod, only: & - shr_const_pi, & - shr_const_rhofw + ! Calculate the coefficient for the minimum mean ice crystal concentration, + ! where |_min = Nim_min_coef * and has units of 1/kg. + real( r8 ), parameter :: & + Nim_min_coef = 1.0_r8 / ( four_thirds * pi * rho_ice * mvr_ice_max**3 ) - use constituents, only: & - qmin + ! Calculate the coefficient for the minimum mean snow flake concentration, + ! where |_min = Nsm_min_coef * and has units of 1/kg. + real( r8 ), parameter :: & + Nsm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_ice * mvr_snow_max**3 ) - use ref_pres, only: & - top_lev => trop_cloud_top_lev + integer :: ncol ! Number of grid columns - implicit none + integer :: icol ! Column loop index - ! Input Variables - type(physics_state), intent(in) :: state ! Physics state variables - real(r8), intent(in) :: dt ! Time step duration + integer :: k ! Vertical level loop index - ! Input/Output Variable - type(physics_ptend), intent(inout) :: ptend ! Parameterization tendencies - ! Local Variables - real( r8 ) :: & - rcm_update, & ! New value of mean cloud water mixing ratio [kg/kg] - rrm_update, & ! New value of mean rain water mixing ratio [kg/kg] - rim_update, & ! New value of mean ice mixing ratio [kg/kg] - rsm_update ! New value of mean snow mixing ratio [kg/kg] - - real( r8 ) :: & - Nc_tend_min, & ! Minimum value of cloud droplet conc. tendency [num/kg/s] - Nr_tend_min, & ! Minimum value of rain drop conc. tendency [num/kg/s] - Ni_tend_min, & ! Minimum value of ice conc. tendency [num/kg/s] - Ns_tend_min ! Minimum value of snow conc. tendency [num/kg/s] - - real( r8 ), parameter :: & - four_thirds = 4.0_r8/3.0_r8, & ! 4/3 - rho_ice = 917.0_r8, & ! Density of ice [kg/m^3] - rho_lw = shr_const_rhofw, & ! Density of liquid water [kg/m^3] - pi = shr_const_pi ! Pi - - real( r8 ), parameter :: & - mvr_cloud_max = 1.6E-5_r8, & ! Max. avg. mean vol. rad. cloud [m] - mvr_rain_max = 5.0E-3_r8, & ! Max. avg. mean vol. rad. rain [m] - mvr_ice_max = 1.3E-4_r8, & ! Max. avg. mean vol. rad. ice [m] - mvr_snow_max = 1.0E-2_r8 ! Max. avg. mean vol. rad. snow [m] - - ! Calculate the coefficient for the minimum mean cloud droplet - ! concentration, where |_min = Ncm_min_coef * and has units of - ! 1/kg. - real( r8 ), parameter :: & - Ncm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_lw * mvr_cloud_max**3 ) - - ! Calculate the coefficient for the minimum mean rain drop concentration, - ! where |_min = Nrm_min_coef * and has units of 1/kg. - real( r8 ), parameter :: & - Nrm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_lw * mvr_rain_max**3 ) - - ! Calculate the coefficient for the minimum mean ice crystal concentration, - ! where |_min = Nim_min_coef * and has units of 1/kg. - real( r8 ), parameter :: & - Nim_min_coef = 1.0_r8 / ( four_thirds * pi * rho_ice * mvr_ice_max**3 ) - - ! Calculate the coefficient for the minimum mean snow flake concentration, - ! where |_min = Nsm_min_coef * and has units of 1/kg. - real( r8 ), parameter :: & - Nsm_min_coef = 1.0_r8 / ( four_thirds * pi * rho_ice * mvr_snow_max**3 ) - - integer :: ncol ! Number of grid columns - - integer :: icol ! Column loop index - - integer :: k ! Vertical level loop index - - - ! Get the number of grid columns. - ncol = state%ncol + ! Get the number of grid columns. + ncol = state%ncol - ! Loop over all grid columns. - do icol = 1, ncol + ! Loop over all grid columns. + do icol = 1, ncol - ! Loop over all vertical levels from top_lev to pver. - do k = top_lev, pver + ! Loop over all vertical levels from top_lev to pver. + do k = top_lev, pver - ! Cloud droplet concentration - if ( ixcldliq > 0 .and. ixnumliq > 0 ) then + ! Cloud droplet concentration + if ( ixcldliq > 0 .and. ixnumliq > 0 ) then - ! Calculate the value of cloud water mixing ratio after the - ! update. - rcm_update & - = max( state%q(icol,k,ixcldliq) + ptend%q(icol,k,ixcldliq) * dt, & - qmin(ixcldliq) ) + ! Calculate the value of cloud water mixing ratio after the + ! update. + rcm_update & + = max( state%q(icol,k,ixcldliq) + ptend%q(icol,k,ixcldliq) * dt, & + qmin(ixcldliq) ) - ! Calculate the limiting cloud droplet concentration tendency so - ! that cloud maintains a reasonable (not too big) mean volume - ! radius. - Nc_tend_min & - = ( Ncm_min_coef * rcm_update - state%q(icol,k,ixnumliq) ) / dt + ! Calculate the limiting cloud droplet concentration tendency so + ! that cloud maintains a reasonable (not too big) mean volume + ! radius. + Nc_tend_min & + = ( Ncm_min_coef * rcm_update - state%q(icol,k,ixnumliq) ) / dt - ! The cloud droplet concentration tendency needs to be the greater - ! of the current Nc_tend and Nc_tend_min. - ptend%q(icol,k,ixnumliq) & - = max( ptend%q(icol,k,ixnumliq), Nc_tend_min ) + ! The cloud droplet concentration tendency needs to be the greater + ! of the current Nc_tend and Nc_tend_min. + ptend%q(icol,k,ixnumliq) & + = max( ptend%q(icol,k,ixnumliq), Nc_tend_min ) - endif ! ixcldliq > 0 .and. ixnumliq > 0 + endif ! ixcldliq > 0 .and. ixnumliq > 0 - ! Rain drop concentration - if ( ixrain > 0 .and. ixnumrain > 0 ) then + ! Rain drop concentration + if ( ixrain > 0 .and. ixnumrain > 0 ) then - ! Calculate the value of rain water mixing ratio after the update. - rrm_update & - = max( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt, & - qmin(ixrain) ) + ! Calculate the value of rain water mixing ratio after the update. + rrm_update & + = max( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt, & + qmin(ixrain) ) - ! Calculate the limiting rain drop concentration tendency so that - ! rain maintains a reasonable (not too big) mean volume radius. - Nr_tend_min & - = ( Nrm_min_coef * rrm_update - state%q(icol,k,ixnumrain) ) / dt + ! Calculate the limiting rain drop concentration tendency so that + ! rain maintains a reasonable (not too big) mean volume radius. + Nr_tend_min & + = ( Nrm_min_coef * rrm_update - state%q(icol,k,ixnumrain) ) / dt - ! The rain drop concentration tendency needs to be the greater of - ! the current Nr_tend and Nr_tend_min. - ptend%q(icol,k,ixnumrain) & - = max( ptend%q(icol,k,ixnumrain), Nr_tend_min ) + ! The rain drop concentration tendency needs to be the greater of + ! the current Nr_tend and Nr_tend_min. + ptend%q(icol,k,ixnumrain) & + = max( ptend%q(icol,k,ixnumrain), Nr_tend_min ) - endif ! ixrain > 0 .and. ixnumrain > 0 + endif ! ixrain > 0 .and. ixnumrain > 0 - ! Ice crystal concentration - if ( ixcldice > 0 .and. ixnumice > 0 ) then + ! Ice crystal concentration + if ( ixcldice > 0 .and. ixnumice > 0 ) then - ! Calculate the value of ice mixing ratio after the update. - rim_update & - = max( state%q(icol,k,ixcldice) + ptend%q(icol,k,ixcldice) * dt, & - qmin(ixcldice) ) + ! Calculate the value of ice mixing ratio after the update. + rim_update & + = max( state%q(icol,k,ixcldice) + ptend%q(icol,k,ixcldice) * dt, & + qmin(ixcldice) ) - ! Calculate the limiting ice crystal concentration tendency so - ! that ice maintains a reasonable (not too big) mean volume - ! radius. - Ni_tend_min & - = ( Nim_min_coef * rim_update - state%q(icol,k,ixnumice) ) / dt + ! Calculate the limiting ice crystal concentration tendency so + ! that ice maintains a reasonable (not too big) mean volume + ! radius. + Ni_tend_min & + = ( Nim_min_coef * rim_update - state%q(icol,k,ixnumice) ) / dt - ! The ice crystal concentration tendency needs to be the greater - ! of the current Ni_tend and Ni_tend_min. - ptend%q(icol,k,ixnumice) & - = max( ptend%q(icol,k,ixnumice), Ni_tend_min ) + ! The ice crystal concentration tendency needs to be the greater + ! of the current Ni_tend and Ni_tend_min. + ptend%q(icol,k,ixnumice) & + = max( ptend%q(icol,k,ixnumice), Ni_tend_min ) - endif ! ixcldice > 0 .and. ixnumice > 0 + endif ! ixcldice > 0 .and. ixnumice > 0 - ! Snow flake concentration - if ( ixsnow > 0 .and. ixnumsnow > 0 ) then + ! Snow flake concentration + if ( ixsnow > 0 .and. ixnumsnow > 0 ) then - ! Calculate the value of snow mixing ratio after the update. - rsm_update & - = max( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt, & - qmin(ixsnow) ) + ! Calculate the value of snow mixing ratio after the update. + rsm_update & + = max( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt, & + qmin(ixsnow) ) - ! Calculate the limiting snow flake concentration tendency so that - ! snow maintains a reasonable (not too big) mean volume radius. - Ns_tend_min & - = ( Nsm_min_coef * rsm_update - state%q(icol,k,ixnumsnow) ) / dt + ! Calculate the limiting snow flake concentration tendency so that + ! snow maintains a reasonable (not too big) mean volume radius. + Ns_tend_min & + = ( Nsm_min_coef * rsm_update - state%q(icol,k,ixnumsnow) ) / dt - ! The snow flake concentration tendency needs to be the greater of - ! the current Ns_tend and Ns_tend_min. - ptend%q(icol,k,ixnumsnow) & - = max( ptend%q(icol,k,ixnumsnow), Ns_tend_min ) + ! The snow flake concentration tendency needs to be the greater of + ! the current Ns_tend and Ns_tend_min. + ptend%q(icol,k,ixnumsnow) & + = max( ptend%q(icol,k,ixnumsnow), Ns_tend_min ) - endif ! ixsnow > 0 .and. ixnumsnow > 0 + endif ! ixsnow > 0 .and. ixnumsnow > 0 - end do ! k = top_lev, pver + end do ! k = top_lev, pver - end do ! icol = 1, ncol + end do ! icol = 1, ncol - return + return - end subroutine subcol_SILHS_hydromet_conc_tend_lim + end subroutine subcol_SILHS_hydromet_conc_tend_lim - !============================================================================ + !============================================================================ - ! Getunit and Freeunit are depreciated in Fortran going forward, so this is a - ! small function to get an unused stream identifier to send to setup_corr_varnce_array_api - ! or any other silhs/clubb functions that require a unit number argument - ! This comes directly from the Fortran wiki - integer function newunit(unit) - integer, intent(out), optional :: unit - - integer, parameter :: LUN_MIN=10, LUN_MAX=1000 - logical :: opened - integer :: lun - - newunit=-1 - do lun=LUN_MIN,LUN_MAX - inquire(unit=lun,opened=opened) - if (.not. opened) then - newunit=lun - exit - end if - end do - if (present(unit)) unit=newunit - end function newunit + ! Getunit and Freeunit are depreciated in Fortran going forward, so this is a + ! small function to get an unused stream identifier to send to setup_corr_varnce_array_api + ! or any other silhs/clubb functions that require a unit number argument + ! This comes directly from the Fortran wiki + integer function newunit(unit) + integer, intent(out), optional :: unit + integer, parameter :: LUN_MIN=10, LUN_MAX=1000 + logical :: opened + integer :: lun + + newunit=-1 + do lun=LUN_MIN,LUN_MAX + inquire(unit=lun,opened=opened) + if (.not. opened) then + newunit=lun + exit + end if + end do + if (present(unit)) unit=newunit + end function newunit + end module subcol_SILHS From e67fc4719fa21f8e449b024a0e3b6df2d0a7f8cb Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Thu, 13 Nov 2025 15:26:25 -0700 Subject: [PATCH 02/29] Merging up to clubb_release 673beb05 --- src/physics/cam/clubb_intr.F90 | 201 ++++++++++++------------------- src/physics/cam/subcol_SILHS.F90 | 15 +-- 2 files changed, 81 insertions(+), 135 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index b1aed9d7f1..5e98c7f2bc 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -95,7 +95,7 @@ module clubb_intr #ifdef CLUBB_SGS type(clubb_config_flags_type), public :: clubb_config_flags - real(r8), dimension(nparams), public :: clubb_params_single_col ! Adjustable CLUBB parameters (C1, C2 ...) + real(r8), dimension(1,nparams), public :: clubb_params_single_col ! Adjustable CLUBB parameters (C1, C2 ...) #endif ! These are zero by default, but will be set by SILHS before they are used by subcolumns @@ -1442,8 +1442,7 @@ subroutine clubb_ini_cam(pbuf2d) set_clubb_debug_level_api, & clubb_fatal_error, & ! Error code value to indicate a fatal error nparams, & - set_default_parameters_api, & - read_parameters_api, & + init_clubb_params_api, & w_tol_sqd, & rt_tol, & thl_tol, & @@ -1617,112 +1616,61 @@ subroutine clubb_ini_cam(pbuf2d) ! Setup CLUBB core ! ----------------------------------------------------------------- ! - ! Read in parameters for CLUBB. Just read in default values - call set_default_parameters_api( & - C1, C1b, C1c, C2rt, C2thl, C2rtthl, & - C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & - C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & - C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & - c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & - slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & - coef_spread_DG_means_rt, coef_spread_DG_means_thl, & - gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & - omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & - lambda0_stability_coef, mult_coef, taumin, taumax, & - Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & - Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & - thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & - Skw_max_mag, xp3_coef_base, xp3_coef_slope, & - altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & - C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & - C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & - C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & - C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & - Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & - wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace ) - - call read_parameters_api( 1, -99, "", & - C1, C1b, C1c, C2rt, C2thl, C2rtthl, & - C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & - C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & - C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & - C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & - C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & - c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & - c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & - slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & - coef_spread_DG_means_rt, coef_spread_DG_means_thl, & - gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & - omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & - lambda0_stability_coef, mult_coef, taumin, taumax, & - Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & - Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & - thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & - Skw_max_mag, xp3_coef_base, xp3_coef_slope, & - altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & - C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & - C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & - C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & - C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & - Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & - wpxp_Ri_exp, a3_coef_min, a_const, bv_efold, z_displace, & - clubb_params_single_col ) - - clubb_params_single_col(iC2rtthl) = clubb_C2rtthl - clubb_params_single_col(iC8) = clubb_C8 - clubb_params_single_col(iC11) = clubb_c11 - clubb_params_single_col(iC11b) = clubb_c11b - clubb_params_single_col(iC14) = clubb_c14 - clubb_params_single_col(iC_wp3_pr_turb) = clubb_C_wp3_pr_turb - clubb_params_single_col(ic_K10) = clubb_c_K10 - clubb_params_single_col(imult_coef) = clubb_mult_coef - clubb_params_single_col(iSkw_denom_coef) = clubb_Skw_denom_coef - clubb_params_single_col(iC2rt) = clubb_C2rt - clubb_params_single_col(iC2thl) = clubb_C2thl - clubb_params_single_col(ibeta) = clubb_beta - clubb_params_single_col(iC6rt) = clubb_c6rt - clubb_params_single_col(iC6rtb) = clubb_c6rtb - clubb_params_single_col(iC6rtc) = clubb_c6rtc - clubb_params_single_col(iC6thl) = clubb_c6thl - clubb_params_single_col(iC6thlb) = clubb_c6thlb - clubb_params_single_col(iC6thlc) = clubb_c6thlc - clubb_params_single_col(iwpxp_L_thresh) = clubb_wpxp_L_thresh - clubb_params_single_col(iC7) = clubb_C7 - clubb_params_single_col(iC7b) = clubb_C7b - clubb_params_single_col(igamma_coef) = clubb_gamma_coef - clubb_params_single_col(ic_K10h) = clubb_c_K10h - clubb_params_single_col(ilambda0_stability_coef) = clubb_lambda0_stability_coef - clubb_params_single_col(ilmin_coef) = clubb_lmin_coef - clubb_params_single_col(iC8b) = clubb_C8b - clubb_params_single_col(iskw_max_mag) = clubb_skw_max_mag - clubb_params_single_col(iC1) = clubb_C1 - clubb_params_single_col(iC1b) = clubb_C1b - clubb_params_single_col(igamma_coefb) = clubb_gamma_coefb - clubb_params_single_col(iup2_sfc_coef) = clubb_up2_sfc_coef - clubb_params_single_col(iC4) = clubb_C4 - clubb_params_single_col(iC_uu_shr) = clubb_C_uu_shr - clubb_params_single_col(iC_uu_buoy) = clubb_C_uu_buoy - clubb_params_single_col(ic_K1) = clubb_c_K1 - clubb_params_single_col(ic_K2) = clubb_c_K2 - clubb_params_single_col(inu2) = clubb_nu2 - clubb_params_single_col(ic_K8) = clubb_c_K8 - clubb_params_single_col(ic_K9) = clubb_c_K9 - clubb_params_single_col(inu9) = clubb_nu9 - clubb_params_single_col(iC_wp2_splat) = clubb_C_wp2_splat - clubb_params_single_col(iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd - clubb_params_single_col(iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc - clubb_params_single_col(iC_invrs_tau_shear) = clubb_C_invrs_tau_shear - clubb_params_single_col(iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 - clubb_params_single_col(iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 - clubb_params_single_col(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 - clubb_params_single_col(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp - clubb_params_single_col(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 - clubb_params_single_col(ibv_efold) = clubb_bv_efold - clubb_params_single_col(iwpxp_Ri_exp) = clubb_wpxp_Ri_exp - clubb_params_single_col(iz_displace) = clubb_z_displace + call init_clubb_params_api( 1, -99, "", & + clubb_params_single_col ) + + clubb_params_single_col(:,iC2rtthl) = clubb_C2rtthl + clubb_params_single_col(:,iC8) = clubb_C8 + clubb_params_single_col(:,iC11) = clubb_c11 + clubb_params_single_col(:,iC11b) = clubb_c11b + clubb_params_single_col(:,iC14) = clubb_c14 + clubb_params_single_col(:,iC_wp3_pr_turb) = clubb_C_wp3_pr_turb + clubb_params_single_col(:,ic_K10) = clubb_c_K10 + clubb_params_single_col(:,imult_coef) = clubb_mult_coef + clubb_params_single_col(:,iSkw_denom_coef) = clubb_Skw_denom_coef + clubb_params_single_col(:,iC2rt) = clubb_C2rt + clubb_params_single_col(:,iC2thl) = clubb_C2thl + clubb_params_single_col(:,ibeta) = clubb_beta + clubb_params_single_col(:,iC6rt) = clubb_c6rt + clubb_params_single_col(:,iC6rtb) = clubb_c6rtb + clubb_params_single_col(:,iC6rtc) = clubb_c6rtc + clubb_params_single_col(:,iC6thl) = clubb_c6thl + clubb_params_single_col(:,iC6thlb) = clubb_c6thlb + clubb_params_single_col(:,iC6thlc) = clubb_c6thlc + clubb_params_single_col(:,iwpxp_L_thresh) = clubb_wpxp_L_thresh + clubb_params_single_col(:,iC7) = clubb_C7 + clubb_params_single_col(:,iC7b) = clubb_C7b + clubb_params_single_col(:,igamma_coef) = clubb_gamma_coef + clubb_params_single_col(:,ic_K10h) = clubb_c_K10h + clubb_params_single_col(:,ilambda0_stability_coef) = clubb_lambda0_stability_coef + clubb_params_single_col(:,ilmin_coef) = clubb_lmin_coef + clubb_params_single_col(:,iC8b) = clubb_C8b + clubb_params_single_col(:,iskw_max_mag) = clubb_skw_max_mag + clubb_params_single_col(:,iC1) = clubb_C1 + clubb_params_single_col(:,iC1b) = clubb_C1b + clubb_params_single_col(:,igamma_coefb) = clubb_gamma_coefb + clubb_params_single_col(:,iup2_sfc_coef) = clubb_up2_sfc_coef + clubb_params_single_col(:,iC4) = clubb_C4 + clubb_params_single_col(:,iC_uu_shr) = clubb_C_uu_shr + clubb_params_single_col(:,iC_uu_buoy) = clubb_C_uu_buoy + clubb_params_single_col(:,ic_K1) = clubb_c_K1 + clubb_params_single_col(:,ic_K2) = clubb_c_K2 + clubb_params_single_col(:,inu2) = clubb_nu2 + clubb_params_single_col(:,ic_K8) = clubb_c_K8 + clubb_params_single_col(:,ic_K9) = clubb_c_K9 + clubb_params_single_col(:,inu9) = clubb_nu9 + clubb_params_single_col(:,iC_wp2_splat) = clubb_C_wp2_splat + clubb_params_single_col(:,iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd + clubb_params_single_col(:,iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc + clubb_params_single_col(:,iC_invrs_tau_shear) = clubb_C_invrs_tau_shear + clubb_params_single_col(:,iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 + clubb_params_single_col(:,iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 + clubb_params_single_col(:,iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 + clubb_params_single_col(:,iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp + clubb_params_single_col(:,iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 + clubb_params_single_col(:,ibv_efold) = clubb_bv_efold + clubb_params_single_col(:,iwpxp_Ri_exp) = clubb_wpxp_Ri_exp + clubb_params_single_col(:,iz_displace) = clubb_z_displace ! Override clubb default if ( trim(subcol_scheme) == 'SILHS' ) then @@ -1732,18 +1680,18 @@ subroutine clubb_ini_cam(pbuf2d) end if ! Define model constant parameters - call setup_parameters_model_api( theta0, ts_nudge, clubb_params_single_col(iSkw_max_mag) ) + call setup_parameters_model_api( theta0, ts_nudge, clubb_params_single_col(1,iSkw_max_mag) ) ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change ! at each time step, which is why dummy arrays are read in here for heights ! as they are immediately overwrote. !$OMP PARALLEL - call check_clubb_settings_api( nzm_clubb, clubb_params_single_col, & ! Intent(in) - l_implemented, & ! Intent(in) - l_input_fields, & ! Intent(in) - clubb_config_flags, & ! intent(in) - err_code ) ! Intent(out) + call check_clubb_settings_api( 1, clubb_params_single_col, & ! Intent(in) + l_implemented, & ! Intent(in) + l_input_fields, & ! Intent(in) + clubb_config_flags, & ! intent(in) + err_code ) ! Intent(out) if ( err_code == clubb_fatal_error ) then call endrun('clubb_ini_cam: FATAL ERROR CALLING SETUP_CLUBB_CORE') @@ -1753,7 +1701,7 @@ subroutine clubb_ini_cam(pbuf2d) ! Print the list of CLUBB parameters if ( masterproc ) then do j = 1, nparams, 1 - write(iulog,*) params_list(j), " = ", clubb_params_single_col(j) + write(iulog,*) params_list(j), " = ", clubb_params_single_col(1,j) enddo endif @@ -2360,7 +2308,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzt_clubb,hydromet_dim) :: & - hydromet, & wp2hmp, & rtphmp_zt, & thlphmp_zt @@ -2610,6 +2557,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,nparams) :: & clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) + real(r8), dimension(state%ncol,nzt_clubb) :: & + Lscale + integer :: & sclr, & edsclr, & @@ -2956,7 +2906,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc copyout( edsclr_out ) !$acc data if( hydromet_dim > 0 ) & - !$acc create( hydromet, wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) & + !$acc create( wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) & !$acc copyin( hm_metadata, hm_metadata%l_mix_rat_hm ) call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') @@ -3100,7 +3050,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do ixind=1, hydromet_dim do k=1, nzt_clubb do i=1, ncol - hydromet(i,k,ixind) = 0._r8 wp2hmp(i,k,ixind) = 0._r8 rtphmp_zt(i,k,ixind) = 0._r8 thlphmp_zt(i,k,ixind) = 0._r8 @@ -3354,7 +3303,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do i = 1, ncol do n = 1, nparams - clubb_params(i,n) = clubb_params_single_col(n) + clubb_params(i,:) = clubb_params_single_col(1,:) end do end do @@ -3745,7 +3694,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & p_in_Pa, rho_zm, rho_zt, exner, & rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & - hydromet, hm_metadata%l_mix_rat_hm, & + hm_metadata%l_mix_rat_hm, & rfrzm, & wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & grid_dx, grid_dy, & @@ -3773,7 +3722,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qclvar_out, thlprcp_out, & wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, & cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & - rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out ) + rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out, & + Lscale ) call t_stopf('clubb_tend_cam:advance_clubb_core_api') ! Note that CLUBB does not produce an error code specific to any column, and @@ -3828,10 +3778,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qrl_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qrl_clubb ) thlp2_rad_out(:,:) = 0._r8 - do i=1, ncol - call calculate_thlp2_rad_api(nzm_clubb, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params(i,:), & - thlp2_rad_out(i,:)) - end do + call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr, & + rcm_inout, thlprcp_out, qrl_clubb, clubb_params, & + thlp2_rad_out ) do i=1, ncol thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 5892dc7205..8e031d6d9e 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -59,10 +59,6 @@ module subcol_SILHS ! Calc subcol mean ! Calc subcol variance private :: meansc private :: stdsc - - type (stats), target :: stats_lh_zt, & - stats_lh_sfc - !$omp threadprivate(stats_lh_zt, stats_lh_sfc) real( kind = core_rknd ), dimension(:,:), allocatable :: & corr_array_n_cloud, & @@ -620,7 +616,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) genrand_intg, genrand_init_api, & nparams, ic_K, & - read_parameters_api, & Cp, Lv, & grid, setup_grid_api, & init_precip_fracs_api @@ -736,6 +731,9 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) nice_all_pts, & ! Calculate Num cld ice from LH nclw_all_pts ! Calculate Num cld wat from LH + type (stats), dimension(state%ngrdcol) :: stats_lh_zt, & + stats_lh_sfc + !---------------- ! Output from clip_transform_silhs_output_api !---------------- @@ -920,7 +918,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call pbuf_get_field(pbuf, kvh_idx, khzm_in) ! Pull c_K from clubb parameters. - c_K = clubb_params_single_col(ic_K) + c_K = clubb_params_single_col(1,ic_K) !---------------- ! Copy state and populate numbers and values of sub-columns @@ -1137,7 +1135,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) corr_array_n_cloud, corr_array_n_below, & ! In hm_metadata, & ! In pdf_params_chnk(lchnk), & ! In - clubb_params_single_col, & ! In + clubb_params_single_col(1,:), & ! In clubb_config_flags%iiPDF_type, & ! In clubb_config_flags%l_use_precip_frac, & ! In clubb_config_flags%l_predict_upwp_vpwp, & ! In @@ -1219,7 +1217,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) l_calc_weights_all_levs_itime, & ! In pdf_params_chnk(lchnk), delta_zm, Lscale, & ! In lh_seed, hm_metadata, & ! In - rho_ds_zt, & ! In mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In precip_fracs, silhs_config_flags, & ! In @@ -1230,7 +1227,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) lh_sample_point_weights) ! Out ! Extract clipped variables from subcolumns - call clip_transform_silhs_output_api( gr, pver-top_lev+1, ngrdcol, num_subcols, & ! In + call clip_transform_silhs_output_api( pver-top_lev+1, ngrdcol, num_subcols, & ! In pdf_dim, hydromet_dim, hm_metadata, & ! In X_mixt_comp_all_levs, & ! In X_nl_all_levs, & ! In From 187d7b536c2f36968fc7f5e1b9d1167e430ad03f Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Thu, 13 Nov 2025 18:06:38 -0700 Subject: [PATCH 03/29] Merging up to clubb_release dc302b95 (current basically) --- bld/build-namelist | 3 + bld/namelist_files/namelist_defaults_cam.xml | 3 + bld/namelist_files/namelist_definition.xml | 17 +++ src/physics/cam/clubb_intr.F90 | 147 +++++++++++++------ src/physics/cam/subcol_SILHS.F90 | 61 ++++++-- 5 files changed, 177 insertions(+), 54 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index 175aef4298..b7177e87c7 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3594,9 +3594,12 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_detphase_lowtemp'); add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_do_liqsupersat'); + add_default($nl, 'clubb_grid_adapt_in_time_method'); + add_default($nl, 'clubb_grid_remap_method'); add_default($nl, 'clubb_ipdf_call_placement'); add_default($nl, 'clubb_lambda0_stability_coef'); add_default($nl, 'clubb_lmin_coef'); + add_default($nl, 'clubb_l_add_dycore_grid'); add_default($nl, 'clubb_l_brunt_vaisala_freq_moist'); add_default($nl, 'clubb_l_call_pdf_closure_twice'); add_default($nl, 'clubb_l_damp_wp2_using_em'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index c75c36c473..92ae7832bc 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2180,9 +2180,12 @@ 0.280 0.32 0.3 + 0 + 1 2 0.04 0.1 + .false. .false. .false. .true. diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index efb62cac72..8a98adbc24 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3940,6 +3940,18 @@ Gaussian PDF, and also decreases the difference between the means of w from each Gaussian. + +Specifier for method to construct a grid density function to adapt grid to. +Valid values: 0 (no grid adaptation), 1 (use Lscale and wp2) + + + +Specifier for method to remap values from one grid to another. +Valid values: 1 (ullrich remapping) + + Selected option for the two-component normal (double Gaussian) PDF type to use for the w, rt, @@ -3966,6 +3978,11 @@ scale (Lscale) in a grid-spacing dependent formula. Increasing the value of clubb_lmin_coef increases the minimum allowable value for length scale. + +Flag to remap values from the dycore grid. + + Flag to uses an alternate equation to calculate the Brunt-Vaisala frequency. diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 5e98c7f2bc..d28b3a41af 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -137,9 +137,11 @@ module clubb_intr sclr_tol = 1.e-8_r8 ! Total water in kg/kg real(r8), parameter :: & - theta0 = 300._r8, & ! Reference temperature [K] - ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s] - p0_clubb = 100000._r8 + rtm_min = epsilon( rtm_min ), & ! Value below which rtm will be nudged [kg/kg] + rtm_nudge_max_altitude = 10000._r8, & ! Highest altitude at which to nudge rtm [m] + theta0 = 300._r8, & ! Reference temperature [K] + ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s] + p0_clubb = 100000._r8 real(r8), parameter :: & wp3_const = 1._r8 ! Constant to add to wp3 when moments are advected @@ -227,7 +229,13 @@ module clubb_intr ! CLUBB's PDF. clubb_penta_solve_method = unset_i, & ! Specifier for method to solve the penta-diagonal system clubb_tridiag_solve_method = unset_i,& ! Specifier for method to solve tri-diagonal systems - clubb_saturation_equation = unset_i ! Specifier for which saturation formula to use + clubb_saturation_equation = unset_i, & ! Specifier for which saturation formula to use + clubb_grid_remap_method = unset_i, & ! Specifier for which method should be used to + ! map values from one grid to another + ! (starts at 1, so 0 is an invalid option for this flag) + clubb_grid_adapt_in_time_method = unset_i ! Specifier for how the grid density method should + ! be constructed if the grid should be adapted over time + ! (set to 0 for no adaptation) logical :: & @@ -346,7 +354,10 @@ module clubb_intr clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that ! eliminates spurious drying tendencies at model top - clubb_l_host_applies_sfc_fluxes ! Whether the host model applies the surface fluxes + clubb_l_host_applies_sfc_fluxes, & ! Whether the host model applies the surface fluxes + clubb_l_wp2_fill_holes_tke, & ! Whether TKE is taken from up2 and vp2 to fill holes in wp2 + clubb_l_add_dycore_grid ! Flag to remap values from dycore grid + logical :: & clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes @@ -499,6 +510,8 @@ module clubb_intr type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] + + logical, parameter, public :: l_ascending_grid = .true. ! For now #endif contains @@ -824,10 +837,13 @@ subroutine clubb_readnl(nlfile) clubb_do_liqsupersat, & clubb_gamma_coef, & clubb_gamma_coefb, & + clubb_grid_adapt_in_time_method, & + clubb_grid_remap_method, & clubb_iiPDF_type, & clubb_ipdf_call_placement, & clubb_lambda0_stability_coef, & clubb_lmin_coef, & + clubb_l_add_dycore_grid, & clubb_l_brunt_vaisala_freq_moist, & clubb_l_C2_cloud_frac, & clubb_l_calc_thlp2_rad, & @@ -909,6 +925,8 @@ subroutine clubb_readnl(nlfile) clubb_penta_solve_method, & ! Out clubb_tridiag_solve_method, & ! Out clubb_saturation_equation, & ! Out + clubb_grid_remap_method, & ! Out + clubb_grid_adapt_in_time_method, & ! Out clubb_l_use_precip_frac, & ! Out clubb_l_predict_upwp_vpwp, & ! Out clubb_l_min_wp2_from_corr_wx, & ! Out @@ -963,7 +981,9 @@ subroutine clubb_readnl(nlfile) clubb_l_mono_flux_lim_um, & ! Out clubb_l_mono_flux_lim_vm, & ! Out clubb_l_mono_flux_lim_spikefix, & ! Out - clubb_l_host_applies_sfc_fluxes ) ! Out + clubb_l_host_applies_sfc_fluxes, & ! Out + clubb_l_wp2_fill_holes_tke, & ! Out + clubb_l_add_dycore_grid ) ! Out ! Call CLUBB+MF namelist call clubb_mf_readnl(nlfile) @@ -1214,12 +1234,20 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_mono_flux_lim_spikefix") call mpi_bcast(clubb_l_host_applies_sfc_fluxes, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_host_applies_sfc_fluxes") + call mpi_bcast(clubb_l_wp2_fill_holes_tke, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_wp2_fill_holes_tke") + call mpi_bcast(clubb_l_add_dycore_grid, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_add_dycore_grid") call mpi_bcast(clubb_penta_solve_method, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_penta_solve_method") call mpi_bcast(clubb_tridiag_solve_method, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_tridiag_solve_method") call mpi_bcast(clubb_saturation_equation, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_saturation_equation") + call mpi_bcast(clubb_grid_remap_method, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_grid_remap_method") + call mpi_bcast(clubb_grid_adapt_in_time_method, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_grid_adapt_in_time_method") call mpi_bcast(clubb_l_intr_sfc_flux_smooth, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_intr_sfc_flux_smooth") call mpi_bcast(clubb_l_vary_convect_depth, 1, mpi_logical, mstrid, mpicom, ierr) @@ -1326,6 +1354,8 @@ subroutine clubb_readnl(nlfile) if(clubb_penta_solve_method == unset_i) call endrun(sub//": FATAL: clubb_penta_solve_method not set") if(clubb_tridiag_solve_method == unset_i) call endrun(sub//": FATAL: clubb_tridiag_solve_method not set") if(clubb_saturation_equation == unset_i) call endrun(sub//": FATAL: clubb_saturation_equation not set") + if(clubb_grid_remap_method == unset_i) call endrun(sub//": FATAL: clubb_grid_remap_method not set") + if(clubb_grid_adapt_in_time_method == unset_i) call endrun(sub//": FATAL: clubb_grid_adapt_in_time_method not set") if(clubb_detphase_lowtemp >= meltpt_temp) & call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") @@ -1334,6 +1364,8 @@ subroutine clubb_readnl(nlfile) clubb_penta_solve_method, & ! In clubb_tridiag_solve_method, & ! In clubb_saturation_equation, & ! In + clubb_grid_remap_method, & ! In + clubb_grid_adapt_in_time_method, & ! In clubb_l_use_precip_frac, & ! In clubb_l_predict_upwp_vpwp, & ! In clubb_l_min_wp2_from_corr_wx, & ! In @@ -1389,6 +1421,8 @@ subroutine clubb_readnl(nlfile) clubb_l_mono_flux_lim_vm, & ! In clubb_l_mono_flux_lim_spikefix, & ! In clubb_l_host_applies_sfc_fluxes, & ! In + clubb_l_wp2_fill_holes_tke, & ! In + clubb_l_add_dycore_grid, & ! In clubb_config_flags ) ! Out #endif @@ -1434,13 +1468,15 @@ subroutine clubb_ini_cam(pbuf2d) use clubb_api_module, only: & print_clubb_config_flags_api, & - setup_parameters_model_api, & check_clubb_settings_api, & init_pdf_params_api, & time_precision, & core_rknd, & set_clubb_debug_level_api, & clubb_fatal_error, & ! Error code value to indicate a fatal error + err_info_type, & + init_default_err_info_api, & + cleanup_err_info_api, & nparams, & init_clubb_params_api, & w_tol_sqd, & @@ -1454,7 +1490,6 @@ subroutine clubb_ini_cam(pbuf2d) use time_manager, only: is_first_step use constituents, only: cnst_get_ind use phys_control, only: phys_getopts - use spmd_utils, only: iam use cam_logfile, only: iulog #endif @@ -1470,7 +1505,9 @@ subroutine clubb_ini_cam(pbuf2d) ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb - integer :: err_code ! Code for when CLUBB fails + type(err_info_type) :: & + err_info ! err_info struct used in CLUBB containing err_code and err_header + integer :: i, j, k, l ! Indices integer :: nmodes, nspec, m integer :: ixq, ixcldice, ixcldliq, ixnumliq, ixnumice @@ -1679,25 +1716,27 @@ subroutine clubb_ini_cam(pbuf2d) clubb_config_flags%saturation_formula = saturation_gfdl ! Goff & Gratch (1946) approximation for SVP end if - ! Define model constant parameters - call setup_parameters_model_api( theta0, ts_nudge, clubb_params_single_col(1,iSkw_max_mag) ) - ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change ! at each time step, which is why dummy arrays are read in here for heights ! as they are immediately overwrote. + !! Initialize err_info with default values since info is not available here + call init_default_err_info_api(1, err_info) !$OMP PARALLEL call check_clubb_settings_api( 1, clubb_params_single_col, & ! Intent(in) l_implemented, & ! Intent(in) l_input_fields, & ! Intent(in) clubb_config_flags, & ! intent(in) - err_code ) ! Intent(out) + err_info ) ! Intent(inout) - if ( err_code == clubb_fatal_error ) then - call endrun('clubb_ini_cam: FATAL ERROR CALLING SETUP_CLUBB_CORE') + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun('clubb_ini_cam: FATAL ERROR CALLING CHECK_CLUBB_SETTINGS_API') end if !$OMP END PARALLEL + ! Cleanup err_info since it is not needed anymore + call cleanup_err_info_api(err_info) + ! Print the list of CLUBB parameters if ( masterproc ) then do j = 1, nparams, 1 @@ -2054,9 +2093,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef CLUBB_SGS use holtslag_boville_diff, only: hb_pbl_dependent_coefficients_run + use spmd_utils, only: iam use clubb_api_module, only: & nparams, & - setup_parameters_api, & + calc_derrived_params_api, & + check_parameters_api, & time_precision, & advance_clubb_core_api, & zt2zm_api, zm2zt_api, & @@ -2077,8 +2118,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & init_pdf_implicit_coefs_terms_api, & setup_grid_api + ! Import setup for CLUBB error messaging use clubb_api_module, only: & - clubb_fatal_error ! Error code value to indicate a fatal error + clubb_fatal_error, & ! Error code value to indicate a fatal error + err_info_type, & + init_err_info_api, & + cleanup_err_info_api use cldfrc2m, only: aist_vector, rhmini_const, rhmaxi_const, rhminis_const, rhmaxis_const use cam_history, only: outfld @@ -2134,7 +2179,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq integer :: itim_old integer :: ncol, lchnk ! # of columns, and chunk identifier - integer :: err_code ! Diagnostic, for if some calculation goes amiss. integer :: icnt logical :: lq2(pcnst) @@ -2142,6 +2186,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & integer :: clubbtop(pcols) + type(err_info_type) :: & + err_info ! err_info struct used in CLUBB containing err_code and err_header + real(r8) :: frac_limit, ic_limit real(r8) :: dtime ! CLUBB time step [s] @@ -2527,6 +2574,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8) :: temp2d(pcols,pver) ! temporary array for holding scaled outputs + real(r8), dimension(state%ncol) :: deltaz + real(r8), dimension(pcols,pver) :: & rvmtend_clubb, & rcmtend_clubb, & @@ -2552,7 +2601,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & type(grid) :: gr type(nu_vertical_res_dep) :: nu_vert_res_dep ! Vertical resolution dependent nu values - real(r8) :: lmin + real(r8) :: lmin, mixt_frac_max_mag real(r8), dimension(state%ncol,nparams) :: & clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) @@ -2738,6 +2787,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_implicit_coefs_terms_chnk(lchnk) ) end if + ! Initialize err_info with parallelization and geographical info + call init_err_info_api(ncol, lchnk, iam, state1%lat*rad2deg, state1%lon*rad2deg, err_info) + !--------------------- Scalar Setting -------------------- dl_rad = clubb_detliq_rad @@ -2852,7 +2904,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, & !$acc radf, wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & - !$acc thlprcp_out, zi_g, zt_g, qrl_clubb, & + !$acc thlprcp_out, deltaz, zi_g, zt_g, qrl_clubb, & !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & @@ -3290,6 +3342,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i = 1, ncol + deltaz(i) = zi_g(i,2) - zi_g(i,1) + ! For consistency, set surface pressure to p_in_Pa at the first thermo. ! level above the surface (according to the CLUBB ascending grid). p_sfc(i) = p_in_Pa(i,1) @@ -3359,7 +3413,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Heights need to be set at each timestep. Therefore, recall - ! setup_grid and setup_parameters for this. + ! setup_grid and check_parameters_api for this. ! Set-up CLUBB core at each CLUBB call because heights can change ! Important note: do not make any calls that use CLUBB grid-height @@ -3368,20 +3422,31 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:ACCR') call t_startf('clubb_tend_cam:NAR') - !$acc update host( zi_g, zt_g, clubb_params, sfc_elevation ) + !$acc update host( deltaz, zi_g, zt_g, clubb_params, sfc_elevation ) - call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - grid_type, zi_g(:,2), zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + l_ascending_grid, grid_type, & ! intent(in) + deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) zi_g, zt_g, & ! intent(in) - gr ) ! intent(out) + gr, err_info ) ! intent(inout) + + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(subr//': '//err_info%err_header_global//NEW_LINE('a')// & + 'in CLUBB setup_grid') + end if + call calc_derrived_params_api( gr, ncol, grid_type, deltaz, & ! Intent(in) + clubb_params, & ! Intent(in) + clubb_config_flags%l_prescribed_avg_deltaz, & ! Intent(in) + nu_vert_res_dep, lmin, & ! intent(inout) + mixt_frac_max_mag ) ! intent(inout) - call setup_parameters_api( zi_g(:,2), clubb_params, gr, ncol, grid_type, & ! intent(in) - clubb_config_flags%l_prescribed_avg_deltaz, & ! intent(in) - lmin, nu_vert_res_dep, err_code ) ! intent(out) + call check_parameters_api( ncol, clubb_params, lmin, & ! Intent(in) + err_info ) ! Intent(inout) - if ( err_code == clubb_fatal_error ) then - call endrun(subr//': Fatal error in CLUBB setup_parameters') + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(subr//': '//err_info%err_header_global//NEW_LINE('a')// & + 'in CLUBB check_parameters_api') end if call t_stopf('clubb_tend_cam:NAR') @@ -3699,6 +3764,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & grid_dx, grid_dy, & clubb_params, nu_vert_res_dep, lmin, & + mixt_frac_max_mag, theta0, ts_nudge, & + rtm_min, rtm_nudge_max_altitude, & clubb_config_flags, & stats_metadata, & stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & @@ -3707,7 +3774,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wp2_in, wp3_in, rtp2_in, rtp3_in, thlp2_in, thlp3_in, rtpthlp_in, & sclrm, & sclrp2, sclrp3, sclrprtp, sclrpthlp, & - wpsclrp, edsclr_in, err_code, & + wpsclrp, edsclr_in, err_info, & rcm_inout, cloud_frac_inout, & wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & sclrpthvp_inout, & @@ -3728,16 +3795,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Note that CLUBB does not produce an error code specific to any column, and ! one value only for the entire chunk - if ( err_code == clubb_fatal_error ) then - write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep() - write(fstderr,*) "LAT Range: ", state1%lat(1)*rad2deg, & - " -- ", state1%lat(ncol)*rad2deg - tmp_lon1 = state1%lon(1)*rad2deg - tmp_lon1 = state1%lon(ncol)*rad2deg - if(tmp_lon1.gt.180.0_r8) tmp_lon1=tmp_lon1-360.0_r8 - if(tmp_lonN.gt.180.0_r8) tmp_lonN=tmp_lonN-360.0_r8 - write(fstderr,*) "LON: Range:", tmp_lon1, " -- ", tmp_lonN - call endrun(subr//': Fatal error in CLUBB library') + if ( any(err_info%err_code == clubb_fatal_error) ) then + write(fstderr,*) "Fatal error in CLUBB advance_clubb_core: at timestep ", get_nstep() + call endrun(subr//': '//err_info%err_header_global//NEW_LINE('a')//'Fatal error in CLUBB advance_clubb_core') end if if ( do_rainturb ) then @@ -4800,6 +4860,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:NAR') #endif + ! Cleanup err_info + call cleanup_err_info_api(err_info) + call t_stopf('clubb_tend_cam') return @@ -5498,7 +5561,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st enddo do i = 1, stats_zm%num_output_fields - do k = 1, stats_zt%kk + do k = 1, stats_zm%kk out_zm(thecol,pverp-k+1,i) = stats_zm%accum_field_values(1,1,k,i) if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 enddo diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 8e031d6d9e..d8eadc1049 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -25,7 +25,8 @@ module subcol_SILHS pdf_params_chnk, & hm_metadata, & hydromet_dim, & - pdf_dim + pdf_dim, & + l_ascending_grid use clubb_api_module, only: & hmp2_ip_on_hmm2_ip_slope_type, & @@ -599,7 +600,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) use subcol_utils, only : subcol_set_subcols, subcol_set_weight use subcol_pack_mod, only : subcol_pack use phys_control, only : phys_getopts - use spmd_utils, only : masterproc + use spmd_utils, only : masterproc, iam use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RHOFW #ifdef CLUBB_SGS @@ -613,15 +614,18 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) w_tol_sqd, zero_threshold, & em_min, cloud_frac_min, & ! rc_tol, & - genrand_intg, genrand_init_api, & - nparams, ic_K, & Cp, Lv, & grid, setup_grid_api, & - init_precip_fracs_api + init_precip_fracs_api, & + clubb_fatal_error, & + err_info_type, & + init_err_info_api, & + cleanup_err_info_api use silhs_api_module, only : generate_silhs_sample_api, & ! Ncn_to_Nc, & clip_transform_silhs_output_api, & + genrand_intg, genrand_init_api, & est_kessler_microphys_api, & vert_decorr_coef @@ -665,6 +669,11 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) lh_seed ! Seed used in random number generator that will be different ! for each column, yet reproducible for a restart run + type(err_info_type) :: & + err_info ! err_info struct used in CLUBB containing err_code and err_header + + real(r8), parameter :: rad2deg=180.0_r8/SHR_CONST_PI + !---------------- ! Required for set_up_pdf_params_incl_hydromet !---------------- @@ -691,6 +700,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) integer :: iter ! CLUBB iteration integer :: num_subcols ! Number of subcolumns integer, parameter :: sequence_length = 1 ! Number of timesteps btn subcol calls + + real(r8), dimension(state%ngrdcol) :: deltaz real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer @@ -920,6 +931,9 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Pull c_K from clubb parameters. c_K = clubb_params_single_col(1,ic_K) + ! Initialize err_info with parallelization and geographical info + call init_err_info_api(ncol, iam, lchnk, state%lat*rad2deg, state%lon*rad2deg, err_info) + !---------------- ! Copy state and populate numbers and values of sub-columns !---------------- @@ -964,13 +978,23 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Set the elevation of the surface sfc_elevation(i) = state%zi(i,pver+1) end do - + + do i=1, ngrdcol + deltaz(i) = zi_g(i,2) - zi_g(i,1) + end do + ! Heights need to be set at each timestep. call setup_grid_api( pverp+1-top_lev, ncol, sfc_elevation(1:ncol), l_implemented, & ! intent(in) - grid_type, zi_g(1:ncol,2), zi_g(1:ncol,1), zi_g(1:ncol,pverp+1-top_lev), & ! intent(in) - zi_g(1:ncol,:), zt_g(1:ncol,:), & ! intent(in) - gr ) + l_ascending_grid, grid_type, & + deltaz, zi_g(1:ncol,1), zi_g(1:ncol,pverp+1-top_lev), & ! intent(in) + zi_g(1:ncol,:), zt_g(1:ncol,:), & ! intent(in) + gr, err_info ) + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(err_info%err_header_global//NEW_LINE('a')// & + 'CAM subcol_gen_SILHS: Fatal error calling setup_grid_api') + end if + ! Calculate the distance between grid levels on the host model grid, ! using host model grid indices. do k = top_lev, pver @@ -1144,7 +1168,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) clubb_config_flags%l_const_Nc_in_cloud, & ! In clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In stats_metadata, & ! In - stats_zt, stats_zm, stats_sfc, & ! In + stats_zt, stats_zm, stats_sfc, err_info, & ! In hydrometp2, & ! Inout mu_x_1, mu_x_2, & ! Out sigma_x_1, sigma_x_2, & ! Out @@ -1152,6 +1176,11 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out precip_fracs ) ! Inout + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(err_info%err_header_global//NEW_LINE('a')// & + 'CAM subcol_gen_SILHS: Fatal error calling setup_pdf_parameters_api') + end if + ! In order for Lscale to be used properly, it needs to be passed out of ! advance_clubb_core, saved to the pbuf, and then pulled out of the ! pbuf for use here. The profile of Lscale is passed into subroutine @@ -1215,17 +1244,22 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call generate_silhs_sample_api( & iter, pdf_dim, num_subcols, sequence_length, pver-top_lev+1, ngrdcol, & ! In l_calc_weights_all_levs_itime, & ! In - pdf_params_chnk(lchnk), delta_zm, Lscale, & ! In + gr, pdf_params_chnk(lchnk), delta_zm, Lscale, & ! In lh_seed, hm_metadata, & ! In mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In precip_fracs, silhs_config_flags, & ! In vert_decorr_coef, & ! In stats_metadata, & ! In - stats_lh_zt, stats_lh_sfc, & ! InOut + stats_lh_zt, stats_lh_sfc, err_info, & ! InOut X_nl_all_levs, X_mixt_comp_all_levs, & ! Out lh_sample_point_weights) ! Out + if ( any(err_info%err_code == clubb_fatal_error) ) then + call endrun(err_info%err_header_global//NEW_LINE('a')// & + 'CAM subcol_gen_SILHS: Fatal error calling generate_silhs_sample_api') + end if + ! Extract clipped variables from subcolumns call clip_transform_silhs_output_api( pver-top_lev+1, ngrdcol, num_subcols, & ! In pdf_dim, hydromet_dim, hm_metadata, & ! In @@ -1238,6 +1272,9 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) lh_Nc_clipped ) ! Out !$acc wait + ! Cleaning up err_info + call cleanup_err_info_api(err_info) + if ( l_est_kessler_microphys ) then call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') end if From e4b71220b33aeaddb0afc68c9103555edccb59eb Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Thu, 13 Nov 2025 21:17:37 -0700 Subject: [PATCH 04/29] Small cleanups --- src/physics/cam/clubb_intr.F90 | 153 +++++++++++++++++---------------- 1 file changed, 81 insertions(+), 72 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index d28b3a41af..765785cfdd 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -405,7 +405,6 @@ module clubb_intr wp2thvp_idx, & ! second order buoyancy term rtpthvp_idx, & ! moisture buoyancy correlation thlpthvp_idx, & ! temperature buoyancy correlation - sclrpthvp_idx, & ! passive scalar buoyancy correlation wp2rtp_idx, & ! w'^2 rt' wp2thlp_idx, & ! w'^2 thl' uprcp_idx, & ! < u' r_c' > @@ -2116,7 +2115,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_parameter, & init_pdf_params_api, & init_pdf_implicit_coefs_terms_api, & - setup_grid_api + setup_grid_api, & + iiPDF_new, & + iiPDF_new_hybrid ! Import setup for CLUBB error messaging use clubb_api_module, only: & @@ -2782,9 +2783,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call init_pdf_params_api( nzm_clubb, ncol, pdf_params_zm_chnk(lchnk) ) end if - if ( .not. allocated(pdf_implicit_coefs_terms_chnk(lchnk)%coef_wp4_implicit) ) then - call init_pdf_implicit_coefs_terms_api( nzt_clubb, ncol, sclr_dim, & - pdf_implicit_coefs_terms_chnk(lchnk) ) + if ( clubb_config_flags%iiPDF_type == iiPDF_new .or. & + clubb_config_flags%iiPDF_type == iiPDF_new_hybrid ) then + + if ( .not. allocated(pdf_implicit_coefs_terms_chnk(lchnk)%coef_wp4_implicit) ) then + call init_pdf_implicit_coefs_terms_api( nzt_clubb, ncol, sclr_dim, & + pdf_implicit_coefs_terms_chnk(lchnk) ) + end if + end if ! Initialize err_info with parallelization and geographical info @@ -2874,7 +2880,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc state1, state1%q, state1%u, state1%v, state1%t, state1%pmid, state1%s, state1%pint, & !$acc state1%zm, state1%zi, state1%pdeldry, state1%pdel, state1%omega, state1%phis, & !$acc cam_in, cam_in%shf, cam_in%wsx, cam_in%wsy, cam_in%cflx, & - !$acc rrho, prer_evap, rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, wpthlp_mc_zt, rtpthlp_mc_zt ) & + !$acc rrho, prer_evap, rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, wpthlp_mc_zt, rtpthlp_mc_zt, & + !$acc err_info, err_info%err_header ) & !$acc copy( um, vm, upwp, vpwp, wpthvp, wp2thvp, rtpthvp, thlpthvp, up2, vp2, up3, vp3, & !$acc wp2, wp3, rtp2, thlp2, rtp3, thlp3, thlm, rtm, rvm, wprtp, wpthlp, rtpthlp, & !$acc pdf_zm_w_1, pdf_zm_w_2, pdf_zm_varnce_w_1, pdf_zm_varnce_w_2, pdf_zm_mixt_frac, & @@ -2905,6 +2912,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc radf, wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & !$acc thlprcp_out, deltaz, zi_g, zt_g, qrl_clubb, & + !$acc err_info%err_code, & !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & @@ -2963,6 +2971,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') + !$acc parallel loop gang vector collapse(2) default(present) + do i = 1, ncol + do n = 1, nparams + clubb_params(i,:) = clubb_params_single_col(1,:) + end do + end do + !$acc parallel loop gang vector collapse(2) default(present) do k = 1, pver do i = 1, pcols @@ -3271,14 +3286,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif - ! Define the CLUBB momentum grid (in height, units of m) - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzm_clubb - do i=1, ncol - zi_g(i,k) = state1%zi(i,pverp-k+1) - state1%zi(i,pver+1) - end do - end do - !$acc parallel loop gang vector collapse(2) default(present) do k=1, pver do i=1, ncol @@ -3307,8 +3314,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo + ! Define the CLUBB momentum grid (in height, units of m) + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, nzm_clubb + do i=1, ncol + zi_g(i,k) = state1%zi(i,pverp-k+1) - state1%zi(i,pver+1) + end do + end do + ! Compute thermodynamic stuff needed for CLUBB on thermo levels. ! Inputs for the momentum levels are set below setup_clubb core + ! Flipped grid calcs !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, ncol @@ -3354,64 +3370,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do - !$acc parallel loop gang vector collapse(2) default(present) - do i = 1, ncol - do n = 1, nparams - clubb_params(i,:) = clubb_params_single_col(1,:) - end do - end do - - ! ------------------------------------------------- ! - ! Begin case specific code for SCAM cases. ! - ! This section of code block is NOT called in ! - ! global simulations ! - ! ------------------------------------------------- ! - if (single_column .and. .not. scm_cambfb_mode) then - - ! Initialize zo if variable ustar is used - if (cam_in%landfrac(1) >= 0.5_r8) then - zo(1) = 0.035_r8 - else - zo(1) = 0.0001_r8 - endif - - ! Compute surface wind (ubar) - ubar = sqrt(um(1,pver)**2+vm(1,pver)**2) - if (ubar < 0.25_r8) ubar = 0.25_r8 - - ! Below denotes case specifics for surface momentum - ! and thermodynamic fluxes, depending on the case - - ! Define ustar (based on case, if not variable) - ustar = 0.25_r8 ! Initialize ustar in case no case - - if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then - ustar = 0.28_r8 - endif - - if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then - ustar = 0.30_r8 - endif - - if(trim(scm_clubb_iop_name) == 'RICO_3day') then - ustar = 0.28_r8 - endif - - if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & - trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & - trim(scm_clubb_iop_name) == 'ARM_CC') then - - bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) - ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) - endif - - ! Compute the surface momentum fluxes, if this is a SCAM simulation - upwp_sfc(1) = -um(1,pver)*ustar**2/ubar - vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar - - end if - - ! Heights need to be set at each timestep. Therefore, recall ! setup_grid and check_parameters_api for this. @@ -3493,6 +3451,57 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux end do + + ! ------------------------------------------------- ! + ! Begin case specific code for SCAM cases. ! + ! This section of code block is NOT called in ! + ! global simulations ! + ! ------------------------------------------------- ! + if (single_column .and. .not. scm_cambfb_mode) then + + ! Initialize zo if variable ustar is used + if (cam_in%landfrac(1) >= 0.5_r8) then + zo(1) = 0.035_r8 + else + zo(1) = 0.0001_r8 + endif + + ! Compute surface wind (ubar) + ubar = sqrt(um(1,pver)**2+vm(1,pver)**2) + if (ubar < 0.25_r8) ubar = 0.25_r8 + + ! Below denotes case specifics for surface momentum + ! and thermodynamic fluxes, depending on the case + + ! Define ustar (based on case, if not variable) + ustar = 0.25_r8 ! Initialize ustar in case no case + + if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then + ustar = 0.28_r8 + endif + + if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then + ustar = 0.30_r8 + endif + + if(trim(scm_clubb_iop_name) == 'RICO_3day') then + ustar = 0.28_r8 + endif + + if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & + trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & + trim(scm_clubb_iop_name) == 'ARM_CC') then + + bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) + ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) + endif + + ! Compute the surface momentum fluxes, if this is a SCAM simulation + upwp_sfc(1) = -um(1,pver)*ustar**2/ubar + vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar + + end if + ! Implementation after Thomas Toniazzo (NorESM) and Colin Zarzycki (PSU) ! Other Surface fluxes provided by host model if( (cld_macmic_num_steps > 1) .and. clubb_l_intr_sfc_flux_smooth ) then From 703aca60ed1e0b6b24f2cd890c3a4497041d25b8 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Sat, 15 Nov 2025 00:25:40 -0600 Subject: [PATCH 05/29] Making work with clubb_release d5957b30 (current as of 11-15-25) --- bld/build-namelist | 1 + bld/namelist_files/namelist_defaults_cam.xml | 1 + bld/namelist_files/namelist_definition.xml | 6 ++++++ src/physics/cam/clubb_intr.F90 | 20 ++++++++++++++------ 4 files changed, 22 insertions(+), 6 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index b7177e87c7..b3e566f2c9 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3595,6 +3595,7 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_do_liqsupersat'); add_default($nl, 'clubb_grid_adapt_in_time_method'); + add_default($nl, 'clubb_fill_holes_type'); add_default($nl, 'clubb_grid_remap_method'); add_default($nl, 'clubb_ipdf_call_placement'); add_default($nl, 'clubb_lambda0_stability_coef'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 92ae7832bc..696147d27e 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2181,6 +2181,7 @@ 0.32 0.3 0 + 2 1 2 0.04 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 8a98adbc24..a108088cbc 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3946,6 +3946,12 @@ Specifier for method to construct a grid density function to adapt grid to. Valid values: 0 (no grid adaptation), 1 (use Lscale and wp2) + +Selects which algorithm the fill_holes routine uses to correct +below threshold values in field solutions. + + Specifier for method to remap values from one grid to another. diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 765785cfdd..ef07096a8b 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -233,9 +233,11 @@ module clubb_intr clubb_grid_remap_method = unset_i, & ! Specifier for which method should be used to ! map values from one grid to another ! (starts at 1, so 0 is an invalid option for this flag) - clubb_grid_adapt_in_time_method = unset_i ! Specifier for how the grid density method should + clubb_grid_adapt_in_time_method = unset_i, & ! Specifier for how the grid density method should ! be constructed if the grid should be adapted over time ! (set to 0 for no adaptation) + clubb_fill_holes_type = unset_i ! Option for which type of hole filler to use in the + ! fill_holes_vertical procedure logical :: & @@ -837,6 +839,7 @@ subroutine clubb_readnl(nlfile) clubb_gamma_coef, & clubb_gamma_coefb, & clubb_grid_adapt_in_time_method, & + clubb_fill_holes_type, & clubb_grid_remap_method, & clubb_iiPDF_type, & clubb_ipdf_call_placement, & @@ -926,6 +929,7 @@ subroutine clubb_readnl(nlfile) clubb_saturation_equation, & ! Out clubb_grid_remap_method, & ! Out clubb_grid_adapt_in_time_method, & ! Out + clubb_fill_holes_type, & ! Out clubb_l_use_precip_frac, & ! Out clubb_l_predict_upwp_vpwp, & ! Out clubb_l_min_wp2_from_corr_wx, & ! Out @@ -1247,6 +1251,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_grid_remap_method") call mpi_bcast(clubb_grid_adapt_in_time_method, 1, mpi_integer, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_grid_adapt_in_time_method") + call mpi_bcast(clubb_fill_holes_type, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_fill_holes_type") call mpi_bcast(clubb_l_intr_sfc_flux_smooth, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_intr_sfc_flux_smooth") call mpi_bcast(clubb_l_vary_convect_depth, 1, mpi_logical, mstrid, mpicom, ierr) @@ -1355,6 +1361,7 @@ subroutine clubb_readnl(nlfile) if(clubb_saturation_equation == unset_i) call endrun(sub//": FATAL: clubb_saturation_equation not set") if(clubb_grid_remap_method == unset_i) call endrun(sub//": FATAL: clubb_grid_remap_method not set") if(clubb_grid_adapt_in_time_method == unset_i) call endrun(sub//": FATAL: clubb_grid_adapt_in_time_method not set") + if(clubb_fill_holes_type == unset_i) call endrun(sub//": FATAL: clubb_fill_holes_type not set") if(clubb_detphase_lowtemp >= meltpt_temp) & call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") @@ -1365,6 +1372,7 @@ subroutine clubb_readnl(nlfile) clubb_saturation_equation, & ! In clubb_grid_remap_method, & ! In clubb_grid_adapt_in_time_method, & ! In + clubb_fill_holes_type, & ! In clubb_l_use_precip_frac, & ! In clubb_l_predict_upwp_vpwp, & ! In clubb_l_min_wp2_from_corr_wx, & ! In @@ -2885,7 +2893,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc copy( um, vm, upwp, vpwp, wpthvp, wp2thvp, rtpthvp, thlpthvp, up2, vp2, up3, vp3, & !$acc wp2, wp3, rtp2, thlp2, rtp3, thlp3, thlm, rtm, rvm, wprtp, wpthlp, rtpthlp, & !$acc pdf_zm_w_1, pdf_zm_w_2, pdf_zm_varnce_w_1, pdf_zm_varnce_w_2, pdf_zm_mixt_frac, & - !$acc cloud_frac, wp2rtp, wp2thlp, uprcp, vprcp, rc_coef, wp4, wpup2, wpvp2, & + !$acc cloud_frac, wp2rtp, wp2thlp, uprcp, vprcp, rc_coef_zm, wp4, wpup2, wpvp2, & !$acc ttend_clubb_mc, upwp_clubb_gw_mc, vpwp_clubb_gw_mc, thlp2_clubb_gw_mc, wpthlp_clubb_gw_mc, & !$acc ttend_clubb, upwp_clubb_gw, vpwp_clubb_gw, thlp2_clubb_gw, wpthlp_clubb_gw, & !$acc wp2up2, wp2vp2, ice_supersat_frac, & @@ -2911,7 +2919,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, & !$acc radf, wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & - !$acc thlprcp_out, deltaz, zi_g, zt_g, qrl_clubb, & + !$acc thlprcp_out, deltaz, zi_g, zt_g, qrl_clubb, p_sfc, & !$acc err_info%err_code, & !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & @@ -2972,9 +2980,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:ACCR') !$acc parallel loop gang vector collapse(2) default(present) - do i = 1, ncol - do n = 1, nparams - clubb_params(i,:) = clubb_params_single_col(1,:) + do n = 1, nparams + do i = 1, ncol + clubb_params(i,n) = clubb_params_single_col(1,n) end do end do From 4d9b1b8a528ca532d964c1799e1860e96e068a12 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Mon, 17 Nov 2025 14:57:44 -0600 Subject: [PATCH 06/29] Definine PDFP_RTP2_CLUBB with the correct size. --- src/physics/cam/clubb_intr.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index ef07096a8b..eedb7ea2b6 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1774,7 +1774,7 @@ subroutine clubb_ini_cam(pbuf2d) call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux', sampled_on_subcycle=.true.) call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance', sampled_on_subcycle=.true.) call addfld ('RTP2_ZT_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','Moisture Variance on zt grid', sampled_on_subcycle=.true.) - call addfld ('PDFP_RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2','PDF Rtot Variance', sampled_on_subcycle=.true.) + call addfld ('PDFP_RTP2_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','PDF Rtot Variance', sampled_on_subcycle=.true.) call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance', sampled_on_subcycle=.true.) call addfld ('THLP2_ZT_CLUBB', (/ 'lev' /), 'A', 'K^2', 'Temperature Variance on zt grid', sampled_on_subcycle=.true.) call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance', sampled_on_subcycle=.true.) From e60848b4ec4df90a3060ffd7f664fab42e847509 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Mon, 17 Nov 2025 17:57:08 -0600 Subject: [PATCH 07/29] First step to making grid resversible in clubb_intr. This is BFB when clubb_grid_dir = 1, no BFB (as expected) with -1 --- src/physics/cam/clubb_intr.F90 | 397 ++++++++++++++----------- src/physics/cam/subcol_SILHS.F90 | 484 +++++++++++++------------------ 2 files changed, 435 insertions(+), 446 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index eedb7ea2b6..ac894c2ce2 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -60,9 +60,19 @@ module clubb_intr type (sclr_idx_type) :: & sclr_idx + integer, parameter :: & + clubb_grid_dir = 1 + integer :: & - nzm_clubb, & !Number of vertical levels used by CLUBB momentum variables - nzt_clubb !Number of vertical levels used by CLUBB thermodynamic variables + nzm_clubb, & ! Number of vertical levels used by CLUBB momentum variables + nzt_clubb, & ! Number of vertical levels used by CLUBB thermodynamic variables + k1_clubb_in_cam_zm, & + k1_clubb_in_cam_zt, & + k_sfc_zm, & + k_sfc_zt, & + k_top_zm, & + k_top_zt + #endif private @@ -80,6 +90,15 @@ module clubb_intr stats_zt, stats_zm, stats_sfc, & stats_rad_zt, stats_rad_zm, & stats_end_timestep_clubb, & + clubb_grid_dir, & + nzm_clubb, & + nzt_clubb, & + k1_clubb_in_cam_zm, & + k1_clubb_in_cam_zt, & + k_sfc_zm, & + k_sfc_zt, & + k_top_zm, & + k_top_zt, & #endif clubb_readnl, & clubb_init_cnst, & @@ -512,7 +531,7 @@ module clubb_intr type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] - logical, parameter, public :: l_ascending_grid = .true. ! For now + logical, public :: l_ascending_grid = .true. ! For now #endif contains @@ -1560,6 +1579,30 @@ subroutine clubb_ini_cam(pbuf2d) nzt_clubb = pver + 1 - top_lev nzm_clubb = pverp + 1 - top_lev + if ( clubb_grid_dir == 1 ) then + ! if we are in ascending grid mode, then we start filling the clubb arrays with the + ! surface values (pverp for zm or pverp for zt) because they need to be flipped + k1_clubb_in_cam_zm = pverp + k1_clubb_in_cam_zt = pver + k_sfc_zm = 1 + k_sfc_zt = 1 + k_top_zm = nzm_clubb + k_top_zt = nzt_clubb + l_ascending_grid = .true. + else if ( clubb_grid_dir == -1 ) then + ! if we are in descending grid mode, then we start filling the clubb arrays with the + ! top level values (top_lev), because this is the maximum level clubb considers + k1_clubb_in_cam_zm = top_lev + k1_clubb_in_cam_zt = top_lev + k_sfc_zm = nzm_clubb + k_sfc_zt = nzt_clubb + k_top_zm = 1 + k_top_zt = 1 + l_ascending_grid = .false. + else + call endrun('clubb_ini_cam: clubb_grid_dir can only be +1 or -1') + end if + ! Allocate PDF parameters across columns and chunks allocate( & pdf_params_chnk(begchunk:endchunk), & @@ -2627,6 +2670,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & character(len=512) :: errmsg integer :: errflg + integer :: & + k_cam + #endif call t_startf('clubb_tend_cam') @@ -3217,7 +3263,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), & state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), & latsub, hdtime, stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & - qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1)) + qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver), ncol * nzt_clubb ) call t_stopf('clubb_tend_cam:ice_macro_tend') ! update local copy of state with the tendencies @@ -3322,11 +3368,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo + ! Define the CLUBB momentum grid (in height, units of m) !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzm_clubb do i=1, ncol - zi_g(i,k) = state1%zi(i,pverp-k+1) - state1%zi(i,pver+1) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + zi_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,pverp) end do end do @@ -3337,40 +3385,42 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + ! Define the CLUBB thermodynamic grid (in units of m) - zt_g(i,k) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) + zt_g(i,k) = state1%zm(i,k_cam)-state1%zi(i,pverp) ! base state (dry) variables - rho_ds_zt(i,k) = rga*(state1%pdeldry(i,pver-k+1)/dz_g(i,pver-k+1)) + rho_ds_zt(i,k) = rga*(state1%pdeldry(i,k_cam)/dz_g(i,k_cam)) invrs_rho_ds_zt(i,k) = 1._r8/(rho_ds_zt(i,k)) ! full state (moist) variables - p_in_Pa(i,k) = state1%pmid(i,pver-k+1) - exner(i,k) = 1._r8/inv_exner_clubb(i,pver-k+1) - thv(i,k) = state1%t(i,pver-k+1)*inv_exner_clubb(i,pver-k+1)*(1._r8+zvir*state1%q(i,pver-k+1,ixq) & - -state1%q(i,pver-k+1,ixcldliq)) - rho_zt(i,k) = rga*state1%pdel(i,pver-k+1)/dz_g(i,pver-k+1) + p_in_Pa(i,k) = state1%pmid(i,k_cam) + exner(i,k) = 1._r8/inv_exner_clubb(i,k_cam) + thv(i,k) = state1%t(i,k_cam)*inv_exner_clubb(i,k_cam)*(1._r8+zvir*state1%q(i,k_cam,ixq) & + -state1%q(i,k_cam,ixcldliq)) + rho_zt(i,k) = rga*state1%pdel(i,k_cam)/dz_g(i,k_cam) ! exception - setting this to moist thv thv_ds_zt(i,k) = thv(i,k) - rfrzm(i,k) = state1%q(i,pver-k+1,ixcldice) - radf(i,k) = radf_clubb(i,pver-k+1) - qrl_clubb(i,k) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdeldry(i,pver-k+1)) + rfrzm(i,k) = state1%q(i,k_cam,ixcldice) + radf(i,k) = radf_clubb(i,k_cam) + qrl_clubb(i,k) = qrl(i,k_cam)/(cpairv(i,k,lchnk)*state1%pdeldry(i,k_cam)) ! Compute mean w wind on thermo grid, convert from omega to w - wm_zt(i,k) = -1._r8*(state1%omega(i,pver-k+1)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) + wm_zt(i,k) = -1._r8*(state1%omega(i,k_cam)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) end do end do !$acc parallel loop gang vector default(present) do i = 1, ncol - deltaz(i) = zi_g(i,2) - zi_g(i,1) + deltaz(i) = state1%zi(i,pverp-1) - state1%zi(i,pverp) ! For consistency, set surface pressure to p_in_Pa at the first thermo. ! level above the surface (according to the CLUBB ascending grid). - p_sfc(i) = p_in_Pa(i,1) + p_sfc(i) = state1%pmid(i,pver) ! Set the elevation of the surface sfc_elevation(i) = state1%zi(i,pverp) @@ -3392,7 +3442,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) l_ascending_grid, grid_type, & ! intent(in) - deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) + deltaz, zi_g(:,k_sfc_zm), zi_g(:,k_top_zm), & ! intent(in) zi_g, zt_g, & ! intent(in) gr, err_info ) ! intent(inout) @@ -3454,9 +3504,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Surface fluxes provided by host model !$acc parallel loop gang vector default(present) do i=1,ncol - wpthlp_sfc(i) = cam_in%shf(i)/(cpairv(i,pver,lchnk)*rho_ds_zm(i,1)) ! Sensible heat flux - wpthlp_sfc(i) = wpthlp_sfc(i)*inv_exner_clubb(i,pver) ! Potential temperature flux - wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux + wpthlp_sfc(i) = cam_in%shf(i) / ( cpairv(i,pver,lchnk) * rho_ds_zm(i,k_sfc_zm) ) ! Sensible heat flux + wpthlp_sfc(i) = wpthlp_sfc(i) * inv_exner_clubb(i,pver) ! Potential temperature flux + wprtp_sfc(i) = cam_in%cflx(i,1) / rho_ds_zm(i,k_sfc_zm) ! Moisture flux end do @@ -3538,8 +3588,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i=1,ncol - upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,1) ! Surface meridional momentum flux - vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,1) ! Surface zonal momentum flux + upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,k_sfc_zm) ! Surface meridional momentum flux + vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,k_sfc_zm) ! Surface zonal momentum flux end do endif @@ -3550,24 +3600,26 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, ncol - um_in(i,k) = um(i,pver-k+1) - vm_in(i,k) = vm(i,pver-k+1) - wp2thvp_in(i,k) = wp2thvp(i,pver-k+1) - up3_in(i,k) = up3(i,pver-k+1) - vp3_in(i,k) = vp3(i,pver-k+1) - wp3_in(i,k) = wp3(i,pver-k+1) - rtp3_in(i,k) = rtp3(i,pver-k+1) - thlp3_in(i,k) = thlp3(i,pver-k+1) - thlm_in(i,k) = thlm(i,pver-k+1) - rtm_in(i,k) = rtm(i,pver-k+1) - rvm_in(i,k) = rvm(i,pver-k+1) - cloud_frac_inout(i,k) = cloud_frac(i,pver-k+1) - rcm_inout(i,k) = state1%q(i,pver-k+1,ixcldliq) - wp2rtp_inout(i,k) = wp2rtp(i,pver-k+1) - wp2thlp_inout(i,k) = wp2thlp(i,pver-k+1) - wpup2_inout(i,k) = wpup2(i,pver-k+1) - wpvp2_inout(i,k) = wpvp2(i,pver-k+1) - ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,pver-k+1) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + um_in(i,k) = um(i,k_cam) + vm_in(i,k) = vm(i,k_cam) + wp2thvp_in(i,k) = wp2thvp(i,k_cam) + up3_in(i,k) = up3(i,k_cam) + vp3_in(i,k) = vp3(i,k_cam) + wp3_in(i,k) = wp3(i,k_cam) + rtp3_in(i,k) = rtp3(i,k_cam) + thlp3_in(i,k) = thlp3(i,k_cam) + thlm_in(i,k) = thlm(i,k_cam) + rtm_in(i,k) = rtm(i,k_cam) + rvm_in(i,k) = rvm(i,k_cam) + cloud_frac_inout(i,k) = cloud_frac(i,k_cam) + rcm_inout(i,k) = state1%q(i,k_cam,ixcldliq) + wp2rtp_inout(i,k) = wp2rtp(i,k_cam) + wp2thlp_inout(i,k) = wp2thlp(i,k_cam) + wpup2_inout(i,k) = wpup2(i,k_cam) + wpvp2_inout(i,k) = wpvp2(i,k_cam) + ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,k_cam) + pre_in(i,k) = prer_evap(i,k_cam) end do end do @@ -3575,25 +3627,26 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - upwp_in(i,k) = upwp(i,pverp-k+1) - vpwp_in(i,k) = vpwp(i,pverp-k+1) - wpthvp_in(i,k) = wpthvp(i,pverp-k+1) - rtpthvp_in(i,k) = rtpthvp(i,pverp-k+1) - thlpthvp_in(i,k)= thlpthvp(i,pverp-k+1) - up2_in(i,k) = up2(i,pverp-k+1) - vp2_in(i,k) = vp2(i,pverp-k+1) - wp2_in(i,k) = wp2(i,pverp-k+1) - rtp2_in(i,k) = rtp2(i,pverp-k+1) - thlp2_in(i,k) = thlp2(i,pverp-k+1) - wprtp_in(i,k) = wprtp(i,pverp-k+1) - wpthlp_in(i,k) = wpthlp(i,pverp-k+1) - rtpthlp_in(i,k) = rtpthlp(i,pverp-k+1) - uprcp_inout(i,k) = uprcp(i,pverp-k+1) - vprcp_inout(i,k) = vprcp(i,pverp-k+1) - rc_coef_zm_inout(i,k) = rc_coef_zm(i,pverp-k+1) - wp4_inout(i,k) = wp4(i,pverp-k+1) - wp2up2_inout(i,k) = wp2up2(i,pverp-k+1) - wp2vp2_inout(i,k) = wp2vp2(i,pverp-k+1) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + upwp_in(i,k) = upwp(i,k_cam) + vpwp_in(i,k) = vpwp(i,k_cam) + wpthvp_in(i,k) = wpthvp(i,k_cam) + rtpthvp_in(i,k) = rtpthvp(i,k_cam) + thlpthvp_in(i,k)= thlpthvp(i,k_cam) + up2_in(i,k) = up2(i,k_cam) + vp2_in(i,k) = vp2(i,k_cam) + wp2_in(i,k) = wp2(i,k_cam) + rtp2_in(i,k) = rtp2(i,k_cam) + thlp2_in(i,k) = thlp2(i,k_cam) + wprtp_in(i,k) = wprtp(i,k_cam) + wpthlp_in(i,k) = wpthlp(i,k_cam) + rtpthlp_in(i,k) = rtpthlp(i,k_cam) + uprcp_inout(i,k) = uprcp(i,k_cam) + vprcp_inout(i,k) = vprcp(i,k_cam) + rc_coef_zm_inout(i,k) = rc_coef_zm(i,k_cam) + wp4_inout(i,k) = wp4(i,k_cam) + wp2up2_inout(i,k) = wp2up2(i,k_cam) + wp2vp2_inout(i,k) = wp2vp2(i,k_cam) end do end do @@ -3604,30 +3657,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,pverp-k+1) - pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,pverp-k+1) - pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,pverp-k+1) - pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2(i,pverp-k+1) - pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,pverp-k+1) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,k_cam) + pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,k_cam) + pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,k_cam) + pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2(i,k_cam) + pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,k_cam) end do end do end if - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzt_clubb - do i=1,ncol - pre_in(i,k) = prer_evap(i,pver-k+1) - end do - end do - ! pressure,exner on momentum grid needed for mass flux calc. if (do_clubb_mf) then do k=1,nzt_clubb do i=1,ncol - kappa_zt(i,k) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) - qc_zt(i,k) = state1%q(i,pver-k+1,ixcldliq) - invrs_exner_zt(i,k) = inv_exner_clubb(i,pver-k+1) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + kappa_zt(i,k) = (rairv(i,k_cam,lchnk)/cpairv(i,k_cam,lchnk)) + qc_zt(i,k) = state1%q(i,k_cam,ixcldliq) + invrs_exner_zt(i,k) = inv_exner_clubb(i,k_cam) end do end do @@ -3635,7 +3683,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,pverp do i=1,ncol - p_in_Pa_zm(i,k) = state1%pint(i,pverp-k+1) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + p_in_Pa_zm(i,k) = state1%pint(i,k_cam) invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) end do end do @@ -3677,7 +3726,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1,nzt_clubb do i=1,ncol - edsclr_in(i,k,icnt) = state1%q(i,pver-k+1,ixind) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + edsclr_in(i,k,icnt) = state1%q(i,k_cam,ixind) end do end do @@ -3689,8 +3739,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1,nzt_clubb do i=1, ncol - edsclr_in(i,k,icnt+1) = thlm(i,pver-k+1) - edsclr_in(i,k,icnt+2) = rtm(i,pver-k+1) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + edsclr_in(i,k,icnt+1) = thlm(i,k_cam) + edsclr_in(i,k,icnt+2) = rtm(i,k_cam) end do end do @@ -3916,65 +3967,67 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzt_clubb do i=1, ncol - um(i,pver-k+1) = um_in(i,k) - vm(i,pver-k+1) = vm_in(i,k) - wp2thvp(i,pver-k+1) = wp2thvp_in(i,k) - up3(i,pver-k+1) = up3_in(i,k) - vp3(i,pver-k+1) = vp3_in(i,k) - thlm(i,pver-k+1) = thlm_in(i,k) - rtm(i,pver-k+1) = rtm_in(i,k) - wp3(i,pver-k+1) = wp3_in(i,k) - rtp3(i,pver-k+1) = rtp3_in(i,k) - thlp3(i,pver-k+1) = thlp3_in(i,k) - rcm(i,pver-k+1) = rcm_inout(i,k) - cloud_frac(i,pver-k+1) = min(cloud_frac_inout(i,k),1._r8) - rcm_in_layer(i,pver-k+1) = rcm_in_layer_out(i,k) - cloud_cover(i,pver-k+1) = min(cloud_cover_out(i,k),1._r8) - zt_out(i,pver-k+1) = zt_g(i,k) - wm_zt_out(i,pver-k+1) = wm_zt(i,k) - wp2rtp(i,pver-k+1) = wp2rtp_inout(i,k) - wp2thlp(i,pver-k+1) = wp2thlp_inout(i,k) - wpup2(i,pver-k+1) = wpup2_inout(i,k) - wpvp2(i,pver-k+1) = wpvp2_inout(i,k) - ice_supersat_frac(i,pver-k+1) = ice_supersat_frac_inout(i,k) - qclvar(i,pver-k+1) = min(1._r8,qclvar_out(i,k)) - - rtp2_zt_out(i,pver-k+1) = rtp2_zt(i,k) - thl2_zt_out(i,pver-k+1) = thl2_zt(i,k) - wp2_zt_out(i,pver-k+1) = wp2_zt(i,k) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + um(i,k_cam) = um_in(i,k) + vm(i,k_cam) = vm_in(i,k) + wp2thvp(i,k_cam) = wp2thvp_in(i,k) + up3(i,k_cam) = up3_in(i,k) + vp3(i,k_cam) = vp3_in(i,k) + thlm(i,k_cam) = thlm_in(i,k) + rtm(i,k_cam) = rtm_in(i,k) + wp3(i,k_cam) = wp3_in(i,k) + rtp3(i,k_cam) = rtp3_in(i,k) + thlp3(i,k_cam) = thlp3_in(i,k) + rcm(i,k_cam) = rcm_inout(i,k) + cloud_frac(i,k_cam) = min(cloud_frac_inout(i,k),1._r8) + rcm_in_layer(i,k_cam) = rcm_in_layer_out(i,k) + cloud_cover(i,k_cam) = min(cloud_cover_out(i,k),1._r8) + zt_out(i,k_cam) = zt_g(i,k) + wm_zt_out(i,k_cam) = wm_zt(i,k) + wp2rtp(i,k_cam) = wp2rtp_inout(i,k) + wp2thlp(i,k_cam) = wp2thlp_inout(i,k) + wpup2(i,k_cam) = wpup2_inout(i,k) + wpvp2(i,k_cam) = wpvp2_inout(i,k) + ice_supersat_frac(i,k_cam) = ice_supersat_frac_inout(i,k) + qclvar(i,k_cam) = min(1._r8,qclvar_out(i,k)) + + rtp2_zt_out(i,k_cam) = rtp2_zt(i,k) + thl2_zt_out(i,k_cam) = thl2_zt(i,k) + wp2_zt_out(i,k_cam) = wp2_zt(i,k) end do end do !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzm_clubb do i=1, ncol - upwp(i,pverp-k+1) = upwp_in(i,k) - vpwp(i,pverp-k+1) = vpwp_in(i,k) - wpthvp(i,pverp-k+1) = wpthvp_in(i,k) - rtpthvp(i,pverp-k+1) = rtpthvp_in(i,k) - thlpthvp(i,pverp-k+1) = thlpthvp_in(i,k) - up2(i,pverp-k+1) = up2_in(i,k) - vp2(i,pverp-k+1) = vp2_in(i,k) - wprtp(i,pverp-k+1) = wprtp_in(i,k) - wpthlp(i,pverp-k+1) = wpthlp_in(i,k) - wp2(i,pverp-k+1) = wp2_in(i,k) - rtp2(i,pverp-k+1) = rtp2_in(i,k) - thlp2(i,pverp-k+1) = thlp2_in(i,k) - rtpthlp(i,pverp-k+1) = rtpthlp_in(i,k) - wprcp(i,pverp-k+1) = wprcp_out(i,k) - pdf_zm_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_1(i,k) - pdf_zm_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_2(i,k) - pdf_zm_varnce_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) - pdf_zm_varnce_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) - pdf_zm_mixt_frac(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) - zi_out(i,pverp-k+1) = zi_g(i,k) - khzm(i,pverp-k+1) = khzm_out(i,k) - uprcp(i,pverp-k+1) = uprcp_inout(i,k) - vprcp(i,pverp-k+1) = vprcp_inout(i,k) - rc_coef_zm(i,pverp-k+1) = rc_coef_zm_inout(i,k) - wp4(i,pverp-k+1) = wp4_inout(i,k) - wp2up2(i,pverp-k+1) = wp2up2_inout(i,k) - wp2vp2(i,pverp-k+1) = wp2vp2_inout(i,k) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + upwp(i,k_cam) = upwp_in(i,k) + vpwp(i,k_cam) = vpwp_in(i,k) + wpthvp(i,k_cam) = wpthvp_in(i,k) + rtpthvp(i,k_cam) = rtpthvp_in(i,k) + thlpthvp(i,k_cam) = thlpthvp_in(i,k) + up2(i,k_cam) = up2_in(i,k) + vp2(i,k_cam) = vp2_in(i,k) + wprtp(i,k_cam) = wprtp_in(i,k) + wpthlp(i,k_cam) = wpthlp_in(i,k) + wp2(i,k_cam) = wp2_in(i,k) + rtp2(i,k_cam) = rtp2_in(i,k) + thlp2(i,k_cam) = thlp2_in(i,k) + rtpthlp(i,k_cam) = rtpthlp_in(i,k) + wprcp(i,k_cam) = wprcp_out(i,k) + pdf_zm_w_1(i,k_cam) = pdf_params_zm_chnk(lchnk)%w_1(i,k) + pdf_zm_w_2(i,k_cam) = pdf_params_zm_chnk(lchnk)%w_2(i,k) + pdf_zm_varnce_w_1(i,k_cam) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) + pdf_zm_varnce_w_2(i,k_cam) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) + pdf_zm_mixt_frac(i,k_cam) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) + zi_out(i,k_cam) = zi_g(i,k) + khzm(i,k_cam) = khzm_out(i,k) + uprcp(i,k_cam) = uprcp_inout(i,k) + vprcp(i,k_cam) = vprcp_inout(i,k) + rc_coef_zm(i,k_cam) = rc_coef_zm_inout(i,k) + wp4(i,k_cam) = wp4_inout(i,k) + wp2up2(i,k_cam) = wp2up2_inout(i,k) + wp2vp2(i,k_cam) = wp2vp2_inout(i,k) end do end do @@ -3984,7 +4037,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do ixind=1,edsclr_dim do k=1, nzt_clubb do i=1, ncol - edsclr_out(i,pver-k+1,ixind) = edsclr_in(i,k,ixind) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + edsclr_out(i,k_cam,ixind) = edsclr_in(i,k,ixind) end do end do end do @@ -3993,31 +4047,32 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then do k=1, nzm_clubb do i=1, ncol - mf_dry_a_output(i,pverp-k+1) = mf_dry_a(i,k) - mf_moist_a_output(i,pverp-k+1) = mf_moist_a(i,k) - mf_dry_w_output(i,pverp-k+1) = mf_dry_w(i,k) - mf_moist_w_output(i,pverp-k+1) = mf_moist_w(i,k) - mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(i,k) - mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(i,k) - mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(i,k) - mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(i,k) - mf_dry_u_output(i,pverp-k+1) = mf_dry_u(i,k) - mf_moist_u_output(i,pverp-k+1) = mf_moist_u(i,k) - mf_dry_v_output(i,pverp-k+1) = mf_dry_v(i,k) - mf_moist_v_output(i,pverp-k+1) = mf_moist_v(i,k) - mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(i,k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) - s_ae_output(i,pverp-k+1) = s_ae(i,k) - s_aw_output(i,pverp-k+1) = s_aw(i,k) - s_awthl_output(i,pverp-k+1) = s_awthl(i,k) - s_awqt_output(i,pverp-k+1) = s_awqt(i,k) - s_awql_output(i,pverp-k+1) = s_awql(i,k) - s_awqi_output(i,pverp-k+1) = s_awqi(i,k) - s_awu_output(i,pverp-k+1) = s_awu(i,k) - s_awv_output(i,pverp-k+1) = s_awv(i,k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + mf_dry_a_output(i,k_cam) = mf_dry_a(i,k) + mf_moist_a_output(i,k_cam) = mf_moist_a(i,k) + mf_dry_w_output(i,k_cam) = mf_dry_w(i,k) + mf_moist_w_output(i,k_cam) = mf_moist_w(i,k) + mf_dry_qt_output(i,k_cam) = mf_dry_qt(i,k) + mf_moist_qt_output(i,k_cam) = mf_moist_qt(i,k) + mf_dry_thl_output(i,k_cam) = mf_dry_thl(i,k) + mf_moist_thl_output(i,k_cam) = mf_moist_thl(i,k) + mf_dry_u_output(i,k_cam) = mf_dry_u(i,k) + mf_moist_u_output(i,k_cam) = mf_moist_u(i,k) + mf_dry_v_output(i,k_cam) = mf_dry_v(i,k) + mf_moist_v_output(i,k_cam) = mf_moist_v(i,k) + mf_moist_qc_output(i,k_cam) = mf_moist_qc(i,k) + mf_thlflx_output(i,k_cam) = mf_thlflx(i,k) + mf_qtflx_output(i,k_cam) = mf_qtflx(i,k) + s_ae_output(i,k_cam) = s_ae(i,k) + s_aw_output(i,k_cam) = s_aw(i,k) + s_awthl_output(i,k_cam) = s_awthl(i,k) + s_awqt_output(i,k_cam) = s_awqt(i,k) + s_awql_output(i,k_cam) = s_awql(i,k) + s_awqi_output(i,k_cam) = s_awqi(i,k) + s_awu_output(i,k_cam) = s_awu(i,k) + s_awv_output(i,k_cam) = s_awv(i,k) + mf_thlflx_output(i,k_cam) = mf_thlflx(i,k) + mf_qtflx_output(i,k_cam) = mf_qtflx(i,k) end do end do end if @@ -4031,7 +4086,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & * pdf_params_chnk(lchnk)%rt_2(i,k) - pdfp_rtp2(i,pver-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + + pdfp_rtp2(i,k_cam) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & @@ -4371,7 +4428,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,ixq), & state1%q(1:ncol,top_lev:pver,ixcldliq), state1%q(1:ncol,top_lev:pver,ixnumliq), & latvap, hdtime, stend(1:ncol,top_lev:pver),qvtend(1:ncol,top_lev:pver), & - qctend(1:ncol,top_lev:pver), inctend(1:ncol,top_lev:pver), ncol*(pver-top_lev+1)) + qctend(1:ncol,top_lev:pver), inctend(1:ncol,top_lev:pver), ncol * nzt_clubb ) ! update local copy of state with the tendencies ptend_loc%q(:ncol,top_lev:pver,ixq)=qvtend(:ncol,top_lev:pver) @@ -5546,7 +5603,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st ! Local Variables - integer :: i, k + integer :: i, k, k_cam logical :: l_error ! Check if it is time to write to file @@ -5572,29 +5629,33 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st ! in the vertical level to be the same as CAM output. do i = 1, stats_zt%num_output_fields do k = 1, stats_zt%kk - out_zt(thecol,pver-k+1,i) = stats_zt%accum_field_values(1,1,k,i) - if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + out_zt(thecol,k_cam,i) = stats_zt%accum_field_values(1,1,k,i) + if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 enddo enddo do i = 1, stats_zm%num_output_fields do k = 1, stats_zm%kk - out_zm(thecol,pverp-k+1,i) = stats_zm%accum_field_values(1,1,k,i) - if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + out_zm(thecol,k_cam,i) = stats_zm%accum_field_values(1,1,k,i) + if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 enddo enddo if (stats_metadata%l_output_rad_files) then do i = 1, stats_rad_zt%num_output_fields do k = 1, stats_rad_zt%kk - out_radzt(thecol,pver-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + out_radzt(thecol,k_cam,i) = stats_rad_zt%accum_field_values(1,1,k,i) if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8 enddo enddo do i = 1, stats_rad_zm%num_output_fields do k = 1, stats_rad_zm%kk - out_radzm(thecol,pverp-k+1,i) = stats_rad_zm%accum_field_values(1,1,k,i) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + out_radzm(thecol,k_cam,i) = stats_rad_zm%accum_field_values(1,1,k,i) if(is_nan(out_radzm(thecol,k,i))) out_radzm(thecol,k,i) = 0.0_r8 enddo enddo diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index d8eadc1049..77b90ed982 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -26,7 +26,17 @@ module subcol_SILHS hm_metadata, & hydromet_dim, & pdf_dim, & - l_ascending_grid + l_ascending_grid, & + clubb_grid_dir, & + nzm_clubb, & + nzt_clubb, & + k1_clubb_in_cam_zm, & + k1_clubb_in_cam_zt, & + k_sfc_zm, & + k_sfc_zt, & + k_top_zm, & + k_top_zt + use clubb_api_module, only: & hmp2_ip_on_hmm2_ip_slope_type, & @@ -656,8 +666,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) integer :: i, j, k, ngrdcol, ncol, lchnk, stncol real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: zt_g ! Thermo grid for clubb - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: zi_g ! Momentum grid for clubb + real(r8), dimension(state%ngrdcol,nzt_clubb) :: zt_g ! Thermo grid for clubb + real(r8), dimension(state%ngrdcol,nzm_clubb) :: zi_g ! Momentum grid for clubb real(r8), dimension(pver) :: scfrac ! cloud fraction based on sc distributions real(r8) :: msc, std, maxcldfrac, maxsccldfrac @@ -677,21 +687,21 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Required for set_up_pdf_params_incl_hydromet !---------------- - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: cld_frac_in ! Cloud fraction + real(r8), dimension(state%ngrdcol,nzt_clubb) :: cld_frac_in ! Cloud fraction - real(r8), dimension(state%ngrdcol, pver-top_lev+1, pdf_dim, pdf_dim) :: & + real(r8), dimension(state%ngrdcol, nzt_clubb, pdf_dim, pdf_dim) :: & corr_array_1, corr_array_2 ! Correlation matrix for pdf components - real(r8), dimension(state%ngrdcol, pver-top_lev+1, pdf_dim) :: & + real(r8), dimension(state%ngrdcol, nzt_clubb, pdf_dim) :: & mu_x_1, mu_x_2, & ! Mean array for PDF components sigma_x_1, sigma_x_2 ! Std dev arr for PDF components - real(r8), dimension(state%ngrdcol, pver-top_lev+1, pdf_dim, pdf_dim) :: & + real(r8), dimension(state%ngrdcol, nzt_clubb, pdf_dim, pdf_dim) :: & corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx - real(r8), dimension(state%ngrdcol, pver-top_lev+1) :: Nc_in_cloud - real(r8), dimension(state%ngrdcol, pver-top_lev+1) :: ice_supersat_frac_in - real(r8), dimension(state%ngrdcol, pverp-top_lev+1, hydromet_dim) :: hydrometp2 + real(r8), dimension(state%ngrdcol, nzt_clubb) :: Nc_in_cloud + real(r8), dimension(state%ngrdcol, nzt_clubb) :: ice_supersat_frac_in + real(r8), dimension(state%ngrdcol, nzm_clubb, hydromet_dim) :: hydrometp2 !---------------- @@ -703,18 +713,17 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), dimension(state%ngrdcol) :: deltaz - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs + real(r8), dimension(state%ngrdcol,nzt_clubb) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: delta_zm ! Difference in u wind altitudes - real(r8), dimension(state%ngrdcol,pver-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species - real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: Ncm ! Mean cloud droplet concentration, + real(r8), dimension(state%ngrdcol,nzt_clubb,hydromet_dim) :: hydromet ! Hydrometeor species + real(r8), dimension(state%ngrdcol,nzm_clubb,hydromet_dim) :: wphydrometp ! Hydrometeor flux + real(r8), dimension(state%ngrdcol,nzt_clubb) :: Ncm ! Mean cloud droplet concentration, - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: tke ! TKE - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: khzm ! Eddy diffusivity coef - real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: Lscale ! CLUBB's length scale + real(r8), dimension(state%ngrdcol,nzm_clubb) :: tke ! TKE + real(r8), dimension(state%ngrdcol,nzm_clubb) :: khzm ! Eddy diffusivity coef + real(r8), dimension(state%ngrdcol,nzm_clubb) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels + real(r8), dimension(state%ngrdcol,nzt_clubb) :: Lscale ! CLUBB's length scale logical, parameter :: & l_calc_weights_all_levs = .false. ! .false. if all time steps use the same @@ -727,11 +736,11 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !--------------- !Output from generate_silhs_sample !-------------- - real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pver-top_lev+1,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal - real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pver-top_lev+1) :: lh_sample_point_weights ! Subcolumn weights - integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,pver-top_lev+1) :: X_mixt_comp_all_levs ! Which Mixture Component + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,nzt_clubb,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,nzt_clubb) :: lh_sample_point_weights ! Subcolumn weights + integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,nzt_clubb) :: X_mixt_comp_all_levs ! Which Mixture Component - real(r8), dimension(state%ngrdcol,pver-top_lev+1, subcol_SILHS_numsubcol) :: & + real(r8), dimension(state%ngrdcol,nzt_clubb, subcol_SILHS_numsubcol) :: & rc_all_points, & ! Calculate RCM from LH output rain_all_pts, & ! Calculate Rain from LH output nrain_all_pts, & ! Calculate Rain Conc from LH @@ -748,7 +757,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Output from clip_transform_silhs_output_api !---------------- - real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pver-top_lev+1) :: & + real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,nzt_clubb) :: & lh_rt_clipped, & ! rt generated from silhs sample points lh_thl_clipped, & ! thl generated from silhs sample points lh_rc_clipped, & ! rc generated from silhs sample points @@ -802,13 +811,13 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Output from Est_Kessler_microphys !---------------- - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKm ! Exact Kessler autoconversion - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc - real(r8), dimension(state%ngrdcol,pver-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water + real(r8), dimension(state%ngrdcol,nzt_clubb) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKm ! Exact Kessler autoconversion + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKstd ! Exact Stdev of gba Kessler + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKm_rcm ! Exact local gba Kessler auto based on rcm + real(r8), dimension(state%ngrdcol,nzt_clubb) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc + real(r8), dimension(state%ngrdcol,nzt_clubb) :: lh_rcm_avg ! LH estimate of grid box avg liquid water real(r8), dimension(pcols,pver) :: lh_AKm_out, AKm_out !---------------- @@ -851,6 +860,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) iiPDF_ri, iiPDF_Ni, iiPDF_Ncn, iiPDF_rs, iiPDF_Ns, & iirr, iiNr, iirs, iiri, & iirg, iiNs, iiNi, iiNg + + integer :: k_cam !------------------------------------------------ ! Begin Code @@ -960,17 +971,19 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! column as the z-distance between hybrid pressure levels can ! change easily. ! Define the CLUBB momentum grid (in height, units of m) - do k = 1, pverp-top_lev+1 + do k = 1, nzm_clubb do i = 1, ngrdcol - zi_g(i,k) = state%zi(i,pverp-k+1)-state%zi(i,pverp) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + zi_g(i,k) = state%zi(i,k_cam)-state%zi(i,pverp) end do end do ! Define the CLUBB thermodynamic grid (in units of m) - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb do i = 1, ngrdcol - zt_g(i,k) = state%zm(i,pver-k+1)-state%zi(i,pverp) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + zt_g(i,k) = state%zm(i,k_cam)-state%zi(i,pverp) end do end do @@ -1001,159 +1014,108 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) do i = 1, ngrdcol dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) end do - end do - - ! Inverse delta_zm is required for the 3-level L-scale averaging - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - delta_zm(i,k) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) - end do - end do + end do ! Compute dry static density on CLUBB vertical grid - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb do i = 1, ngrdcol - rho_ds_zt(i,k) = (rga)*state%pdel(i,pverp-k)/dz_g(i,pverp-k) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + rho_ds_zt(i,k) = (rga)*state%pdel(i,k_cam)/dz_g(i,k_cam) end do end do - ! Set up hydromet array, flipped from CAM vert grid to CLUBB - if ( iirr > 0 ) then - ! If ixrain and family are greater than zero, then MG2 is - ! being used, and rain and snow are part of state. Otherwise, - ! diagnostic rain and snow from MG1 are used in hydromet. - if (ixrain > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iirr) = state%q(i,pver-k+1,ixrain) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iirr) = qrain(i,pver-k+1) - end do - end do - endif - endif - - if ( iiNr > 0 ) then - if (ixnumrain > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iiNr) = state%q(i,pver-k+1,ixnumrain) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iiNr) = nrain(i,pver-k+1) - end do - end do - endif - endif - - if ( iirs > 0 ) then - if (ixsnow > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iirs) = state%q(i,pver-k+1,ixsnow) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iirs) = qsnow(i,pver-k+1) - end do - end do - endif - endif - - if ( iiNs > 0 ) then - if (ixnumsnow > 0) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iiNs) = state%q(i,pver-k+1,ixnumsnow) - end do - end do - else - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iiNs) = nsnow(i,pver-k+1) - end do - end do - endif - endif - - if ( iiri > 0 ) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iiri) = state%q(i,pver-k+1,ixcldice) - end do - end do - endif - - if ( iiNi > 0 ) then - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - hydromet(i,k,iiNi) = state%q(i,pver-k+1,ixnumice) - end do - end do - endif - - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - Ncm(i,k) = state%q(i,pver-k+1,ixnumliq) + do k = 1, nzt_clubb + do i = 1, ngrdcol + + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + + ! Set up hydromet array, flipped from CAM vert grid to CLUBB + if ( iirr > 0 ) then + ! If ixrain and family are greater than zero, then MG2 is + ! being used, and rain and snow are part of state. Otherwise, + ! diagnostic rain and snow from MG1 are used in hydromet. + if (ixrain > 0) then + hydromet(i,k,iirr) = state%q(i,k_cam,ixrain) + else + hydromet(i,k,iirr) = qrain(i,k_cam) + endif + endif + + if ( iiNr > 0 ) then + if (ixnumrain > 0) then + hydromet(i,k,iiNr) = state%q(i,k_cam,ixnumrain) + else + hydromet(i,k,iiNr) = nrain(i,k_cam) + endif + endif + + if ( iirs > 0 ) then + if (ixsnow > 0) then + hydromet(i,k,iirs) = state%q(i,k_cam,ixsnow) + else + hydromet(i,k,iirs) = qsnow(i,k_cam) + endif + endif + + if ( iiNs > 0 ) then + if (ixnumsnow > 0) then + hydromet(i,k,iiNs) = state%q(i,k_cam,ixnumsnow) + else + hydromet(i,k,iiNs) = nsnow(i,k_cam) + endif + endif + + if ( iiri > 0 ) then + hydromet(i,k,iiri) = state%q(i,k_cam,ixcldice) + endif + + if ( iiNi > 0 ) then + hydromet(i,k,iiNi) = state%q(i,k_cam,ixnumice) + endif + end do - end do + end do + + do k = 1, nzt_clubb + do i = 1, ngrdcol + + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + + Ncm(i,k) = state%q(i,k_cam,ixnumliq) - ! Convert from CAM vertical grid to CLUBB - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - ice_supersat_frac_in(i,k) = ice_supersat_frac(i,pver-k+1) - end do - end do + ! Convert from CAM vertical grid to CLUBB + ice_supersat_frac_in(i,k) = ice_supersat_frac(i,k_cam) - - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - cld_frac_in(i,k) = alst(i,pver-k+1) - end do - end do + cld_frac_in(i,k) = alst(i,k_cam) - ! Calculate a clubb-specific exner function - ! (This is grid mean, as pressure levels do not change in - ! the subcolumn state) - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) - end do - end do + ! Calculate a clubb-specific exner function + ! (This is grid mean, as pressure levels do not change in + ! the subcolumn state) + invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) - ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS - ! Compute Num concentration of cloud nuclei - do k = 1, pver-top_lev+1 - do i = 1, ngrdcol - Nc_in_cloud(i,k) = Ncm(i,k) / max( cld_frac_in(i,k), cloud_frac_min ) - end do - end do + ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS + ! Compute Num concentration of cloud nuclei + Nc_in_cloud(i,k) = Ncm(i,k) / max( cld_frac_in(i,k), cloud_frac_min ) + end do + end do ! The variable wphydrometp is only used when l_calc_w_corr is enabled. ! The l_calc_w_corr flag is turned off by default, so wphydrometp will ! simply be set to 0 to simplify matters. wphydrometp = 0.0_r8 - do k = 1, pverp-top_lev+1 + do k = 1, nzm_clubb do i = 1, ngrdcol - khzm(i,k) = khzm_in(i,pverp-k+1) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + khzm(i,k) = khzm_in(i,k_cam) end do end do ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels - call init_precip_fracs_api( pver-top_lev+1, ngrdcol, & + call init_precip_fracs_api( nzt_clubb, ngrdcol, & precip_fracs ) - call setup_pdf_parameters_api( gr, pverp-top_lev+1, pver-top_lev+1, ngrdcol, pdf_dim, & ! In + call setup_pdf_parameters_api( gr, nzm_clubb, nzt_clubb, ngrdcol, pdf_dim, & ! In hydromet_dim, ztodt, Nc_in_cloud, cld_frac_in, khzm, & ! In ice_supersat_frac_in, hydromet, wphydrometp, & ! In corr_array_n_cloud, corr_array_n_below, & ! In @@ -1200,28 +1162,29 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! resulting calculation of Lscale is also found on momentum levels. It ! needs to be interpolated back to thermodynamic (midpoint) grid levels ! for further use. - do k = 1, pverp-top_lev+1 + do k = 1, nzm_clubb do i = 1, ngrdcol - tke(i,k) = tke_in(i,pverp-k+1) + k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + tke(i,k) = tke_in(i,k_cam) end do end do - do k = 1, pverp-top_lev+1 + do k = 1, nzm_clubb do i = 1, ngrdcol Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) end do end do - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb do i = 1, ngrdcol Lscale(i,k) = Lscale_zm(i,k) + ( Lscale_zm(i,k+1) - Lscale_zm(i,k) ) & * ( zt_g(i,k) - zi_g(i,k) ) / ( zi_g(i,k+1) - zi_g(i,k) ) end do end do - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb do i = 1, ngrdcol - Lscale(i,:) = max( Lscale(i,:), 0.01_r8 ) + Lscale(i,k) = max( Lscale(i,k), 0.01_r8 ) end do end do @@ -1234,7 +1197,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !$acc& OMEGA_lh_out ) & !$acc& copyin( state, state%zm, state%phis, rho_ds_zt, invs_exner ) & !$acc& copyout( state%t, state%s, state%omega, state_sc%q ) - !$acc& async(1) + !$acc& ! Set the seed to the random number generator based on a quantity that ! will be reproducible for restarts. @@ -1242,9 +1205,9 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Let's generate some subcolumns!!!!! call generate_silhs_sample_api( & - iter, pdf_dim, num_subcols, sequence_length, pver-top_lev+1, ngrdcol, & ! In + iter, pdf_dim, num_subcols, sequence_length, nzt_clubb, ngrdcol, & ! In l_calc_weights_all_levs_itime, & ! In - gr, pdf_params_chnk(lchnk), delta_zm, Lscale, & ! In + gr, pdf_params_chnk(lchnk), gr%dzt, Lscale, & ! In lh_seed, hm_metadata, & ! In mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In @@ -1261,7 +1224,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end if ! Extract clipped variables from subcolumns - call clip_transform_silhs_output_api( pver-top_lev+1, ngrdcol, num_subcols, & ! In + call clip_transform_silhs_output_api( nzt_clubb, ngrdcol, num_subcols, & ! In pdf_dim, hydromet_dim, hm_metadata, & ! In X_mixt_comp_all_levs, & ! In X_nl_all_levs, & ! In @@ -1270,7 +1233,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) lh_rt_clipped, lh_thl_clipped, & ! Out lh_rc_clipped, lh_rv_clipped, & ! Out lh_Nc_clipped ) ! Out - !$acc wait ! Cleaning up err_info call cleanup_err_info_api(err_info) @@ -1282,53 +1244,38 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !------------------------------------------------------------------------- ! Convert from CLUBB vertical grid to CAM grid !------------------------------------------------------------------------ - ! This kernel is executed in stream 1: - !$acc parallel loop collapse(3) default(present) async(1) - do k = top_lev, pver - do j = 1, num_subcols - do i = 1, ngrdcol - RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,pver-k+1) - RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,pver-k+1) - NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,pver-k+1) - RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,pver-k+1) - THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,pver-k+1) - end do - end do - end do - - ! This kernel is executed in stream 2: - !$acc parallel loop collapse(3) default(present) async(2) - do k = top_lev, pver - do j = 1, num_subcols - do i = 1, ngrdcol - ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_ri) - NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_Ni) - RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_rr) - NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_Nr) - SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_rs) - NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_Ns) - WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pver-k+1,iiPDF_w) - end do - end do - end do - - ! This kernel is executed in stream 2 because WM_lh_out comes from stream 2: - !$acc parallel loop collapse(3) default(present) async(2) + !$acc parallel loop collapse(3) default(present) do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,k_cam) + RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,k_cam) + NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,k_cam) + RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,k_cam) + THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,k_cam) + + ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_ri) + NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_Ni) + RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_rr) + NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_Nr) + SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_rs) + NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_Ns) + WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_w) + OMEGA_lh_out( num_subcols*(i-1)+j,k ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k) & - * rho_ds_zt(i,pver-k+1) * gravit - end do + * rho_ds_zt(i,k_cam) * gravit + end do end do end do - + if ( l_est_kessler_microphys ) then do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol - AKm_out(i,k) = AKm(i,pver-k+1) - lh_AKm_out(i,k) = lh_AKm(i,pver-k+1) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + AKm_out(i,k) = AKm(i,k_cam) + lh_AKm_out(i,k) = lh_AKm(i,k_cam) end do end do end do @@ -1428,10 +1375,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Updating state variables !--------------------------------------------------- ! Code to update the state variables for interactive runs - ! This kernel is executed in stream 3, but waits for stream 1 - ! because THL_lh_out and RCM_lh_out come from stream 1: - !$acc parallel loop collapse(3) default(present) wait(1) async(3) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol @@ -1444,10 +1389,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end do end do - ! This kernel is executed in stream 4, but waits for stream 1 and 2 - ! because RVM_lh_out is from stream 1 and OMEGA_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(4) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol ! Vertical Velocity is not part of the energy conservation checks, but @@ -1461,10 +1404,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp - ! This kernel is executed in stream 5, but waits for stream 1 and 2 - ! because RCM_lh_out is from stream 1 and ICE_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(5) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) @@ -1474,10 +1415,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end do if (ixrain > 0) then - ! This kernel is executed in stream 6, but waits for stream 2 - ! because RAIN_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(6) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) @@ -1487,10 +1426,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end if if (ixsnow > 0) then - ! This kernel is executed in stream 7, but waits for stream 2 - ! because SNOW_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(7) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) @@ -1501,7 +1438,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) else - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) @@ -1520,10 +1457,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp - ! This kernel is executed in stream 8, but waits for stream 1 and 2 - ! because NCLW_lh_out is from stream 1 and NICE_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(1,2) async(8) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) @@ -1533,10 +1468,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end do if (ixnumrain > 0) then - ! This kernel is executed in stream 9, but waits for stream 2 - ! because NRAIN_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(9) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) @@ -1546,10 +1479,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end if if (ixnumsnow > 0) then - ! This kernel is executed in stream 10, but waits for stream 2 - ! because NSNOW_lh_out is from stream 2: - !$acc parallel loop collapse(3) default(present) wait(2) async(10) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) @@ -1560,7 +1491,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) else - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) @@ -1577,10 +1508,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) endif - ! This kernel is executed in stream 8, because state_sc%q(:,:,ixnumliq) and - ! state_sc%q(:,:,ixnumice) are from stream 8 - !$acc parallel loop collapse(3) default(present) async(8) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) @@ -1596,10 +1525,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end do if (ixnumrain > 0) then - ! This kernel is executed in stream 9, because state_sc%q(:,:,ixnumrain) is - ! from stream 9 - !$acc parallel loop collapse(3) default(present) async(9) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then @@ -1611,10 +1538,8 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) endif if (ixnumsnow > 0) then - ! This kernel is executed in stream 10, because state_sc%q(:,:,ixnumsnow) is - ! from stream 10 - !$acc parallel loop collapse(3) default(present) async(10) - do k = 1, pver-top_lev+1 + !$acc parallel loop collapse(3) default(present) + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then @@ -1627,14 +1552,16 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if ( l_outfld_subcol ) then - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb do i = 1, ngrdcol do j = 1, num_subcols + + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir ! Calc effective cloud fraction for testing - if ( ( lh_rc_clipped(i,j,pver-k+1) .gt. qsmall ) & - .or. ( X_nl_all_levs(i,j,pver-k+1,iiPDF_ri) .gt. qsmall ) ) then - eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,pver-k+1) + if ( ( lh_rc_clipped(i,j,k_cam) .gt. qsmall ) & + .or. ( X_nl_all_levs(i,j,k_cam,iiPDF_ri) .gt. qsmall ) ) then + eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,k_cam) else eff_cldfrac(i,k) = 0.0_r8 endif @@ -1647,9 +1574,10 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end do ! Pack precip_frac for output - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb do i = 1, ngrdcol - precip_frac_out(i,pver-k+2) = precip_fracs%precip_frac(i,k) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + precip_frac_out(i,k_cam) = precip_fracs%precip_frac(i,k) end do end do @@ -1693,7 +1621,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end if !$acc end data - !$acc wait #endif #endif @@ -1778,7 +1705,7 @@ subroutine subcol_SILHS_var_covar_driver & ! Inputs to lh_microphys_var_covar_driver real(r8), dimension(pcols,psubcols,pver) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & qctend_clubb, qvtend_clubb, thltend_clubb - real(r8), dimension(pcols,psubcols,pver-top_lev+1) :: height_depndt_weights + real(r8), dimension(pcols,psubcols,nzt_clubb) :: height_depndt_weights ! Outputs from lh_microphys_var_covar_driver real(r8), dimension(:,:), pointer :: rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, & @@ -1910,7 +1837,7 @@ subroutine subcol_SILHS_var_covar_driver & ! This code assumes that the weights are height independent. ! It will have to change once the weights vary with altitude! ! I'm not sure whether the grid will need to be flipped. - do k = 1, pver-top_lev+1 + do k = 1, nzt_clubb height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) end do @@ -1922,15 +1849,15 @@ subroutine subcol_SILHS_var_covar_driver & ! Make the call!!!!! call lh_microphys_var_covar_driver_api & - ( pver-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:pver-top_lev+1), & + ( nzt_clubb, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:nzt_clubb), & pdf_params_single_col, & - rt_all_clubb(igrdcol,1:ns,1:pver-top_lev+1), thl_all_clubb(igrdcol,1:ns,1:pver-top_lev+1), & - w_all_clubb(igrdcol,1:ns,1:pver-top_lev+1), qctend_clubb(igrdcol,1:ns,1:pver-top_lev+1), & - qvtend_clubb(igrdcol,1:ns,1:pver-top_lev+1), thltend_clubb(igrdcol,1:ns,1:pver-top_lev+1), & + rt_all_clubb(igrdcol,1:ns,1:nzt_clubb), thl_all_clubb(igrdcol,1:ns,1:nzt_clubb), & + w_all_clubb(igrdcol,1:ns,1:nzt_clubb), qctend_clubb(igrdcol,1:ns,1:nzt_clubb), & + qvtend_clubb(igrdcol,1:ns,1:nzt_clubb), thltend_clubb(igrdcol,1:ns,1:nzt_clubb), & silhs_config_flags%l_lh_instant_var_covar_src, & - rtp2_mc_zt(igrdcol,1:pver-top_lev+1), thlp2_mc_zt(igrdcol,1:pver-top_lev+1), & - wprtp_mc_zt(igrdcol,1:pver-top_lev+1), wpthlp_mc_zt(igrdcol,1:pver-top_lev+1), & - rtpthlp_mc_zt(igrdcol,1:pver-top_lev+1) ) + rtp2_mc_zt(igrdcol,1:nzt_clubb), thlp2_mc_zt(igrdcol,1:nzt_clubb), & + wprtp_mc_zt(igrdcol,1:nzt_clubb), wpthlp_mc_zt(igrdcol,1:nzt_clubb), & + rtpthlp_mc_zt(igrdcol,1:nzt_clubb) ) ! The *_mc_zt microphysics tendencies are passed out of SILHS and back ! to CLUBB without being used at all in the rest of the host model code. @@ -1940,13 +1867,13 @@ subroutine subcol_SILHS_var_covar_driver & ! CLUBB used pver (thermodynamic) vertical levels, but SILHS only uses ! pver - top_lev + 1 vertical levels. ! Fill the upper levels with 0s when necessary. - if ( pver > pver-top_lev+1 ) then + if ( pver > nzt_clubb ) then rtp2_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 thlp2_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 wprtp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 wpthlp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 rtpthlp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 - endif ! pver > pver-top_lev+1 + endif ! pver > nzt_clubb end do ! igrdcol = 1, ngrdcol #endif @@ -2056,10 +1983,11 @@ function clubb_flip_grid ( profile ) result( profile_flipped ) real(r8), dimension(pver) :: profile_flipped ! Local Variable - integer :: k + integer :: k, k_cam do k=1, pver - profile_flipped(k) = profile(pver-k+1) + k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + profile_flipped(k) = profile(k_cam) end do ! k=1, pver return From dddff494966bf2bf4341fa4a7526b2f8b0f3d16e Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Wed, 19 Nov 2025 17:37:12 -0600 Subject: [PATCH 08/29] Big improvements to flipping. Now almost all calculations are in cam grid, and flipping sections have been consolidated to directly around the time stepping loop. Next is to push them inward until the only clubb grid calculations are done inside advance_clubb_core. --- src/physics/cam/clubb_intr.F90 | 454 ++++++++++++++++++++++--------- src/physics/cam/subcol_SILHS.F90 | 39 ++- 2 files changed, 356 insertions(+), 137 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index ac894c2ce2..c6d7ba0187 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -17,6 +17,8 @@ module clubb_intr ! ! !----------------------------------------------------------------------------------------------------- ! + use ref_pres, only: trop_cloud_top_press + use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pver, pverp, pcols, begchunk, endchunk use phys_control, only: phys_getopts @@ -2358,7 +2360,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_in, & ! total water variance [kg^2/kg^2] thlp2_in, & ! thetal variance [K^2] rtpthlp_in, & ! covariance of thetal and qt [kg/kg K] - rcm_out_zm, & wpthvp_in, & ! w'th_v' (momentum levels) [m/s K] rtpthvp_in, & ! r_t'th_v' (momentum levels) [kg/kg K] thlpthvp_in, & ! th_l'th_v' (momentum levels) [K^2] @@ -2373,7 +2374,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_mc_out, & wpthlp_mc_out, & rtpthlp_mc_out, & - qrl_zm, & uprcp_inout, & ! < u' r_c' > (momentum levels) vprcp_inout, & ! < v' r_c' > (momentum levels) rc_coef_zm_inout, & ! Coef. of X'r_c' in Eq. (34) (t-levs.) @@ -2459,7 +2459,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3] real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s] real(r8) :: latsub - real(r8) :: thlp2_rad_out(pcols,nzm_clubb) + real(r8) :: thlp2_rad_out(state%ncol,nzm_clubb) real(r8) :: apply_const, rtm_test real(r8) :: dl_rad, di_rad, dt_low @@ -2600,29 +2600,29 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_thlflx_output, mf_qtflx_output ! MF Plume ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines - real(r8), dimension(pcols,pverp) :: mf_dry_a, mf_moist_a, & - mf_dry_w, mf_moist_w, & - mf_dry_qt, mf_moist_qt, & - mf_dry_thl, mf_moist_thl, & - mf_dry_u, mf_moist_u, & - mf_dry_v, mf_moist_v, & - mf_moist_qc, & - s_ae, s_aw, & - s_awthl, s_awqt, & - s_awql, s_awqi, & - s_awu, s_awv, & - mf_thlflx, mf_qtflx + real(r8), dimension(state%ncol,nzm_clubb) :: mf_dry_a, mf_moist_a, & + mf_dry_w, mf_moist_w, & + mf_dry_qt, mf_moist_qt, & + mf_dry_thl, mf_moist_thl, & + mf_dry_u, mf_moist_u, & + mf_dry_v, mf_moist_v, & + mf_moist_qc, & + s_ae, s_aw, & + s_awthl, s_awqt, & + s_awql, s_awqi, & + s_awu, s_awv, & + mf_thlflx, mf_qtflx real(r8) :: inv_rh2o ! To reduce the number of divisions in clubb_tend ! MF local vars - real(r8), dimension(pcols,pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid - kappa_zm, p_in_Pa_zm, & ! momentum grid - invrs_exner_zm ! momentum grid + real(r8), dimension(state%ncol,nzm_clubb) :: rtm_zm_in, thlm_zm_in, & ! momentum grid + kappa_zm, p_in_Pa_zm, & ! momentum grid + invrs_exner_zm ! momentum grid - real(r8), dimension(pcols,pverp) :: dzt, invrs_dzt, & ! thermodynamic grid - invrs_exner_zt,& ! thermodynamic grid - kappa_zt, qc_zt ! thermodynamic grid + real(r8), dimension(state%ncol,nzt_clubb) :: dzt, invrs_dzt, & ! thermodynamic grid + invrs_exner_zt,& ! thermodynamic grid + kappa_zt, qc_zt ! thermodynamic grid real(r8) :: temp2d(pcols,pver) ! temporary array for holding scaled outputs @@ -2650,7 +2650,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), parameter :: rad2deg=180.0_r8/pi real(r8) :: tmp_lon1, tmp_lonN, invrs_hdtime - type(grid) :: gr + type(grid) :: gr, gr_a type(nu_vertical_res_dep) :: nu_vert_res_dep ! Vertical resolution dependent nu values real(r8) :: lmin, mixt_frac_max_mag @@ -2695,9 +2695,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if #endif + print *, "do_clubb_mf = ", do_clubb_mf + print *, "do_rainturb = ", do_rainturb + print *, "do_cldcool = ", do_cldcool + !-----------------------------------------------------------------------------------! ! MAIN COMPUTATION BEGINS HERE ! !-----------------------------------------------------------------------------------! + print *, "top_lev = ", top_lev + print *, "trop_cloud_top_press = ", trop_cloud_top_press call t_startf('clubb_tend_cam:NAR') @@ -3368,16 +3374,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo - - ! Define the CLUBB momentum grid (in height, units of m) - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzm_clubb - do i=1, ncol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir - zi_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,pverp) - end do - end do - ! Compute thermodynamic stuff needed for CLUBB on thermo levels. ! Inputs for the momentum levels are set below setup_clubb core ! Flipped grid calcs @@ -3385,20 +3381,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k ! Define the CLUBB thermodynamic grid (in units of m) - zt_g(i,k) = state1%zm(i,k_cam)-state1%zi(i,pverp) + zt_g(i,k) = state1%zm(i,k_cam) - state1%zi(i,pverp) ! base state (dry) variables - rho_ds_zt(i,k) = rga*(state1%pdeldry(i,k_cam)/dz_g(i,k_cam)) - invrs_rho_ds_zt(i,k) = 1._r8/(rho_ds_zt(i,k)) + rho_ds_zt(i,k) = rga * ( state1%pdeldry(i,k_cam) / dz_g(i,k_cam) ) + invrs_rho_ds_zt(i,k) = 1._r8 / rho_ds_zt(i,k) ! full state (moist) variables p_in_Pa(i,k) = state1%pmid(i,k_cam) exner(i,k) = 1._r8/inv_exner_clubb(i,k_cam) - thv(i,k) = state1%t(i,k_cam)*inv_exner_clubb(i,k_cam)*(1._r8+zvir*state1%q(i,k_cam,ixq) & - -state1%q(i,k_cam,ixcldliq)) + thv(i,k) = state1%t(i,k_cam) * inv_exner_clubb(i,k_cam) & + * (1._r8 + zvir * state1%q(i,k_cam,ixq) - state1%q(i,k_cam,ixcldliq)) rho_zt(i,k) = rga*state1%pdel(i,k_cam)/dz_g(i,k_cam) ! exception - setting this to moist thv @@ -3406,7 +3402,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rfrzm(i,k) = state1%q(i,k_cam,ixcldice) radf(i,k) = radf_clubb(i,k_cam) - qrl_clubb(i,k) = qrl(i,k_cam)/(cpairv(i,k,lchnk)*state1%pdeldry(i,k_cam)) + qrl_clubb(i,k) = qrl(i,k_cam) / ( cpairv(i,k,lchnk) * state1%pdeldry(i,k_cam) ) ! Compute mean w wind on thermo grid, convert from omega to w wm_zt(i,k) = -1._r8*(state1%omega(i,k_cam)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) @@ -3428,21 +3424,31 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do - ! Heights need to be set at each timestep. Therefore, recall - ! setup_grid and check_parameters_api for this. - ! Set-up CLUBB core at each CLUBB call because heights can change - ! Important note: do not make any calls that use CLUBB grid-height + ! Define the CLUBB momentum grid (in height, units of m) + !$acc parallel loop gang vector collapse(2) default(present) + do k=1, nzm_clubb + do i=1, ncol + !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k + zi_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,pverp) + end do + end do + + + ! Heights need to be set at each timestep. Therefore, recall + ! setup_grid and calc_derrived_params for this. + ! IMPORTANT NOTE: do not make any calls that use CLUBB grid-height ! operators (such as zt2zm_api, etc.) until AFTER the ! call to setup_grid_heights_api. - call t_stopf('clubb_tend_cam:ACCR') call t_startf('clubb_tend_cam:NAR') !$acc update host( deltaz, zi_g, zt_g, clubb_params, sfc_elevation ) + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - l_ascending_grid, grid_type, & ! intent(in) - deltaz, zi_g(:,k_sfc_zm), zi_g(:,k_top_zm), & ! intent(in) + .false., grid_type, & ! intent(in) + deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) zi_g, zt_g, & ! intent(in) gr, err_info ) ! intent(inout) @@ -3465,6 +3471,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & 'in CLUBB check_parameters_api') end if + ! CLUBB's grid data structure (gr) and nu_vert_res_dep contain arrays that need to + ! be copied to the GPU call t_stopf('clubb_tend_cam:NAR') call t_startf('clubb_tend_cam:acc_copyin') !$acc data copyin( gr, gr%zm, gr%zt, gr%dzm, gr%dzt, gr%invrs_dzt, gr%invrs_dzm, & @@ -3474,39 +3482,46 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc nu_vert_res_dep%nu6) call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') - + +!--- TODO: should these be all always zero if we aren't using SILHS? wrap in ifdef SILHS maybe? ! Add forcings for SILHS covariance contributions - rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt ) - thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt ) - wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt ) - wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt ) - rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt ) - - ! Zero out SILHS covariance contribution terms - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pver - do i = 1, pcols - rtp2_mc_zt(i,k) = 0.0_r8 - thlp2_mc_zt(i,k) = 0.0_r8 - wprtp_mc_zt(i,k) = 0.0_r8 - wpthlp_mc_zt(i,k) = 0.0_r8 - rtpthlp_mc_zt(i,k) = 0.0_r8 - end do - end do + ! rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt ) + ! thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt ) + ! wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt ) + ! wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt ) + ! rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt ) + + ! ! Zero out SILHS covariance contribution terms + ! !$acc parallel loop gang vector collapse(2) default(present) + ! do k = 1, pver + ! do i = 1, pcols + ! rtp2_mc_zt(i,k) = 0.0_r8 + ! thlp2_mc_zt(i,k) = 0.0_r8 + ! wprtp_mc_zt(i,k) = 0.0_r8 + ! wpthlp_mc_zt(i,k) = 0.0_r8 + ! rtpthlp_mc_zt(i,k) = 0.0_r8 + ! end do + ! end do + rtp2_forcing = 0._r8 + thlp2_forcing = 0._r8 + wprtp_forcing = 0._r8 + wpthlp_forcing = 0._r8 + rtpthlp_forcing = 0._r8 +!-- END TODO ! Compute some inputs from the thermodynamic grid to the momentum grid rho_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rho_ds_zt ) - rho_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rho_zt ) invrs_rho_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, invrs_rho_ds_zt ) + rho_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rho_zt ) thv_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thv_ds_zt ) wm_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wm_zt ) ! Surface fluxes provided by host model !$acc parallel loop gang vector default(present) do i=1,ncol - wpthlp_sfc(i) = cam_in%shf(i) / ( cpairv(i,pver,lchnk) * rho_ds_zm(i,k_sfc_zm) ) ! Sensible heat flux + wpthlp_sfc(i) = cam_in%shf(i) / ( cpairv(i,pver,lchnk) * rho_ds_zm(i,nzm_clubb) ) ! Sensible heat flux wpthlp_sfc(i) = wpthlp_sfc(i) * inv_exner_clubb(i,pver) ! Potential temperature flux - wprtp_sfc(i) = cam_in%cflx(i,1) / rho_ds_zm(i,k_sfc_zm) ! Moisture flux + wprtp_sfc(i) = cam_in%cflx(i,1) / rho_ds_zm(i,nzm_clubb) ! Moisture flux end do @@ -3588,8 +3603,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i=1,ncol - upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,k_sfc_zm) ! Surface meridional momentum flux - vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,k_sfc_zm) ! Surface zonal momentum flux + upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,nzm_clubb) ! Surface meridional momentum flux + vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,nzm_clubb) ! Surface zonal momentum flux end do endif @@ -3600,7 +3615,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, ncol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k um_in(i,k) = um(i,k_cam) vm_in(i,k) = vm(i,k_cam) wp2thvp_in(i,k) = wp2thvp(i,k_cam) @@ -3627,7 +3643,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k upwp_in(i,k) = upwp(i,k_cam) vpwp_in(i,k) = vpwp(i,k_cam) wpthvp_in(i,k) = wpthvp(i,k_cam) @@ -3654,10 +3671,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! we're calling pdf_closure at the end of advance_clubb_core if ( is_first_restart_step() & .and. clubb_config_flags%ipdf_call_placement .eq. ipdf_post_advance_fields ) then + !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,k_cam) pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,k_cam) pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,k_cam) @@ -3665,6 +3684,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,k_cam) end do end do + end if ! pressure,exner on momentum grid needed for mass flux calc. @@ -3672,18 +3692,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzt_clubb do i=1,ncol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k kappa_zt(i,k) = (rairv(i,k_cam,lchnk)/cpairv(i,k_cam,lchnk)) qc_zt(i,k) = state1%q(i,k_cam,ixcldliq) invrs_exner_zt(i,k) = inv_exner_clubb(i,k_cam) end do end do - kappa_zm(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt(1:ncol,:)) + kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt ) - do k=1,pverp + do k=1,nzm_clubb do i=1,ncol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k p_in_Pa_zm(i,k) = state1%pint(i,k_cam) invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) end do @@ -3716,36 +3738,145 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end if - ! Do the same for tracers - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then + if ( edsclr_dim > 0 ) then + + ! Do the same for tracers + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + + icnt = icnt+1 + + !$acc parallel loop gang vector collapse(2) default(present) + do k=1,nzt_clubb + do i=1,ncol + !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k + edsclr_in(i,k,icnt) = state1%q(i,k_cam,ixind) + end do + end do + + end if + end do - icnt = icnt+1 + if (clubb_l_do_expldiff_rtm_thlm) then !$acc parallel loop gang vector collapse(2) default(present) do k=1,nzt_clubb - do i=1,ncol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir - edsclr_in(i,k,icnt) = state1%q(i,k_cam,ixind) + do i=1, ncol + !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k + edsclr_in(i,k,icnt+1) = thlm(i,k_cam) + edsclr_in(i,k,icnt+2) = rtm(i,k_cam) end do end do + endif + + end if + + if ( l_ascending_grid ) then + p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) + exner = exner(:,nzt_clubb:1:-1) + thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) + rfrzm = rfrzm(:,nzt_clubb:1:-1) + radf = radf(:,nzt_clubb:1:-1) + qrl_clubb = qrl_clubb(:,nzt_clubb:1:-1) + + um_in = um_in(:,nzt_clubb:1:-1) + vm_in = vm_in(:,nzt_clubb:1:-1) + wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) + up3_in = up3_in(:,nzt_clubb:1:-1) + vp3_in = vp3_in(:,nzt_clubb:1:-1) + wp3_in = wp3_in(:,nzt_clubb:1:-1) + rtp3_in = rtp3_in(:,nzt_clubb:1:-1) + thlp3_in = thlp3_in(:,nzt_clubb:1:-1) + thlm_in = thlm_in(:,nzt_clubb:1:-1) + rtm_in = rtm_in(:,nzt_clubb:1:-1) + rvm_in = rvm_in(:,nzt_clubb:1:-1) + cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) + rcm_inout = rcm_inout(:,nzt_clubb:1:-1) + wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) + wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) + wpup2_inout = wpup2_inout(:,nzt_clubb:1:-1) + wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) + pre_in = pre_in(:,nzt_clubb:1:-1) + ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) + upwp_in = upwp_in(:,nzm_clubb:1:-1) + vpwp_in = vpwp_in(:,nzm_clubb:1:-1) + wpthvp_in = wpthvp_in(:,nzm_clubb:1:-1) + rtpthvp_in = rtpthvp_in(:,nzm_clubb:1:-1) + thlpthvp_in = thlpthvp_in(:,nzm_clubb:1:-1) + up2_in = up2_in(:,nzm_clubb:1:-1) + vp2_in = vp2_in(:,nzm_clubb:1:-1) + wp2_in = wp2_in(:,nzm_clubb:1:-1) + rtp2_in = rtp2_in(:,nzm_clubb:1:-1) + thlp2_in = thlp2_in(:,nzm_clubb:1:-1) + wprtp_in = wprtp_in(:,nzm_clubb:1:-1) + wpthlp_in = wpthlp_in(:,nzm_clubb:1:-1) + rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) + uprcp_inout = uprcp_inout(:,nzm_clubb:1:-1) + vprcp_inout = vprcp_inout(:,nzm_clubb:1:-1) + rc_coef_zm_inout = rc_coef_zm_inout(:,nzm_clubb:1:-1) + wp4_inout = wp4_inout(:,nzm_clubb:1:-1) + wp2up2_inout = wp2up2_inout(:,nzm_clubb:1:-1) + wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) + + pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + + pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) + + if (do_clubb_mf) then + kappa_zt = kappa_zt(:,nzt_clubb:1:-1) + qc_zt = qc_zt(:,nzm_clubb:1:-1) + invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) + p_in_Pa_zm = p_in_Pa_zm(:,nzm_clubb:1:-1) + invrs_exner_zm = invrs_exner_zm(:,nzm_clubb:1:-1) end if - end do - if (clubb_l_do_expldiff_rtm_thlm) then + rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) + invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) + rho_zt = rho_zt(:,nzt_clubb:1:-1) + thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) + wm_zt = wm_zt(:,nzt_clubb:1:-1) - !$acc parallel loop gang vector collapse(2) default(present) - do k=1,nzt_clubb - do i=1, ncol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir - edsclr_in(i,k,icnt+1) = thlm(i,k_cam) - edsclr_in(i,k,icnt+2) = rtm(i,k_cam) - end do - end do + rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) + invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) + rho_zm = rho_zm(:,nzm_clubb:1:-1) + thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) + wm_zm = wm_zm(:,nzm_clubb:1:-1) - endif + if ( edsclr_dim > 0 ) then + edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) + end if + + zt_g = zt_g(:,nzt_clubb:1:-1) + zi_g = zi_g(:,nzm_clubb:1:-1) + + ! we are in ascending mode, need to calculate ascending grid + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + l_ascending_grid, grid_type, & ! intent(in) + deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr_a, err_info ) ! intent(inout)- + else + + ! not in ascending mode, so we calculate gr_a the same as gr + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + l_ascending_grid, grid_type, & ! intent(in) + deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr_a, err_info ) ! intent(inout)- + + end if call t_stopf('clubb_tend_cam:flip-index') @@ -3763,23 +3894,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - do k=1,pver + do k=1,nzt_clubb do i=1, ncol dzt(i,k) = zi_g(i,k+1) - zi_g(i,k) + invrs_dzt(i,k) = 1._r8/dzt(i,k) end do end do - do i=1, ncol - invrs_dzt(i,:) = 1._r8/dzt(i,:) - end do - - rtm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm_in(1:ncol,:) ) - thlm_zm_in(1:ncol,:) = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm_in(1:ncol,:) ) + rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr_a, rtm_in ) + thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr_a, thlm_in ) do i=1, ncol - call integrate_mf( pverp, pver, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv(i,:), & ! input + call integrate_mf( nzm_clubb, nzt_clubb, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv(i,1:nzt_clubb), & ! input thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input wpthlp_sfc(i), wprtp_sfc(i), pblh(i), & ! input mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics @@ -3812,7 +3940,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Advance CLUBB CORE one timestep in the future call t_startf('clubb_tend_cam:advance_clubb_core_api') - call advance_clubb_core_api( gr, nzm_clubb, nzt_clubb, ncol, & + call advance_clubb_core_api( gr_a, nzm_clubb, nzt_clubb, ncol, & l_implemented, dtime, fcor, sfc_elevation, & hydromet_dim, & sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & @@ -3877,12 +4005,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - call update_xp2_mc_api( gr, nzm_clubb, nzt_clubb, ncol, dtime, cloud_frac_inout, & - rcm_inout, rvm_in, thlm_in, wm_zt, & - exner, pre_in, pdf_params_chnk(lchnk), & - rtp2_mc_out, thlp2_mc_out, & - wprtp_mc_out, wpthlp_mc_out, & - rtpthlp_mc_out) + call update_xp2_mc_api( gr_a, nzm_clubb, nzt_clubb, ncol, dtime, cloud_frac_inout, & + rcm_inout, rvm_in, thlm_in, wm_zt, & + exner, pre_in, pdf_params_chnk(lchnk), & + rtp2_mc_out, thlp2_mc_out, & + wprtp_mc_out, wpthlp_mc_out, & + rtpthlp_mc_out) do k=1,nzm_clubb do i=1,ncol @@ -3902,17 +4030,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_cldcool) then call t_startf('clubb_tend_cam:do_cldcool') - rcm_out_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rcm_inout ) - qrl_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, qrl_clubb ) thlp2_rad_out(:,:) = 0._r8 - call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr, & + call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr_a, & rcm_inout, thlprcp_out, qrl_clubb, clubb_params, & thlp2_rad_out ) - do i=1, ncol - thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime - thlp2_in(i,:) = max(thl_tol**2,thlp2_in(i,:)) + do k=1,nzm_clubb + do i=1, ncol + thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) + thlp2_rad_out(i,k) * dtime ) + end do end do call t_stopf('clubb_tend_cam:do_cldcool') @@ -3931,6 +4058,80 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo ! end time loop + call t_startf('clubb_tend_cam:flip-index') + if ( l_ascending_grid ) then + + thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) + + um_in = um_in(:,nzt_clubb:1:-1) + vm_in = vm_in(:,nzt_clubb:1:-1) + wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) + up3_in = up3_in(:,nzt_clubb:1:-1) + vp3_in = vp3_in(:,nzt_clubb:1:-1) + thlm_in = thlm_in(:,nzt_clubb:1:-1) + rtm_in = rtm_in(:,nzt_clubb:1:-1) + wp3_in = wp3_in(:,nzt_clubb:1:-1) + rtp3_in = rtp3_in(:,nzt_clubb:1:-1) + thlp3_in = thlp3_in(:,nzt_clubb:1:-1) + rcm_inout = rcm_inout(:,nzt_clubb:1:-1) + cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) + rcm_in_layer_out = rcm_in_layer_out(:,nzt_clubb:1:-1) + cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) + zt_g = zt_g(:,nzt_clubb:1:-1) + wm_zt = wm_zt(:,nzt_clubb:1:-1) + wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) + wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) + wpup2_inout = wpup2_inout(:,nzt_clubb:1:-1) + wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) + ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) + qclvar_out = qclvar_out(:,nzt_clubb:1:-1) + rtp2_zt = rtp2_zt(:,nzt_clubb:1:-1) + thl2_zt = thl2_zt(:,nzt_clubb:1:-1) + wp2_zt = wp2_zt(:,nzt_clubb:1:-1) + + upwp_in = upwp_in(:,nzm_clubb:1:-1) + vpwp_in = vpwp_in(:,nzm_clubb:1:-1) + wpthvp_in = wpthvp_in(:,nzm_clubb:1:-1) + rtpthvp_in = rtpthvp_in(:,nzm_clubb:1:-1) + thlpthvp_in = thlpthvp_in(:,nzm_clubb:1:-1) + up2_in = up2_in(:,nzm_clubb:1:-1) + vp2_in = vp2_in(:,nzm_clubb:1:-1) + wprtp_in = wprtp_in(:,nzm_clubb:1:-1) + wpthlp_in = wpthlp_in(:,nzm_clubb:1:-1) + wp2_in = wp2_in(:,nzm_clubb:1:-1) + rtp2_in = rtp2_in(:,nzm_clubb:1:-1) + thlp2_in = thlp2_in(:,nzm_clubb:1:-1) + rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) + wprcp_out = wprcp_out(:,nzm_clubb:1:-1) + + pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac(:,nzm_clubb:1:-1) + + pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) + + + zi_g = zi_g(:,nzm_clubb:1:-1) + khzm_out = khzm_out(:,nzm_clubb:1:-1) + uprcp_inout = uprcp_inout(:,nzm_clubb:1:-1) + vprcp_inout = vprcp_inout(:,nzm_clubb:1:-1) + rc_coef_zm_inout = rc_coef_zm_inout(:,nzm_clubb:1:-1) + wp4_inout = wp4_inout(:,nzm_clubb:1:-1) + wp2up2_inout = wp2up2_inout(:,nzm_clubb:1:-1) + wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) + + if ( edsclr_dim > 0 ) then + edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) + end if + + end if + if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then @@ -3961,13 +4162,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) wp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) - call t_startf('clubb_tend_cam:flip-index') - ! Arrays need to be "flipped" to CAM grid !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzt_clubb do i=1, ncol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k um(i,k_cam) = um_in(i,k) vm(i,k_cam) = vm_in(i,k) wp2thvp(i,k_cam) = wp2thvp_in(i,k) @@ -4000,7 +4200,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzm_clubb do i=1, ncol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k upwp(i,k_cam) = upwp_in(i,k) vpwp(i,k_cam) = vpwp_in(i,k) wpthvp(i,k_cam) = wpthvp_in(i,k) @@ -4030,18 +4231,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wp2vp2(i,k_cam) = wp2vp2_inout(i,k) end do end do - if ( edsclr_dim > 0 ) then + !$acc parallel loop gang vector collapse(3) default(present) do ixind=1,edsclr_dim do k=1, nzt_clubb do i=1, ncol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k edsclr_out(i,k_cam,ixind) = edsclr_in(i,k,ixind) end do end do end do + end if if (do_clubb_mf) then @@ -4086,7 +4289,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & * pdf_params_chnk(lchnk)%rt_2(i,k) - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k pdfp_rtp2(i,k_cam) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 77b90ed982..8429e3ecf1 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -1723,7 +1723,7 @@ subroutine subcol_SILHS_var_covar_driver & !----- Begin Code ----- - call init_pdf_params_api( pver+1-top_lev, 1, pdf_params_single_col ) + call init_pdf_params_api( nzt_clubb, 1, pdf_params_single_col ) ! Don't do anything if this option isn't enabled. if ( .not. subcol_SILHS_var_covar_src ) return @@ -1816,12 +1816,27 @@ subroutine subcol_SILHS_var_covar_driver & end do ! k = 1, pver ! Flip inputs to CLUBB's grid. Note the dimension ordering change. - rt_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pver) ) - thl_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pver) ) - w_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pver) ) - qctend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pver) ) - qvtend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pver) ) - thltend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pver) ) + ! rt_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pver) ) + ! thl_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pver) ) + ! w_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pver) ) + ! qctend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pver) ) + ! qvtend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pver) ) + ! thltend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pver) ) + if ( l_ascending_grid ) then + rt_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pver) ) + thl_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pver) ) + w_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pver) ) + qctend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pver) ) + qvtend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pver) ) + thltend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pver) ) + else ! descending grid + rt_all_clubb(igrdcol,isubcol,1:pver) = rt_all(igrdcol,isubcol,1:pver) + thl_all_clubb(igrdcol,isubcol,1:pver) = thl_all(igrdcol,isubcol,1:pver) + w_all_clubb(igrdcol,isubcol,1:pver) = w_all(igrdcol,isubcol,1:pver) + qctend_clubb(igrdcol,isubcol,1:pver) = qctend(igrdcol,isubcol,1:pver) + qvtend_clubb(igrdcol,isubcol,1:pver) = qvtend(igrdcol,isubcol,1:pver) + thltend_clubb(igrdcol,isubcol,1:pver) = thltend(igrdcol,isubcol,1:pver) + endif end do ! isubcol = 1, nsubcol(igrdcol) end do ! igrdcol = 1, ngrdcol @@ -1868,11 +1883,11 @@ subroutine subcol_SILHS_var_covar_driver & ! pver - top_lev + 1 vertical levels. ! Fill the upper levels with 0s when necessary. if ( pver > nzt_clubb ) then - rtp2_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 - thlp2_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 - wprtp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 - wpthlp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 - rtpthlp_mc_zt(igrdcol,pver-top_lev+2:pver) = 0.0_r8 + rtp2_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 + thlp2_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 + wprtp_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 + wpthlp_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 + rtpthlp_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 endif ! pver > nzt_clubb end do ! igrdcol = 1, ngrdcol From 055e53f70741531a58d0f7da788b824c76fef087 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Wed, 19 Nov 2025 23:38:46 -0600 Subject: [PATCH 09/29] Consolidated ascending functionality as much as possible. Ascending vs descending BFB (except wp3_ta but that's internal and doesn't matter) - this is even true with clubb_cloudtop_cooling, clubb_rainevap_turb, and do_clubb_mf. --- src/physics/cam/clubb_intr.F90 | 657 +++++++++++++++++++++------------ 1 file changed, 429 insertions(+), 228 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index c6d7ba0187..79993b8b2c 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -62,8 +62,13 @@ module clubb_intr type (sclr_idx_type) :: & sclr_idx - integer, parameter :: & - clubb_grid_dir = 1 + logical, public, parameter :: & + l_ascending_grid = .true. ! Set clubb to ascending mode, which is opposite of the + ! cam grid the rest of this code uses, thus it requires + ! an expensive array flipping step before calling clubb + + integer :: & + clubb_grid_dir integer :: & nzm_clubb, & ! Number of vertical levels used by CLUBB momentum variables @@ -533,7 +538,6 @@ module clubb_intr type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] - logical, public :: l_ascending_grid = .true. ! For now #endif contains @@ -1581,7 +1585,7 @@ subroutine clubb_ini_cam(pbuf2d) nzt_clubb = pver + 1 - top_lev nzm_clubb = pverp + 1 - top_lev - if ( clubb_grid_dir == 1 ) then + if ( l_ascending_grid ) then ! if we are in ascending grid mode, then we start filling the clubb arrays with the ! surface values (pverp for zm or pverp for zt) because they need to be flipped k1_clubb_in_cam_zm = pverp @@ -1590,8 +1594,8 @@ subroutine clubb_ini_cam(pbuf2d) k_sfc_zt = 1 k_top_zm = nzm_clubb k_top_zt = nzt_clubb - l_ascending_grid = .true. - else if ( clubb_grid_dir == -1 ) then + clubb_grid_dir = 1 + else ! if we are in descending grid mode, then we start filling the clubb arrays with the ! top level values (top_lev), because this is the maximum level clubb considers k1_clubb_in_cam_zm = top_lev @@ -1600,9 +1604,7 @@ subroutine clubb_ini_cam(pbuf2d) k_sfc_zt = nzt_clubb k_top_zm = 1 k_top_zt = 1 - l_ascending_grid = .false. - else - call endrun('clubb_ini_cam: clubb_grid_dir can only be +1 or -1') + clubb_grid_dir = -1 end if ! Allocate PDF parameters across columns and chunks @@ -2335,7 +2337,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wp2thlp_inout, & ! w'^2 thl' (thermodynamic levels) wpup2_inout, & ! w'u'^2 (thermodynamic levels) wpvp2_inout, & ! w'v'^2 (thermodynamic levels) - zt_g ! Thermodynamic grid of CLUBB [m] + zt_g, & ! Thermodynamic grid of CLUBB [m] + Lscale ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLES SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES @@ -2658,9 +2661,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,nparams) :: & clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) - real(r8), dimension(state%ncol,nzt_clubb) :: & - Lscale - integer :: & sclr, & edsclr, & @@ -3046,13 +3046,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wp2_zt_out(i,k) = 0._r8 pdfp_rtp2(i,k) = 0._r8 wm_zt_out(i,k) = 0._r8 - end do - end do - - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pver - do i = 1, pcols - temp2d(i,k) = 0._r8 + temp2d(i,k) = 0._r8 end do end do @@ -3429,7 +3423,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzm_clubb do i=1, ncol - !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k zi_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,pverp) end do @@ -3445,7 +3438,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:NAR') !$acc update host( deltaz, zi_g, zt_g, clubb_params, sfc_elevation ) - + ! Calculate grid assuming a descending grid (cam grid), since we want to + ! confine ascending behavior to advance_clubb_core call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) .false., grid_type, & ! intent(in) deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) @@ -3566,7 +3560,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & trim(scm_clubb_iop_name) == 'ARM_CC') then bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) - ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) + ustar = diag_ustar(zt_g(1,nzt_clubb-1),bflx22(1),ubar,zo(1)) endif ! Compute the surface momentum fluxes, if this is a SCAM simulation @@ -3615,7 +3609,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, ncol - !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k um_in(i,k) = um(i,k_cam) vm_in(i,k) = vm(i,k_cam) @@ -3643,7 +3636,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k upwp_in(i,k) = upwp(i,k_cam) vpwp_in(i,k) = vpwp(i,k_cam) @@ -3675,7 +3667,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,k_cam) pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,k_cam) @@ -3692,7 +3683,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzt_clubb do i=1,ncol - !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k kappa_zt(i,k) = (rairv(i,k_cam,lchnk)/cpairv(i,k_cam,lchnk)) qc_zt(i,k) = state1%q(i,k_cam,ixcldliq) @@ -3704,7 +3694,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzm_clubb do i=1,ncol - !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k p_in_Pa_zm(i,k) = state1%pint(i,k_cam) invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) @@ -3750,7 +3739,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1,nzt_clubb do i=1,ncol - !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k edsclr_in(i,k,icnt) = state1%q(i,k_cam,ixind) end do @@ -3764,7 +3752,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1,nzt_clubb do i=1, ncol - !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k edsclr_in(i,k,icnt+1) = thlm(i,k_cam) edsclr_in(i,k,icnt+2) = rtm(i,k_cam) @@ -3774,109 +3761,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif end if - - if ( l_ascending_grid ) then - p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) - exner = exner(:,nzt_clubb:1:-1) - thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) - rfrzm = rfrzm(:,nzt_clubb:1:-1) - radf = radf(:,nzt_clubb:1:-1) - qrl_clubb = qrl_clubb(:,nzt_clubb:1:-1) - - um_in = um_in(:,nzt_clubb:1:-1) - vm_in = vm_in(:,nzt_clubb:1:-1) - wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) - up3_in = up3_in(:,nzt_clubb:1:-1) - vp3_in = vp3_in(:,nzt_clubb:1:-1) - wp3_in = wp3_in(:,nzt_clubb:1:-1) - rtp3_in = rtp3_in(:,nzt_clubb:1:-1) - thlp3_in = thlp3_in(:,nzt_clubb:1:-1) - thlm_in = thlm_in(:,nzt_clubb:1:-1) - rtm_in = rtm_in(:,nzt_clubb:1:-1) - rvm_in = rvm_in(:,nzt_clubb:1:-1) - cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) - rcm_inout = rcm_inout(:,nzt_clubb:1:-1) - wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) - wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) - wpup2_inout = wpup2_inout(:,nzt_clubb:1:-1) - wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) - pre_in = pre_in(:,nzt_clubb:1:-1) - ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) - upwp_in = upwp_in(:,nzm_clubb:1:-1) - vpwp_in = vpwp_in(:,nzm_clubb:1:-1) - wpthvp_in = wpthvp_in(:,nzm_clubb:1:-1) - rtpthvp_in = rtpthvp_in(:,nzm_clubb:1:-1) - thlpthvp_in = thlpthvp_in(:,nzm_clubb:1:-1) - up2_in = up2_in(:,nzm_clubb:1:-1) - vp2_in = vp2_in(:,nzm_clubb:1:-1) - wp2_in = wp2_in(:,nzm_clubb:1:-1) - rtp2_in = rtp2_in(:,nzm_clubb:1:-1) - thlp2_in = thlp2_in(:,nzm_clubb:1:-1) - wprtp_in = wprtp_in(:,nzm_clubb:1:-1) - wpthlp_in = wpthlp_in(:,nzm_clubb:1:-1) - rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) - uprcp_inout = uprcp_inout(:,nzm_clubb:1:-1) - vprcp_inout = vprcp_inout(:,nzm_clubb:1:-1) - rc_coef_zm_inout = rc_coef_zm_inout(:,nzm_clubb:1:-1) - wp4_inout = wp4_inout(:,nzm_clubb:1:-1) - wp2up2_inout = wp2up2_inout(:,nzm_clubb:1:-1) - wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) - - pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) - - pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) - - if (do_clubb_mf) then - kappa_zt = kappa_zt(:,nzt_clubb:1:-1) - qc_zt = qc_zt(:,nzm_clubb:1:-1) - invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) - p_in_Pa_zm = p_in_Pa_zm(:,nzm_clubb:1:-1) - invrs_exner_zm = invrs_exner_zm(:,nzm_clubb:1:-1) - end if - - rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) - invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) - rho_zt = rho_zt(:,nzt_clubb:1:-1) - thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) - wm_zt = wm_zt(:,nzt_clubb:1:-1) - - rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) - invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) - rho_zm = rho_zm(:,nzm_clubb:1:-1) - thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) - wm_zm = wm_zm(:,nzm_clubb:1:-1) - - if ( edsclr_dim > 0 ) then - edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) - end if - - zt_g = zt_g(:,nzt_clubb:1:-1) - zi_g = zi_g(:,nzm_clubb:1:-1) - - ! we are in ascending mode, need to calculate ascending grid - call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - l_ascending_grid, grid_type, & ! intent(in) - deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) - zi_g, zt_g, & ! intent(in) - gr_a, err_info ) ! intent(inout)- - else - - ! not in ascending mode, so we calculate gr_a the same as gr - call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - l_ascending_grid, grid_type, & ! intent(in) - deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) - zi_g, zt_g, & ! intent(in) - gr_a, err_info ) ! intent(inout)- - - end if call t_stopf('clubb_tend_cam:flip-index') @@ -3894,15 +3778,39 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - do k=1,nzt_clubb + do k = 1, nzt_clubb do i=1, ncol - dzt(i,k) = zi_g(i,k+1) - zi_g(i,k) - invrs_dzt(i,k) = 1._r8/dzt(i,k) + dzt(i,k) = zi_g(i,k) - zi_g(i,k+1) + invrs_dzt(i,k) = 1._r8 / dzt(i,k) end do end do - rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr_a, rtm_in ) - thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr_a, thlm_in ) + rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm_in ) + thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm_in ) + + !--------------------------------------- integrate_mf call and flip --------------------------------------- + ! integrate_mf assumes an ascending grid, which is the opposide of the cam grid that + ! clubb_intr now mainly uses, so we need to flip the fields before calling integrate_mf + ! + ! Ideally, integrate_mf would operate in descending mode, then we could remove the flipping. + ! If the column loop gets pushed into it, we can also avoid the array slicing. + + dzt = dzt(:,nzt_clubb:1:-1) + p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) + invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) + um_in = um_in(:,nzt_clubb:1:-1) + vm_in = vm_in(:,nzt_clubb:1:-1) + thlm_in = thlm_in(:,nzt_clubb:1:-1) + rtm_in = rtm_in(:,nzt_clubb:1:-1) + + thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) + + ! Flip zm inputs + zi_g = zi_g(:,nzm_clubb:1:-1) + p_in_Pa_zm = p_in_Pa_zm(:,nzm_clubb:1:-1) + invrs_exner_zm = invrs_exner_zm(:,nzm_clubb:1:-1) + thlm_zm_in = thlm_zm_in(:,nzm_clubb:1:-1) + rtm_zm_in = rtm_zm_in(:,nzm_clubb:1:-1) do i=1, ncol call integrate_mf( nzm_clubb, nzt_clubb, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input @@ -3923,15 +3831,61 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver end do + + ! Flip zt inputs back + dzt = dzt(:,nzt_clubb:1:-1) + p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) + invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) + um_in = um_in(:,nzt_clubb:1:-1) + vm_in = vm_in(:,nzt_clubb:1:-1) + thlm_in = thlm_in(:,nzt_clubb:1:-1) + rtm_in = rtm_in(:,nzt_clubb:1:-1) + + thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) + + ! Flip zm inputs back + zi_g = zi_g(:,nzm_clubb:1:-1) + p_in_Pa_zm = p_in_Pa_zm(:,nzm_clubb:1:-1) + invrs_exner_zm = invrs_exner_zm(:,nzm_clubb:1:-1) + thlm_zm_in = thlm_zm_in(:,nzm_clubb:1:-1) + rtm_zm_in = rtm_zm_in(:,nzm_clubb:1:-1) + + ! Flip clubb_mf output, since it + mf_dry_a = mf_dry_a(:,nzm_clubb:1:-1) + mf_moist_a = mf_moist_a(:,nzm_clubb:1:-1) + mf_dry_w = mf_dry_w(:,nzm_clubb:1:-1) + mf_moist_w = mf_moist_w(:,nzm_clubb:1:-1) + mf_dry_qt = mf_dry_qt(:,nzm_clubb:1:-1) + mf_moist_qt = mf_moist_qt(:,nzm_clubb:1:-1) + mf_dry_thl = mf_dry_thl(:,nzm_clubb:1:-1) + mf_moist_thl = mf_moist_thl(:,nzm_clubb:1:-1) + mf_dry_u = mf_dry_u(:,nzm_clubb:1:-1) + mf_moist_u = mf_moist_u(:,nzm_clubb:1:-1) + mf_dry_v = mf_dry_v(:,nzm_clubb:1:-1) + mf_moist_v = mf_moist_v(:,nzm_clubb:1:-1) + mf_moist_qc = mf_moist_qc(:,nzm_clubb:1:-1) + mf_thlflx = mf_thlflx(:,nzm_clubb:1:-1) + mf_qtflx = mf_qtflx(:,nzm_clubb:1:-1) + s_ae = s_ae(:,nzm_clubb:1:-1) + s_aw = s_aw(:,nzm_clubb:1:-1) + s_awthl = s_awthl(:,nzm_clubb:1:-1) + s_awqt = s_awqt(:,nzm_clubb:1:-1) + s_awql = s_awql(:,nzm_clubb:1:-1) + s_awqi = s_awqi(:,nzm_clubb:1:-1) + s_awu = s_awu(:,nzm_clubb:1:-1) + s_awv = s_awv(:,nzm_clubb:1:-1) + mf_thlflx = mf_thlflx(:,nzm_clubb:1:-1) + mf_qtflx = mf_qtflx(:,nzm_clubb:1:-1) + !--------------------------------------- END integrate_mf call and flip --------------------------------------- ! pass MF turbulent advection term as CLUBB explicit forcing term do k = 1, nzt_clubb do i = 1, ncol rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & - ((rho_ds_zm(i,k+1) * mf_qtflx(i,k+1)) - (rho_ds_zm(i,k) * mf_qtflx(i,k))) + ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflx(i,k+1))) thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & - ((rho_ds_zm(i,k+1) * mf_thlflx(i,k+1)) - (rho_ds_zm(i,k) * mf_thlflx(i,k))) + ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflx(i,k+1))) end do end do call t_stopf('clubb_tend_cam:do_clubb_mf') @@ -3940,6 +3894,164 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Advance CLUBB CORE one timestep in the future call t_startf('clubb_tend_cam:advance_clubb_core_api') + + if ( l_ascending_grid ) then + + ! CLUBB is to be run in ascending mode, which has the surface at k=1, which is + ! the opposite of the cam grid that the rest of clubb_intr uses, so + ! we need to flip the fields (in the vertical dimensions) before calling advance_clubb_core + ! + ! NOTE: We do not neccesarily flip all arrays, only ones that are used within this + ! subroutine (clubb_tend_cam). For example, only the pdf_params fields that + ! are used within this subroutine (or used in a subroutine we call) need to + ! be flipped. + + thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) + rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) + um_forcing = um_forcing(:,nzt_clubb:1:-1) + vm_forcing = vm_forcing(:,nzt_clubb:1:-1) + wm_zt = wm_zt(:,nzt_clubb:1:-1) + rho_zt = rho_zt(:,nzt_clubb:1:-1) + rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) + invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) + thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) + khzt_out = khzt_out(:,nzt_clubb:1:-1) + rtm_ref = rtm_ref(:,nzt_clubb:1:-1) + thlm_ref = thlm_ref(:,nzt_clubb:1:-1) + um_ref = um_ref(:,nzt_clubb:1:-1) + vm_ref = vm_ref(:,nzt_clubb:1:-1) + ug = ug(:,nzt_clubb:1:-1) + vg = vg(:,nzt_clubb:1:-1) + p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) + exner = exner(:,nzt_clubb:1:-1) + rfrzm = rfrzm(:,nzt_clubb:1:-1) + um_in = um_in(:,nzt_clubb:1:-1) + vm_in = vm_in(:,nzt_clubb:1:-1) + up3_in = up3_in(:,nzt_clubb:1:-1) + vp3_in = vp3_in(:,nzt_clubb:1:-1) + wp3_in = wp3_in(:,nzt_clubb:1:-1) + rtp3_in = rtp3_in(:,nzt_clubb:1:-1) + thlp3_in = thlp3_in(:,nzt_clubb:1:-1) + rcm_inout = rcm_inout(:,nzt_clubb:1:-1) + cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) + wpup2_inout = wpup2_inout(:,nzt_clubb:1:-1) + wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) + wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) + wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) + qclvar_out = qclvar_out(:,nzt_clubb:1:-1) + cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) + w_up_in_cloud_out = w_up_in_cloud_out(:,nzt_clubb:1:-1) + w_down_in_cloud_out = w_down_in_cloud_out(:,nzt_clubb:1:-1) + cloudy_updraft_frac_out = cloudy_updraft_frac_out(:,nzt_clubb:1:-1) + cloudy_downdraft_frac_out = cloudy_downdraft_frac_out(:,nzt_clubb:1:-1) + rcm_in_layer_out = rcm_in_layer_out(:,nzt_clubb:1:-1) + ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) + um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) + vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) + wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) + rtm_in = rtm_in(:,nzt_clubb:1:-1) + thlm_in = thlm_in(:,nzt_clubb:1:-1) + Lscale = Lscale(:,nzt_clubb:1:-1) + + wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) + wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) + rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) + thlp2_forcing = thlp2_forcing(:,nzm_clubb:1:-1) + rtpthlp_forcing = rtpthlp_forcing(:,nzm_clubb:1:-1) + wm_zm = wm_zm(:,nzm_clubb:1:-1) + rho_zm = rho_zm(:,nzm_clubb:1:-1) + rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) + invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) + thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) + upwp_in = upwp_in(:,nzm_clubb:1:-1) + vpwp_in = vpwp_in(:,nzm_clubb:1:-1) + up2_in = up2_in(:,nzm_clubb:1:-1) + vp2_in = vp2_in(:,nzm_clubb:1:-1) + wprtp_in = wprtp_in(:,nzm_clubb:1:-1) + wpthlp_in = wpthlp_in(:,nzm_clubb:1:-1) + wp2_in = wp2_in(:,nzm_clubb:1:-1) + rtp2_in = rtp2_in(:,nzm_clubb:1:-1) + thlp2_in = thlp2_in(:,nzm_clubb:1:-1) + rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) + wpthvp_in = wpthvp_in(:,nzm_clubb:1:-1) + rtpthvp_in = rtpthvp_in(:,nzm_clubb:1:-1) + thlpthvp_in = thlpthvp_in(:,nzm_clubb:1:-1) + uprcp_inout = uprcp_inout(:,nzm_clubb:1:-1) + vprcp_inout = vprcp_inout(:,nzm_clubb:1:-1) + rc_coef_zm_inout = rc_coef_zm_inout(:,nzm_clubb:1:-1) + wp4_inout = wp4_inout(:,nzm_clubb:1:-1) + wp2up2_inout = wp2up2_inout(:,nzm_clubb:1:-1) + wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) + upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) + vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) + khzm_out = khzm_out(:,nzm_clubb:1:-1) + thlprcp_out = thlprcp_out(:,nzm_clubb:1:-1) + wprcp_out = wprcp_out(:,nzm_clubb:1:-1) + invrs_tau_zm_out = invrs_tau_zm_out(:,nzm_clubb:1:-1) + + if ( edsclr_dim > 0 ) then + edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) + edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) + end if + + if ( sclr_dim > 0 ) then + + sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) + sclrm = sclrm(:,nzt_clubb:1:-1,:) + sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) + + sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) + sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) + sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) + wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) + sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) + end if + + pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + + pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) + + pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) + + pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) + + if ( t == 1 ) then + + ! we are in ascending mode, need to calculate ascending grid + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + l_ascending_grid, grid_type, & ! intent(in) + deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) + zi_g(:,nzm_clubb:1:-1), zt_g(:,nzt_clubb:1:-1), & ! intent(in) + gr_a, err_info ) ! intent(inout) + end if + else + + if ( t == 1 ) then + ! not in ascending mode, so we calculate gr_a the same as gr + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + l_ascending_grid, grid_type, & ! intent(in) + deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr_a, err_info ) ! intent(inout) + end if + + end if + + call advance_clubb_core_api( gr_a, nzm_clubb, nzt_clubb, ncol, & l_implemented, dtime, fcor, sfc_elevation, & hydromet_dim, & @@ -3987,6 +4099,139 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out, & Lscale ) + + + if ( l_ascending_grid ) then + + ! If running in ascending mode, we flip the arrays before calling advance_clubb_core + ! so we need to flip them back. This section should flip every array that was flipped + ! before the advance_clubb_core call. + + thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) + rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) + um_forcing = um_forcing(:,nzt_clubb:1:-1) + vm_forcing = vm_forcing(:,nzt_clubb:1:-1) + wm_zt = wm_zt(:,nzt_clubb:1:-1) + rho_zt = rho_zt(:,nzt_clubb:1:-1) + rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) + invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) + thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) + khzt_out = khzt_out(:,nzt_clubb:1:-1) + rtm_ref = rtm_ref(:,nzt_clubb:1:-1) + thlm_ref = thlm_ref(:,nzt_clubb:1:-1) + um_ref = um_ref(:,nzt_clubb:1:-1) + vm_ref = vm_ref(:,nzt_clubb:1:-1) + ug = ug(:,nzt_clubb:1:-1) + vg = vg(:,nzt_clubb:1:-1) + p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) + exner = exner(:,nzt_clubb:1:-1) + rfrzm = rfrzm(:,nzt_clubb:1:-1) + um_in = um_in(:,nzt_clubb:1:-1) + vm_in = vm_in(:,nzt_clubb:1:-1) + up3_in = up3_in(:,nzt_clubb:1:-1) + vp3_in = vp3_in(:,nzt_clubb:1:-1) + wp3_in = wp3_in(:,nzt_clubb:1:-1) + rtp3_in = rtp3_in(:,nzt_clubb:1:-1) + thlp3_in = thlp3_in(:,nzt_clubb:1:-1) + rcm_inout = rcm_inout(:,nzt_clubb:1:-1) + cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) + wpup2_inout = wpup2_inout(:,nzt_clubb:1:-1) + wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) + wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) + wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) + qclvar_out = qclvar_out(:,nzt_clubb:1:-1) + cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) + w_up_in_cloud_out = w_up_in_cloud_out(:,nzt_clubb:1:-1) + w_down_in_cloud_out = w_down_in_cloud_out(:,nzt_clubb:1:-1) + cloudy_updraft_frac_out = cloudy_updraft_frac_out(:,nzt_clubb:1:-1) + cloudy_downdraft_frac_out = cloudy_downdraft_frac_out(:,nzt_clubb:1:-1) + rcm_in_layer_out = rcm_in_layer_out(:,nzt_clubb:1:-1) + ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) + um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) + vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) + wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) + rtm_in = rtm_in(:,nzt_clubb:1:-1) + thlm_in = thlm_in(:,nzt_clubb:1:-1) + Lscale = Lscale(:,nzt_clubb:1:-1) + + wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) + wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) + rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) + thlp2_forcing = thlp2_forcing(:,nzm_clubb:1:-1) + rtpthlp_forcing = rtpthlp_forcing(:,nzm_clubb:1:-1) + wm_zm = wm_zm(:,nzm_clubb:1:-1) + rho_zm = rho_zm(:,nzm_clubb:1:-1) + rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) + invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) + thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) + upwp_in = upwp_in(:,nzm_clubb:1:-1) + vpwp_in = vpwp_in(:,nzm_clubb:1:-1) + up2_in = up2_in(:,nzm_clubb:1:-1) + vp2_in = vp2_in(:,nzm_clubb:1:-1) + wprtp_in = wprtp_in(:,nzm_clubb:1:-1) + wpthlp_in = wpthlp_in(:,nzm_clubb:1:-1) + wp2_in = wp2_in(:,nzm_clubb:1:-1) + rtp2_in = rtp2_in(:,nzm_clubb:1:-1) + thlp2_in = thlp2_in(:,nzm_clubb:1:-1) + rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) + wpthvp_in = wpthvp_in(:,nzm_clubb:1:-1) + rtpthvp_in = rtpthvp_in(:,nzm_clubb:1:-1) + thlpthvp_in = thlpthvp_in(:,nzm_clubb:1:-1) + uprcp_inout = uprcp_inout(:,nzm_clubb:1:-1) + vprcp_inout = vprcp_inout(:,nzm_clubb:1:-1) + rc_coef_zm_inout = rc_coef_zm_inout(:,nzm_clubb:1:-1) + wp4_inout = wp4_inout(:,nzm_clubb:1:-1) + wp2up2_inout = wp2up2_inout(:,nzm_clubb:1:-1) + wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) + upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) + vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) + khzm_out = khzm_out(:,nzm_clubb:1:-1) + thlprcp_out = thlprcp_out(:,nzm_clubb:1:-1) + wprcp_out = wprcp_out(:,nzm_clubb:1:-1) + invrs_tau_zm_out = invrs_tau_zm_out(:,nzm_clubb:1:-1) + + if ( edsclr_dim > 0 ) then + edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) + edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) + end if + + if ( sclr_dim > 0 ) then + + sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) + sclrm = sclrm(:,nzt_clubb:1:-1,:) + sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) + + sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) + sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) + sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) + wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) + sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) + end if + + pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + + pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) + + pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) + + pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) + + end if + call t_stopf('clubb_tend_cam:advance_clubb_core_api') ! Note that CLUBB does not produce an error code specific to any column, and @@ -3997,6 +4242,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if if ( do_rainturb ) then + call t_startf('clubb_tend_cam:do_rainturb') do k=1,nzt_clubb @@ -4005,7 +4251,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - call update_xp2_mc_api( gr_a, nzm_clubb, nzt_clubb, ncol, dtime, cloud_frac_inout, & + call update_xp2_mc_api( gr, nzm_clubb, nzt_clubb, ncol, dtime, cloud_frac_inout, & rcm_inout, rvm_in, thlm_in, wm_zt, & exner, pre_in, pdf_params_chnk(lchnk), & rtp2_mc_out, thlp2_mc_out, & @@ -4025,14 +4271,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do call t_stopf('clubb_tend_cam:do_rainturb') + end if if (do_cldcool) then + call t_startf('clubb_tend_cam:do_cldcool') thlp2_rad_out(:,:) = 0._r8 - call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr_a, & + call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr, & rcm_inout, thlprcp_out, qrl_clubb, clubb_params, & thlp2_rad_out ) @@ -4041,6 +4289,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) + thlp2_rad_out(i,k) * dtime ) end do end do + call t_stopf('clubb_tend_cam:do_cldcool') end if @@ -4059,78 +4308,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo ! end time loop call t_startf('clubb_tend_cam:flip-index') - if ( l_ascending_grid ) then - - thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) - - um_in = um_in(:,nzt_clubb:1:-1) - vm_in = vm_in(:,nzt_clubb:1:-1) - wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) - up3_in = up3_in(:,nzt_clubb:1:-1) - vp3_in = vp3_in(:,nzt_clubb:1:-1) - thlm_in = thlm_in(:,nzt_clubb:1:-1) - rtm_in = rtm_in(:,nzt_clubb:1:-1) - wp3_in = wp3_in(:,nzt_clubb:1:-1) - rtp3_in = rtp3_in(:,nzt_clubb:1:-1) - thlp3_in = thlp3_in(:,nzt_clubb:1:-1) - rcm_inout = rcm_inout(:,nzt_clubb:1:-1) - cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) - rcm_in_layer_out = rcm_in_layer_out(:,nzt_clubb:1:-1) - cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) - zt_g = zt_g(:,nzt_clubb:1:-1) - wm_zt = wm_zt(:,nzt_clubb:1:-1) - wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) - wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) - wpup2_inout = wpup2_inout(:,nzt_clubb:1:-1) - wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) - ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) - qclvar_out = qclvar_out(:,nzt_clubb:1:-1) - rtp2_zt = rtp2_zt(:,nzt_clubb:1:-1) - thl2_zt = thl2_zt(:,nzt_clubb:1:-1) - wp2_zt = wp2_zt(:,nzt_clubb:1:-1) - - upwp_in = upwp_in(:,nzm_clubb:1:-1) - vpwp_in = vpwp_in(:,nzm_clubb:1:-1) - wpthvp_in = wpthvp_in(:,nzm_clubb:1:-1) - rtpthvp_in = rtpthvp_in(:,nzm_clubb:1:-1) - thlpthvp_in = thlpthvp_in(:,nzm_clubb:1:-1) - up2_in = up2_in(:,nzm_clubb:1:-1) - vp2_in = vp2_in(:,nzm_clubb:1:-1) - wprtp_in = wprtp_in(:,nzm_clubb:1:-1) - wpthlp_in = wpthlp_in(:,nzm_clubb:1:-1) - wp2_in = wp2_in(:,nzm_clubb:1:-1) - rtp2_in = rtp2_in(:,nzm_clubb:1:-1) - thlp2_in = thlp2_in(:,nzm_clubb:1:-1) - rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) - wprcp_out = wprcp_out(:,nzm_clubb:1:-1) - - pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac(:,nzm_clubb:1:-1) - - pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) - - - zi_g = zi_g(:,nzm_clubb:1:-1) - khzm_out = khzm_out(:,nzm_clubb:1:-1) - uprcp_inout = uprcp_inout(:,nzm_clubb:1:-1) - vprcp_inout = vprcp_inout(:,nzm_clubb:1:-1) - rc_coef_zm_inout = rc_coef_zm_inout(:,nzm_clubb:1:-1) - wp4_inout = wp4_inout(:,nzm_clubb:1:-1) - wp2up2_inout = wp2up2_inout(:,nzm_clubb:1:-1) - wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) - - if ( edsclr_dim > 0 ) then - edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) - end if - - end if if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then @@ -4166,7 +4343,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzt_clubb do i=1, ncol - !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k um(i,k_cam) = um_in(i,k) vm(i,k_cam) = vm_in(i,k) @@ -4200,7 +4376,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzm_clubb do i=1, ncol - !k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k upwp(i,k_cam) = upwp_in(i,k) vpwp(i,k_cam) = vpwp_in(i,k) @@ -4238,7 +4413,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do ixind=1,edsclr_dim do k=1, nzt_clubb do i=1, ncol - !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k edsclr_out(i,k_cam,ixind) = edsclr_in(i,k,ixind) end do @@ -4250,7 +4424,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then do k=1, nzm_clubb do i=1, ncol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k mf_dry_a_output(i,k_cam) = mf_dry_a(i,k) mf_moist_a_output(i,k_cam) = mf_moist_a(i,k) mf_dry_w_output(i,k_cam) = mf_dry_w(i,k) @@ -4289,7 +4463,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & * pdf_params_chnk(lchnk)%rt_2(i,k) - !k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir k_cam = top_lev - 1 + k pdfp_rtp2(i,k_cam) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & @@ -5807,7 +5980,7 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st ! Local Variables - integer :: i, k, k_cam + integer :: i, k logical :: l_error ! Check if it is time to write to file @@ -5833,34 +6006,62 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st ! in the vertical level to be the same as CAM output. do i = 1, stats_zt%num_output_fields do k = 1, stats_zt%kk - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir - out_zt(thecol,k_cam,i) = stats_zt%accum_field_values(1,1,k,i) + + ! The data stored in stats types are ascending if l_ascending_grid = .true. + if ( l_ascending_grid ) then + out_zt(thecol,pver+1-k,i) = stats_zt%accum_field_values(1,1,k,i) + else + out_zt(thecol,top_lev-1+k,i) = stats_zt%accum_field_values(1,1,k,i) + end if + if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8 + enddo enddo do i = 1, stats_zm%num_output_fields do k = 1, stats_zm%kk - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir - out_zm(thecol,k_cam,i) = stats_zm%accum_field_values(1,1,k,i) + + ! The data stored in stats types are ascending if l_ascending_grid = .true. + if ( l_ascending_grid ) then + out_zm(thecol,pverp+1-k,i) = stats_zm%accum_field_values(1,1,k,i) + else + out_zm(thecol,top_lev-1+k,i) = stats_zm%accum_field_values(1,1,k,i) + end if + if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8 + enddo enddo if (stats_metadata%l_output_rad_files) then do i = 1, stats_rad_zt%num_output_fields do k = 1, stats_rad_zt%kk - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir - out_radzt(thecol,k_cam,i) = stats_rad_zt%accum_field_values(1,1,k,i) + + ! The data stored in stats types are ascending if l_ascending_grid = .true. + if ( l_ascending_grid ) then + out_radzt(thecol,pver+1-k,i) = stats_rad_zt%accum_field_values(1,1,k,i) + else + out_radzt(thecol,top_lev-1+k,i) = stats_rad_zt%accum_field_values(1,1,k,i) + end if + if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8 + enddo enddo do i = 1, stats_rad_zm%num_output_fields do k = 1, stats_rad_zm%kk - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir - out_radzm(thecol,k_cam,i) = stats_rad_zm%accum_field_values(1,1,k,i) + + ! The data stored in stats types are ascending if l_ascending_grid = .true. + if ( l_ascending_grid ) then + out_radzm(thecol,pverp+1-k,i) = stats_rad_zm%accum_field_values(1,1,k,i) + else + out_radzm(thecol,top_lev-1+k,i) = stats_rad_zm%accum_field_values(1,1,k,i) + end if + if(is_nan(out_radzm(thecol,k,i))) out_radzm(thecol,k,i) = 0.0_r8 + enddo enddo From 2fb2ba9bd6b1ec5e5c60039f90d0c1020663d0c9 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Fri, 21 Nov 2025 00:15:12 -0600 Subject: [PATCH 10/29] Made silhs work in descending mode, though it is not BFB with the ascending mode, even though there is no notion of ascending in it. There must be some bug with the flipper perhaps? Otherwise an internal interaction between clubb and silhs somehow, it's very upsetting, but I think it's time to give up and come back to it someday. --- src/physics/cam/clubb_intr.F90 | 150 ++++++------ src/physics/cam/subcol_SILHS.F90 | 399 +++++++++++++++++-------------- 2 files changed, 301 insertions(+), 248 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 79993b8b2c..bdbb4d029f 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -63,22 +63,13 @@ module clubb_intr sclr_idx logical, public, parameter :: & - l_ascending_grid = .true. ! Set clubb to ascending mode, which is opposite of the + l_ascending_grid = .false. ! Set clubb to ascending mode, which is opposite of the ! cam grid the rest of this code uses, thus it requires ! an expensive array flipping step before calling clubb - integer :: & - clubb_grid_dir - integer :: & nzm_clubb, & ! Number of vertical levels used by CLUBB momentum variables - nzt_clubb, & ! Number of vertical levels used by CLUBB thermodynamic variables - k1_clubb_in_cam_zm, & - k1_clubb_in_cam_zt, & - k_sfc_zm, & - k_sfc_zt, & - k_top_zm, & - k_top_zt + nzt_clubb ! Number of vertical levels used by CLUBB thermodynamic variables #endif @@ -97,15 +88,8 @@ module clubb_intr stats_zt, stats_zm, stats_sfc, & stats_rad_zt, stats_rad_zm, & stats_end_timestep_clubb, & - clubb_grid_dir, & nzm_clubb, & - nzt_clubb, & - k1_clubb_in_cam_zm, & - k1_clubb_in_cam_zt, & - k_sfc_zm, & - k_sfc_zt, & - k_top_zm, & - k_top_zt, & + nzt_clubb, & #endif clubb_readnl, & clubb_init_cnst, & @@ -531,7 +515,7 @@ module clubb_intr logical :: do_cnst=.false. #ifdef CLUBB_SGS - type(pdf_parameter), target, allocatable, public, protected :: & + type(pdf_parameter), target, allocatable, public :: & pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] @@ -1585,28 +1569,6 @@ subroutine clubb_ini_cam(pbuf2d) nzt_clubb = pver + 1 - top_lev nzm_clubb = pverp + 1 - top_lev - if ( l_ascending_grid ) then - ! if we are in ascending grid mode, then we start filling the clubb arrays with the - ! surface values (pverp for zm or pverp for zt) because they need to be flipped - k1_clubb_in_cam_zm = pverp - k1_clubb_in_cam_zt = pver - k_sfc_zm = 1 - k_sfc_zt = 1 - k_top_zm = nzm_clubb - k_top_zt = nzt_clubb - clubb_grid_dir = 1 - else - ! if we are in descending grid mode, then we start filling the clubb arrays with the - ! top level values (top_lev), because this is the maximum level clubb considers - k1_clubb_in_cam_zm = top_lev - k1_clubb_in_cam_zt = top_lev - k_sfc_zm = nzm_clubb - k_sfc_zt = nzt_clubb - k_top_zm = 1 - k_top_zt = 1 - clubb_grid_dir = -1 - end if - ! Allocate PDF parameters across columns and chunks allocate( & pdf_params_chnk(begchunk:endchunk), & @@ -3479,28 +3441,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !--- TODO: should these be all always zero if we aren't using SILHS? wrap in ifdef SILHS maybe? ! Add forcings for SILHS covariance contributions - ! rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt ) - ! thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt ) - ! wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt ) - ! wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt ) - ! rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt ) - - ! ! Zero out SILHS covariance contribution terms - ! !$acc parallel loop gang vector collapse(2) default(present) - ! do k = 1, pver - ! do i = 1, pcols - ! rtp2_mc_zt(i,k) = 0.0_r8 - ! thlp2_mc_zt(i,k) = 0.0_r8 - ! wprtp_mc_zt(i,k) = 0.0_r8 - ! wpthlp_mc_zt(i,k) = 0.0_r8 - ! rtpthlp_mc_zt(i,k) = 0.0_r8 - ! end do - ! end do - rtp2_forcing = 0._r8 - thlp2_forcing = 0._r8 - wprtp_forcing = 0._r8 - wpthlp_forcing = 0._r8 - rtpthlp_forcing = 0._r8 + rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt(1:ncol,top_lev:pver) ) + thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt(1:ncol,top_lev:pver) ) + wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt(1:ncol,top_lev:pver) ) + wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt(1:ncol,top_lev:pver) ) + rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt(1:ncol,top_lev:pver) ) + + ! Zero out SILHS covariance contribution terms + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, pver + do i = 1, pcols + rtp2_mc_zt(i,k) = 0.0_r8 + thlp2_mc_zt(i,k) = 0.0_r8 + wprtp_mc_zt(i,k) = 0.0_r8 + wpthlp_mc_zt(i,k) = 0.0_r8 + rtpthlp_mc_zt(i,k) = 0.0_r8 + end do + end do !-- END TODO ! Compute some inputs from the thermodynamic grid to the momentum grid @@ -4007,28 +3964,53 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) end if + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! only because these are need to be stored for restarts pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! only for pdfp_rtp2 calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) - - pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! only for update_xp2_mc_api call + pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) + ! These are flipped for silhs, which uses a cam grid + pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cloud_frac_1 = pdf_params_chnk(lchnk)%cloud_frac_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cloud_frac_2 = pdf_params_chnk(lchnk)%cloud_frac_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%chi_1 = pdf_params_chnk(lchnk)%chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%chi_2 = pdf_params_chnk(lchnk)%chi_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%stdev_chi_1 = pdf_params_chnk(lchnk)%stdev_chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%stdev_chi_2 = pdf_params_chnk(lchnk)%stdev_chi_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%crt_1 = pdf_params_chnk(lchnk)%crt_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%crt_2 = pdf_params_chnk(lchnk)%crt_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cthl_1 = pdf_params_chnk(lchnk)%cthl_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cthl_2 = pdf_params_chnk(lchnk)%cthl_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%ice_supersat_frac_1 = pdf_params_chnk(lchnk)%ice_supersat_frac_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%ice_supersat_frac_2 = pdf_params_chnk(lchnk)%ice_supersat_frac_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_chi_eta_1 = pdf_params_chnk(lchnk)%corr_chi_eta_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2 (:,nzt_clubb:1:-1) + if ( t == 1 ) then ! we are in ascending mode, need to calculate ascending grid @@ -4208,28 +4190,52 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) end if + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! only because these are need to be stored for restarts pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! only for pdfp_rtp2 calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! only for update_xp2_mc_api call pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) + ! These are flipped for silhs, which uses a cam grid + pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cloud_frac_1 = pdf_params_chnk(lchnk)%cloud_frac_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cloud_frac_2 = pdf_params_chnk(lchnk)%cloud_frac_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%chi_1 = pdf_params_chnk(lchnk)%chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%chi_2 = pdf_params_chnk(lchnk)%chi_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%stdev_chi_1 = pdf_params_chnk(lchnk)%stdev_chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%stdev_chi_2 = pdf_params_chnk(lchnk)%stdev_chi_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%crt_1 = pdf_params_chnk(lchnk)%crt_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%crt_2 = pdf_params_chnk(lchnk)%crt_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cthl_1 = pdf_params_chnk(lchnk)%cthl_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%cthl_2 = pdf_params_chnk(lchnk)%cthl_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%ice_supersat_frac_1 = pdf_params_chnk(lchnk)%ice_supersat_frac_1(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%ice_supersat_frac_2 = pdf_params_chnk(lchnk)%ice_supersat_frac_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_chi_eta_1 = pdf_params_chnk(lchnk)%corr_chi_eta_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2 (:,nzt_clubb:1:-1) end if call t_stopf('clubb_tend_cam:advance_clubb_core_api') diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 8429e3ecf1..477aa49f05 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -27,16 +27,8 @@ module subcol_SILHS hydromet_dim, & pdf_dim, & l_ascending_grid, & - clubb_grid_dir, & - nzm_clubb, & - nzt_clubb, & - k1_clubb_in_cam_zm, & - k1_clubb_in_cam_zt, & - k_sfc_zm, & - k_sfc_zt, & - k_top_zm, & - k_top_zt - + nzm_clubb, & + nzt_clubb use clubb_api_module, only: & hmp2_ip_on_hmm2_ip_slope_type, & @@ -850,7 +842,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) logical, parameter :: l_est_kessler_microphys = .false. logical, parameter :: l_outfld_subcol = .false. - type(grid) :: gr + type(grid) :: gr, gr_a type(precipitation_fractions) :: precip_fracs @@ -896,6 +888,10 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Determine num of columns and which chunk we're working on and what timestep ngrdcol = state%ngrdcol ncol = state%ncol + + print *, " ngrdcol = ", ngrdcol + print *, " ncol = ", ncol + lchnk = state%lchnk iter = get_nstep() ! #KTCtodo: The model iteration is passed into SILHS without taking ! substepping into account. I may need to change this in @@ -944,6 +940,10 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Initialize err_info with parallelization and geographical info call init_err_info_api(ncol, iam, lchnk, state%lat*rad2deg, state%lon*rad2deg, err_info) + + ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels + call init_precip_fracs_api( nzt_clubb, ngrdcol, & + precip_fracs ) !---------------- ! Copy state and populate numbers and values of sub-columns @@ -951,15 +951,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ztodt = ztodt_ptr(1) num_subcols = subcol_SILHS_numsubcol - ! The number of thermodynamic vertical grid levels used in CLUBB is pver, which is - ! originally set in the call to setup_clubb_core_api from subroutine clubb_ini_cam. - ! This is stored in CLUBB in the object gr%nzt. This isn't changed in CLUBB. - ! However, when SILHS is used, SILHS only uses pver - top_lev + 1 vertical grid - ! levels and also uses the gr%nzt object. The value of gr%nzt needs to be reset - ! for SILHS here and then set again for CLUBB in subroutine clubb_tend_cam. - gr%nzm = pverp - top_lev + 1 - gr%nzt = pver - top_lev + 1 - ! Calculate sample weights separately at all grid levels when ! radiation is not called l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs @@ -973,34 +964,32 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Define the CLUBB momentum grid (in height, units of m) do k = 1, nzm_clubb do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k zi_g(i,k) = state%zi(i,k_cam)-state%zi(i,pverp) end do end do - - + ! Define the CLUBB thermodynamic grid (in units of m) do k = 1, nzt_clubb do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir - zt_g(i,k) = state%zm(i,k_cam)-state%zi(i,pverp) + k_cam = top_lev - 1 + k + zt_g(i,k) = state%zm(i,k_cam) - state%zi(i,pverp) end do end do do i=1, ncol + ! Set the elevation of the surface - sfc_elevation(i) = state%zi(i,pver+1) - end do + sfc_elevation(i) = state%zi(i,pverp) - do i=1, ngrdcol - deltaz(i) = zi_g(i,2) - zi_g(i,1) + deltaz(i) = state%zi(i,pverp-1) - state%zi(i,pverp) end do ! Heights need to be set at each timestep. - call setup_grid_api( pverp+1-top_lev, ncol, sfc_elevation(1:ncol), l_implemented, & ! intent(in) - l_ascending_grid, grid_type, & - deltaz, zi_g(1:ncol,1), zi_g(1:ncol,pverp+1-top_lev), & ! intent(in) - zi_g(1:ncol,:), zt_g(1:ncol,:), & ! intent(in) + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + .false., grid_type, & + deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) + zi_g, zt_g, & ! intent(in) gr, err_info ) if ( any(err_info%err_code == clubb_fatal_error) ) then @@ -1008,18 +997,25 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) 'CAM subcol_gen_SILHS: Fatal error calling setup_grid_api') end if - ! Calculate the distance between grid levels on the host model grid, - ! using host model grid indices. do k = top_lev, pver do i = 1, ngrdcol + + ! Calculate the distance between grid levels on the host model grid, + ! using host model grid indices. dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) + + ! Calculate a clubb-specific exner function + ! (This is grid mean, as pressure levels do not change in + ! the subcolumn state) + invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) + end do end do ! Compute dry static density on CLUBB vertical grid do k = 1, nzt_clubb do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k rho_ds_zt(i,k) = (rga)*state%pdel(i,k_cam)/dz_g(i,k_cam) end do end do @@ -1027,7 +1023,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) do k = 1, nzt_clubb do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k ! Set up hydromet array, flipped from CAM vert grid to CLUBB if ( iirr > 0 ) then @@ -1079,7 +1075,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) do k = 1, nzt_clubb do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k Ncm(i,k) = state%q(i,k_cam,ixnumliq) @@ -1087,11 +1083,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ice_supersat_frac_in(i,k) = ice_supersat_frac(i,k_cam) cld_frac_in(i,k) = alst(i,k_cam) - - ! Calculate a clubb-specific exner function - ! (This is grid mean, as pressure levels do not change in - ! the subcolumn state) - invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS ! Compute Num concentration of cloud nuclei @@ -1106,14 +1097,74 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) do k = 1, nzm_clubb do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k khzm(i,k) = khzm_in(i,k_cam) + tke(i,k) = tke_in(i,k_cam) end do end do - - ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels - call init_precip_fracs_api( nzt_clubb, ngrdcol, & - precip_fracs ) + + + !======================================== ASCENDING MODE CODE ======================================== + + !---------------------------------- FLIPPING ---------------------------------- + ! ice_supersat_frac_in = ice_supersat_frac_in(:,nzt_clubb:1:-1) + ! cld_frac_in = cld_frac_in (:,nzt_clubb:1:-1) + ! Nc_in_cloud = Nc_in_cloud (:,nzt_clubb:1:-1) + + ! khzm = khzm (:,nzm_clubb:1:-1) + ! tke = tke (:,nzm_clubb:1:-1) + + ! if ( hydromet_dim > 0 ) then + ! hydromet = hydromet (:,nzt_clubb:1:-1,:) + ! end if + + + ! ! These need always be flipped, as they are always in descending mode + ! pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) + + ! pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) + + ! pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) + + ! if ( l_ascending_grid ) then + ! ! These only need flip these to descending mode + ! pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2(:,nzt_clubb:1:-1) + + ! pdf_params_chnk(lchnk)%cloud_frac_1 = pdf_params_chnk(lchnk)%cloud_frac_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%cloud_frac_2 = pdf_params_chnk(lchnk)%cloud_frac_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%chi_1 = pdf_params_chnk(lchnk)%chi_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%chi_2 = pdf_params_chnk(lchnk)%chi_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%stdev_chi_1 = pdf_params_chnk(lchnk)%stdev_chi_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%stdev_chi_2 = pdf_params_chnk(lchnk)%stdev_chi_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%crt_1 = pdf_params_chnk(lchnk)%crt_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%cthl_1 = pdf_params_chnk(lchnk)%cthl_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%crt_2 = pdf_params_chnk(lchnk)%crt_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%cthl_2 = pdf_params_chnk(lchnk)%cthl_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%ice_supersat_frac_1 = pdf_params_chnk(lchnk)%ice_supersat_frac_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%ice_supersat_frac_2 = pdf_params_chnk(lchnk)%ice_supersat_frac_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%corr_chi_eta_1 = pdf_params_chnk(lchnk)%corr_chi_eta_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2(:,nzt_clubb:1:-1) + ! end if + + ! zi_g = zi_g(:,nzm_clubb:1:-1) + ! zt_g = zt_g(:,nzt_clubb:1:-1) + + ! ! we are in ascending mode, need to calculate ascending grid + ! call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + ! .true., grid_type, & ! intent(in) + ! deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) + ! zi_g, zt_g, & ! intent(in) + ! gr_a, err_info ) ! intent(inout) + !---------------------------------- FLIPPING ---------------------------------- call setup_pdf_parameters_api( gr, nzm_clubb, nzt_clubb, ngrdcol, pdf_dim, & ! In hydromet_dim, ztodt, Nc_in_cloud, cld_frac_in, khzm, & ! In @@ -1162,25 +1213,15 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! resulting calculation of Lscale is also found on momentum levels. It ! needs to be interpolated back to thermodynamic (midpoint) grid levels ! for further use. - do k = 1, nzm_clubb - do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zm - ( k - 1 ) * clubb_grid_dir - tke(i,k) = tke_in(i,k_cam) - end do - end do - + do k = 1, nzm_clubb do i = 1, ngrdcol Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) end do end do - do k = 1, nzt_clubb - do i = 1, ngrdcol - Lscale(i,k) = Lscale_zm(i,k) + ( Lscale_zm(i,k+1) - Lscale_zm(i,k) ) & - * ( zt_g(i,k) - zi_g(i,k) ) / ( zi_g(i,k+1) - zi_g(i,k) ) - end do - end do + ! Interpolate to thermodynamic grid levels + Lscale = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, Lscale_zm ) do k = 1, nzt_clubb do i = 1, ngrdcol @@ -1241,49 +1282,105 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') end if - !------------------------------------------------------------------------- - ! Convert from CLUBB vertical grid to CAM grid - !------------------------------------------------------------------------ + !---------------------------------- FLIPPING ---------------------------------- + ! Flip to descending + ! lh_rt_clipped = lh_rt_clipped(:,:,nzt_clubb:1:-1) + ! lh_rc_clipped = lh_rc_clipped(:,:,nzt_clubb:1:-1) + ! lh_Nc_clipped = lh_Nc_clipped(:,:,nzt_clubb:1:-1) + ! lh_rv_clipped = lh_rv_clipped(:,:,nzt_clubb:1:-1) + ! lh_thl_clipped = lh_thl_clipped(:,:,nzt_clubb:1:-1) + + ! X_nl_all_levs = X_nl_all_levs(:,:,nzt_clubb:1:-1,:) + + ! lh_sample_point_weights = lh_sample_point_weights(:,:,nzt_clubb:1:-1) + + ! precip_fracs%precip_frac = precip_fracs%precip_frac(:,nzt_clubb:1:-1) + + ! ! These need always be flipped, as they are always in descending mode + ! pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) + + ! pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) + + ! pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) + + ! ! Flip these back to avoid making ascending clubb sad + ! pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2(:,nzt_clubb:1:-1) + + ! pdf_params_chnk(lchnk)%cloud_frac_1 = pdf_params_chnk(lchnk)%cloud_frac_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%cloud_frac_2 = pdf_params_chnk(lchnk)%cloud_frac_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%chi_1 = pdf_params_chnk(lchnk)%chi_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%chi_2 = pdf_params_chnk(lchnk)%chi_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%stdev_chi_1 = pdf_params_chnk(lchnk)%stdev_chi_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%stdev_chi_2 = pdf_params_chnk(lchnk)%stdev_chi_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%crt_1 = pdf_params_chnk(lchnk)%crt_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%crt_2 = pdf_params_chnk(lchnk)%crt_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%cthl_1 = pdf_params_chnk(lchnk)%cthl_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%cthl_2 = pdf_params_chnk(lchnk)%cthl_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%ice_supersat_frac_1 = pdf_params_chnk(lchnk)%ice_supersat_frac_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%ice_supersat_frac_2 = pdf_params_chnk(lchnk)%ice_supersat_frac_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%corr_chi_eta_1 = pdf_params_chnk(lchnk)%corr_chi_eta_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1(:,nzt_clubb:1:-1) + ! pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2(:,nzt_clubb:1:-1) + + ! Flip these that are never used... + ! if ( l_est_kessler_microphys ) then + ! AKm = AKm(:,nzt_clubb:1:-1) + ! lh_AKm = lh_AKm(:,nzt_clubb:1:-1) + ! end if + !---------------------------------- FLIPPING ---------------------------------- + + !======================================== END ASCENDING MODE CODE ======================================== + !$acc parallel loop collapse(3) default(present) - do k = top_lev, pver + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir - RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,k_cam) - RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,k_cam) - NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,k_cam) - RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,k_cam) - THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,k_cam) - - ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_ri) - NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_Ni) - RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_rr) - NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_Nr) - SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_rs) - NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_Ns) - WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,k_cam,iiPDF_w) - - OMEGA_lh_out( num_subcols*(i-1)+j,k ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k) & - * rho_ds_zt(i,k_cam) * gravit + k_cam = top_lev - 1 + k + RT_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_rt_clipped(i,j,k) + RCM_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_rc_clipped(i,j,k) + NCLW_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_Nc_clipped(i,j,k) + RVM_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_rv_clipped(i,j,k) + THL_lh_out( num_subcols*(i-1)+j,k_cam ) = lh_thl_clipped(i,j,k) + + ICE_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_ri) + NICE_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_Ni) + RAIN_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_rr) + NRAIN_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_Nr) + SNOW_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_rs) + NSNOW_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_Ns) + WM_lh_out( num_subcols*(i-1)+j,k_cam ) = X_nl_all_levs(i,j,k,iiPDF_w) + + OMEGA_lh_out( num_subcols*(i-1)+j,k_cam ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k_cam) & + * rho_ds_zt(i,k) * gravit end do end do end do if ( l_est_kessler_microphys ) then - do k = top_lev, pver + + do k = 1, nzt_clubb do j = 1, num_subcols do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir - AKm_out(i,k) = AKm(i,k_cam) - lh_AKm_out(i,k) = lh_AKm(i,k_cam) + k_cam = top_lev - 1 + k + AKm_out(i,k_cam) = AKm(i,k) + lh_AKm_out(i,k_cam) = lh_AKm(i,k) end do end do end do + end if ! Pack up weights - ! Using grid level 2 always won't work if weights vary with height. - call subcol_pack(lchnk, lh_sample_point_weights(:,:,2), weights ) + ! Using grid level nzt_clubb-1 (level above surface) won't always work if weights vary with height. + call subcol_pack(lchnk, lh_sample_point_weights(:,:,nzt_clubb-1), weights ) call subcol_set_weight(lchnk, weights) ! Constrain the sample distribution of cloud water and ice to the same mean @@ -1376,7 +1473,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !--------------------------------------------------- ! Code to update the state variables for interactive runs !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol @@ -1390,7 +1487,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end do !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol ! Vertical Velocity is not part of the energy conservation checks, but @@ -1405,7 +1502,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) @@ -1416,7 +1513,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (ixrain > 0) then !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) @@ -1427,7 +1524,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (ixsnow > 0) then !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) @@ -1438,7 +1535,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) else - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) @@ -1458,7 +1555,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) @@ -1469,7 +1566,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (ixnumrain > 0) then !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) @@ -1480,7 +1577,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (ixnumsnow > 0) then !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) @@ -1491,7 +1588,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) else - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) @@ -1509,7 +1606,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) endif !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) @@ -1526,7 +1623,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (ixnumrain > 0) then !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then @@ -1539,7 +1636,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) if (ixnumsnow > 0) then !$acc parallel loop collapse(3) default(present) - do k = 1, nzt_clubb + do k = top_lev, pver do j = 1, num_subcols do i = 1, ngrdcol if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then @@ -1556,19 +1653,19 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) do i = 1, ngrdcol do j = 1, num_subcols - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k ! Calc effective cloud fraction for testing - if ( ( lh_rc_clipped(i,j,k_cam) .gt. qsmall ) & - .or. ( X_nl_all_levs(i,j,k_cam,iiPDF_ri) .gt. qsmall ) ) then - eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,k_cam) + if ( ( lh_rc_clipped(i,j,k) .gt. qsmall ) & + .or. ( X_nl_all_levs(i,j,k,iiPDF_ri) .gt. qsmall ) ) then + eff_cldfrac(i,k_cam) = eff_cldfrac(i,k_cam) + lh_sample_point_weights(i,j,k) else - eff_cldfrac(i,k) = 0.0_r8 + eff_cldfrac(i,k_cam) = 0.0_r8 endif end do - eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) + eff_cldfrac(i,k_cam) = eff_cldfrac(i,k_cam)/real(num_subcols, kind=r8) end do end do @@ -1576,7 +1673,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Pack precip_frac for output do k = 1, nzt_clubb do i = 1, ngrdcol - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir + k_cam = top_lev - 1 + k precip_frac_out(i,k_cam) = precip_fracs%precip_frac(i,k) end do end do @@ -1599,12 +1696,15 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) + if ( l_est_kessler_microphys ) then call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) end if + call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) + if ( subcol_SILHS_constrainmn ) then call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) @@ -1615,6 +1715,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call outfld( 'SILHS_STDSC_Q', stdsc_vap, pcols, lchnk ) endif ! ixsnow > 0 endif ! subcol_SILHS_constrainmn + call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) @@ -1815,28 +1916,12 @@ subroutine subcol_SILHS_var_covar_driver & rc_all(igrdcol,isubcol,k) ) end do ! k = 1, pver - ! Flip inputs to CLUBB's grid. Note the dimension ordering change. - ! rt_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pver) ) - ! thl_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pver) ) - ! w_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pver) ) - ! qctend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pver) ) - ! qvtend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pver) ) - ! thltend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pver) ) - if ( l_ascending_grid ) then - rt_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pver) ) - thl_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pver) ) - w_all_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pver) ) - qctend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pver) ) - qvtend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pver) ) - thltend_clubb(igrdcol,isubcol,1:pver) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pver) ) - else ! descending grid rt_all_clubb(igrdcol,isubcol,1:pver) = rt_all(igrdcol,isubcol,1:pver) thl_all_clubb(igrdcol,isubcol,1:pver) = thl_all(igrdcol,isubcol,1:pver) w_all_clubb(igrdcol,isubcol,1:pver) = w_all(igrdcol,isubcol,1:pver) qctend_clubb(igrdcol,isubcol,1:pver) = qctend(igrdcol,isubcol,1:pver) qvtend_clubb(igrdcol,isubcol,1:pver) = qvtend(igrdcol,isubcol,1:pver) thltend_clubb(igrdcol,isubcol,1:pver) = thltend(igrdcol,isubcol,1:pver) - endif end do ! isubcol = 1, nsubcol(igrdcol) end do ! igrdcol = 1, ngrdcol @@ -1851,7 +1936,6 @@ subroutine subcol_SILHS_var_covar_driver & ! This code assumes that the weights are height independent. ! It will have to change once the weights vary with altitude! - ! I'm not sure whether the grid will need to be flipped. do k = 1, nzt_clubb height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) end do @@ -1866,31 +1950,28 @@ subroutine subcol_SILHS_var_covar_driver & call lh_microphys_var_covar_driver_api & ( nzt_clubb, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:nzt_clubb), & pdf_params_single_col, & - rt_all_clubb(igrdcol,1:ns,1:nzt_clubb), thl_all_clubb(igrdcol,1:ns,1:nzt_clubb), & - w_all_clubb(igrdcol,1:ns,1:nzt_clubb), qctend_clubb(igrdcol,1:ns,1:nzt_clubb), & - qvtend_clubb(igrdcol,1:ns,1:nzt_clubb), thltend_clubb(igrdcol,1:ns,1:nzt_clubb), & + rt_all_clubb(igrdcol,1:ns,top_lev:pver), thl_all_clubb(igrdcol,1:ns,top_lev:pver), & + w_all_clubb(igrdcol,1:ns,top_lev:pver), qctend_clubb(igrdcol,1:ns,top_lev:pver), & + qvtend_clubb(igrdcol,1:ns,top_lev:pver), thltend_clubb(igrdcol,1:ns,top_lev:pver), & silhs_config_flags%l_lh_instant_var_covar_src, & - rtp2_mc_zt(igrdcol,1:nzt_clubb), thlp2_mc_zt(igrdcol,1:nzt_clubb), & - wprtp_mc_zt(igrdcol,1:nzt_clubb), wpthlp_mc_zt(igrdcol,1:nzt_clubb), & - rtpthlp_mc_zt(igrdcol,1:nzt_clubb) ) + rtp2_mc_zt(igrdcol,top_lev:pver), thlp2_mc_zt(igrdcol,top_lev:pver), & + wprtp_mc_zt(igrdcol,top_lev:pver), wpthlp_mc_zt(igrdcol,top_lev:pver), & + rtpthlp_mc_zt(igrdcol,top_lev:pver) ) ! The *_mc_zt microphysics tendencies are passed out of SILHS and back ! to CLUBB without being used at all in the rest of the host model code. - ! The arrays aren't flipped for the *_mc_zt microphysics tendencies, and - ! they don't need to be. ! CLUBB used pver (thermodynamic) vertical levels, but SILHS only uses - ! pver - top_lev + 1 vertical levels. + ! nzt_clubb (pver-top_lev+1) vertical levels. ! Fill the upper levels with 0s when necessary. - if ( pver > nzt_clubb ) then - rtp2_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 - thlp2_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 - wprtp_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 - wpthlp_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 - rtpthlp_mc_zt(igrdcol,nzt_clubb+1:pver) = 0.0_r8 - endif ! pver > nzt_clubb - + rtp2_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 + thlp2_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 + wprtp_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 + wpthlp_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 + rtpthlp_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 + end do ! igrdcol = 1, ngrdcol + #endif #endif @@ -1976,40 +2057,6 @@ subroutine subcol_constrainmn( num_subcols, samples, weights, grid_mean, mean_sc end do end subroutine subcol_constrainmn - ! =============================================================================== ! - ! ! - ! =============================================================================== ! - function clubb_flip_grid ( profile ) result( profile_flipped ) - - ! Description: - ! Swaps the elements in profile so they are in reverse order. CAM and - ! CLUBB's grids are flipped with respect to each other. - ! - ! Usage: - ! clubb_var = clubb_flip_grid( cam_var ) - ! cam_var = clubb_flip_grid( clubb_var ) - - implicit none - - ! Input Variable - real(r8), dimension(pver), intent(in) :: profile - - ! Output Variable - real(r8), dimension(pver) :: profile_flipped - - ! Local Variable - integer :: k, k_cam - - do k=1, pver - k_cam = k1_clubb_in_cam_zt - ( k - 1 ) * clubb_grid_dir - profile_flipped(k) = profile(k_cam) - end do ! k=1, pver - - return - end function clubb_flip_grid - ! =============================================================================== ! - ! ! - ! =============================================================================== ! #endif !============================================================================ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) From bded8a561131e4dbbccad293f14226e5e8c0e856 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Sat, 22 Nov 2025 03:29:16 -0600 Subject: [PATCH 11/29] Mainly organization and some pbuf simplifications. No major redimensioning yet. All changes should be BFB, but a handful of field outputs are different above top_lev because I made it zero everything above top_lev. Among the fields that differ: some (RTM_CLUBB RTP2_CLUBB THLM_CLUBB UP2_CLUBB WP2_CLUBB) were being initiazed to a tolerance above top_lev, and others (THLP2_CLUBB RTP2_CLUBB UM_CLUBB VM_CLUBB) were never initialized or set above top_lev, so we were outputting random garbage. --- src/physics/cam/clubb_intr.F90 | 2058 ++++++++++++++++---------------- 1 file changed, 1012 insertions(+), 1046 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index bdbb4d029f..c55ea30a7d 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -450,7 +450,6 @@ module clubb_intr naai_idx, & ! ice number concentration prer_evap_idx, & ! rain evaporation rate qrl_idx, & ! longwave cooling rate - radf_idx, & qsatfac_idx, & ! subgrid cloud water saturation scaling factor ice_supersat_idx, & ! ice cloud fraction for SILHS rcm_idx, & ! Cloud water mixing ratio for SILHS @@ -573,6 +572,7 @@ subroutine clubb_register_cam( ) call cnst_add(trim(cnst_names(8)),0._r8,0._r8,0._r8,ixup2,longname='CLUBB 2nd moment u wind',cam_outfld=.false.) call cnst_add(trim(cnst_names(9)),0._r8,0._r8,0._r8,ixvp2,longname='CLUBB 2nd moment v wind',cam_outfld=.false.) end if + if (do_hb_above_clubb) then call pbuf_add_field('clubbtop', 'physpkg', dtype_i4, (/pcols/), clubbtop_idx) endif @@ -590,58 +590,51 @@ subroutine clubb_register_cam( ) call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) call pbuf_add_field('FICE', 'physpkg',dtype_r8, (/pcols,pver/), fice_idx) - call pbuf_add_field('RAD_CLUBB', 'global', dtype_r8, (/pcols,pver/), radf_idx) call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx) call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) + ! pbuf fields for Gravity Wave scheme + call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver/), ttend_clubb_idx) + call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx) + call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx) + call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx) + call pbuf_add_field('WPTHLP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_idx) + + - call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) - call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), wp3_idx) - call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wpthlp_idx) - call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wprtp_idx) - call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtpthlp_idx) - call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp2_idx) - call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp2_idx) - call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up2_idx) - call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx) - - call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), rtp3_idx) - call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), thlp3_idx) - call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), up3_idx) - call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), vp3_idx) - - call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), upwp_idx) - call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vpwp_idx) - call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), thlm_idx) - call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), rtm_idx) - call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), um_idx) - call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), vm_idx) + + ! For SILHS microphysical covariance contributions + call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pver/), rtp2_mc_zt_idx) + call pbuf_add_field('thlp2_mc_zt','global', dtype_r8, (/pcols,pver/), thlp2_mc_zt_idx) + call pbuf_add_field('wprtp_mc_zt','global', dtype_r8, (/pcols,pver/), wprtp_mc_zt_idx) + call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pver/), wpthlp_mc_zt_idx) + call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pver/), rtpthlp_mc_zt_idx) + + + ! Only in clubb_intr.F90, these are safe to dimensions (ngrdcol,nzm_clubb) or (ngrdcol,nzt_clubb) + call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_w_1_idx) + call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_w_2_idx) + call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_varnce_w_1_idx) + call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_varnce_w_2_idx) + call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_mixt_frac_idx) call pbuf_add_field('WPTHVP', 'global', dtype_r8, (/pcols,pverp/), wpthvp_idx) - call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,pver/), wp2thvp_idx) call pbuf_add_field('RTPTHVP', 'global', dtype_r8, (/pcols,pverp/), rtpthvp_idx) call pbuf_add_field('THLPTHVP', 'global', dtype_r8, (/pcols,pverp/), thlpthvp_idx) - call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pver/), cloud_frac_idx) - call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pver/), ice_supersat_idx) - call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pver/), rcm_idx) - call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) - call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pver/), wp2rtp_idx) - call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pver/), wp2thlp_idx) call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,pverp/), uprcp_idx) call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,pverp/), vprcp_idx) call pbuf_add_field('RC_COEF_ZM', 'global', dtype_r8, (/pcols,pverp/), rc_coef_zm_idx) call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,pverp/), wp4_idx) - call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pver/), wpup2_idx) - call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pver/), wpvp2_idx) call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,pverp/), wp2up2_idx) call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,pverp/), wp2vp2_idx) - ! pbuf fields for Gravity Wave scheme - call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver/), ttend_clubb_idx) - call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx) - call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx) - call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx) - call pbuf_add_field('WPTHLP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_idx) + call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp/), upwp_idx) + call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp/), vpwp_idx) + call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp/), wpthlp_idx) + call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,pverp/), wprtp_idx) + call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp/), rtpthlp_idx) + call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp/), rtp2_idx) + call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp/), thlp2_idx) call pbuf_add_field('TTEND_CLUBB_MC', 'physpkg', dtype_r8, (/pcols,pverp/), ttend_clubb_mc_idx) call pbuf_add_field('UPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_mc_idx) @@ -649,19 +642,44 @@ subroutine clubb_register_cam( ) call pbuf_add_field('THLP2_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_mc_idx) call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_mc_idx) - ! For SILHS microphysical covariance contributions - call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pver/), rtp2_mc_zt_idx) - call pbuf_add_field('thlp2_mc_zt','global', dtype_r8, (/pcols,pver/), thlp2_mc_zt_idx) - call pbuf_add_field('wprtp_mc_zt','global', dtype_r8, (/pcols,pver/), wprtp_mc_zt_idx) - call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pver/), wpthlp_mc_zt_idx) - call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pver/), rtpthlp_mc_zt_idx) + call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,pver/), wp2thvp_idx) + call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pver/), rcm_idx) + call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pver/), wp2rtp_idx) + call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pver/), wp2thlp_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pver/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pver/), wpvp2_idx) + + call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pver/), um_idx) + call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pver/), vm_idx) + call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pver/), rtp3_idx) + call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pver/), thlp3_idx) + call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,pver/), up3_idx) + call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,pver/), vp3_idx) + + ! Only in clubb_intr.F90 or SILHS + call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pver/), ice_supersat_idx) + call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) + call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pver/), thlm_idx) + call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pver/), rtm_idx) + - call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_1_idx) - call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_2_idx) - call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_1_idx) - call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_2_idx) - call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_mixt_frac_idx) + ! Things output + ! Only in clubb_intr.F90, these are safe to dimensions (ngrdcol,nzm_clubb) or (ngrdcol,nzt_clubb) + call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp/), up2_idx) + call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp/), vp2_idx) + call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pver/), wp3_idx) + + call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pver/), cloud_frac_idx) + + ! Only in clubb_intr.F90 or SILHS + + ! Used in clubb intr and microp_aero? + call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) + + + + #endif end subroutine clubb_register_cam @@ -1783,7 +1801,7 @@ subroutine clubb_ini_cam(pbuf2d) call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux', sampled_on_subcycle=.true.) call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance', sampled_on_subcycle=.true.) call addfld ('RTP2_ZT_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','Moisture Variance on zt grid', sampled_on_subcycle=.true.) - call addfld ('PDFP_RTP2_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','PDF Rtot Variance', sampled_on_subcycle=.true.) + call addfld ('pdfp_rtp2_output_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','PDF Rtot Variance', sampled_on_subcycle=.true.) call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance', sampled_on_subcycle=.true.) call addfld ('THLP2_ZT_CLUBB', (/ 'lev' /), 'A', 'K^2', 'Temperature Variance on zt grid', sampled_on_subcycle=.true.) call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance', sampled_on_subcycle=.true.) @@ -1919,7 +1937,7 @@ subroutine clubb_ini_cam(pbuf2d) call add_default('WPRTP_CLUBB', 1, ' ') call add_default('RTP2_CLUBB', 1, ' ') call add_default('RTP2_ZT_CLUBB', 1, ' ') - call add_default('PDFP_RTP2_CLUBB', 1, ' ') + call add_default('pdfp_rtp2_output_CLUBB', 1, ' ') call add_default('THLP2_CLUBB', 1, ' ') call add_default('THLP2_ZT_CLUBB', 1, ' ') call add_default('RTPTHLP_CLUBB', 1, ' ') @@ -2020,7 +2038,6 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, cloud_frac_idx, 0.0_r8) call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8) call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, radf_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wp2rtp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wp2thlp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, uprcp_idx, 0.0_r8) @@ -2181,6 +2198,95 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check + ! ---------------------------------------------------- ! + ! Pointers for pbuf ! + ! ---------------------------------------------------- ! + + real(r8), pointer, dimension(:,:) :: wp2_pbuf ! vertical velocity variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wp3_pbuf ! third moment of vertical velocity [m^3/s^3] + real(r8), pointer, dimension(:,:) :: wpthlp_pbuf ! turbulent flux of thetal [m/s K] + real(r8), pointer, dimension(:,:) :: wprtp_pbuf ! turbulent flux of moisture [m/s kg/kg] + real(r8), pointer, dimension(:,:) :: rtpthlp_pbuf ! covariance of thetal and qt [kg/kg K] + real(r8), pointer, dimension(:,:) :: rtp2_pbuf ! moisture variance [kg^2/kg^2] + real(r8), pointer, dimension(:,:) :: thlp2_pbuf ! temperature variance [K^2] + real(r8), pointer, dimension(:,:) :: rtp3_pbuf ! moisture 3rd order [kg^3/kg^3] + real(r8), pointer, dimension(:,:) :: thlp3_pbuf ! temperature 3rd order [K^3] + real(r8), pointer, dimension(:,:) :: up2_pbuf ! east-west wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vp2_pbuf ! north-south wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: up3_pbuf ! east-west wind 3rd order [m^3/s^3] + real(r8), pointer, dimension(:,:) :: vp3_pbuf ! north-south wind 3rd order [m^3/s^3] + real(r8), pointer, dimension(:,:) :: upwp_pbuf ! east-west momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vpwp_pbuf ! north-south momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wpthvp_pbuf ! w'th_v' (momentum levels) [m/s K] + real(r8), pointer, dimension(:,:) :: wp2thvp_pbuf ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] + real(r8), pointer, dimension(:,:) :: rtpthvp_pbuf ! r_t'th_v' (momentum levels) [kg/kg K] + real(r8), pointer, dimension(:,:) :: thlpthvp_pbuf ! th_l'th_v' (momentum levels) [K^2] + real(r8), pointer, dimension(:,:) :: cloud_frac_pbuf ! Cloud fraction (thermodynamic levels) [K^2] + real(r8), pointer, dimension(:,:) :: pdf_zm_w_1_pbuf !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_w_2_pbuf !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1_pbuf !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2_pbuf !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac_pbuf !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: wp2rtp_pbuf ! w'^2 rt' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2thlp_pbuf ! w'^2 thl' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: uprcp_pbuf ! < u' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: vprcp_pbuf ! < v' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: rc_coef_zm_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) + real(r8), pointer, dimension(:,:) :: wp4_pbuf ! w'^4 (momentum levels + real(r8), pointer, dimension(:,:) :: wpup2_pbuf ! w'u'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wpvp2_pbuf ! w'v'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2up2_pbuf ! w'^2 u'^2 (momentum levels) + real(r8), pointer, dimension(:,:) :: wp2vp2_pbuf ! w'^2 v'^2 (momentum levels) + real(r8), pointer, dimension(:,:) :: thlm_pbuf ! mean temperature [K] + real(r8), pointer, dimension(:,:) :: rtm_pbuf ! mean moisture mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: rcm_pbuf ! CLUBB cloud water mixing ratio [kg/kg] + real(r8), pointer, dimension(:) :: ztodtptr_pbuf ! timestep to send to SILHS + real(r8), pointer, dimension(:,:) :: um_pbuf ! mean east-west wind [m/s] + real(r8), pointer, dimension(:,:) :: vm_pbuf ! mean north-south wind [m/s] + real(r8), pointer, dimension(:,:) :: cld_pbuf ! cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: concld_pbuf ! convective cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: ast_pbuf ! stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: alst_pbuf ! liquid stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: aist_pbuf ! ice stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: qlst_pbuf ! Physical in-stratus LWC [kg/kg] + real(r8), pointer, dimension(:,:) :: qist_pbuf ! Physical in-stratus IWC [kg/kg] + real(r8), pointer, dimension(:,:) :: deepcu_pbuf ! deep convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: shalcu_pbuf ! shallow convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: khzm_pbuf ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + real(r8), pointer, dimension(:) :: pblh_pbuf ! planetary boundary layer height [m] + real(r8), pointer, dimension(:,:) :: tke_pbuf ! turbulent kinetic energy [m^2/s^2] + real(r8), pointer, dimension(:,:) :: dp_icwmr_pbuf ! deep convection in cloud mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: ice_supersat_frac_pbuf ! Cloud fraction of ice clouds (pver)[fraction] + real(r8), pointer, dimension(:,:) :: relvar_pbuf ! relative cloud water variance [-] + real(r8), pointer, dimension(:,:) :: accre_enhan_pbuf ! accretion enhancement factor [-] + real(r8), pointer, dimension(:,:) :: naai_pbuf + real(r8), pointer, dimension(:,:) :: cmeliq_pbuf + real(r8), pointer, dimension(:,:) :: cmfmc_sh_pbuf ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] + + real(r8), pointer, dimension(:,:) :: qsatfac_pbuf + real(r8), pointer, dimension(:,:) :: npccn_pbuf + real(r8), pointer, dimension(:,:) :: prer_evap_pbuf + real(r8), pointer, dimension(:,:) :: qrl_pbuf + + ! SILHS covariance contributions + real(r8), pointer, dimension(:,:) :: rtp2_mc_zt_pbuf + real(r8), pointer, dimension(:,:) :: thlp2_mc_zt_pbuf + real(r8), pointer, dimension(:,:) :: wprtp_mc_zt_pbuf + real(r8), pointer, dimension(:,:) :: wpthlp_mc_zt_pbuf + real(r8), pointer, dimension(:,:) :: rtpthlp_mc_zt_pbuf + + ! Connections to Gravity Wave parameterization + real(r8), pointer, dimension(:,:) :: ttend_clubb_pbuf + real(r8), pointer, dimension(:,:) :: upwp_clubb_gw_pbuf + real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw_pbuf + real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_pbuf + real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_pbuf + + real(r8), pointer, dimension(:,:) :: ttend_clubb_mc_pbuf + real(r8), pointer, dimension(:,:) :: upwp_clubb_gw_mc_pbuf + real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw_mc_pbuf + real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_mc_pbuf + real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc_pbuf ! ---------------------------------------------------- ! ! Local Variables ! @@ -2190,44 +2296,32 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef CLUBB_SGS - type(physics_state) :: state1 ! Local copy of state variable - type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all - - integer :: j, k, t, ixind, nadv - integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq - integer :: itim_old - integer :: ncol, lchnk ! # of columns, and chunk identifier - integer :: icnt - logical :: lq2(pcnst) + real(r8), parameter :: & + rad2deg=180.0_r8/pi - integer :: iter + character(len=*), parameter :: subr='clubb_tend_cam' - integer :: clubbtop(pcols) + type(physics_state) :: state1 ! Local copy of state variable + type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all type(err_info_type) :: & err_info ! err_info struct used in CLUBB containing err_code and err_header - real(r8) :: frac_limit, ic_limit - - real(r8) :: dtime ! CLUBB time step [s] - real(r8) :: zt_out(pcols,pver) ! output for the thermo CLUBB grid [m] - real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] - real(r8) :: ubar ! surface wind [m/s] - real(r8) :: ustar ! surface stress [m/s] - real(r8) :: z0 ! roughness height [m] - real(r8) :: bflx22(pcols) ! Variable for buoyancy flux for pbl [K m/s] - real(r8) :: qclvar(pcols,pver) ! cloud water variance [kg^2/kg^2] - real(r8) :: zo(pcols) ! roughness height [m] - real(r8) :: dz_g(pcols,pver) ! thickness of layer [m] - real(r8) :: relvarmax - real(r8) :: se_upper_a(pcols), se_upper_b(pcols), se_upper_diss(pcols) - real(r8) :: tw_upper_a(pcols), tw_upper_b(pcols), tw_upper_diss(pcols) + type(grid) :: & + gr, gr_a ! CLUBB grid data structure + + type(nu_vertical_res_dep) :: & + nu_vert_res_dep ! Vertical resolution dependent nu values + + real(r8), dimension(state%ncol,nparams) :: & + clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLES SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol) :: & + deltaz, & fcor, & ! Coriolis forcing [s^-1] - sfc_elevation, & ! Elevation of ground [m AMSL][m] + sfc_elevation, & ! Elevation of ground [m AMSL][m] wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s] wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)] upwp_sfc, & ! u'w' at surface [m^2/s^2] @@ -2265,7 +2359,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K] rfrzm, & - radf, & um_in, & ! meridional wind [m/s] vm_in, & ! zonal wind [m/s] up3_in, & ! meridional wind third-order [m^3/s^3] @@ -2290,7 +2383,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & w_down_in_cloud_out, & cloudy_updraft_frac_out, & cloudy_downdraft_frac_out,& - rcm_in_layer_out, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] + rcm_in_layer, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction] pre_in, & ! input for precip evaporation qrl_clubb, & @@ -2300,11 +2393,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpup2_inout, & ! w'u'^2 (thermodynamic levels) wpvp2_inout, & ! w'v'^2 (thermodynamic levels) zt_g, & ! Thermodynamic grid of CLUBB [m] - Lscale + Lscale, & + + ! MF local thermodynamic vars + invrs_dzt, & ! thermodynamic grid + invrs_exner_zt,& ! thermodynamic grid + kappa_zt, qc_zt ! thermodynamic grid ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLES SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzm_clubb) :: & + thlp2_rad, & wprtp_forcing, & wpthlp_forcing, & rtp2_forcing, & @@ -2345,7 +2444,26 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wp4_inout, & ! w'^4 (momentum levels wp2up2_inout, & ! w'^2 u'^2 (momentum levels) wp2vp2_inout, & ! w'^2 v'^2 (momentum levels) - zi_g ! Momentum grid of CLUBB [m] + zi_g, & ! Momentum grid of CLUBB [m] + + ! MF Plume + mf_dry_a, mf_moist_a, & + mf_dry_w, mf_moist_w, & + mf_dry_qt, mf_moist_qt, & + mf_dry_thl, mf_moist_thl, & + mf_dry_u, mf_moist_u, & + mf_dry_v, mf_moist_v, & + mf_moist_qc, & + s_ae, s_aw, & + s_awthl, s_awqt, & + s_awql, s_awqi, & + s_awu, s_awv, & + mf_thlflx, mf_qtflx, & + + ! MF local momentum vars + rtm_zm_in, thlm_zm_in, & ! momentum grid + kappa_zm, p_in_Pa_zm, & ! momentum grid + invrs_exner_zm ! momentum grid ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES @@ -2381,259 +2499,144 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,nzm_clubb,hydromet_dim) :: & wphydrometp - ! Variables below are needed to compute energy integrals for conservation - ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines - real(r8) :: te_a, se_a, ke_a, wv_a, wl_a - real(r8) :: te_b, se_b, ke_b, wv_b, wl_b - real(r8) :: se_dis(pcols), clubb_s(pcols,pver), eleak(pcols) - - real(r8) :: inv_exner_clubb(pcols,pver) ! Inverse exner function consistent with CLUBB [-] - real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2] - real(r8) :: wprtp_output(pcols,pverp) ! Total water flux output variable [W/m2] - real(r8) :: wp3_output(pcols,pver) ! wp3 output [m^3/s^3] - real(r8) :: rtpthlp_output(pcols,pverp) ! rtpthlp ouptut [K kg/kg] - real(r8) :: qt_output(pcols,pver) ! Total water mixing ratio for output [kg/kg] - real(r8) :: thetal_output(pcols,pver) ! Liquid water potential temperature output [K] - real(r8) :: sl_output(pcols,pver) ! Liquid water static energy [J/kg] - real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2] - real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3] - real(r8) :: thv(pcols,pver) ! virtual potential temperature [K] - real(r8) :: edsclr_out(pcols,pver,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] - real(r8) :: rcm_in_layer(pcols,pver) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] - real(r8) :: cloud_cover(pcols,pver) ! CLUBB in-cloud cloud fraction [fraction] - real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg] - real(r8) :: wpthvp_diag(pcols,pverp) ! CLUBB buoyancy flux [W/m^2] - real(r8) :: rvm(pcols,pver) - real(r8) :: pdfp_rtp2(pcols, pver) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] - real(r8) :: rtp2_zt_out(pcols, pver) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] - real(r8) :: thl2_zt_out(pcols, pver) ! CLUBB Theta-l variance on thermo levs - real(r8) :: wp2_zt_out(pcols, pver) - real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s] - real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s] - real(r8) :: wm_zt_out(pcols, pver) ! CLUBB mean W on thermo levs output [m/s] - real(r8) :: mean_rt ! Calculated R-tot mean from pdf_params (temp) [kg/kg] - real(r8) :: dlf2(pcols,pver) ! Detraining cld H20 from shallow convection [kg/kg/day] - real(r8) :: eps ! Rv/Rd [-] - real(r8) :: dum1 ! dummy variable [units vary] - real(r8) :: obklen(pcols) ! Obukov length [m] - real(r8) :: kbfs(pcols) ! Kinematic Surface heat flux [K m/s] - real(r8) :: th(pcols,pver) ! potential temperature [K] - real(r8) :: dummy2(pcols) ! dummy variable [units vary] - real(r8) :: dummy3(pcols) ! dummy variable [units vary] - real(r8) :: kinheat(pcols) ! Kinematic Surface heat flux [K m/s] - real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3] - real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s] - real(r8) :: latsub - real(r8) :: thlp2_rad_out(state%ncol,nzm_clubb) - real(r8) :: apply_const, rtm_test - real(r8) :: dl_rad, di_rad, dt_low - - character(len=200) :: temp1, sub ! Strings needed for CLUBB output - real(kind=time_precision) :: time_elapsed ! time keep track of stats [s] - integer :: stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] - - real(r8) :: rtm_integral_vtend(pcols), & - rtm_integral_ltend(pcols) - - - real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing - - ! ---------------------------------------------------- ! - ! Pointers ! - ! ---------------------------------------------------- ! - - real(r8), pointer, dimension(:,:) :: wp2 ! vertical velocity variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: wp3 ! third moment of vertical velocity [m^3/s^3] - real(r8), pointer, dimension(:,:) :: wpthlp ! turbulent flux of thetal [m/s K] - real(r8), pointer, dimension(:,:) :: wprtp ! turbulent flux of moisture [m/s kg/kg] - real(r8), pointer, dimension(:,:) :: rtpthlp ! covariance of thetal and qt [kg/kg K] - real(r8), pointer, dimension(:,:) :: rtp2 ! moisture variance [kg^2/kg^2] - real(r8), pointer, dimension(:,:) :: thlp2 ! temperature variance [K^2] - real(r8), pointer, dimension(:,:) :: rtp3 ! moisture 3rd order [kg^3/kg^3] - real(r8), pointer, dimension(:,:) :: thlp3 ! temperature 3rd order [K^3] - real(r8), pointer, dimension(:,:) :: up2 ! east-west wind variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: vp2 ! north-south wind variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: up3 ! east-west wind 3rd order [m^3/s^3] - real(r8), pointer, dimension(:,:) :: vp3 ! north-south wind 3rd order [m^3/s^3] - real(r8), pointer, dimension(:,:) :: upwp ! east-west momentum flux [m^2/s^2] - real(r8), pointer, dimension(:,:) :: vpwp ! north-south momentum flux [m^2/s^2] - real(r8), pointer, dimension(:,:) :: wpthvp ! w'th_v' (momentum levels) [m/s K] - real(r8), pointer, dimension(:,:) :: wp2thvp ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - real(r8), pointer, dimension(:,:) :: rtpthvp ! r_t'th_v' (momentum levels) [kg/kg K] - real(r8), pointer, dimension(:,:) :: thlpthvp ! th_l'th_v' (momentum levels) [K^2] - real(r8), pointer, dimension(:,:) :: cloud_frac ! Cloud fraction (thermodynamic levels) [K^2] - real(r8), pointer, dimension(:,:) :: pdf_zm_w_1 !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_w_2 !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1 !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2 !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: wp2rtp ! w'^2 rt' (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wp2thlp ! w'^2 thl' (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: uprcp ! < u' r_c' > (momentum levels) - real(r8), pointer, dimension(:,:) :: vprcp ! < v' r_c' > (momentum levels) - real(r8), pointer, dimension(:,:) :: rc_coef_zm ! Coef. of X'r_c' in Eq. (34) (t-levs.) - real(r8), pointer, dimension(:,:) :: wp4 ! w'^4 (momentum levels - real(r8), pointer, dimension(:,:) :: wpup2 ! w'u'^2 (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wpvp2 ! w'v'^2 (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wp2up2 ! w'^2 u'^2 (momentum levels) - real(r8), pointer, dimension(:,:) :: wp2vp2 ! w'^2 v'^2 (momentum levels) - real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K] - real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: rcm ! CLUBB cloud water mixing ratio [kg/kg] - real(r8), pointer, dimension(:) :: ztodtptr ! timestep to send to SILHS - real(r8), pointer, dimension(:,:) :: um ! mean east-west wind [m/s] - real(r8), pointer, dimension(:,:) :: vm ! mean north-south wind [m/s] - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: concld ! convective cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: ast ! stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: alst ! liquid stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: aist ! ice stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: qlst ! Physical in-stratus LWC [kg/kg] - real(r8), pointer, dimension(:,:) :: qist ! Physical in-stratus IWC [kg/kg] - real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: khzm ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] - real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m] - real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2] - real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! Cloud fraction of ice clouds (pver)[fraction] - real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-] - real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-] - real(r8), pointer, dimension(:,:) :: naai - real(r8), pointer, dimension(:,:) :: cmeliq - real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] - - real(r8), pointer, dimension(:,:) :: qsatfac - real(r8), pointer, dimension(:,:) :: npccn - real(r8), pointer, dimension(:,:) :: prer_evap - real(r8), pointer, dimension(:,:) :: qrl - real(r8), pointer, dimension(:,:) :: radf_clubb - - ! SILHS covariance contributions - real(r8), pointer, dimension(:,:) :: rtp2_mc_zt - real(r8), pointer, dimension(:,:) :: thlp2_mc_zt - real(r8), pointer, dimension(:,:) :: wprtp_mc_zt - real(r8), pointer, dimension(:,:) :: wpthlp_mc_zt - real(r8), pointer, dimension(:,:) :: rtpthlp_mc_zt - ! Connections to Gravity Wave parameterization - real(r8), pointer, dimension(:,:) :: ttend_clubb - real(r8), pointer, dimension(:,:) :: upwp_clubb_gw - real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw - real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw - real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw - - real(r8), pointer, dimension(:,:) :: ttend_clubb_mc - real(r8), pointer, dimension(:,:) :: upwp_clubb_gw_mc - real(r8), pointer, dimension(:,:) :: vpwp_clubb_gw_mc - real(r8), pointer, dimension(:,:) :: thlp2_clubb_gw_mc - real(r8), pointer, dimension(:,:) :: wpthlp_clubb_gw_mc - - - real(r8) qitend(pcols,pver) - real(r8) initend(pcols,pver) ! Needed for ice supersaturation adjustment calculation - - ! ZM microphysics - real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio. - real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen. - real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen. - - real(r8) :: stend(pcols,pver) - real(r8) :: qvtend(pcols,pver) - real(r8) :: qctend(pcols,pver) - real(r8) :: inctend(pcols,pver) - real(r8) :: fqtend(pcols,pver) - real(r8) :: rhmini(pcols) - real(r8) :: rhmaxi(pcols) - integer :: troplev(pcols) - logical :: lqice(pcnst) - logical :: apply_to_surface(pcols) - - ! MF outputs to outfld - ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines - real(r8), dimension(pcols,pverp) :: mf_dry_a_output, mf_moist_a_output, & - mf_dry_w_output, mf_moist_w_output, & - mf_dry_qt_output, mf_moist_qt_output, & - mf_dry_thl_output, mf_moist_thl_output, & - mf_dry_u_output, mf_moist_u_output, & - mf_dry_v_output, mf_moist_v_output, & - mf_moist_qc_output, & - s_ae_output, s_aw_output, & - s_awthl_output, s_awqt_output, & - s_awql_output, s_awqi_output, & - s_awu_output, s_awv_output, & - mf_thlflx_output, mf_qtflx_output - ! MF Plume - ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines - real(r8), dimension(state%ncol,nzm_clubb) :: mf_dry_a, mf_moist_a, & - mf_dry_w, mf_moist_w, & - mf_dry_qt, mf_moist_qt, & - mf_dry_thl, mf_moist_thl, & - mf_dry_u, mf_moist_u, & - mf_dry_v, mf_moist_v, & - mf_moist_qc, & - s_ae, s_aw, & - s_awthl, s_awqt, & - s_awql, s_awqi, & - s_awu, s_awv, & - mf_thlflx, mf_qtflx - - real(r8) :: inv_rh2o ! To reduce the number of divisions in clubb_tend - - ! MF local vars - real(r8), dimension(state%ncol,nzm_clubb) :: rtm_zm_in, thlm_zm_in, & ! momentum grid - kappa_zm, p_in_Pa_zm, & ! momentum grid - invrs_exner_zm ! momentum grid - - real(r8), dimension(state%ncol,nzt_clubb) :: dzt, invrs_dzt, & ! thermodynamic grid - invrs_exner_zt,& ! thermodynamic grid - kappa_zt, qc_zt ! thermodynamic grid - - real(r8) :: temp2d(pcols,pver) ! temporary array for holding scaled outputs - - real(r8), dimension(state%ncol) :: deltaz + ! Variables used for output (zm) + real(r8), dimension(pcols,pverp) :: & + zi_output, & ! output for momentum CLUBB grid [m] + wpthlp_output, & ! Heat flux output variable [W/m2] + rtpthlp_output, & ! rtpthlp ouptut [K kg/kg] + wprtp_output, & ! Total water flux output variable [W/m2] + wp2_output, & + up2_output, & + vp2_output, & + upwp_output, & + vpwp_output, & + rtp2_output, & + wprcp_clubb_output, & + wpthvp_clubb_output, & + thlp2_output, & + dlf_liq_out, & ! Detrained liquid water from ZM [kg/kg/s] + dlf_ice_out, & ! Detrained ice water from ZM [kg/kg/s] + + ! MF outputs to outfld + ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines + mf_dry_a_output, mf_moist_a_output, & + mf_dry_w_output, mf_moist_w_output, & + mf_dry_qt_output, mf_moist_qt_output, & + mf_dry_thl_output, mf_moist_thl_output, & + mf_dry_u_output, mf_moist_u_output, & + mf_dry_v_output, mf_moist_v_output, & + mf_moist_qc_output, & + s_ae_output, s_aw_output, & + s_awthl_output, s_awqt_output, & + s_awql_output, s_awqi_output, & + s_awu_output, s_awv_output, & + mf_thlflx_output, mf_qtflx_output + + ! Variables used for output (zt) + real(r8), dimension(pcols,pver) :: & + rvmtend_clubb_output, & + rcmtend_clubb_output, & + rimtend_clubb_output, & + stend_clubb_output, & + utend_clubb_output, & + vtend_clubb_output, & + dpdlfliq_output, & + dpdlfice_output, & + dpdlft_output, & + detnliquid_output, & + zt_output, & ! output for the thermo CLUBB grid [m] + rtp2_zt_output, & ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] + wp3_output, & ! wp3 output [m^3/s^3] + thl2_zt_output, & ! CLUBB Theta-l variance on thermo levs + wp2_zt_output, & + rcm_in_layer_output, & ! CLUBB in-cloud liquid water mixing ratio [kg/kg] + pdfp_rtp2_output, & ! Calculated R-tot variance from pdf_params [kg^2/kg^2] + wm_zt_output, & ! CLUBB mean W on thermo levs output [m/s] + rcm_output, & + rtm_output, & + thlm_output, & + cloud_frac_output, & + um_output, & + vm_output + + real(r8), dimension(pcols) :: & + rhmini, & + rhmaxi, & + rtm_integral_vtend, & + rtm_integral_ltend, & + se_dis, & + eleak, & + ustar2, & ! Surface stress for PBL height [m2/s2] + obklen, & ! Obukov length [m] + kbfs, & ! Kinematic Surface heat flux [K m/s] + kinheat, & ! Kinematic Surface heat flux [K m/s] + rrho, & ! Inverse of air density [1/kg/m^3] + kinwat, & ! Kinematic water vapor flux [m/s] + dummy2, & ! dummy variable [units vary] + dummy3 ! dummy variable [units vary] real(r8), dimension(pcols,pver) :: & - rvmtend_clubb, & - rcmtend_clubb, & - rimtend_clubb, & - stend_clubb, & - utend_clubb, & - vtend_clubb, & - dpdlfliq, & - dpdlfice, & - dpdlft, & - detnliquid + temp2d, & ! temporary array for holding scaled outputs + qitend, & + initend, & ! Needed for ice supersaturation adjustment calculation + stend, & + qvtend, & + qctend, & + inctend, & + qclvar, & ! cloud water variance [kg^2/kg^2] + dz_g, & ! thickness of layer [m] + clubb_s, & + inv_exner_clubb, & ! Inverse exner function consistent with CLUBB [-] + thv, & ! virtual potential temperature [K] + th ! potential temperature [K] real(r8), dimension(pcols,pverp) :: & - wprcp_clubb, & - wpthvp_clubb + rho ! Midpoint density in CAM [kg/m^3] - intrinsic :: max - - character(len=*), parameter :: subr='clubb_tend_cam' - real(r8), parameter :: rad2deg=180.0_r8/pi - real(r8) :: tmp_lon1, tmp_lonN, invrs_hdtime - - type(grid) :: gr, gr_a + real(r8) :: & + dlf2, & ! Detraining cld H20 from shallow convection [kg/kg/day] + dum1, & ! dummy variable [units vary] + invrs_hdtime, & + lmin, & + mixt_frac_max_mag, & + dtime, & ! CLUBB time step [s] + ubar, & ! surface wind [m/s] + ustar, & ! surface stress [m/s] + bflx22, & ! Variable for buoyancy flux for pbl [K m/s] + zo, & ! roughness height [m] + relvarmax, & + frac_limit, ic_limit, & + mean_rt, & ! Calculated R-tot mean from pdf_params (temp) [kg/kg] + latsub, & + apply_const, & + dl_rad, di_rad, dt_low, & + ! Variables below are needed to compute energy integrals for conservation + te_a, se_a, ke_a, wv_a, wl_a, & + te_b, se_b, ke_b, wv_b, wl_b - type(nu_vertical_res_dep) :: nu_vert_res_dep ! Vertical resolution dependent nu values - real(r8) :: lmin, mixt_frac_max_mag + intrinsic :: max - real(r8), dimension(state%ncol,nparams) :: & - clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) + logical, dimension(pcnst) :: & + lq2, & + lqice - integer :: & - sclr, & - edsclr, & - n + character(len=200) :: temp1, sub ! Strings needed for CLUBB output + character(len=512) :: errmsg - ! dummy outputs for CCPP-ized subroutines - character(len=512) :: errmsg - integer :: errflg + integer, dimension(pcols) :: & + clubbtop, & + troplev integer :: & - k_cam + errflg, & + j, k, t, ixind, nadv, n, & ! Loop variables + k_cam, k_clubb, sclr, edsclr, & ! Loop variables + ixcldice, ixcldliq, ixnumliq, ixnumice, ixq, & + itim_old, & + ncol, lchnk, & ! # of columns, and chunk identifier + icnt, & + stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] #endif @@ -2657,10 +2660,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if #endif - print *, "do_clubb_mf = ", do_clubb_mf - print *, "do_rainturb = ", do_rainturb - print *, "do_cldcool = ", do_cldcool - !-----------------------------------------------------------------------------------! ! MAIN COMPUTATION BEGINS HERE ! !-----------------------------------------------------------------------------------! @@ -2680,100 +2679,99 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & itim_old = pbuf_old_tim_idx() ! Establish associations between pointers and physics buffer fields - call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wprtp_idx, wprtp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, rtp2_idx, rtp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, thlp2_idx, thlp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, up2_idx, up2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vp2_idx, vp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, rtp3_idx, rtp3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, thlp3_idx, thlp3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, up3_idx, up3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, vp3_idx, vp3, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - call pbuf_get_field(pbuf, upwp_idx, upwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, vpwp_idx, vpwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, wpthvp_idx, wpthvp) - call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp) - call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp) - call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp) - call pbuf_get_field(pbuf, rcm_idx, rcm) - call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac) - - call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, pdf_zm_varnce_w_1_idx, pdf_zm_varnce_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) - - call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp) - call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp) - call pbuf_get_field(pbuf, uprcp_idx, uprcp) - call pbuf_get_field(pbuf, vprcp_idx, vprcp) - call pbuf_get_field(pbuf, rc_coef_zm_idx, rc_coef_zm) - call pbuf_get_field(pbuf, wp4_idx, wp4) - call pbuf_get_field(pbuf, wpup2_idx, wpup2) - call pbuf_get_field(pbuf, wpvp2_idx, wpvp2) - call pbuf_get_field(pbuf, wp2up2_idx, wp2up2) - call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2) - call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - call pbuf_get_field(pbuf, tke_idx, tke) - call pbuf_get_field(pbuf, qrl_idx, qrl) - call pbuf_get_field(pbuf, radf_idx, radf_clubb) - - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) - - call pbuf_get_field(pbuf, qsatfac_idx, qsatfac) - - call pbuf_get_field(pbuf, prer_evap_idx, prer_evap) - call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan) - call pbuf_get_field(pbuf, cmeliq_idx, cmeliq) - call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) - call pbuf_get_field(pbuf, ztodt_idx, ztodtptr) - call pbuf_get_field(pbuf, relvar_idx, relvar) - call pbuf_get_field(pbuf, dp_frac_idx, deepcu) - call pbuf_get_field(pbuf, sh_frac_idx, shalcu) - call pbuf_get_field(pbuf, kvh_idx, khzm) - call pbuf_get_field(pbuf, pblh_idx, pblh) - call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr) - call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh) + call pbuf_get_field(pbuf, wp2_idx, wp2_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wp3_idx, wp3_pbuf ) + call pbuf_get_field(pbuf, wpthlp_idx, wpthlp_pbuf ) + call pbuf_get_field(pbuf, wprtp_idx, wprtp_pbuf ) + call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp_pbuf ) + call pbuf_get_field(pbuf, rtp2_idx, rtp2_pbuf ) + call pbuf_get_field(pbuf, thlp2_idx, thlp2_pbuf ) + call pbuf_get_field(pbuf, up2_idx, up2_pbuf ) + call pbuf_get_field(pbuf, vp2_idx, vp2_pbuf ) + + call pbuf_get_field(pbuf, rtp3_idx, rtp3_pbuf ) + call pbuf_get_field(pbuf, thlp3_idx, thlp3_pbuf ) + call pbuf_get_field(pbuf, up3_idx, up3_pbuf ) + call pbuf_get_field(pbuf, vp3_idx, vp3_pbuf ) + + call pbuf_get_field(pbuf, upwp_idx, upwp_pbuf ) + call pbuf_get_field(pbuf, vpwp_idx, vpwp_pbuf ) + call pbuf_get_field(pbuf, wpthvp_idx, wpthvp_pbuf) + call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp_pbuf) + call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp_pbuf) + call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp_pbuf) + call pbuf_get_field(pbuf, rcm_idx, rcm_pbuf) + call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac_pbuf) + + call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1_pbuf ) + call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2_pbuf ) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_1_idx, pdf_zm_varnce_w_1_pbuf ) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2_pbuf ) + call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac_pbuf ) + + call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp_pbuf) + call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp_pbuf) + call pbuf_get_field(pbuf, uprcp_idx, uprcp_pbuf) + call pbuf_get_field(pbuf, vprcp_idx, vprcp_pbuf) + call pbuf_get_field(pbuf, rc_coef_zm_idx, rc_coef_zm_pbuf) + call pbuf_get_field(pbuf, wp4_idx, wp4_pbuf) + call pbuf_get_field(pbuf, wpup2_idx, wpup2_pbuf) + call pbuf_get_field(pbuf, wpvp2_idx, wpvp2_pbuf) + call pbuf_get_field(pbuf, wp2up2_idx, wp2up2_pbuf) + call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2_pbuf) + call pbuf_get_field(pbuf, thlm_idx, thlm_pbuf ) + call pbuf_get_field(pbuf, rtm_idx, rtm_pbuf ) + call pbuf_get_field(pbuf, um_idx, um_pbuf ) + call pbuf_get_field(pbuf, vm_idx, vm_pbuf ) + + call pbuf_get_field(pbuf, tke_idx, tke_pbuf) + call pbuf_get_field(pbuf, qrl_idx, qrl_pbuf) + + call pbuf_get_field(pbuf, cld_idx, cld_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, concld_idx, concld_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, ast_idx, ast_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, alst_idx, alst_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, aist_idx, aist_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, qlst_idx, qlst_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, qist_idx, qist_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + + call pbuf_get_field(pbuf, qsatfac_idx, qsatfac_pbuf) + + call pbuf_get_field(pbuf, prer_evap_idx, prer_evap_pbuf) + call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan_pbuf) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_pbuf) + call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac_pbuf) + call pbuf_get_field(pbuf, ztodt_idx, ztodtptr_pbuf) + call pbuf_get_field(pbuf, relvar_idx, relvar_pbuf) + call pbuf_get_field(pbuf, dp_frac_idx, deepcu_pbuf) + call pbuf_get_field(pbuf, sh_frac_idx, shalcu_pbuf) + call pbuf_get_field(pbuf, kvh_idx, khzm_pbuf) + call pbuf_get_field(pbuf, pblh_idx, pblh_pbuf) + call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr_pbuf) + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh_pbuf) ! SILHS covariance contributions - call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt) - call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt) - call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) - call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) - call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) + call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt_pbuf) + call pbuf_get_field(pbuf, thlp2_mc_zt_idx, thlp2_mc_zt_pbuf) + call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt_pbuf) + call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt_pbuf) + call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt_pbuf) ! For Gravity Wave - call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb ) - call pbuf_get_field(pbuf, thlp2_clubb_gw_idx, thlp2_clubb_gw ) - call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw ) - call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw ) - call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw ) - - call pbuf_get_field(pbuf, ttend_clubb_mc_idx, ttend_clubb_mc ) - call pbuf_get_field(pbuf, thlp2_clubb_gw_mc_idx, thlp2_clubb_gw_mc ) - call pbuf_get_field(pbuf, upwp_clubb_gw_mc_idx, upwp_clubb_gw_mc ) - call pbuf_get_field(pbuf, vpwp_clubb_gw_mc_idx, vpwp_clubb_gw_mc ) - call pbuf_get_field(pbuf, wpthlp_clubb_gw_mc_idx, wpthlp_clubb_gw_mc ) + call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb_pbuf ) + call pbuf_get_field(pbuf, thlp2_clubb_gw_idx, thlp2_clubb_gw_pbuf ) + call pbuf_get_field(pbuf, upwp_clubb_gw_idx, upwp_clubb_gw_pbuf ) + call pbuf_get_field(pbuf, vpwp_clubb_gw_idx, vpwp_clubb_gw_pbuf ) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_idx, wpthlp_clubb_gw_pbuf ) + + call pbuf_get_field(pbuf, ttend_clubb_mc_idx, ttend_clubb_mc_pbuf ) + call pbuf_get_field(pbuf, thlp2_clubb_gw_mc_idx, thlp2_clubb_gw_mc_pbuf ) + call pbuf_get_field(pbuf, upwp_clubb_gw_mc_idx, upwp_clubb_gw_mc_pbuf ) + call pbuf_get_field(pbuf, vpwp_clubb_gw_mc_idx, vpwp_clubb_gw_mc_pbuf ) + call pbuf_get_field(pbuf, wpthlp_clubb_gw_mc_idx, wpthlp_clubb_gw_mc_pbuf ) if (clubb_do_icesuper) then - call pbuf_get_field(pbuf, naai_idx, naai) + call pbuf_get_field(pbuf, naai_idx, naai_pbuf) end if ! Initialize physics tendency arrays @@ -2787,7 +2785,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call set_wet_to_dry(state1, convert_cnst_type='wet') if (clubb_do_liqsupersat) then - call pbuf_get_field(pbuf, npccn_idx, npccn) + call pbuf_get_field(pbuf, npccn_idx, npccn_pbuf) endif ! Define the grid box size. CLUBB needs this information to determine what @@ -2820,14 +2818,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !--------------------- Scalar Setting -------------------- - dl_rad = clubb_detliq_rad - di_rad = clubb_detice_rad - dt_low = clubb_detphase_lowtemp - - frac_limit = 0.01_r8 - ic_limit = 1.e-12_r8 - inv_rh2o = 1._r8/rh2o - ! Determine CLUBB time step and make it sub-step friendly ! For now we want CLUBB time step to be 5 min since that is ! what has been scientifically validated. However, there are certain @@ -2885,38 +2875,38 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif ! Initialize the apply_const variable (note special logic is due to eulerian backstepping) - if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) == 0._r8))) then + if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp_pbuf(1:ncol,1:pver) == 0._r8))) then apply_const = 0._r8 ! On first time through do not remove constant ! from moments since it has not been added yet endif !--------------------- Initializations -------------------- - ! Set the ztodt timestep in pbuf for SILHS - ztodtptr(:) = 1.0_r8*hdtime + ! Set the ztodt timestep in pbuf for SILHS, this is needed because hdtime is not input to silhs + ztodtptr_pbuf(:) = 1.0_r8 * hdtime call t_stopf('clubb_tend_cam:NAR') call t_startf('clubb_tend_cam:acc_copyin') - !$acc data copyin( sclr_idx, clubb_params_single_col, grid_dx, grid_dy, rairv, cpairv, radf_clubb, qrl, & + !$acc data copyin( sclr_idx, clubb_params_single_col, grid_dx, grid_dy, rairv, cpairv, qrl_pbuf, & !$acc pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & !$acc state1, state1%q, state1%u, state1%v, state1%t, state1%pmid, state1%s, state1%pint, & !$acc state1%zm, state1%zi, state1%pdeldry, state1%pdel, state1%omega, state1%phis, & !$acc cam_in, cam_in%shf, cam_in%wsx, cam_in%wsy, cam_in%cflx, & - !$acc rrho, prer_evap, rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, wpthlp_mc_zt, rtpthlp_mc_zt, & + !$acc rrho, prer_evap_pbuf, rtp2_mc_zt_pbuf, thlp2_mc_zt_pbuf, wprtp_mc_zt_pbuf, wpthlp_mc_zt_pbuf, rtpthlp_mc_zt_pbuf, & !$acc err_info, err_info%err_header ) & - !$acc copy( um, vm, upwp, vpwp, wpthvp, wp2thvp, rtpthvp, thlpthvp, up2, vp2, up3, vp3, & - !$acc wp2, wp3, rtp2, thlp2, rtp3, thlp3, thlm, rtm, rvm, wprtp, wpthlp, rtpthlp, & - !$acc pdf_zm_w_1, pdf_zm_w_2, pdf_zm_varnce_w_1, pdf_zm_varnce_w_2, pdf_zm_mixt_frac, & - !$acc cloud_frac, wp2rtp, wp2thlp, uprcp, vprcp, rc_coef_zm, wp4, wpup2, wpvp2, & - !$acc ttend_clubb_mc, upwp_clubb_gw_mc, vpwp_clubb_gw_mc, thlp2_clubb_gw_mc, wpthlp_clubb_gw_mc, & - !$acc ttend_clubb, upwp_clubb_gw, vpwp_clubb_gw, thlp2_clubb_gw, wpthlp_clubb_gw, & - !$acc wp2up2, wp2vp2, ice_supersat_frac, & + !$acc copy( um_pbuf, vm_pbuf, upwp_pbuf, vpwp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, & + !$acc wp2_pbuf, wp3_pbuf, rtp2_pbuf, thlp2_pbuf, rtp3_pbuf, thlp3_pbuf, thlm_pbuf, rtm_pbuf, wprtp_pbuf, wpthlp_pbuf, rtpthlp_pbuf, & + !$acc pdf_zm_w_1_pbuf, pdf_zm_w_2_pbuf, pdf_zm_varnce_w_1_pbuf, pdf_zm_varnce_w_2_pbuf, pdf_zm_mixt_frac_pbuf, & + !$acc cloud_frac_pbuf, wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & + !$acc ttend_clubb_mc_pbuf, upwp_clubb_gw_mc_pbuf, vpwp_clubb_gw_mc_pbuf, thlp2_clubb_gw_mc_pbuf, wpthlp_clubb_gw_mc_pbuf, & + !$acc ttend_clubb_pbuf, upwp_clubb_gw_pbuf, vpwp_clubb_gw_pbuf, thlp2_clubb_gw_pbuf, wpthlp_clubb_gw_pbuf, & + !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf, & !$acc pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & !$acc pdf_params_zm_chnk(lchnk)%mixt_frac ) & - !$acc copyout( temp2d, rtp2_zt_out, thl2_zt_out, wp2_zt_out, pdfp_rtp2, wm_zt_out, inv_exner_clubb, & - !$acc rcm, wprcp, rcm_in_layer, cloud_cover, zt_out, zi_out, khzm, qclvar, thv, dz_g, & - !$acc clubbtop, se_dis, eleak, clubb_s, wpthvp_clubb, wprcp_clubb ) & + !$acc copyout( temp2d, inv_exner_clubb, & + !$acc rcm_pbuf, khzm_pbuf, qclvar, thv, dz_g, & + !$acc clubbtop, se_dis, eleak, clubb_s ) & !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & !$acc fcor, um_in, vm_in, upwp_in, vpwp_in, wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & !$acc up2_in, vp2_in, up3_in, vp3_in, wp2_in, wp3_in, rtp2_in, thlp2_in, rtp3_in, & @@ -2924,14 +2914,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc rcm_inout, wp2rtp_inout, wp2thlp_inout, uprcp_inout, vprcp_inout, & !$acc rc_coef_zm_inout, wp4_inout, wpup2_inout, wpvp2_inout, wp2up2_inout, wp2vp2_inout, & !$acc ice_supersat_frac_inout, pre_in, kappa_zt, qc_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & - !$acc invrs_exner_zm, cloud_cover_out, rcm_in_layer_out, wprcp_out, & - !$acc qclvar_out, rtp2_zt, thl2_zt, wp2_zt, w_up_in_cloud_out, cloudy_downdraft_frac_out, & + !$acc invrs_exner_zm, cloud_cover_out, rcm_in_layer, wprcp_out, & + !$acc qclvar_out, w_up_in_cloud_out, cloudy_downdraft_frac_out, & !$acc w_down_in_cloud_out, invrs_tau_zm_out, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & !$acc thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & !$acc wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, & !$acc rtpthlp_forcing, wm_zm, wm_zt, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, & !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, & - !$acc radf, wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & + !$acc wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & !$acc thlprcp_out, deltaz, zi_g, zt_g, qrl_clubb, p_sfc, & !$acc err_info%err_code, & @@ -2984,8 +2974,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc copyin( sclr_tol ) !$acc data if( edsclr_dim > 0 ) & - !$acc create( wpedsclrp_sfc, edsclrm_forcing, edsclr_in ) & - !$acc copyout( edsclr_out ) + !$acc create( wpedsclrp_sfc, edsclrm_forcing ) & + !$acc copy( edsclr_in ) !$acc data if( hydromet_dim > 0 ) & !$acc create( wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) & @@ -2993,21 +2983,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') - !$acc parallel loop gang vector collapse(2) default(present) - do n = 1, nparams - do i = 1, ncol - clubb_params(i,n) = clubb_params_single_col(1,n) - end do - end do - !$acc parallel loop gang vector collapse(2) default(present) do k = 1, pver do i = 1, pcols - rtp2_zt_out(i,k) = 0._r8 - thl2_zt_out(i,k) = 0._r8 - wp2_zt_out(i,k) = 0._r8 - pdfp_rtp2(i,k) = 0._r8 - wm_zt_out(i,k) = 0._r8 temp2d(i,k) = 0._r8 end do end do @@ -3038,11 +3016,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Perturbed winds are not used in CAM um_pert_inout(i,k) = 0.0_r8 vm_pert_inout(i,k) = 0.0_r8 - - ! Initialize these to prevent crashing behavior - rcm_in_layer_out(i,k) = 0._r8 - cloud_cover_out(i,k) = 0._r8 - khzt_out(i,k) = 0._r8 end do end do @@ -3052,10 +3025,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Perturbed winds are not used in CAM upwp_pert_inout(i,k) = 0.0_r8 vpwp_pert_inout(i,k) = 0.0_r8 - - ! Initialize these to prevent crashing behavior - wprcp_out(i,k) = 0._r8 - khzm_out(i,k) = 0._r8 end do end do @@ -3112,7 +3081,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol do k = 1, nzt_clubb edsclrm_forcing(i,k,edsclr) = 0._r8 - edsclr_in(i,k,edsclr) = 0._r8 end do end do end do @@ -3154,44 +3122,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! need to initialize macmic coupling to zero if ( macmic_it == 1 ) then !$acc parallel loop gang vector collapse(2) default(present) - do i = 1, ncol - do k = 1, pverp - ttend_clubb_mc(i,k) = 0._r8 - upwp_clubb_gw_mc(i,k) = 0._r8 - vpwp_clubb_gw_mc(i,k) = 0._r8 - thlp2_clubb_gw_mc(i,k) = 0._r8 - wpthlp_clubb_gw_mc(i,k) = 0._r8 - end do - end do - end if - - ! Initialize EDMF outputs - if (do_clubb_mf) then do k = 1, pverp - do i = 1, pcols - mf_dry_a_output(i,k) = 0._r8 - mf_moist_a_output(i,k) = 0._r8 - mf_dry_w_output(i,k) = 0._r8 - mf_moist_w_output(i,k) = 0._r8 - mf_dry_qt_output(i,k) = 0._r8 - mf_moist_qt_output(i,k) = 0._r8 - mf_dry_thl_output(i,k) = 0._r8 - mf_moist_thl_output(i,k) = 0._r8 - mf_dry_u_output(i,k) = 0._r8 - mf_moist_u_output(i,k) = 0._r8 - mf_dry_v_output(i,k) = 0._r8 - mf_moist_v_output(i,k) = 0._r8 - mf_moist_qc_output(i,k) = 0._r8 - s_ae_output(i,k) = 0._r8 - s_aw_output(i,k) = 0._r8 - s_awthl_output(i,k) = 0._r8 - s_awqt_output(i,k) = 0._r8 - s_awql_output(i,k) = 0._r8 - s_awqi_output(i,k) = 0._r8 - s_awu_output(i,k) = 0._r8 - s_awv_output(i,k) = 0._r8 - mf_thlflx_output(i,k) = 0._r8 - mf_qtflx_output(i,k) = 0._r8 + do i = 1, ncol + ttend_clubb_mc_pbuf(i,k) = 0._r8 + upwp_clubb_gw_mc_pbuf(i,k) = 0._r8 + vpwp_clubb_gw_mc_pbuf(i,k) = 0._r8 + thlp2_clubb_gw_mc_pbuf(i,k) = 0._r8 + wpthlp_clubb_gw_mc_pbuf(i,k) = 0._r8 end do end do end if @@ -3221,7 +3158,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do call t_startf('clubb_tend_cam:ice_macro_tend') - call ice_macro_tend(naai(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & + call ice_macro_tend(naai_pbuf(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), & state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), & latsub, hdtime, stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & @@ -3258,7 +3195,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif - if (clubb_do_adv) then + if ( clubb_do_adv ) then if (macmic_it == 1) then @@ -3267,15 +3204,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! them to prevent dynamics from making them positive. do k = 1, pver do i = 1, ncol - thlp2(i,k) = state1%q(i,k,ixthlp2) - rtp2(i,k) = state1%q(i,k,ixrtp2) - rtpthlp(i,k) = state1%q(i,k,ixrtpthlp) - ( rtpthlp_const * apply_const ) - wpthlp(i,k) = state1%q(i,k,ixwpthlp) - ( wpthlp_const * apply_const ) - wprtp(i,k) = state1%q(i,k,ixwprtp) - ( wprtp_const * apply_const ) - wp2(i,k) = state1%q(i,k,ixwp2) - wp3(i,k) = state1%q(i,k,ixwp3) - ( wp3_const * apply_const ) - up2(i,k) = state1%q(i,k,ixup2) - vp2(i,k) = state1%q(i,k,ixvp2) + thlp2_pbuf(i,k) = state1%q(i,k,ixthlp2) + rtp2_pbuf(i,k) = state1%q(i,k,ixrtp2) + rtpthlp_pbuf(i,k) = state1%q(i,k,ixrtpthlp) - ( rtpthlp_const * apply_const ) + wpthlp_pbuf(i,k) = state1%q(i,k,ixwpthlp) - ( wpthlp_const * apply_const ) + wprtp_pbuf(i,k) = state1%q(i,k,ixwprtp) - ( wprtp_const * apply_const ) + wp2_pbuf(i,k) = state1%q(i,k,ixwp2) + wp3_pbuf(i,k) = state1%q(i,k,ixwp3) - ( wp3_const * apply_const ) + up2_pbuf(i,k) = state1%q(i,k,ixup2) + vp2_pbuf(i,k) = state1%q(i,k,ixvp2) enddo enddo @@ -3290,18 +3227,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif do i = 1, ncol - thlp2(i,pverp) = thlp2(i,pver) - rtp2(i,pverp) = rtp2(i,pver) - rtpthlp(i,pverp) = rtpthlp(i,pver) - wpthlp(i,pverp) = wpthlp(i,pver) - wprtp(i,pverp) = wprtp(i,pver) - wp2(i,pverp) = wp2(i,pver) - up2(i,pverp) = up2(i,pver) - vp2(i,pverp) = vp2(i,pver) + thlp2_pbuf(i,pverp) = thlp2_pbuf(i,pver) + rtp2_pbuf(i,pverp) = rtp2_pbuf(i,pver) + rtpthlp_pbuf(i,pverp) = rtpthlp_pbuf(i,pver) + wpthlp_pbuf(i,pverp) = wpthlp_pbuf(i,pver) + wprtp_pbuf(i,pverp) = wprtp_pbuf(i,pver) + wp2_pbuf(i,pverp) = wp2_pbuf(i,pver) + up2_pbuf(i,pverp) = up2_pbuf(i,pver) + vp2_pbuf(i,pverp) = vp2_pbuf(i,pver) end do endif + !$acc parallel loop gang vector collapse(2) default(present) + do n = 1, nparams + do i = 1, ncol + clubb_params(i,n) = clubb_params_single_col(1,n) + end do + end do + !$acc parallel loop gang vector collapse(2) default(present) do k=1, pver do i=1, ncol @@ -3320,11 +3264,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! At each CLUBB call, initialize mean momentum and thermo CLUBB state ! from the CAM state - rtm(i,k) = state1%q(i,k,ixq) + state1%q(i,k,ixcldliq) - rvm(i,k) = state1%q(i,k,ixq) - um(i,k) = state1%u(i,k) - vm(i,k) = state1%v(i,k) - thlm(i,k) = ( state1%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state1%q(i,k,ixcldliq) ) & + rtm_pbuf(i,k) = state1%q(i,k,ixq) + state1%q(i,k,ixcldliq) + um_pbuf(i,k) = state1%u(i,k) + vm_pbuf(i,k) = state1%v(i,k) + thlm_pbuf(i,k) = ( state1%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state1%q(i,k,ixcldliq) ) & * inv_exner_clubb(i,k) enddo @@ -3357,8 +3300,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thv_ds_zt(i,k) = thv(i,k) rfrzm(i,k) = state1%q(i,k_cam,ixcldice) - radf(i,k) = radf_clubb(i,k_cam) - qrl_clubb(i,k) = qrl(i,k_cam) / ( cpairv(i,k,lchnk) * state1%pdeldry(i,k_cam) ) ! Compute mean w wind on thermo grid, convert from omega to w wm_zt(i,k) = -1._r8*(state1%omega(i,k_cam)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) @@ -3439,26 +3380,38 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') -!--- TODO: should these be all always zero if we aren't using SILHS? wrap in ifdef SILHS maybe? +#ifdef SILHS ! Add forcings for SILHS covariance contributions - rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt(1:ncol,top_lev:pver) ) - thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt(1:ncol,top_lev:pver) ) - wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt(1:ncol,top_lev:pver) ) - wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt(1:ncol,top_lev:pver) ) - rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt(1:ncol,top_lev:pver) ) + rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt_pbuf(1:ncol,top_lev:pver) ) + thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt_pbuf(1:ncol,top_lev:pver) ) + wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt_pbuf(1:ncol,top_lev:pver) ) + wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt_pbuf(1:ncol,top_lev:pver) ) + rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt_pbuf(1:ncol,top_lev:pver) ) ! Zero out SILHS covariance contribution terms !$acc parallel loop gang vector collapse(2) default(present) do k = 1, pver do i = 1, pcols - rtp2_mc_zt(i,k) = 0.0_r8 - thlp2_mc_zt(i,k) = 0.0_r8 - wprtp_mc_zt(i,k) = 0.0_r8 - wpthlp_mc_zt(i,k) = 0.0_r8 - rtpthlp_mc_zt(i,k) = 0.0_r8 + rtp2_mc_zt_pbuf(i,k) = 0.0_r8 + thlp2_mc_zt_pbuf(i,k) = 0.0_r8 + wprtp_mc_zt_pbuf(i,k) = 0.0_r8 + wpthlp_mc_zt_pbuf(i,k) = 0.0_r8 + rtpthlp_mc_zt_pbuf(i,k) = 0.0_r8 end do end do -!-- END TODO +#else + ! Set forcings to zero if not using SILHS + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol + rtp2_forcing(i,k) = 0._r8 + thlp2_forcing(i,k) = 0._r8 + wprtp_forcing(i,k) = 0._r8 + wpthlp_forcing(i,k) = 0._r8 + rtpthlp_forcing(i,k) = 0._r8 + end do + end do +#endif ! Compute some inputs from the thermodynamic grid to the momentum grid rho_ds_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rho_ds_zt ) @@ -3485,13 +3438,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Initialize zo if variable ustar is used if (cam_in%landfrac(1) >= 0.5_r8) then - zo(1) = 0.035_r8 + zo = 0.035_r8 else - zo(1) = 0.0001_r8 + zo = 0.0001_r8 endif ! Compute surface wind (ubar) - ubar = sqrt(um(1,pver)**2+vm(1,pver)**2) + ubar = sqrt(um_pbuf(1,pver)**2+vm_pbuf(1,pver)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 ! Below denotes case specifics for surface momentum @@ -3516,13 +3469,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & trim(scm_clubb_iop_name) == 'ARM_CC') then - bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) - ustar = diag_ustar(zt_g(1,nzt_clubb-1),bflx22(1),ubar,zo(1)) + bflx22 = (gravit/theta0)*wpthlp_sfc(1) + ustar = diag_ustar(zt_g(1,nzt_clubb-1),bflx22,ubar,zo) endif ! Compute the surface momentum fluxes, if this is a SCAM simulation - upwp_sfc(1) = -um(1,pver)*ustar**2/ubar - vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar + upwp_sfc(1) = -um_pbuf(1,pver)*ustar**2/ubar + vpwp_sfc(1) = -vm_pbuf(1,pver)*ustar**2/ubar end if @@ -3567,25 +3520,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol k_cam = top_lev - 1 + k - um_in(i,k) = um(i,k_cam) - vm_in(i,k) = vm(i,k_cam) - wp2thvp_in(i,k) = wp2thvp(i,k_cam) - up3_in(i,k) = up3(i,k_cam) - vp3_in(i,k) = vp3(i,k_cam) - wp3_in(i,k) = wp3(i,k_cam) - rtp3_in(i,k) = rtp3(i,k_cam) - thlp3_in(i,k) = thlp3(i,k_cam) - thlm_in(i,k) = thlm(i,k_cam) - rtm_in(i,k) = rtm(i,k_cam) - rvm_in(i,k) = rvm(i,k_cam) - cloud_frac_inout(i,k) = cloud_frac(i,k_cam) - rcm_inout(i,k) = state1%q(i,k_cam,ixcldliq) - wp2rtp_inout(i,k) = wp2rtp(i,k_cam) - wp2thlp_inout(i,k) = wp2thlp(i,k_cam) - wpup2_inout(i,k) = wpup2(i,k_cam) - wpvp2_inout(i,k) = wpvp2(i,k_cam) - ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,k_cam) - pre_in(i,k) = prer_evap(i,k_cam) + um_in(i,k) = um_pbuf(i,k_cam) + vm_in(i,k) = vm_pbuf(i,k_cam) + wp2thvp_in(i,k) = wp2thvp_pbuf(i,k_cam) + up3_in(i,k) = up3_pbuf(i,k_cam) + vp3_in(i,k) = vp3_pbuf(i,k_cam) + wp3_in(i,k) = wp3_pbuf(i,k_cam) + rtp3_in(i,k) = rtp3_pbuf(i,k_cam) + thlp3_in(i,k) = thlp3_pbuf(i,k_cam) + thlm_in(i,k) = thlm_pbuf(i,k_cam) + rtm_in(i,k) = rtm_pbuf(i,k_cam) + rvm_in(i,k) = state1%q(i,k_cam,ixq) + cloud_frac_inout(i,k) = cloud_frac_pbuf(i,k_cam) + rcm_inout(i,k) = state1%q(i,k_cam,ixcldliq) + wp2rtp_inout(i,k) = wp2rtp_pbuf(i,k_cam) + wp2thlp_inout(i,k) = wp2thlp_pbuf(i,k_cam) + wpup2_inout(i,k) = wpup2_pbuf(i,k_cam) + wpvp2_inout(i,k) = wpvp2_pbuf(i,k_cam) + ice_supersat_frac_inout(i,k) = ice_supersat_frac_pbuf(i,k_cam) + pre_in(i,k) = prer_evap_pbuf(i,k_cam) end do end do @@ -3594,25 +3547,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - upwp_in(i,k) = upwp(i,k_cam) - vpwp_in(i,k) = vpwp(i,k_cam) - wpthvp_in(i,k) = wpthvp(i,k_cam) - rtpthvp_in(i,k) = rtpthvp(i,k_cam) - thlpthvp_in(i,k)= thlpthvp(i,k_cam) - up2_in(i,k) = up2(i,k_cam) - vp2_in(i,k) = vp2(i,k_cam) - wp2_in(i,k) = wp2(i,k_cam) - rtp2_in(i,k) = rtp2(i,k_cam) - thlp2_in(i,k) = thlp2(i,k_cam) - wprtp_in(i,k) = wprtp(i,k_cam) - wpthlp_in(i,k) = wpthlp(i,k_cam) - rtpthlp_in(i,k) = rtpthlp(i,k_cam) - uprcp_inout(i,k) = uprcp(i,k_cam) - vprcp_inout(i,k) = vprcp(i,k_cam) - rc_coef_zm_inout(i,k) = rc_coef_zm(i,k_cam) - wp4_inout(i,k) = wp4(i,k_cam) - wp2up2_inout(i,k) = wp2up2(i,k_cam) - wp2vp2_inout(i,k) = wp2vp2(i,k_cam) + upwp_in(i,k) = upwp_pbuf(i,k_cam) + vpwp_in(i,k) = vpwp_pbuf(i,k_cam) + wpthvp_in(i,k) = wpthvp_pbuf(i,k_cam) + rtpthvp_in(i,k) = rtpthvp_pbuf(i,k_cam) + thlpthvp_in(i,k)= thlpthvp_pbuf(i,k_cam) + up2_in(i,k) = up2_pbuf(i,k_cam) + vp2_in(i,k) = vp2_pbuf(i,k_cam) + wp2_in(i,k) = wp2_pbuf(i,k_cam) + rtp2_in(i,k) = rtp2_pbuf(i,k_cam) + thlp2_in(i,k) = thlp2_pbuf(i,k_cam) + wprtp_in(i,k) = wprtp_pbuf(i,k_cam) + wpthlp_in(i,k) = wpthlp_pbuf(i,k_cam) + rtpthlp_in(i,k) = rtpthlp_pbuf(i,k_cam) + uprcp_inout(i,k) = uprcp_pbuf(i,k_cam) + vprcp_inout(i,k) = vprcp_pbuf(i,k_cam) + rc_coef_zm_inout(i,k) = rc_coef_zm_pbuf(i,k_cam) + wp4_inout(i,k) = wp4_pbuf(i,k_cam) + wp2up2_inout(i,k) = wp2up2_pbuf(i,k_cam) + wp2vp2_inout(i,k) = wp2vp2_pbuf(i,k_cam) end do end do @@ -3625,11 +3578,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,k_cam) - pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,k_cam) - pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,k_cam) - pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2(i,k_cam) - pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,k_cam) + pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1_pbuf(i,k_cam) + pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2_pbuf(i,k_cam) + pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1_pbuf(i,k_cam) + pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2_pbuf(i,k_cam) + pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac_pbuf(i,k_cam) end do end do @@ -3641,8 +3594,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzt_clubb do i=1,ncol k_cam = top_lev - 1 + k - kappa_zt(i,k) = (rairv(i,k_cam,lchnk)/cpairv(i,k_cam,lchnk)) - qc_zt(i,k) = state1%q(i,k_cam,ixcldliq) + kappa_zt(i,k) = rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) + qc_zt(i,k) = state1%q(i,k_cam,ixcldliq) invrs_exner_zt(i,k) = inv_exner_clubb(i,k_cam) end do end do @@ -3652,36 +3605,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzm_clubb do i=1,ncol k_cam = top_lev - 1 + k - p_in_Pa_zm(i,k) = state1%pint(i,k_cam) - invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) + p_in_Pa_zm(i,k) = state1%pint(i,k_cam) + invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k)/p0_clubb)**kappa_zm(i,k) ) end do end do end if - if (clubb_do_adv) then - if (macmic_it == 1) then - - wp2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) - wpthlp_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_in ) - wprtp_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_in ) - up2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, up2_in ) - vp2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, vp2_in ) - thlp2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) - rtp2_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_in ) - rtpthlp_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_in ) - - do k = 1, nzm_clubb - do i = 1, ncol - thlp2_in(i,k) = max(thl_tol**2,thlp2_in(i,k)) - rtp2_in(i,k) = max(rt_tol**2,rtp2_in(i,k)) - wp2_in(i,k) = max(w_tol_sqd,wp2_in(i,k)) - up2_in(i,k) = max(w_tol_sqd,up2_in(i,k)) - vp2_in(i,k) = max(w_tol_sqd,vp2_in(i,k)) - end do + if ( clubb_do_adv .and. macmic_it == 1 ) then + do k = 1, nzm_clubb + do i = 1, ncol + thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) ) + rtp2_in(i,k) = max( rt_tol**2, rtp2_in(i,k) ) + wp2_in(i,k) = max( w_tol_sqd, wp2_in(i,k) ) + up2_in(i,k) = max( w_tol_sqd, up2_in(i,k) ) + vp2_in(i,k) = max( w_tol_sqd, vp2_in(i,k) ) end do - - end if + end do end if if ( edsclr_dim > 0 ) then @@ -3710,8 +3650,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzt_clubb do i=1, ncol k_cam = top_lev - 1 + k - edsclr_in(i,k,icnt+1) = thlm(i,k_cam) - edsclr_in(i,k,icnt+2) = rtm(i,k_cam) + edsclr_in(i,k,icnt+1) = thlm_pbuf(i,k_cam) + edsclr_in(i,k,icnt+2) = rtm_pbuf(i,k_cam) end do end do @@ -3737,8 +3677,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i=1, ncol - dzt(i,k) = zi_g(i,k) - zi_g(i,k+1) - invrs_dzt(i,k) = 1._r8 / dzt(i,k) + invrs_dzt(i,k) = 1._r8 / dz_g(i,k) end do end do @@ -3752,7 +3691,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Ideally, integrate_mf would operate in descending mode, then we could remove the flipping. ! If the column loop gets pushed into it, we can also avoid the array slicing. - dzt = dzt(:,nzt_clubb:1:-1) + dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) um_in = um_in(:,nzt_clubb:1:-1) @@ -3770,11 +3709,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtm_zm_in = rtm_zm_in(:,nzm_clubb:1:-1) do i=1, ncol - call integrate_mf( nzm_clubb, nzt_clubb, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv(i,1:nzt_clubb), & ! input thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input - wpthlp_sfc(i), wprtp_sfc(i), pblh(i), & ! input + wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics @@ -3790,7 +3729,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! Flip zt inputs back - dzt = dzt(:,nzt_clubb:1:-1) + dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) um_in = um_in(:,nzt_clubb:1:-1) @@ -3807,7 +3746,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlm_zm_in = thlm_zm_in(:,nzm_clubb:1:-1) rtm_zm_in = rtm_zm_in(:,nzm_clubb:1:-1) - ! Flip clubb_mf output, since it + ! Flip clubb_mf output, since it assumes an ascending grid currently mf_dry_a = mf_dry_a(:,nzm_clubb:1:-1) mf_moist_a = mf_moist_a(:,nzm_clubb:1:-1) mf_dry_w = mf_dry_w(:,nzm_clubb:1:-1) @@ -3872,7 +3811,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) - khzt_out = khzt_out(:,nzt_clubb:1:-1) rtm_ref = rtm_ref(:,nzt_clubb:1:-1) thlm_ref = thlm_ref(:,nzt_clubb:1:-1) um_ref = um_ref(:,nzt_clubb:1:-1) @@ -3895,20 +3833,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) - qclvar_out = qclvar_out(:,nzt_clubb:1:-1) - cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) - w_up_in_cloud_out = w_up_in_cloud_out(:,nzt_clubb:1:-1) - w_down_in_cloud_out = w_down_in_cloud_out(:,nzt_clubb:1:-1) - cloudy_updraft_frac_out = cloudy_updraft_frac_out(:,nzt_clubb:1:-1) - cloudy_downdraft_frac_out = cloudy_downdraft_frac_out(:,nzt_clubb:1:-1) - rcm_in_layer_out = rcm_in_layer_out(:,nzt_clubb:1:-1) ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) rtm_in = rtm_in(:,nzt_clubb:1:-1) thlm_in = thlm_in(:,nzt_clubb:1:-1) - Lscale = Lscale(:,nzt_clubb:1:-1) wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) @@ -3941,10 +3871,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) - khzm_out = khzm_out(:,nzm_clubb:1:-1) - thlprcp_out = thlprcp_out(:,nzm_clubb:1:-1) - wprcp_out = wprcp_out(:,nzm_clubb:1:-1) - invrs_tau_zm_out = invrs_tau_zm_out(:,nzm_clubb:1:-1) if ( edsclr_dim > 0 ) then edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) @@ -3973,7 +3899,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid - ! only for pdfp_rtp2 calc + ! only for pdfp_rtp2_output calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) @@ -4034,53 +3960,53 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - call advance_clubb_core_api( gr_a, nzm_clubb, nzt_clubb, ncol, & - l_implemented, dtime, fcor, sfc_elevation, & + call advance_clubb_core_api( gr_a, nzm_clubb, nzt_clubb, ncol, & ! ins + l_implemented, dtime, fcor(:ncol), sfc_elevation(:ncol), & hydromet_dim, & sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & - thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & - sclrm_forcing, edsclrm_forcing, wprtp_forcing, & - wpthlp_forcing, rtp2_forcing, thlp2_forcing, & - rtpthlp_forcing, wm_zm, wm_zt, & - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, p_sfc, & - wpsclrp_sfc, wpedsclrp_sfc, & - upwp_sfc_pert, vpwp_sfc_pert, & - rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, & - p_in_Pa, rho_zm, rho_zt, exner, & - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & + thlm_forcing(:ncol,:), rtm_forcing(:ncol,:), um_forcing(:ncol,:), vm_forcing(:ncol,:), & + sclrm_forcing(:ncol,:,:), edsclrm_forcing(:ncol,:,:), wprtp_forcing(:ncol,:), & + wpthlp_forcing(:ncol,:), rtp2_forcing(:ncol,:), thlp2_forcing(:ncol,:), & + rtpthlp_forcing(:ncol,:), wm_zm(:ncol,:), wm_zt(:ncol,:), & + wpthlp_sfc(:ncol), wprtp_sfc(:ncol), upwp_sfc(:ncol), vpwp_sfc(:ncol), p_sfc(:ncol), & + wpsclrp_sfc(:ncol,:), wpedsclrp_sfc(:ncol,:), & + upwp_sfc_pert(:ncol), vpwp_sfc_pert(:ncol), & + rtm_ref(:ncol,:), thlm_ref(:ncol,:), um_ref(:ncol,:), vm_ref(:ncol,:), ug(:ncol,:), vg(:ncol,:), & + p_in_Pa(:ncol,:), rho_zm(:ncol,:), rho_zt(:ncol,:), exner(:ncol,:), & + rho_ds_zm(:ncol,:), rho_ds_zt(:ncol,:), invrs_rho_ds_zm(:ncol,:), & + invrs_rho_ds_zt(:ncol,:), thv_ds_zm(:ncol,:), thv_ds_zt(:ncol,:), & hm_metadata%l_mix_rat_hm, & - rfrzm, & - wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & - grid_dx, grid_dy, & - clubb_params, nu_vert_res_dep, lmin, & + rfrzm(:ncol,:), & + wphydrometp(:ncol,:,:), wp2hmp(:ncol,:,:), rtphmp_zt(:ncol,:,:), thlphmp_zt(:ncol,:,:), & + grid_dx(:ncol), grid_dy(:ncol), & + clubb_params(:ncol,:), nu_vert_res_dep, lmin, & mixt_frac_max_mag, theta0, ts_nudge, & rtm_min, rtm_nudge_max_altitude, & clubb_config_flags, & stats_metadata, & - stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & - um_in, vm_in, upwp_in, vpwp_in, up2_in, vp2_in, up3_in, vp3_in, & - thlm_in, rtm_in, wprtp_in, wpthlp_in, & - wp2_in, wp3_in, rtp2_in, rtp3_in, thlp2_in, thlp3_in, rtpthlp_in, & - sclrm, & - sclrp2, sclrp3, sclrprtp, sclrpthlp, & - wpsclrp, edsclr_in, err_info, & - rcm_inout, cloud_frac_inout, & - wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & - sclrpthvp_inout, & - wp2rtp_inout, wp2thlp_inout, uprcp_inout, & - vprcp_inout, rc_coef_zm_inout, & - wp4_inout, wpup2_inout, wpvp2_inout, & - wp2up2_inout, wp2vp2_inout, ice_supersat_frac_inout, & - um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & + stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! inouts + um_in(:ncol,:), vm_in(:ncol,:), upwp_in(:ncol,:), vpwp_in(:ncol,:), up2_in(:ncol,:), vp2_in(:ncol,:), up3_in(:ncol,:), vp3_in(:ncol,:), & + thlm_in(:ncol,:), rtm_in(:ncol,:), wprtp_in(:ncol,:), wpthlp_in(:ncol,:), & + wp2_in(:ncol,:), wp3_in(:ncol,:), rtp2_in(:ncol,:), rtp3_in(:ncol,:), thlp2_in(:ncol,:), thlp3_in(:ncol,:), rtpthlp_in(:ncol,:), & + sclrm(:ncol,:,:), & + sclrp2(:ncol,:,:), sclrp3(:ncol,:,:), sclrprtp(:ncol,:,:), sclrpthlp(:ncol,:,:), & + wpsclrp(:ncol,:,:), edsclr_in(:ncol,:,:), err_info, & + rcm_inout(:ncol,:), cloud_frac_inout(:ncol,:), & + wpthvp_in(:ncol,:), wp2thvp_in(:ncol,:), rtpthvp_in(:ncol,:), thlpthvp_in(:ncol,:), & + sclrpthvp_inout(:ncol,:,:), & + wp2rtp_inout(:ncol,:), wp2thlp_inout(:ncol,:), uprcp_inout(:ncol,:), & + vprcp_inout(:ncol,:), rc_coef_zm_inout(:ncol,:), & + wp4_inout(:ncol,:), wpup2_inout(:ncol,:), wpvp2_inout(:ncol,:), & + wp2up2_inout(:ncol,:), wp2vp2_inout(:ncol,:), ice_supersat_frac_inout(:ncol,:), & + um_pert_inout(:ncol,:), vm_pert_inout(:ncol,:), upwp_pert_inout(:ncol,:), vpwp_pert_inout(:ncol,:), & pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & pdf_implicit_coefs_terms_chnk(lchnk), & - khzm_out, khzt_out, & - qclvar_out, thlprcp_out, & - wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, & - cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & - rcm_in_layer_out, cloud_cover_out, invrs_tau_zm_out, & - Lscale ) + khzm_out(:ncol,:), khzt_out(:ncol,:), & ! outs + qclvar_out(:ncol,:), thlprcp_out(:ncol,:), & + wprcp_out(:ncol,:), w_up_in_cloud_out(:ncol,:), w_down_in_cloud_out(:ncol,:), & + cloudy_updraft_frac_out(:ncol,:), cloudy_downdraft_frac_out(:ncol,:), & + rcm_in_layer(:ncol,:), cloud_cover_out(:ncol,:), invrs_tau_zm_out(:ncol,:), & + Lscale(:ncol,:) ) if ( l_ascending_grid ) then @@ -4127,7 +4053,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & w_down_in_cloud_out = w_down_in_cloud_out(:,nzt_clubb:1:-1) cloudy_updraft_frac_out = cloudy_updraft_frac_out(:,nzt_clubb:1:-1) cloudy_downdraft_frac_out = cloudy_downdraft_frac_out(:,nzt_clubb:1:-1) - rcm_in_layer_out = rcm_in_layer_out(:,nzt_clubb:1:-1) + rcm_in_layer = rcm_in_layer(:,nzt_clubb:1:-1) ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) @@ -4199,7 +4125,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid - ! only for pdfp_rtp2 calc + ! only for pdfp_rtp2_output calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) @@ -4284,15 +4210,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:do_cldcool') - thlp2_rad_out(:,:) = 0._r8 + thlp2_rad(:,:) = 0._r8 + + do k = 1, nzt_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + qrl_clubb(i,k) = qrl_pbuf(i,k_cam) / ( cpairv(i,k_cam,lchnk) * state1%pdeldry(i,k_cam) ) + end do + end do call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr, & rcm_inout, thlprcp_out, qrl_clubb, clubb_params, & - thlp2_rad_out ) + thlp2_rad ) do k=1,nzm_clubb do i=1, ncol - thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) + thlp2_rad_out(i,k) * dtime ) + thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) + thlp2_rad(i,k) * dtime ) end do end do @@ -4315,67 +4248,42 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:flip-index') - if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - - wp2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) - wpthlp_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_in ) - wprtp_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_in ) - up2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, up2_in ) - vp2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, vp2_in ) - thlp2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) - rtp2_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_in ) - rtpthlp_in = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_in ) - - do k=1,nzm_clubb - do i=1, ncol - thlp2_in(i,k) = max(thl_tol**2, thlp2_in(i,k)) - rtp2_in(i,k) = max(rt_tol**2, rtp2_in(i,k)) - wp2_in(i,k) = max(w_tol_sqd, wp2_in(i,k)) - up2_in(i,k) = max(w_tol_sqd, up2_in(i,k)) - vp2_in(i,k) = max(w_tol_sqd, vp2_in(i,k)) - end do + if ( clubb_do_adv .and. macmic_it == cld_macmic_num_steps ) then + do k=1,nzm_clubb + do i=1, ncol + thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) ) + rtp2_in(i,k) = max( rt_tol**2, rtp2_in(i,k) ) + wp2_in(i,k) = max( w_tol_sqd, wp2_in(i,k) ) + up2_in(i,k) = max( w_tol_sqd, up2_in(i,k) ) + vp2_in(i,k) = max( w_tol_sqd, vp2_in(i,k) ) end do - - end if + end do end if - ! Convert RTP2 and THLP2 to thermo grid for output - rtp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_in ) - thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) - wp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) - ! Arrays need to be "flipped" to CAM grid !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzt_clubb do i=1, ncol k_cam = top_lev - 1 + k - um(i,k_cam) = um_in(i,k) - vm(i,k_cam) = vm_in(i,k) - wp2thvp(i,k_cam) = wp2thvp_in(i,k) - up3(i,k_cam) = up3_in(i,k) - vp3(i,k_cam) = vp3_in(i,k) - thlm(i,k_cam) = thlm_in(i,k) - rtm(i,k_cam) = rtm_in(i,k) - wp3(i,k_cam) = wp3_in(i,k) - rtp3(i,k_cam) = rtp3_in(i,k) - thlp3(i,k_cam) = thlp3_in(i,k) - rcm(i,k_cam) = rcm_inout(i,k) - cloud_frac(i,k_cam) = min(cloud_frac_inout(i,k),1._r8) - rcm_in_layer(i,k_cam) = rcm_in_layer_out(i,k) - cloud_cover(i,k_cam) = min(cloud_cover_out(i,k),1._r8) - zt_out(i,k_cam) = zt_g(i,k) - wm_zt_out(i,k_cam) = wm_zt(i,k) - wp2rtp(i,k_cam) = wp2rtp_inout(i,k) - wp2thlp(i,k_cam) = wp2thlp_inout(i,k) - wpup2(i,k_cam) = wpup2_inout(i,k) - wpvp2(i,k_cam) = wpvp2_inout(i,k) - ice_supersat_frac(i,k_cam) = ice_supersat_frac_inout(i,k) + um_pbuf(i,k_cam) = um_in(i,k) + vm_pbuf(i,k_cam) = vm_in(i,k) + wp2thvp_pbuf(i,k_cam) = wp2thvp_in(i,k) + up3_pbuf(i,k_cam) = up3_in(i,k) + vp3_pbuf(i,k_cam) = vp3_in(i,k) + thlm_pbuf(i,k_cam) = thlm_in(i,k) + rtm_pbuf(i,k_cam) = rtm_in(i,k) + wp3_pbuf(i,k_cam) = wp3_in(i,k) + rtp3_pbuf(i,k_cam) = rtp3_in(i,k) + thlp3_pbuf(i,k_cam) = thlp3_in(i,k) + rcm_pbuf(i,k_cam) = rcm_inout(i,k) + cloud_frac_pbuf(i,k_cam) = min(cloud_frac_inout(i,k),1._r8) + wp2rtp_pbuf(i,k_cam) = wp2rtp_inout(i,k) + wp2thlp_pbuf(i,k_cam) = wp2thlp_inout(i,k) + wpup2_pbuf(i,k_cam) = wpup2_inout(i,k) + wpvp2_pbuf(i,k_cam) = wpvp2_inout(i,k) + ice_supersat_frac_pbuf(i,k_cam) = ice_supersat_frac_inout(i,k) qclvar(i,k_cam) = min(1._r8,qclvar_out(i,k)) - rtp2_zt_out(i,k_cam) = rtp2_zt(i,k) - thl2_zt_out(i,k_cam) = thl2_zt(i,k) - wp2_zt_out(i,k_cam) = wp2_zt(i,k) end do end do @@ -4383,100 +4291,31 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1, nzm_clubb do i=1, ncol k_cam = top_lev - 1 + k - upwp(i,k_cam) = upwp_in(i,k) - vpwp(i,k_cam) = vpwp_in(i,k) - wpthvp(i,k_cam) = wpthvp_in(i,k) - rtpthvp(i,k_cam) = rtpthvp_in(i,k) - thlpthvp(i,k_cam) = thlpthvp_in(i,k) - up2(i,k_cam) = up2_in(i,k) - vp2(i,k_cam) = vp2_in(i,k) - wprtp(i,k_cam) = wprtp_in(i,k) - wpthlp(i,k_cam) = wpthlp_in(i,k) - wp2(i,k_cam) = wp2_in(i,k) - rtp2(i,k_cam) = rtp2_in(i,k) - thlp2(i,k_cam) = thlp2_in(i,k) - rtpthlp(i,k_cam) = rtpthlp_in(i,k) - wprcp(i,k_cam) = wprcp_out(i,k) - pdf_zm_w_1(i,k_cam) = pdf_params_zm_chnk(lchnk)%w_1(i,k) - pdf_zm_w_2(i,k_cam) = pdf_params_zm_chnk(lchnk)%w_2(i,k) - pdf_zm_varnce_w_1(i,k_cam) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) - pdf_zm_varnce_w_2(i,k_cam) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) - pdf_zm_mixt_frac(i,k_cam) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) - zi_out(i,k_cam) = zi_g(i,k) - khzm(i,k_cam) = khzm_out(i,k) - uprcp(i,k_cam) = uprcp_inout(i,k) - vprcp(i,k_cam) = vprcp_inout(i,k) - rc_coef_zm(i,k_cam) = rc_coef_zm_inout(i,k) - wp4(i,k_cam) = wp4_inout(i,k) - wp2up2(i,k_cam) = wp2up2_inout(i,k) - wp2vp2(i,k_cam) = wp2vp2_inout(i,k) - end do - end do - - if ( edsclr_dim > 0 ) then - - !$acc parallel loop gang vector collapse(3) default(present) - do ixind=1,edsclr_dim - do k=1, nzt_clubb - do i=1, ncol - k_cam = top_lev - 1 + k - edsclr_out(i,k_cam,ixind) = edsclr_in(i,k,ixind) - end do - end do - end do - - end if - - if (do_clubb_mf) then - do k=1, nzm_clubb - do i=1, ncol - k_cam = top_lev - 1 + k - mf_dry_a_output(i,k_cam) = mf_dry_a(i,k) - mf_moist_a_output(i,k_cam) = mf_moist_a(i,k) - mf_dry_w_output(i,k_cam) = mf_dry_w(i,k) - mf_moist_w_output(i,k_cam) = mf_moist_w(i,k) - mf_dry_qt_output(i,k_cam) = mf_dry_qt(i,k) - mf_moist_qt_output(i,k_cam) = mf_moist_qt(i,k) - mf_dry_thl_output(i,k_cam) = mf_dry_thl(i,k) - mf_moist_thl_output(i,k_cam) = mf_moist_thl(i,k) - mf_dry_u_output(i,k_cam) = mf_dry_u(i,k) - mf_moist_u_output(i,k_cam) = mf_moist_u(i,k) - mf_dry_v_output(i,k_cam) = mf_dry_v(i,k) - mf_moist_v_output(i,k_cam) = mf_moist_v(i,k) - mf_moist_qc_output(i,k_cam) = mf_moist_qc(i,k) - mf_thlflx_output(i,k_cam) = mf_thlflx(i,k) - mf_qtflx_output(i,k_cam) = mf_qtflx(i,k) - s_ae_output(i,k_cam) = s_ae(i,k) - s_aw_output(i,k_cam) = s_aw(i,k) - s_awthl_output(i,k_cam) = s_awthl(i,k) - s_awqt_output(i,k_cam) = s_awqt(i,k) - s_awql_output(i,k_cam) = s_awql(i,k) - s_awqi_output(i,k_cam) = s_awqi(i,k) - s_awu_output(i,k_cam) = s_awu(i,k) - s_awv_output(i,k_cam) = s_awv(i,k) - mf_thlflx_output(i,k_cam) = mf_thlflx(i,k) - mf_qtflx_output(i,k_cam) = mf_qtflx(i,k) - end do - end do - end if - - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzt_clubb - do i=1, ncol - - mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) & - * pdf_params_chnk(lchnk)%rt_1(i,k) & - + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & - * pdf_params_chnk(lchnk)%rt_2(i,k) - - k_cam = top_lev - 1 + k - - pdfp_rtp2(i,k_cam) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & - * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & - + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & - + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & - * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 & - + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) + upwp_pbuf(i,k_cam) = upwp_in(i,k) + vpwp_pbuf(i,k_cam) = vpwp_in(i,k) + wpthvp_pbuf(i,k_cam) = wpthvp_in(i,k) + rtpthvp_pbuf(i,k_cam) = rtpthvp_in(i,k) + thlpthvp_pbuf(i,k_cam) = thlpthvp_in(i,k) + up2_pbuf(i,k_cam) = up2_in(i,k) + vp2_pbuf(i,k_cam) = vp2_in(i,k) + wprtp_pbuf(i,k_cam) = wprtp_in(i,k) + wpthlp_pbuf(i,k_cam) = wpthlp_in(i,k) + wp2_pbuf(i,k_cam) = wp2_in(i,k) + rtp2_pbuf(i,k_cam) = rtp2_in(i,k) + thlp2_pbuf(i,k_cam) = thlp2_in(i,k) + rtpthlp_pbuf(i,k_cam) = rtpthlp_in(i,k) + pdf_zm_w_1_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%w_1(i,k) + pdf_zm_w_2_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%w_2(i,k) + pdf_zm_varnce_w_1_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) + pdf_zm_varnce_w_2_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) + pdf_zm_mixt_frac_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) + khzm_pbuf(i,k_cam) = khzm_out(i,k) + uprcp_pbuf(i,k_cam) = uprcp_inout(i,k) + vprcp_pbuf(i,k_cam) = vprcp_inout(i,k) + rc_coef_zm_pbuf(i,k_cam) = rc_coef_zm_inout(i,k) + wp4_pbuf(i,k_cam) = wp4_inout(i,k) + wp2up2_pbuf(i,k_cam) = wp2up2_inout(i,k) + wp2vp2_pbuf(i,k_cam) = wp2vp2_inout(i,k) end do end do @@ -4487,17 +4326,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i=1, ncol ! Accumulate vars through macmic subcycle - upwp_clubb_gw_mc(i,k) = upwp_clubb_gw_mc(i,k) + upwp(i,k) - vpwp_clubb_gw_mc(i,k) = vpwp_clubb_gw_mc(i,k) + vpwp(i,k) - thlp2_clubb_gw_mc(i,k) = thlp2_clubb_gw_mc(i,k) + thlp2(i,k) - wpthlp_clubb_gw_mc(i,k) = wpthlp_clubb_gw_mc(i,k) + wpthlp(i,k) + upwp_clubb_gw_mc_pbuf(i,k) = upwp_clubb_gw_mc_pbuf(i,k) + upwp_pbuf(i,k) + vpwp_clubb_gw_mc_pbuf(i,k) = vpwp_clubb_gw_mc_pbuf(i,k) + vpwp_pbuf(i,k) + thlp2_clubb_gw_mc_pbuf(i,k) = thlp2_clubb_gw_mc_pbuf(i,k) + thlp2_pbuf(i,k) + wpthlp_clubb_gw_mc_pbuf(i,k) = wpthlp_clubb_gw_mc_pbuf(i,k) + wpthlp_pbuf(i,k) ! And average at last macmic step if (macmic_it == cld_macmic_num_steps) then - upwp_clubb_gw(i,k) = upwp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) - vpwp_clubb_gw(i,k) = vpwp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) - thlp2_clubb_gw(i,k) = thlp2_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) - wpthlp_clubb_gw(i,k) = wpthlp_clubb_gw_mc(i,k)/REAL(cld_macmic_num_steps,r8) + upwp_clubb_gw_pbuf(i,k) = upwp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) + vpwp_clubb_gw_pbuf(i,k) = vpwp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) + thlp2_clubb_gw_pbuf(i,k) = thlp2_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) + wpthlp_clubb_gw_pbuf(i,k) = wpthlp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) end if end do @@ -4509,41 +4348,21 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k=1, top_lev-1 do i=1, ncol - upwp(i,k) = 0._r8 - vpwp(i,k) = 0._r8 - rcm(i,k) = 0._r8 - wprcp(i,k) = 0._r8 - cloud_frac(i,k) = 0._r8 - rcm_in_layer(i,k) = 0._r8 - zt_out(i,k) = 0._r8 - zi_out(i,k) = 0._r8 - khzm(i,k) = 0._r8 + upwp_pbuf(i,k) = 0._r8 + vpwp_pbuf(i,k) = 0._r8 + rcm_pbuf(i,k) = 0._r8 + cloud_frac_pbuf(i,k) = 0._r8 + khzm_pbuf(i,k) = 0._r8 qclvar(i,k) = 2._r8 end do end do - ! enforce zero tracer tendencies above the top_lev level -- no change - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, top_lev-1 - do i=1, ncol - edsclr_out(i,k,icnt) = state1%q(i,k,ixind) - end do - end do - - end if - end do - ! Compute static energy using CLUBB's variables !$acc parallel loop gang vector collapse(2) default(present) do k=1,pver do i=1, ncol - clubb_s(i,k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) & - + latvap * rcm(i,k) & + clubb_s(i,k) = cpairv(i,k,lchnk) * thlm_pbuf(i,k) / inv_exner_clubb(i,k) & + + latvap * rcm_pbuf(i,k) & + gravit * state1%zm(i,k) + state1%phis(i) end do end do @@ -4556,7 +4375,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i=1, ncol clubbtop(i) = top_lev - do while ((rtp2(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver) + do while ((rtp2_pbuf(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm_pbuf(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver) clubbtop(i) = clubbtop(i) + 1 end do end do @@ -4578,9 +4397,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water ! after CLUBB is called. This is for energy conservation purposes. se_a = se_a + clubb_s(i,k)*state1%pdel(i,k)*rga - ke_a = ke_a + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)*rga - wv_a = wv_a + (rtm(i,k)-rcm(i,k))*state1%pdeldry(i,k)*rga - wl_a = wl_a + (rcm(i,k))*state1%pdeldry(i,k)*rga + ke_a = ke_a + 0.5_r8*(um_pbuf(i,k)**2+vm_pbuf(i,k)**2)*state1%pdel(i,k)*rga + wv_a = wv_a + (rtm_pbuf(i,k)-rcm_pbuf(i,k))*state1%pdeldry(i,k)*rga + wl_a = wl_a + (rcm_pbuf(i,k))*state1%pdeldry(i,k)*rga end do ! Based on these integrals, compute the total energy after CLUBB call @@ -4630,13 +4449,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, pverp - do i=1, ncol - wpthvp_clubb(i,k) = wpthvp(i,k) * cpair - wprcp_clubb(i,k) = wprcp(i,k) * latvap - end do - end do call t_stopf('clubb_tend_cam:ACCR') @@ -4653,36 +4465,40 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_init( ptend_loc, state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq ) - ! Now compute the tendencies of CLUBB to CAM - rtm_integral_vtend(:) = 0._r8 - rtm_integral_ltend(:) = 0._r8 do k=1, pver - do i=1, ncol - ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) * invrs_hdtime ! east-west wind - ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) * invrs_hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) * invrs_hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy + ! Now compute the tendencies of CLUBB to CAM + rtm_integral_vtend(i) = 0._r8 + rtm_integral_ltend(i) = 0._r8 - rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k) - rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k) + do i=1, ncol + + ptend_loc%u(i,k) = (um_pbuf(i,k) - state1%u(i,k)) * invrs_hdtime ! east-west wind + ptend_loc%v(i,k) = (vm_pbuf(i,k) - state1%v(i,k)) * invrs_hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = (rtm_pbuf(i,k) - rcm_pbuf(i,k)-state1%q(i,k,ixq)) * invrs_hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = (rcm_pbuf(i,k) - state1%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy + + rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k) + rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k) + + end do + + rtm_integral_ltend(i) = rtm_integral_ltend(i)/gravit + rtm_integral_vtend(i) = rtm_integral_vtend(i)/gravit - end do end do - rtm_integral_ltend(:) = rtm_integral_ltend(:)/gravit - rtm_integral_vtend(:) = rtm_integral_vtend(:)/gravit ! Accumulate Air Temperature Tendency (TTEND) for Gravity Wave parameterization do k=1, pver do i=1, ncol - ttend_clubb_mc(i,k) = ttend_clubb_mc(i,k) + ptend_loc%s(i,k)/cpair + ttend_clubb_mc_pbuf(i,k) = ttend_clubb_mc_pbuf(i,k) + ptend_loc%s(i,k)/cpair ! Average at last macmic step if (macmic_it == cld_macmic_num_steps) then - ttend_clubb(i,k) = ttend_clubb_mc(i,k) / REAL(cld_macmic_num_steps,r8) + ttend_clubb_pbuf(i,k) = ttend_clubb_mc_pbuf(i,k) / REAL(cld_macmic_num_steps,r8) end if end do @@ -4697,20 +4513,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Here add a constant to moments which can be either positive or ! negative. This is to prevent clipping when dynamics tries to ! make all constituents positive - wp3(i,k) = wp3(i,k) + wp3_const - rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const - wpthlp(i,k) = wpthlp(i,k) + wpthlp_const - wprtp(i,k) = wprtp(i,k) + wprtp_const - - ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) * invrs_hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) * invrs_hdtime ! RTP Variance - ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) * invrs_hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) * invrs_hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) * invrs_hdtime ! WPRTP - ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) * invrs_hdtime ! WP2 - ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) * invrs_hdtime ! WP3 - ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) * invrs_hdtime ! UP2 - ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) * invrs_hdtime ! VP2 + wp3_pbuf(i,k) = wp3_pbuf(i,k) + wp3_const + rtpthlp_pbuf(i,k) = rtpthlp_pbuf(i,k) + rtpthlp_const + wpthlp_pbuf(i,k) = wpthlp_pbuf(i,k) + wpthlp_const + wprtp_pbuf(i,k) = wprtp_pbuf(i,k) + wprtp_const + + ptend_loc%q(i,k,ixthlp2) = (thlp2_pbuf(i,k) - state1%q(i,k,ixthlp2)) * invrs_hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = (rtp2_pbuf(i,k) - state1%q(i,k,ixrtp2)) * invrs_hdtime ! RTP Variance + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp_pbuf(i,k) - state1%q(i,k,ixrtpthlp)) * invrs_hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = (wpthlp_pbuf(i,k) - state1%q(i,k,ixwpthlp)) * invrs_hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = (wprtp_pbuf(i,k) - state1%q(i,k,ixwprtp)) * invrs_hdtime ! WPRTP + ptend_loc%q(i,k,ixwp2) = (wp2_pbuf(i,k) - state1%q(i,k,ixwp2)) * invrs_hdtime ! WP2 + ptend_loc%q(i,k,ixwp3) = (wp3_pbuf(i,k) - state1%q(i,k,ixwp3)) * invrs_hdtime ! WP3 + ptend_loc%q(i,k,ixup2) = (up2_pbuf(i,k) - state1%q(i,k,ixup2)) * invrs_hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = (vp2_pbuf(i,k) - state1%q(i,k,ixvp2)) * invrs_hdtime ! VP2 end do end do @@ -4737,7 +4553,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. ! Loading up this array doesn't mean the tendencies are applied. - ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed + ! edsclr_in is compressed with just the constituents being used, ptend and state are not compressed icnt=0 do ixind=1,pcnst if (lq(ixind)) then @@ -4748,9 +4564,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then - do k=1, pver + ! Copy CLUBB's edsclr values + do k=top_lev, pver + do i=1, ncol + k_clubb = k + 1 - top_lev + ptend_loc%q(i,k,ixind) = (edsclr_in(i,k_clubb,icnt)-state1%q(i,k,ixind)) / hdtime ! transported constituents + end do + end do + + ! Zero out levels above top_lev + do k=1, top_lev-1 do i=1, ncol - ptend_loc%q(i,k,ixind) = (edsclr_out(i,k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents + ptend_loc%q(i,k,ixind) = 0._r8 end do end do @@ -4758,13 +4583,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end do - rvmtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - rcmtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - rimtend_clubb(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - stend_clubb(:ncol,:pver) = ptend_loc%s(:ncol,:pver) - utend_clubb(:ncol,:pver) = ptend_loc%u(:ncol,:pver) - vtend_clubb(:ncol,:pver) = ptend_loc%v(:ncol,:pver) - cmeliq(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + rvmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + rcmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + rimtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + stend_clubb_output(:ncol,:pver) = ptend_loc%s(:ncol,:pver) + utend_clubb_output(:ncol,:pver) = ptend_loc%u(:ncol,:pver) + vtend_clubb_output(:ncol,:pver) = ptend_loc%v(:ncol,:pver) + cmeliq_pbuf(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) ! ! set pbuf field so that HB scheme is only applied above CLUBB top @@ -4807,17 +4632,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qctend(:ncol,:)=0._r8 inctend(:ncol,:)=0._r8 - call liquid_macro_tend(npccn(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & + call liquid_macro_tend(npccn_pbuf(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,ixq), & state1%q(1:ncol,top_lev:pver,ixcldliq), state1%q(1:ncol,top_lev:pver,ixnumliq), & latvap, hdtime, stend(1:ncol,top_lev:pver),qvtend(1:ncol,top_lev:pver), & qctend(1:ncol,top_lev:pver), inctend(1:ncol,top_lev:pver), ncol * nzt_clubb ) ! update local copy of state with the tendencies - ptend_loc%q(:ncol,top_lev:pver,ixq)=qvtend(:ncol,top_lev:pver) - ptend_loc%q(:ncol,top_lev:pver,ixcldliq)=qctend(:ncol,top_lev:pver) - ptend_loc%q(:ncol,top_lev:pver,ixnumliq)=inctend(:ncol,top_lev:pver) - ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixq) = qvtend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixcldliq) = qctend(:ncol,top_lev:pver) + ptend_loc%q(:ncol,top_lev:pver,ixnumliq) = inctend(:ncol,top_lev:pver) + ptend_loc%s(:ncol,top_lev:pver) = stend(:ncol,top_lev:pver) ! Add the ice tendency to the output tendency call physics_ptend_sum(ptend_loc, ptend_all, ncol) @@ -4834,12 +4659,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'NCTENDICE', inctend, pcols, lchnk ) where(qctend .ne. 0._r8) - fqtend = 1._r8 + temp2d = 1._r8 elsewhere - fqtend = 0._r8 + temp2d = 0._r8 end where - call outfld( 'FQTENDICE', fqtend, pcols, lchnk ) + call outfld( 'FQTENDICE', temp2d, pcols, lchnk ) call t_stopf('clubb_cam_tend:do_liqsupersat') end if @@ -4854,7 +4679,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! --------------------------------------------------------------------------------- ! ! Initialize the shallow convective detrainment rate, will always be zero - dlf2(:,:) = 0.0_r8 + dlf2 = 0.0_r8 dlf_liq_out(:,:) = 0.0_r8 dlf_ice_out(:,:) = 0.0_r8 @@ -4864,6 +4689,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & lqice(ixnumliq) = .true. lqice(ixnumice) = .true. + dl_rad = clubb_detliq_rad + di_rad = clubb_detice_rad + dt_low = clubb_detphase_lowtemp + call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice) do k=1,pver @@ -4879,13 +4708,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1 - ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) & + ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2 )) * ( 1._r8 - dum1 ) ) & / (4._r8*3.14_r8*dl_rad**3*997._r8) + & ! Deep Convection - 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) & + 3._r8 * ( dlf2 * ( 1._r8 - dum1 ) ) & / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection - ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) & + ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2 )) * dum1 ) & / (4._r8*3.14_r8*di_rad**3*500._r8) + & ! Deep Convection - 3._r8 * ( dlf2(i,k) * dum1 ) & + 3._r8 * ( dlf2 * dum1 ) & / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice @@ -4905,10 +4734,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water - dpdlfliq(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - dpdlfice(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - dpdlft(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk) - detnliquid(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixnumliq) + dpdlfliq_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + dpdlfice_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + dpdlft_output(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk) + detnliquid_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixnumliq) call physics_ptend_sum(ptend_loc,ptend_all,ncol) call physics_update(state1,ptend_loc,hdtime) @@ -4937,15 +4766,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol do k = 1, pver - relvar(i,k) = relvarmax ! default + relvar_pbuf(i,k) = relvarmax ! default end do end do if (deep_scheme .ne. 'CLUBB_SGS') then do i = 1, ncol do k = 1, pver - if ( rcm(i,k) /= 0 .and. qclvar(i,k) /= 0 ) then - relvar(i,k) = min( relvarmax, max(0.001_r8, rcm(i,k)**2 / qclvar(i,k) ) ) + if ( rcm_pbuf(i,k) /= 0 .and. qclvar(i,k) /= 0 ) then + relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm_pbuf(i,k)**2 / qclvar(i,k) ) ) end if end do end do @@ -4954,52 +4783,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! ------------------------------------------------- ! ! Optional Accretion enhancement factor ! ! ------------------------------------------------- ! - accre_enhan(:ncol,:pver) = 1._r8 - - ! ------------------------------------------------- ! - ! Diagnose some output variables ! - ! ------------------------------------------------- ! - - ! density - rho(1:ncol,1:pver) = rga*state1%pdel(1:ncol,1:pver)/(state1%zi(1:ncol,1:pver)-state1%zi(1:ncol,2:pverp)) - rho(1:ncol,pverp) = rho(1:ncol,pver) - - wpthvp_diag(:,:) = 0.0_r8 - do k=1,pver - do i=1,ncol - eps = rairv(i,k,lchnk)*inv_rh2o - ! buoyancy flux - wpthvp_diag(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))+((1._r8-eps)/eps)*theta0* & - (wprtp(i,k)-(apply_const*wprtp_const))+((latvap/cpairv(i,k,lchnk))* & - state1%exner(i,k)-(1._r8/eps)*theta0)*wprcp(i,k) - - ! total water mixing ratio - qt_output(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)+state1%q(i,k,ixcldice) - ! liquid water potential temperature - thetal_output(i,k) = (state1%t(i,k)*state1%exner(i,k))-(latvap/cpairv(i,k,lchnk))*state1%q(i,k,ixcldliq) - ! liquid water static energy - sl_output(i,k) = cpairv(i,k,lchnk)*state1%t(i,k)+gravit*state1%zm(i,k)-latvap*state1%q(i,k,ixcldliq) - enddo - enddo + accre_enhan_pbuf(:ncol,:pver) = 1._r8 do k=1,pverp do i=1,ncol - wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux - wprtp_output(i,k) = (wprtp(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux - rtpthlp_output(i,k) = rtpthlp(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output - tke(i,k) = 0.5_r8*(up2(i,k)+vp2(i,k)+wp2(i,k)) ! turbulent kinetic energy - if (do_clubb_mf) then - mf_thlflx_output(i,k) = mf_thlflx_output(i,k)*rho(i,k)*cpair - mf_qtflx_output(i,k) = mf_qtflx_output(i,k)*rho(i,k)*latvap - end if + tke_pbuf(i,k) = 0.5_r8 * ( up2_pbuf(i,k) + vp2_pbuf(i,k) + wp2_pbuf(i,k) ) ! turbulent kinetic energy enddo enddo - do k=1,pver - do i=1,ncol - wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output - enddo - enddo ! --------------------------------------------------------------------------------- ! ! Diagnose some quantities that are computed in macrop_tend here. ! ! These are inputs required for the microphysics calculation. ! @@ -5008,13 +4799,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! --------------------------------------------------------------------------------- ! ! initialize variables - alst(:,:) = 0.0_r8 - qlst(:,:) = 0.0_r8 + alst_pbuf(:,:) = 0.0_r8 + qlst_pbuf(:,:) = 0.0_r8 do k=1,pver do i=1,ncol - alst(i,k) = cloud_frac(i,k) - qlst(i,k) = rcm(i,k)/max(0.01_r8,alst(i,k)) ! Incloud stratus condensate mixing ratio + alst_pbuf(i,k) = cloud_frac_pbuf(i,k) + qlst_pbuf(i,k) = rcm_pbuf(i,k)/max(0.01_r8,alst_pbuf(i,k)) ! Incloud stratus condensate mixing ratio enddo enddo @@ -5022,8 +4813,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! ! --------------------------------------------------------------------------------- ! - deepcu(:,:) = 0.0_r8 - shalcu(:,:) = 0.0_r8 + frac_limit = 0.01_r8 + ic_limit = 1.e-12_r8 + deepcu_pbuf(:,:) = 0.0_r8 + shalcu_pbuf(:,:) = 0.0_r8 do k=1,pver-1 do i=1,ncol @@ -5031,18 +4824,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! deep convective mass flux, read in from pbuf. Since shallow convection is never ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud ! fraction is purely from deep convection scheme. - deepcu(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh(i,k+1))),0.6_r8)) - shalcu(i,k) = 0._r8 + deepcu_pbuf(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh_pbuf(i,k+1))),0.6_r8)) + shalcu_pbuf(i,k) = 0._r8 - if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then - deepcu(i,k) = 0._r8 + if (deepcu_pbuf(i,k) <= frac_limit .or. dp_icwmr_pbuf(i,k) < ic_limit) then + deepcu_pbuf(i,k) = 0._r8 endif ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud ! from CLUBB plus the deep convective cloud fraction - concld(i,k) = min(cloud_frac(i,k)-alst(i,k)+deepcu(i,k),0.80_r8) + concld_pbuf(i,k) = min(cloud_frac_pbuf(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k),0.80_r8) enddo enddo @@ -5054,8 +4847,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & trim(scm_clubb_iop_name) == 'RICO_3day' .or. & trim(scm_clubb_iop_name) == 'ARM_CC') then - deepcu(:,:) = 0.0_r8 - concld(:,:) = 0.0_r8 + deepcu_pbuf(:,:) = 0.0_r8 + concld_pbuf(:,:) = 0.0_r8 endif endif @@ -5070,8 +4863,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !REMOVECAM_END call tropopause_findChemTrop( state, troplev ) - aist(:,:top_lev-1) = 0._r8 - qsatfac(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below + aist_pbuf(:,:top_lev-1) = 0._r8 + qsatfac_pbuf(:, :) = 0._r8 ! Zero out entire profile in case qsatfac is left undefined in aist_vector below do k = top_lev, pver @@ -5093,11 +4886,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if ( trim(subcol_scheme) == 'SILHS' ) then call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & - state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol ) + state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist_pbuf(:,k),ncol ) else call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & - state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol,& - qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) + state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist_pbuf(:,k),ncol,& + qsatfac_out=qsatfac_pbuf(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) endif enddo @@ -5114,8 +4907,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,pver do i=1,ncol - ast(i,k) = max(alst(i,k),aist(i,k)) - qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k)) + ast_pbuf(i,k) = max(alst_pbuf(i,k),aist_pbuf(i,k)) + qist_pbuf(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist_pbuf(i,k)) enddo enddo @@ -5123,7 +4916,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! be outputting the shallow convective cloud fraction do k=1,pver do i=1,ncol - cloud_frac(i,k) = min(ast(i,k)+deepcu(i,k),1.0_r8) + cloud_frac_pbuf(i,k) = min(ast_pbuf(i,k)+deepcu_pbuf(i,k),1.0_r8) enddo enddo @@ -5155,7 +4948,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Compute PBL depth according to Holtslag-Boville Scheme -- only pblh is needed here ! and other outputs are discarded !REMOVECAM - no longer need this when CAM is retired and pcols no longer exists - pblh(:) = 0._r8 + pblh_pbuf(:) = 0._r8 dummy2(:) = 0._r8 dummy3(:) = 0._r8 !REMOVECAM_END @@ -5168,93 +4961,265 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & zi = state1%zi(:ncol,:pverp), & u = state1%u(:ncol,:pver), & v = state1%v(:ncol,:pver), & - cldn = cloud_frac(:ncol,:pver), & + cldn = cloud_frac_pbuf(:ncol,:pver), & ! Inputs from CLUBB (not HB coefficients) thv = thv(:ncol,:pver), & ustar = ustar2(:ncol), & kbfs = kbfs(:ncol), & obklen = obklen(:ncol), & ! Output variables - pblh = pblh(:ncol), & + pblh = pblh_pbuf(:ncol), & wstar = dummy2(:ncol), & bge = dummy3(:ncol), & errmsg = errmsg, & errflg = errflg) ! Assign the first pver levels of cloud_frac back to cld - cld(:,1:pver) = cloud_frac(:,1:pver) + cld_pbuf(:,1:pver) = cloud_frac_pbuf(:,1:pver) ! --------------------------------------------------------------------------------- ! ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer ! ! --------------------------------------------------------------------------------- ! - call outfld( 'DETNLIQTND', detnliquid,pcols, lchnk ) + call outfld( 'DETNLIQTND', detnliquid_output,pcols, lchnk ) ! Output CLUBB tendencies (convert dry basis to wet for consistency with history variable definition) - call outfld( 'RVMTEND_CLUBB', rvmtend_clubb, pcols, lchnk) - call outfld( 'RCMTEND_CLUBB', rcmtend_clubb, pcols, lchnk) - call outfld( 'RIMTEND_CLUBB', rimtend_clubb, pcols, lchnk) - call outfld( 'STEND_CLUBB', stend_clubb, pcols, lchnk) - call outfld( 'UTEND_CLUBB', utend_clubb, pcols, lchnk) - call outfld( 'VTEND_CLUBB', vtend_clubb, pcols, lchnk) + call outfld( 'RVMTEND_CLUBB', rvmtend_clubb_output, pcols, lchnk) + call outfld( 'RCMTEND_CLUBB', rcmtend_clubb_output, pcols, lchnk) + call outfld( 'RIMTEND_CLUBB', rimtend_clubb_output, pcols, lchnk) + call outfld( 'STEND_CLUBB', stend_clubb_output, pcols, lchnk) + call outfld( 'UTEND_CLUBB', utend_clubb_output, pcols, lchnk) + call outfld( 'VTEND_CLUBB', vtend_clubb_output, pcols, lchnk) - call outfld( 'CMELIQ', cmeliq, pcols, lchnk) + call outfld( 'CMELIQ', cmeliq_pbuf, pcols, lchnk) ! output moist basis to be consistent with history variable definition - call outfld( 'DPDLFLIQ', dpdlfliq, pcols, lchnk) - call outfld( 'DPDLFICE', dpdlfice, pcols, lchnk) - call outfld( 'DPDLFT', dpdlft, pcols, lchnk) + call outfld( 'DPDLFLIQ', dpdlfliq_output, pcols, lchnk) + call outfld( 'DPDLFICE', dpdlfice_output, pcols, lchnk) + call outfld( 'DPDLFT', dpdlft_output, pcols, lchnk) ! Output the PBL depth - call outfld('PBLH', pblh, pcols, lchnk) + call outfld('PBLH', pblh_pbuf, pcols, lchnk) - call outfld('KVH_CLUBB', khzm, pcols, lchnk) + call outfld('KVH_CLUBB', khzm_pbuf, pcols, lchnk) call outfld('ELEAK_CLUBB', eleak, pcols, lchnk) call outfld('TFIX_CLUBB', se_dis, pcols, lchnk) + ! ------------------------------------------------- ! + ! Diagnose some output variables ! + ! ------------------------------------------------- ! + + ! density + rho(1:ncol,1:pver) = rga*state1%pdel(1:ncol,1:pver)/(state1%zi(1:ncol,1:pver)-state1%zi(1:ncol,2:pverp)) + rho(1:ncol,pverp) = rho(1:ncol,pver) + + do k = top_lev, pverp + do i = 1, ncol + + k_clubb = k + 1 - top_lev + + zi_output(i,k) = zi_g(i,k_clubb) + + wp2_output(i,k) = wp2_pbuf(i,k) + up2_output(i,k) = up2_pbuf(i,k) + vp2_output(i,k) = vp2_pbuf(i,k) + upwp_output(i,k) = upwp_pbuf(i,k) + vpwp_output(i,k) = vpwp_pbuf(i,k) + rtp2_output(i,k) = rtp2_pbuf(i,k) + wprcp_clubb_output(i,k) = wprcp_out(i,k_clubb) * latvap + wpthvp_clubb_output(i,k) = wpthvp_pbuf(i,k) * cpair + thlp2_output(i,k) = thlp2_pbuf(i,k) + + wpthlp_output(i,k) = (wpthlp_pbuf(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux + wprtp_output(i,k) = (wprtp_pbuf(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux + rtpthlp_output(i,k) = rtpthlp_pbuf(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output + + end do + end do + + ! Convert RTP2 and THLP2 to thermo grid for output + rtp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_in ) + thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) + wp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) + + do k = top_lev, pver + do i = 1, ncol + + k_clubb = k + 1 - top_lev + + rcm_output(i,k) = rcm_pbuf(i,k) + rtm_output(i,k) = rtm_pbuf(i,k) + thlm_output(i,k) = thlm_pbuf(i,k) + cloud_frac_output(i,k) = cloud_frac_pbuf(i,k) + um_output(i,k) = um_pbuf(i,k) + vm_output(i,k) = vm_pbuf(i,k) + + rcm_in_layer_output(i,k) = rcm_in_layer(i,k_clubb) + zt_output(i,k) = zt_g(i,k_clubb) + wm_zt_output(i,k) = wm_zt(i,k_clubb) + + rtp2_zt_output(i,k) = rtp2_zt(i,k_clubb) + thl2_zt_output(i,k) = thl2_zt(i,k_clubb) + wp2_zt_output(i,k) = wp2_zt(i,k_clubb) + + wp3_output(i,k) = wp3_pbuf(i,k) - (apply_const*wp3_const) ! wp3 output + + end do + end do + + do k=1, nzt_clubb + do i=1, ncol + + mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * pdf_params_chnk(lchnk)%rt_1(i,k) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * pdf_params_chnk(lchnk)%rt_2(i,k) + + k_cam = top_lev - 1 + k + + pdfp_rtp2_output(i,k_cam) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) + end do + end do + + do k = 1, top_lev-1 + do i = 1, ncol + wp2_output(i,k) = 0._r8 + up2_output(i,k) = 0._r8 + vp2_output(i,k) = 0._r8 + rtp2_output(i,k) = 0._r8 + thlp2_output(i,k) = 0._r8 + zt_output(i,k) = 0._r8 + rtp2_zt_output(i,k) = 0._r8 + wp3_output(i,k) = 0._r8 + thl2_zt_output(i,k) = 0._r8 + wp2_zt_output(i,k) = 0._r8 + rcm_in_layer_output(i,k) = 0._r8 + pdfp_rtp2_output(i,k) = 0._r8 + wm_zt_output(i,k) = 0._r8 + rcm_output(i,k) = 0._r8 + rtm_output(i,k) = 0._r8 + thlm_output(i,k) = 0._r8 + cloud_frac_output(i,k) = 0._r8 + um_output(i,k) = 0._r8 + vm_output(i,k) = 0._r8 + zi_output(i,k) = 0._r8 + wpthlp_output(i,k) = 0._r8 + rtpthlp_output(i,k) = 0._r8 + wprtp_output(i,k) = 0._r8 + upwp_output(i,k) = 0._r8 + vpwp_output(i,k) = 0._r8 + wprcp_clubb_output(i,k) = 0._r8 + wpthvp_clubb_output(i,k) = 0._r8 + end do + end do + ! Output calls of variables goes here - call outfld( 'RELVAR', relvar, pcols, lchnk ) - call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) - call outfld( 'WP2_CLUBB', wp2, pcols, lchnk ) - call outfld( 'UP2_CLUBB', up2, pcols, lchnk ) - call outfld( 'VP2_CLUBB', vp2, pcols, lchnk ) + call outfld( 'WP2_CLUBB', wp2_output, pcols, lchnk ) + call outfld( 'UP2_CLUBB', up2_output, pcols, lchnk ) + call outfld( 'VP2_CLUBB', vp2_output, pcols, lchnk ) call outfld( 'WP3_CLUBB', wp3_output, pcols, lchnk ) - call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk ) - call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk ) + call outfld( 'UPWP_CLUBB', upwp_output, pcols, lchnk ) + call outfld( 'VPWP_CLUBB', vpwp_output, pcols, lchnk ) call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) - call outfld( 'RTP2_CLUBB', rtp2, pcols, lchnk ) + call outfld( 'RTP2_CLUBB', rtp2_output, pcols, lchnk ) call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) - call outfld( 'RCM_CLUBB', rcm, pcols, lchnk ) - call outfld( 'RTM_CLUBB', rtm, pcols, lchnk ) - call outfld( 'THLM_CLUBB', thlm, pcols, lchnk ) - call outfld( 'WPRCP_CLUBB', wprcp_clubb, pcols, lchnk ) - call outfld( 'WPTHVP_CLUBB', wpthvp_clubb, pcols, lchnk ) - call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_out, pcols, lchnk ) - call outfld( 'THLP2_ZT_CLUBB', thl2_zt_out, pcols, lchnk ) - call outfld( 'WP2_ZT_CLUBB', wp2_zt_out, pcols, lchnk ) - call outfld( 'PDFP_RTP2_CLUBB', pdfp_rtp2, pcols, lchnk ) - call outfld( 'THLP2_CLUBB', thlp2, pcols, lchnk ) - call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer, pcols, lchnk ) - call outfld( 'CLOUDFRAC_CLUBB', alst, pcols, lchnk ) - call outfld( 'CLOUDCOVER_CLUBB', cloud_frac, pcols, lchnk ) - call outfld( 'ZT_CLUBB', zt_out, pcols, lchnk ) - call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk ) - call outfld( 'UM_CLUBB', um, pcols, lchnk ) - call outfld( 'VM_CLUBB', vm, pcols, lchnk ) - call outfld( 'WM_ZT_CLUBB', wm_zt_out, pcols, lchnk ) - call outfld( 'CONCLD', concld, pcols, lchnk ) - call outfld( 'DP_CLD', deepcu, pcols, lchnk ) + call outfld( 'RCM_CLUBB', rcm_output, pcols, lchnk ) + call outfld( 'RTM_CLUBB', rtm_output, pcols, lchnk ) + call outfld( 'THLM_CLUBB', thlm_output, pcols, lchnk ) + call outfld( 'WPRCP_CLUBB', wprcp_clubb_output, pcols, lchnk ) + call outfld( 'WPTHVP_CLUBB', wpthvp_clubb_output, pcols, lchnk ) + call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_output, pcols, lchnk ) + call outfld( 'THLP2_ZT_CLUBB', thl2_zt_output, pcols, lchnk ) + call outfld( 'WP2_ZT_CLUBB', wp2_zt_output, pcols, lchnk ) + call outfld( 'pdfp_rtp2_output_CLUBB', pdfp_rtp2_output, pcols, lchnk ) + call outfld( 'THLP2_CLUBB', thlp2_output, pcols, lchnk ) + call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer_output, pcols, lchnk ) + call outfld( 'CLOUDCOVER_CLUBB', cloud_frac_output, pcols, lchnk ) + call outfld( 'ZT_CLUBB', zt_output, pcols, lchnk ) + call outfld( 'ZM_CLUBB', zi_output, pcols, lchnk ) + call outfld( 'UM_CLUBB', um_output, pcols, lchnk ) + call outfld( 'VM_CLUBB', vm_output, pcols, lchnk ) + call outfld( 'WM_ZT_CLUBB', wm_zt_output, pcols, lchnk ) + + call outfld( 'RELVAR', relvar_pbuf, pcols, lchnk ) + call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) + call outfld( 'CLOUDFRAC_CLUBB', alst_pbuf, pcols, lchnk ) + call outfld( 'CONCLD', concld_pbuf, pcols, lchnk ) + call outfld( 'DP_CLD', deepcu_pbuf, pcols, lchnk ) call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk ) call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) - call outfld( 'QSATFAC', qsatfac, pcols, lchnk) + call outfld( 'QSATFAC', qsatfac_pbuf, pcols, lchnk) ! --------------------------------------------------------------- ! ! Writing state variables after EDMF scheme for detailed analysis ! ! --------------------------------------------------------------- ! if (do_clubb_mf) then + + do k = top_lev, pverp + do i = 1, ncol + k_clubb = k + 1 - top_lev + mf_dry_a_output(i,k) = mf_dry_a(i,k_clubb) + mf_moist_a_output(i,k) = mf_moist_a(i,k_clubb) + mf_dry_w_output(i,k) = mf_dry_w(i,k_clubb) + mf_moist_w_output(i,k) = mf_moist_w(i,k_clubb) + mf_dry_qt_output(i,k) = mf_dry_qt(i,k_clubb) + mf_moist_qt_output(i,k) = mf_moist_qt(i,k_clubb) + mf_dry_thl_output(i,k) = mf_dry_thl(i,k_clubb) + mf_moist_thl_output(i,k) = mf_moist_thl(i,k_clubb) + mf_dry_u_output(i,k) = mf_dry_u(i,k_clubb) + mf_moist_u_output(i,k) = mf_moist_u(i,k_clubb) + mf_dry_v_output(i,k) = mf_dry_v(i,k_clubb) + mf_moist_v_output(i,k) = mf_moist_v(i,k_clubb) + mf_moist_qc_output(i,k) = mf_moist_qc(i,k_clubb) + s_ae_output(i,k) = s_ae(i,k_clubb) + s_aw_output(i,k) = s_aw(i,k_clubb) + s_awthl_output(i,k) = s_awthl(i,k_clubb) + s_awqt_output(i,k) = s_awqt(i,k_clubb) + s_awql_output(i,k) = s_awql(i,k_clubb) + s_awqi_output(i,k) = s_awqi(i,k_clubb) + s_awu_output(i,k) = s_awu(i,k_clubb) + s_awv_output(i,k) = s_awv(i,k_clubb) + mf_thlflx_output(i,k) = mf_thlflx(i,k_clubb)*rho(i,k)*cpair + mf_qtflx_output(i,k) = mf_qtflx(i,k_clubb)*rho(i,k)*latvap + end do + end do + + do k = 1, top_lev-1 + do i = 1, ncol + mf_dry_a_output(i,k) = 0._r8 + mf_moist_a_output(i,k) = 0._r8 + mf_dry_w_output(i,k) = 0._r8 + mf_moist_w_output(i,k) = 0._r8 + mf_dry_qt_output(i,k) = 0._r8 + mf_moist_qt_output(i,k) = 0._r8 + mf_dry_thl_output(i,k) = 0._r8 + mf_moist_thl_output(i,k) = 0._r8 + mf_dry_u_output(i,k) = 0._r8 + mf_moist_u_output(i,k) = 0._r8 + mf_dry_v_output(i,k) = 0._r8 + mf_moist_v_output(i,k) = 0._r8 + mf_moist_qc_output(i,k) = 0._r8 + s_ae_output(i,k) = 0._r8 + s_aw_output(i,k) = 0._r8 + s_awthl_output(i,k) = 0._r8 + s_awqt_output(i,k) = 0._r8 + s_awql_output(i,k) = 0._r8 + s_awqi_output(i,k) = 0._r8 + s_awu_output(i,k) = 0._r8 + s_awv_output(i,k) = 0._r8 + mf_thlflx_output(i,k) = 0._r8 + mf_qtflx_output(i,k) = 0._r8 + end do + end do + call outfld( 'edmf_DRY_A' , mf_dry_a_output, pcols, lchnk ) call outfld( 'edmf_MOIST_A' , mf_moist_a_output, pcols, lchnk ) call outfld( 'edmf_DRY_W' , mf_dry_w_output, pcols, lchnk ) @@ -5276,6 +5241,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'edmf_S_AWV' , s_awv_output, pcols, lchnk ) call outfld( 'edmf_thlflx' , mf_thlflx_output, pcols, lchnk ) call outfld( 'edmf_qtflx' , mf_qtflx_output, pcols, lchnk ) + end if ! Output CLUBB history here @@ -5387,12 +5353,12 @@ end subroutine clubb_emissions_cam ! Saturation adjustment for ice ! Add ice mass if supersaturated -subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend,vlen) +subroutine ice_macro_tend(naai_pbuf,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend,vlen) use wv_sat_methods, only: wv_sat_qsat_ice integer, intent(in) :: vlen - real(r8), dimension(vlen), intent(in) :: naai !Activated number of ice nuclei + real(r8), dimension(vlen), intent(in) :: naai_pbuf !Activated number of ice nuclei real(r8), dimension(vlen), intent(in) :: t !temperature (k) real(r8), dimension(vlen), intent(in) :: p !pressure (pa) real(r8), dimension(vlen), intent(in) :: qv !water vapor mixing ratio @@ -5422,7 +5388,7 @@ subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nite end do do i = 1, vlen - if (naai(i) > 1.e-18_r8 .and. qv(i) > QSI(i)) then + if (naai_pbuf(i) > 1.e-18_r8 .and. qv(i) > QSI(i)) then qitend(i) = (qv(i)-QSI(i))/deltat qvtend(i) = 0._r8 - qitend(i) From 8ba8c44cd9726edc72c3c0af2cf2c91d554fbe17 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Sat, 22 Nov 2025 16:22:04 -0600 Subject: [PATCH 12/29] Safe and easy redimensionings --- src/physics/cam/clubb_intr.F90 | 535 ++++++++++++++------------------- 1 file changed, 232 insertions(+), 303 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index c55ea30a7d..c4e1afeee4 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -31,111 +31,90 @@ module clubb_intr use atmos_phys_pbl_utils,only: calc_friction_velocity, calc_kinematic_heat_flux, calc_ideal_gas_rrho, & calc_kinematic_water_vapor_flux, calc_kinematic_buoyancy_flux, calc_obukhov_length use ref_pres, only: top_lev => trop_cloud_top_lev + use scamMOD, only: single_column, scm_clubb_iop_name, scm_cambfb_mode #ifdef CLUBB_SGS - use clubb_api_module, only: pdf_parameter, implicit_coefs_terms - use clubb_api_module, only: clubb_config_flags_type, grid, stats, & + use clubb_api_module, only: pdf_parameter, implicit_coefs_terms, & + clubb_config_flags_type, grid, stats, & nu_vertical_res_dep, stats_metadata_type, & - hm_metadata_type, sclr_idx_type + hm_metadata_type, sclr_idx_type, & + nparams - use clubb_api_module, only: nparams use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag use cloud_fraction, only: dp1, dp2 #endif - use scamMOD, only: single_column,scm_clubb_iop_name,scm_cambfb_mode implicit none #ifdef CLUBB_SGS + +#endif + + private + + save + + ! Subroutines to make public + public :: clubb_ini_cam, clubb_register_cam, clubb_tend_cam, clubb_emissions_cam, & + clubb_readnl, clubb_init_cnst, clubb_implements_cnst + +#ifdef CLUBB_SGS + + ! NOTE: the only reason for anything in this section being set to public is for use with SILHS + + public :: stats_init_clubb, stats_end_timestep_clubb + + type(clubb_config_flags_type), public :: & + clubb_config_flags + + real(r8), dimension(1,nparams), public :: & + clubb_params_single_col ! Adjustable CLUBB parameters (C1, C2 ...) + ! Variables that contains all the statistics - type (stats), target, save :: stats_zt(pcols), & ! stats_zt grid - stats_zm(pcols), & ! stats_zm grid - stats_rad_zt(pcols), & ! stats_rad_zt grid - stats_rad_zm(pcols), & ! stats_rad_zm grid - stats_sfc(pcols) ! stats_sfc - type (hm_metadata_type) :: & + type (stats), save, public :: & + stats_zt(pcols), & ! stats_zt grid + stats_zm(pcols), & ! stats_zm grid + stats_rad_zt(pcols), & ! stats_rad_zt grid + stats_rad_zm(pcols), & ! stats_rad_zm grid + stats_sfc(pcols) ! stats_sfc + + type (hm_metadata_type), public :: & hm_metadata - type (stats_metadata_type) :: & + type (stats_metadata_type), public :: & stats_metadata - type (sclr_idx_type) :: & + type (sclr_idx_type), public :: & sclr_idx logical, public, parameter :: & - l_ascending_grid = .false. ! Set clubb to ascending mode, which is opposite of the + l_ascending_grid = .true. ! Set clubb to ascending mode, which is opposite of the ! cam grid the rest of this code uses, thus it requires ! an expensive array flipping step before calling clubb - integer :: & + integer, public :: & nzm_clubb, & ! Number of vertical levels used by CLUBB momentum variables nzt_clubb ! Number of vertical levels used by CLUBB thermodynamic variables -#endif - - private - save - - ! ----------------- ! - ! Public interfaces ! - ! ----------------- ! - - public :: clubb_ini_cam, clubb_register_cam, clubb_tend_cam, clubb_emissions_cam, & -#ifdef CLUBB_SGS - ! This utilizes CLUBB specific variables in its interface - stats_init_clubb, & - stats_metadata, & - stats_zt, stats_zm, stats_sfc, & - stats_rad_zt, stats_rad_zm, & - stats_end_timestep_clubb, & - nzm_clubb, & - nzt_clubb, & -#endif - clubb_readnl, & - clubb_init_cnst, & - clubb_implements_cnst - -#ifdef CLUBB_SGS - ! Both of these utilize CLUBB specific variables in their interface - private :: stats_zero, stats_avg -#endif - - logical, public :: do_cldcool - logical :: clubb_do_icesuper + ! These are zero by default, but will be set by SILHS before they are used by subcolumns + integer, public :: & + hydromet_dim = 0, & + pdf_dim = 0 -#ifdef CLUBB_SGS - type(clubb_config_flags_type), public :: clubb_config_flags - real(r8), dimension(1,nparams), public :: clubb_params_single_col ! Adjustable CLUBB parameters (C1, C2 ...) -#endif + type(pdf_parameter), allocatable, public :: & + pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] - ! These are zero by default, but will be set by SILHS before they are used by subcolumns - integer :: & - hydromet_dim = 0, & - pdf_dim = 0 + type(pdf_parameter), allocatable :: & + pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] + type(implicit_coefs_terms), allocatable :: & + pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] - ! ------------------------ ! - ! Sometimes private data ! - ! ------------------------ ! -#ifdef CLUBB_SGS -#ifdef SILHS - ! If SILHS is in use, it will initialize these - public :: & - hydromet_dim, & - pdf_dim, & - hm_metadata -#else - ! If SILHS is not in use, there is no need for them to be public - private :: & - hydromet_dim, & - pdf_dim, & - hm_metadata -#endif #endif - ! ------------ ! - ! Private data ! - ! ------------ ! + ! ------------------------------------------------------------ ! + ! CONSTANTS ! + ! ------------------------------------------------------------ ! integer, parameter :: & grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels @@ -166,11 +145,62 @@ module clubb_intr rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected real(r8), parameter :: unset_r8 = huge(1.0_r8) + integer, parameter :: unset_i = huge(1) ! Commonly used temperature for the melting temp of ice crystals [K] real(r8), parameter :: meltpt_temp = 268.15_r8 + logical, parameter, private :: & + l_implemented = .true. ! Implemented in a host model (always true) + + ! ----------------------------------------------------------------- ! + ! Things shared between subroutines: generally because they are ! + ! set by an initialization routine, then used by clubb_tend_cam ! + ! ----------------------------------------------------------------- ! + + logical :: do_cldcool + logical :: clubb_do_icesuper + + logical :: & + clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes + + logical :: lq(pcnst) + logical :: do_rainturb + logical :: clubb_do_adv + logical :: clubb_do_liqsupersat = .false. + logical :: clubb_do_energyfix = .true. + integer :: edsclr_dim ! Number of scalars to transport in CLUBB + + integer :: & + ixthlp2 = 0, & + ixwpthlp = 0, & + ixwprtp = 0, & + ixwp2 = 0, & + ixwp3 = 0, & + ixrtpthlp = 0, & + ixrtp2 = 0, & + ixup2 = 0, & + ixvp2 = 0 + + ! Output arrays for CLUBB statistics + real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc + + ! Outputs from phys_getopts + character(len=16) :: eddy_scheme ! Default set in phys_control.F90 + character(len=16) :: deep_scheme ! Default set in phys_control.F90 + logical :: history_budget + integer :: history_budget_histfile_num + logical :: do_hb_above_clubb = .false. + + character(len=16) :: subcol_scheme + + ! For clubb_do_adv + integer, parameter :: ncnst=9 + character(len=8) :: cnst_names(ncnst) + logical :: do_cnst=.false. + + real(r8) :: clubb_timestep = unset_r8 ! Default CLUBB timestep, unless overwriten by namelist real(r8) :: clubb_rnevap_effic = unset_r8 @@ -370,29 +400,9 @@ module clubb_intr clubb_l_wp2_fill_holes_tke, & ! Whether TKE is taken from up2 and vp2 to fill holes in wp2 clubb_l_add_dycore_grid ! Flag to remap values from dycore grid - - logical :: & - clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes - -! Constant parameters - logical, parameter, private :: & - l_implemented = .true. ! Implemented in a host model (always true) - - logical, parameter, private :: & - apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh)) - - logical :: lq(pcnst) - logical :: do_rainturb - logical :: clubb_do_adv - logical :: clubb_do_liqsupersat = .false. - logical :: clubb_do_energyfix = .true. - logical :: history_budget - logical :: do_hb_above_clubb = .false. - integer :: history_budget_histfile_num - integer :: edsclr_dim ! Number of scalars to transport in CLUBB - integer :: offset - -! define physics buffer indicies here + ! ------------------------------------------------------------ ! + ! Indices for physics buffer (pbuf) ! + ! ------------------------------------------------------------ ! integer :: & wp2_idx, & ! vertical velocity variances wp3_idx, & ! third moment of vertical velocity @@ -456,18 +466,18 @@ module clubb_intr ztodt_idx,& ! physics timestep for SILHS clubbtop_idx ! level index for CLUBB top - ! For Gravity Wave code + ! For Gravity Wave code integer :: & - ttend_clubb_idx, & - ttend_clubb_mc_idx, & - upwp_clubb_gw_idx, & - upwp_clubb_gw_mc_idx, & - vpwp_clubb_gw_idx, & - vpwp_clubb_gw_mc_idx, & - thlp2_clubb_gw_idx, & - thlp2_clubb_gw_mc_idx, & - wpthlp_clubb_gw_idx, & - wpthlp_clubb_gw_mc_idx + ttend_clubb_idx, & + ttend_clubb_mc_idx, & + upwp_clubb_gw_idx, & + upwp_clubb_gw_mc_idx, & + vpwp_clubb_gw_idx, & + vpwp_clubb_gw_mc_idx, & + thlp2_clubb_gw_idx, & + thlp2_clubb_gw_mc_idx, & + wpthlp_clubb_gw_idx, & + wpthlp_clubb_gw_mc_idx ! Indices for microphysical covariance tendencies integer :: & @@ -484,44 +494,8 @@ module clubb_intr pdf_zm_varnce_w_2_idx, & pdf_zm_mixt_frac_idx - integer, public :: & - ixthlp2 = 0, & - ixwpthlp = 0, & - ixwprtp = 0, & - ixwp2 = 0, & - ixwp3 = 0, & - ixrtpthlp = 0, & - ixrtp2 = 0, & - ixup2 = 0, & - ixvp2 = 0 - - integer :: cmfmc_sh_idx = 0 - integer :: & - dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio. - dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen. - dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen. - - ! Output arrays for CLUBB statistics - real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc - - character(len=16) :: eddy_scheme ! Default set in phys_control.F90 - character(len=16) :: deep_scheme ! Default set in phys_control.F90 - character(len=16) :: subcol_scheme - - integer, parameter :: ncnst=9 - character(len=8) :: cnst_names(ncnst) - logical :: do_cnst=.false. - -#ifdef CLUBB_SGS - type(pdf_parameter), target, allocatable, public :: & - pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] - - type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] - - type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] - -#endif + cmfmc_sh_idx = 0 contains @@ -573,6 +547,11 @@ subroutine clubb_register_cam( ) call cnst_add(trim(cnst_names(9)),0._r8,0._r8,0._r8,ixvp2,longname='CLUBB 2nd moment v wind',cam_outfld=.false.) end if + ! Determine number of vertical levels used in clubb, thermo variables are nzt_clubb + ! and momentum variables are nzm_clubb + nzt_clubb = pver + 1 - top_lev + nzm_clubb = pverp + 1 - top_lev + if (do_hb_above_clubb) then call pbuf_add_field('clubbtop', 'physpkg', dtype_i4, (/pcols/), clubbtop_idx) endif @@ -612,21 +591,21 @@ subroutine clubb_register_cam( ) ! Only in clubb_intr.F90, these are safe to dimensions (ngrdcol,nzm_clubb) or (ngrdcol,nzt_clubb) - call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_w_1_idx) - call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_w_2_idx) - call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_varnce_w_1_idx) - call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_varnce_w_2_idx) - call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp/), pdf_zm_mixt_frac_idx) - - call pbuf_add_field('WPTHVP', 'global', dtype_r8, (/pcols,pverp/), wpthvp_idx) - call pbuf_add_field('RTPTHVP', 'global', dtype_r8, (/pcols,pverp/), rtpthvp_idx) - call pbuf_add_field('THLPTHVP', 'global', dtype_r8, (/pcols,pverp/), thlpthvp_idx) - call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,pverp/), uprcp_idx) - call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,pverp/), vprcp_idx) - call pbuf_add_field('RC_COEF_ZM', 'global', dtype_r8, (/pcols,pverp/), rc_coef_zm_idx) - call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,pverp/), wp4_idx) - call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,pverp/), wp2up2_idx) - call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,pverp/), wp2vp2_idx) + call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_w_1_idx) + call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_w_2_idx) + call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_varnce_w_1_idx) + call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_varnce_w_2_idx) + call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,nzm_clubb/), pdf_zm_mixt_frac_idx) + + call pbuf_add_field('WPTHVP', 'global', dtype_r8, (/pcols,nzm_clubb/), wpthvp_idx) + call pbuf_add_field('RTPTHVP', 'global', dtype_r8, (/pcols,nzm_clubb/), rtpthvp_idx) + call pbuf_add_field('THLPTHVP', 'global', dtype_r8, (/pcols,nzm_clubb/), thlpthvp_idx) + call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,nzm_clubb/), uprcp_idx) + call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,nzm_clubb/), vprcp_idx) + call pbuf_add_field('RC_COEF_ZM', 'global', dtype_r8, (/pcols,nzm_clubb/), rc_coef_zm_idx) + call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,nzm_clubb/), wp4_idx) + call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2up2_idx) + call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2vp2_idx) call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp/), upwp_idx) call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp/), vpwp_idx) @@ -642,19 +621,21 @@ subroutine clubb_register_cam( ) call pbuf_add_field('THLP2_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_mc_idx) call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_mc_idx) - call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,pver/), wp2thvp_idx) + call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thvp_idx) call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pver/), rcm_idx) - call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pver/), wp2rtp_idx) - call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pver/), wp2thlp_idx) - call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pver/), wpup2_idx) - call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pver/), wpvp2_idx) + call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2rtp_idx) + call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thlp_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpvp2_idx) call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pver/), um_idx) call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pver/), vm_idx) - call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,pver/), rtp3_idx) - call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,pver/), thlp3_idx) - call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,pver/), up3_idx) - call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,pver/), vp3_idx) + call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,nzt_clubb/), rtp3_idx) + call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,nzt_clubb/), thlp3_idx) + call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,nzt_clubb/), up3_idx) + call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,nzt_clubb/), vp3_idx) + + call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pver/), cloud_frac_idx) ! Only in clubb_intr.F90 or SILHS call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pver/), ice_supersat_idx) @@ -663,16 +644,11 @@ subroutine clubb_register_cam( ) call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pver/), rtm_idx) - ! Things output - ! Only in clubb_intr.F90, these are safe to dimensions (ngrdcol,nzm_clubb) or (ngrdcol,nzt_clubb) call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp/), up2_idx) call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp/), vp2_idx) call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pver/), wp3_idx) - call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pver/), cloud_frac_idx) - - ! Only in clubb_intr.F90 or SILHS ! Used in clubb intr and microp_aero? call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) @@ -1478,8 +1454,6 @@ subroutine clubb_ini_cam(pbuf2d) ! None !------------------------------------------------------------------------------- - - #ifdef CLUBB_SGS ! From CAM libraries @@ -1528,7 +1502,9 @@ subroutine clubb_ini_cam(pbuf2d) #endif use physics_buffer, only: pbuf_get_index, pbuf_set_field, physics_buffer_desc + implicit none + ! Input Variables type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -1582,11 +1558,6 @@ subroutine clubb_ini_cam(pbuf2d) call endrun('clubb_ini_cam: CLUBB library core_rknd must match CAM r8 and it does not') end if - ! Determine number of vertical levels used in clubb, thermo variables are nzt_clubb - ! and momentum variables are nzm_clubb - nzt_clubb = pver + 1 - top_lev - nzm_clubb = pverp + 1 - top_lev - ! Allocate PDF parameters across columns and chunks allocate( & pdf_params_chnk(begchunk:endchunk), & @@ -1679,8 +1650,8 @@ subroutine clubb_ini_cam(pbuf2d) ! ----------------------------------------------------------------- ! if (clubb_l_do_expldiff_rtm_thlm) then - offset = 2 ! diffuse temperature and moisture explicitly - edsclr_dim = edsclr_dim + offset + ! add 2 since we want to diffuse temperature and moisture explicitly as well + edsclr_dim = edsclr_dim + 2 endif ! ----------------------------------------------------------------- ! @@ -2361,8 +2332,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rfrzm, & um_in, & ! meridional wind [m/s] vm_in, & ! zonal wind [m/s] - up3_in, & ! meridional wind third-order [m^3/s^3] - vp3_in, & ! zonal wind third-order [m^3/s^3] thlm_in, & ! liquid water potential temperature (thetal) [K] rvm_in, & ! water vapor mixing ratio [kg/kg] rtm_in, & ! total water mixing ratio [kg/kg] @@ -2370,11 +2339,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_zt, & ! CLUBB R-tot variance on thermo levs thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2] wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2] - rtp3_in, & ! total water 3rd order [kg^3/kg^3] - thlp3_in, & ! thetal 3rd order [K^3] rcm_inout, & ! CLUBB output of liquid water mixing ratio [kg/kg] cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction] - wp2thvp_in, & ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] ice_supersat_frac_inout, & um_pert_inout, & ! Perturbed U wind [m/s] vm_pert_inout, & ! Perturbed V wind [m/s] @@ -2388,10 +2354,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pre_in, & ! input for precip evaporation qrl_clubb, & qclvar_out, & ! cloud water variance [kg^2/kg^2] - wp2rtp_inout, & ! w'^2 rt' (thermodynamic levels) - wp2thlp_inout, & ! w'^2 thl' (thermodynamic levels) - wpup2_inout, & ! w'u'^2 (thermodynamic levels) - wpvp2_inout, & ! w'v'^2 (thermodynamic levels) zt_g, & ! Thermodynamic grid of CLUBB [m] Lscale, & @@ -2424,9 +2386,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_in, & ! total water variance [kg^2/kg^2] thlp2_in, & ! thetal variance [K^2] rtpthlp_in, & ! covariance of thetal and qt [kg/kg K] - wpthvp_in, & ! w'th_v' (momentum levels) [m/s K] - rtpthvp_in, & ! r_t'th_v' (momentum levels) [kg/kg K] - thlpthvp_in, & ! th_l'th_v' (momentum levels) [K^2] upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] khzm_out, & ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] @@ -2440,10 +2399,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtpthlp_mc_out, & uprcp_inout, & ! < u' r_c' > (momentum levels) vprcp_inout, & ! < v' r_c' > (momentum levels) - rc_coef_zm_inout, & ! Coef. of X'r_c' in Eq. (34) (t-levs.) - wp4_inout, & ! w'^4 (momentum levels - wp2up2_inout, & ! w'^2 u'^2 (momentum levels) - wp2vp2_inout, & ! w'^2 v'^2 (momentum levels) zi_g, & ! Momentum grid of CLUBB [m] ! MF Plume @@ -2800,9 +2755,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Allocate pdf_params only if they aren't allocated already. if ( .not. allocated(pdf_params_chnk(lchnk)%mixt_frac) ) then call init_pdf_params_api( nzt_clubb, ncol, pdf_params_chnk(lchnk) ) - call init_pdf_params_api( nzm_clubb, ncol, pdf_params_zm_chnk(lchnk) ) end if + ! pdf_params_zm are only used if l_call_pdf_closure_twice=.true. + if ( clubb_config_flags%l_call_pdf_closure_twice ) then + if ( .not. allocated(pdf_params_zm_chnk(lchnk)%mixt_frac) ) then + call init_pdf_params_api( nzm_clubb, ncol, pdf_params_zm_chnk(lchnk) ) + end if + end if + + ! pdf_implicit_coefs_terms are only used if iiPDF_type = iiPDF_new or iiPDF_new_hybrid if ( clubb_config_flags%iiPDF_type == iiPDF_new .or. & clubb_config_flags%iiPDF_type == iiPDF_new_hybrid ) then @@ -2908,11 +2870,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc rcm_pbuf, khzm_pbuf, qclvar, thv, dz_g, & !$acc clubbtop, se_dis, eleak, clubb_s ) & !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & - !$acc fcor, um_in, vm_in, upwp_in, vpwp_in, wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & - !$acc up2_in, vp2_in, up3_in, vp3_in, wp2_in, wp3_in, rtp2_in, thlp2_in, rtp3_in, & + !$acc fcor, um_in, vm_in, upwp_in, vpwp_in, & + !$acc up2_in, vp2_in, wp2_in, wp3_in, rtp2_in, thlp2_in, & !$acc thlp3_in, thlm_in, rtm_in, rvm_in, wprtp_in, wpthlp_in, rtpthlp_in, cloud_frac_inout, & - !$acc rcm_inout, wp2rtp_inout, wp2thlp_inout, uprcp_inout, vprcp_inout, & - !$acc rc_coef_zm_inout, wp4_inout, wpup2_inout, wpvp2_inout, wp2up2_inout, wp2vp2_inout, & + !$acc rcm_inout, uprcp_inout, vprcp_inout, & !$acc ice_supersat_frac_inout, pre_in, kappa_zt, qc_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & !$acc invrs_exner_zm, cloud_cover_out, rcm_in_layer, wprcp_out, & !$acc qclvar_out, w_up_in_cloud_out, cloudy_downdraft_frac_out, & @@ -3522,23 +3483,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k um_in(i,k) = um_pbuf(i,k_cam) vm_in(i,k) = vm_pbuf(i,k_cam) - wp2thvp_in(i,k) = wp2thvp_pbuf(i,k_cam) - up3_in(i,k) = up3_pbuf(i,k_cam) - vp3_in(i,k) = vp3_pbuf(i,k_cam) wp3_in(i,k) = wp3_pbuf(i,k_cam) - rtp3_in(i,k) = rtp3_pbuf(i,k_cam) - thlp3_in(i,k) = thlp3_pbuf(i,k_cam) thlm_in(i,k) = thlm_pbuf(i,k_cam) rtm_in(i,k) = rtm_pbuf(i,k_cam) - rvm_in(i,k) = state1%q(i,k_cam,ixq) cloud_frac_inout(i,k) = cloud_frac_pbuf(i,k_cam) - rcm_inout(i,k) = state1%q(i,k_cam,ixcldliq) - wp2rtp_inout(i,k) = wp2rtp_pbuf(i,k_cam) - wp2thlp_inout(i,k) = wp2thlp_pbuf(i,k_cam) - wpup2_inout(i,k) = wpup2_pbuf(i,k_cam) - wpvp2_inout(i,k) = wpvp2_pbuf(i,k_cam) ice_supersat_frac_inout(i,k) = ice_supersat_frac_pbuf(i,k_cam) pre_in(i,k) = prer_evap_pbuf(i,k_cam) + + rcm_inout(i,k) = state1%q(i,k_cam,ixcldliq) + rvm_in(i,k) = state1%q(i,k_cam,ixq) end do end do @@ -3549,9 +3502,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k upwp_in(i,k) = upwp_pbuf(i,k_cam) vpwp_in(i,k) = vpwp_pbuf(i,k_cam) - wpthvp_in(i,k) = wpthvp_pbuf(i,k_cam) - rtpthvp_in(i,k) = rtpthvp_pbuf(i,k_cam) - thlpthvp_in(i,k)= thlpthvp_pbuf(i,k_cam) up2_in(i,k) = up2_pbuf(i,k_cam) vp2_in(i,k) = vp2_pbuf(i,k_cam) wp2_in(i,k) = wp2_pbuf(i,k_cam) @@ -3560,29 +3510,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_in(i,k) = wprtp_pbuf(i,k_cam) wpthlp_in(i,k) = wpthlp_pbuf(i,k_cam) rtpthlp_in(i,k) = rtpthlp_pbuf(i,k_cam) - uprcp_inout(i,k) = uprcp_pbuf(i,k_cam) - vprcp_inout(i,k) = vprcp_pbuf(i,k_cam) - rc_coef_zm_inout(i,k) = rc_coef_zm_pbuf(i,k_cam) - wp4_inout(i,k) = wp4_pbuf(i,k_cam) - wp2up2_inout(i,k) = wp2up2_pbuf(i,k_cam) - wp2vp2_inout(i,k) = wp2vp2_pbuf(i,k_cam) end do end do - ! We only need to copy pdf_params from pbuf if this is a restart and - ! we're calling pdf_closure at the end of advance_clubb_core + ! We only need to copy pdf_params from pbuf if this is a restart, we're calling pdf_closure + ! at the end of advance_clubb_core, and calling it twice for pdf_params_zm as well if ( is_first_restart_step() & + .and. clubb_config_flags%l_call_pdf_closure_twice & .and. clubb_config_flags%ipdf_call_placement .eq. ipdf_post_advance_fields ) then !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol - k_cam = top_lev - 1 + k - pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1_pbuf(i,k_cam) - pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2_pbuf(i,k_cam) - pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1_pbuf(i,k_cam) - pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2_pbuf(i,k_cam) - pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac_pbuf(i,k_cam) + pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1_pbuf(i,k) + pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2_pbuf(i,k) + pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1_pbuf(i,k) + pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2_pbuf(i,k) + pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac_pbuf(i,k) end do end do @@ -3822,21 +3766,21 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rfrzm = rfrzm(:,nzt_clubb:1:-1) um_in = um_in(:,nzt_clubb:1:-1) vm_in = vm_in(:,nzt_clubb:1:-1) - up3_in = up3_in(:,nzt_clubb:1:-1) - vp3_in = vp3_in(:,nzt_clubb:1:-1) + up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) + vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) wp3_in = wp3_in(:,nzt_clubb:1:-1) - rtp3_in = rtp3_in(:,nzt_clubb:1:-1) - thlp3_in = thlp3_in(:,nzt_clubb:1:-1) + rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) + thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) rcm_inout = rcm_inout(:,nzt_clubb:1:-1) cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) - wpup2_inout = wpup2_inout(:,nzt_clubb:1:-1) - wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) - wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) - wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) + wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) + wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) + wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) + wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) - wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) + wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) rtm_in = rtm_in(:,nzt_clubb:1:-1) thlm_in = thlm_in(:,nzt_clubb:1:-1) @@ -3860,15 +3804,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_in = rtp2_in(:,nzm_clubb:1:-1) thlp2_in = thlp2_in(:,nzm_clubb:1:-1) rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) - wpthvp_in = wpthvp_in(:,nzm_clubb:1:-1) - rtpthvp_in = rtpthvp_in(:,nzm_clubb:1:-1) - thlpthvp_in = thlpthvp_in(:,nzm_clubb:1:-1) - uprcp_inout = uprcp_inout(:,nzm_clubb:1:-1) - vprcp_inout = vprcp_inout(:,nzm_clubb:1:-1) - rc_coef_zm_inout = rc_coef_zm_inout(:,nzm_clubb:1:-1) - wp4_inout = wp4_inout(:,nzm_clubb:1:-1) - wp2up2_inout = wp2up2_inout(:,nzm_clubb:1:-1) - wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) + wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) + rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) + thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) + uprcp_pbuf = uprcp_pbuf(:,nzm_clubb:1:-1) + vprcp_pbuf = vprcp_pbuf(:,nzm_clubb:1:-1) + rc_coef_zm_pbuf = rc_coef_zm_pbuf(:,nzm_clubb:1:-1) + wp4_pbuf = wp4_pbuf(:,nzm_clubb:1:-1) + wp2up2_pbuf = wp2up2_pbuf(:,nzm_clubb:1:-1) + wp2vp2_pbuf = wp2vp2_pbuf(:,nzm_clubb:1:-1) upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) @@ -3985,19 +3929,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & clubb_config_flags, & stats_metadata, & stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! inouts - um_in(:ncol,:), vm_in(:ncol,:), upwp_in(:ncol,:), vpwp_in(:ncol,:), up2_in(:ncol,:), vp2_in(:ncol,:), up3_in(:ncol,:), vp3_in(:ncol,:), & + um_in(:ncol,:), vm_in(:ncol,:), upwp_in(:ncol,:), vpwp_in(:ncol,:), up2_in(:ncol,:), vp2_in(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & thlm_in(:ncol,:), rtm_in(:ncol,:), wprtp_in(:ncol,:), wpthlp_in(:ncol,:), & - wp2_in(:ncol,:), wp3_in(:ncol,:), rtp2_in(:ncol,:), rtp3_in(:ncol,:), thlp2_in(:ncol,:), thlp3_in(:ncol,:), rtpthlp_in(:ncol,:), & + wp2_in(:ncol,:), wp3_in(:ncol,:), rtp2_in(:ncol,:), rtp3_pbuf(:ncol,:), thlp2_in(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_in(:ncol,:), & sclrm(:ncol,:,:), & sclrp2(:ncol,:,:), sclrp3(:ncol,:,:), sclrprtp(:ncol,:,:), sclrpthlp(:ncol,:,:), & wpsclrp(:ncol,:,:), edsclr_in(:ncol,:,:), err_info, & rcm_inout(:ncol,:), cloud_frac_inout(:ncol,:), & - wpthvp_in(:ncol,:), wp2thvp_in(:ncol,:), rtpthvp_in(:ncol,:), thlpthvp_in(:ncol,:), & + wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & sclrpthvp_inout(:ncol,:,:), & - wp2rtp_inout(:ncol,:), wp2thlp_inout(:ncol,:), uprcp_inout(:ncol,:), & - vprcp_inout(:ncol,:), rc_coef_zm_inout(:ncol,:), & - wp4_inout(:ncol,:), wpup2_inout(:ncol,:), wpvp2_inout(:ncol,:), & - wp2up2_inout(:ncol,:), wp2vp2_inout(:ncol,:), ice_supersat_frac_inout(:ncol,:), & + wp2rtp_pbuf(:ncol,:), wp2thlp_pbuf(:ncol,:), uprcp_pbuf(:ncol,:), & + vprcp_pbuf(:ncol,:), rc_coef_zm_pbuf(:ncol,:), & + wp4_pbuf(:ncol,:), wpup2_pbuf(:ncol,:), wpvp2_pbuf(:ncol,:), & + wp2up2_pbuf(:ncol,:), wp2vp2_pbuf(:ncol,:), ice_supersat_frac_inout(:ncol,:), & um_pert_inout(:ncol,:), vm_pert_inout(:ncol,:), upwp_pert_inout(:ncol,:), vpwp_pert_inout(:ncol,:), & pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & pdf_implicit_coefs_terms_chnk(lchnk), & @@ -4036,17 +3980,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rfrzm = rfrzm(:,nzt_clubb:1:-1) um_in = um_in(:,nzt_clubb:1:-1) vm_in = vm_in(:,nzt_clubb:1:-1) - up3_in = up3_in(:,nzt_clubb:1:-1) - vp3_in = vp3_in(:,nzt_clubb:1:-1) + up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) + vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) wp3_in = wp3_in(:,nzt_clubb:1:-1) - rtp3_in = rtp3_in(:,nzt_clubb:1:-1) - thlp3_in = thlp3_in(:,nzt_clubb:1:-1) + rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) + thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) rcm_inout = rcm_inout(:,nzt_clubb:1:-1) cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) - wpup2_inout = wpup2_inout(:,nzt_clubb:1:-1) - wpvp2_inout = wpvp2_inout(:,nzt_clubb:1:-1) - wp2rtp_inout = wp2rtp_inout(:,nzt_clubb:1:-1) - wp2thlp_inout = wp2thlp_inout(:,nzt_clubb:1:-1) + wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) + wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) + wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) + wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) qclvar_out = qclvar_out(:,nzt_clubb:1:-1) cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) w_up_in_cloud_out = w_up_in_cloud_out(:,nzt_clubb:1:-1) @@ -4057,7 +4001,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) - wp2thvp_in = wp2thvp_in(:,nzt_clubb:1:-1) + wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) rtm_in = rtm_in(:,nzt_clubb:1:-1) thlm_in = thlm_in(:,nzt_clubb:1:-1) Lscale = Lscale(:,nzt_clubb:1:-1) @@ -4082,15 +4026,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_in = rtp2_in(:,nzm_clubb:1:-1) thlp2_in = thlp2_in(:,nzm_clubb:1:-1) rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) - wpthvp_in = wpthvp_in(:,nzm_clubb:1:-1) - rtpthvp_in = rtpthvp_in(:,nzm_clubb:1:-1) - thlpthvp_in = thlpthvp_in(:,nzm_clubb:1:-1) - uprcp_inout = uprcp_inout(:,nzm_clubb:1:-1) - vprcp_inout = vprcp_inout(:,nzm_clubb:1:-1) - rc_coef_zm_inout = rc_coef_zm_inout(:,nzm_clubb:1:-1) - wp4_inout = wp4_inout(:,nzm_clubb:1:-1) - wp2up2_inout = wp2up2_inout(:,nzm_clubb:1:-1) - wp2vp2_inout = wp2vp2_inout(:,nzm_clubb:1:-1) + wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) + rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) + thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) + uprcp_pbuf = uprcp_pbuf(:,nzm_clubb:1:-1) + vprcp_pbuf = vprcp_pbuf(:,nzm_clubb:1:-1) + rc_coef_zm_pbuf = rc_coef_zm_pbuf(:,nzm_clubb:1:-1) + wp4_pbuf = wp4_pbuf(:,nzm_clubb:1:-1) + wp2up2_pbuf = wp2up2_pbuf(:,nzm_clubb:1:-1) + wp2vp2_pbuf = wp2vp2_pbuf(:,nzm_clubb:1:-1) upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) khzm_out = khzm_out(:,nzm_clubb:1:-1) @@ -4267,20 +4211,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k um_pbuf(i,k_cam) = um_in(i,k) vm_pbuf(i,k_cam) = vm_in(i,k) - wp2thvp_pbuf(i,k_cam) = wp2thvp_in(i,k) - up3_pbuf(i,k_cam) = up3_in(i,k) - vp3_pbuf(i,k_cam) = vp3_in(i,k) thlm_pbuf(i,k_cam) = thlm_in(i,k) rtm_pbuf(i,k_cam) = rtm_in(i,k) wp3_pbuf(i,k_cam) = wp3_in(i,k) - rtp3_pbuf(i,k_cam) = rtp3_in(i,k) - thlp3_pbuf(i,k_cam) = thlp3_in(i,k) rcm_pbuf(i,k_cam) = rcm_inout(i,k) cloud_frac_pbuf(i,k_cam) = min(cloud_frac_inout(i,k),1._r8) - wp2rtp_pbuf(i,k_cam) = wp2rtp_inout(i,k) - wp2thlp_pbuf(i,k_cam) = wp2thlp_inout(i,k) - wpup2_pbuf(i,k_cam) = wpup2_inout(i,k) - wpvp2_pbuf(i,k_cam) = wpvp2_inout(i,k) ice_supersat_frac_pbuf(i,k_cam) = ice_supersat_frac_inout(i,k) qclvar(i,k_cam) = min(1._r8,qclvar_out(i,k)) @@ -4293,9 +4228,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k upwp_pbuf(i,k_cam) = upwp_in(i,k) vpwp_pbuf(i,k_cam) = vpwp_in(i,k) - wpthvp_pbuf(i,k_cam) = wpthvp_in(i,k) - rtpthvp_pbuf(i,k_cam) = rtpthvp_in(i,k) - thlpthvp_pbuf(i,k_cam) = thlpthvp_in(i,k) up2_pbuf(i,k_cam) = up2_in(i,k) vp2_pbuf(i,k_cam) = vp2_in(i,k) wprtp_pbuf(i,k_cam) = wprtp_in(i,k) @@ -4304,18 +4236,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_pbuf(i,k_cam) = rtp2_in(i,k) thlp2_pbuf(i,k_cam) = thlp2_in(i,k) rtpthlp_pbuf(i,k_cam) = rtpthlp_in(i,k) - pdf_zm_w_1_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%w_1(i,k) - pdf_zm_w_2_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%w_2(i,k) - pdf_zm_varnce_w_1_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) - pdf_zm_varnce_w_2_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) - pdf_zm_mixt_frac_pbuf(i,k_cam) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) khzm_pbuf(i,k_cam) = khzm_out(i,k) - uprcp_pbuf(i,k_cam) = uprcp_inout(i,k) - vprcp_pbuf(i,k_cam) = vprcp_inout(i,k) - rc_coef_zm_pbuf(i,k_cam) = rc_coef_zm_inout(i,k) - wp4_pbuf(i,k_cam) = wp4_inout(i,k) - wp2up2_pbuf(i,k_cam) = wp2up2_inout(i,k) - wp2vp2_pbuf(i,k_cam) = wp2vp2_inout(i,k) + + ! pdf_params_zm_chnk is already persistent across calls, but we + ! save a pbuf version for restarts + pdf_zm_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_1(i,k) + pdf_zm_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_2(i,k) + pdf_zm_varnce_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) + pdf_zm_varnce_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) + pdf_zm_mixt_frac_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) end do end do @@ -4333,10 +4262,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! And average at last macmic step if (macmic_it == cld_macmic_num_steps) then - upwp_clubb_gw_pbuf(i,k) = upwp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) - vpwp_clubb_gw_pbuf(i,k) = vpwp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) - thlp2_clubb_gw_pbuf(i,k) = thlp2_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) - wpthlp_clubb_gw_pbuf(i,k) = wpthlp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) + upwp_clubb_gw_pbuf(i,k) = upwp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) + vpwp_clubb_gw_pbuf(i,k) = vpwp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) + thlp2_clubb_gw_pbuf(i,k) = thlp2_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) + wpthlp_clubb_gw_pbuf(i,k) = wpthlp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) end if end do @@ -5027,7 +4956,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vpwp_output(i,k) = vpwp_pbuf(i,k) rtp2_output(i,k) = rtp2_pbuf(i,k) wprcp_clubb_output(i,k) = wprcp_out(i,k_clubb) * latvap - wpthvp_clubb_output(i,k) = wpthvp_pbuf(i,k) * cpair + wpthvp_clubb_output(i,k) = wpthvp_pbuf(i,k_clubb) * cpair thlp2_output(i,k) = thlp2_pbuf(i,k) wpthlp_output(i,k) = (wpthlp_pbuf(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux From fce8e1b1b5e8d3e93232c2129be7671fae79db23 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Sun, 23 Nov 2025 01:30:40 -0600 Subject: [PATCH 13/29] The DANGEROUS redimensioning. This significantly reduces the memory footprint and data copying steps in clubb_intr, mainly by switching pbuf variables (which are mostly clubb_inouts) to have nzm or nzt dimensions, allowing them to be passed into clubb directly, making the copying/flipping step unnecesary. This was tested with a top_lev > 1, so it should be well tested. There were some above top_lev interactions found, which seem erroneous, so I've marked them with a TODO and a little explaination. --- src/physics/cam/clubb_intr.F90 | 765 +++++++++++++++---------------- src/physics/cam/microp_aero.F90 | 5 +- src/physics/cam/subcol_SILHS.F90 | 168 +------ 3 files changed, 390 insertions(+), 548 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index c4e1afeee4..1ee48b28a1 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -110,6 +110,8 @@ module clubb_intr type(implicit_coefs_terms), allocatable :: & pdf_implicit_coefs_terms_chnk(:) ! PDF impl. coefs. & expl. terms [units vary] + real(r8), public :: & + ztodt ! model timestep #endif ! ------------------------------------------------------------ ! @@ -463,7 +465,6 @@ module clubb_intr qsatfac_idx, & ! subgrid cloud water saturation scaling factor ice_supersat_idx, & ! ice cloud fraction for SILHS rcm_idx, & ! Cloud water mixing ratio for SILHS - ztodt_idx,& ! physics timestep for SILHS clubbtop_idx ! level index for CLUBB top ! For Gravity Wave code @@ -557,37 +558,35 @@ subroutine clubb_register_cam( ) endif ! put pbuf_add calls here (see macrop_driver.F90 for sample) use indicies defined at top - call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) - call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) - call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx) - call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx) - call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) - call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx) - call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx) - call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx) - call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx) - call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) - call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) - call pbuf_add_field('FICE', 'physpkg',dtype_r8, (/pcols,pver/), fice_idx) - call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx) - call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) + call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) + call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) + call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx) + call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx) + call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx) + call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx) + call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx) + call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx) + call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx) + call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx) + call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx) + call pbuf_add_field('FICE', 'physpkg',dtype_r8, (/pcols,pver/), fice_idx) + call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx) + call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) ! pbuf fields for Gravity Wave scheme - call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver/), ttend_clubb_idx) - call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx) - call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx) - call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx) - call pbuf_add_field('WPTHLP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_idx) - - + call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver/), ttend_clubb_idx ) + call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx ) + call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx ) + call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx ) + call pbuf_add_field('WPTHLP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_idx ) ! For SILHS microphysical covariance contributions - call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pver/), rtp2_mc_zt_idx) - call pbuf_add_field('thlp2_mc_zt','global', dtype_r8, (/pcols,pver/), thlp2_mc_zt_idx) - call pbuf_add_field('wprtp_mc_zt','global', dtype_r8, (/pcols,pver/), wprtp_mc_zt_idx) - call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pver/), wpthlp_mc_zt_idx) - call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pver/), rtpthlp_mc_zt_idx) + call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), rtp2_mc_zt_idx) + call pbuf_add_field('thlp2_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), thlp2_mc_zt_idx) + call pbuf_add_field('wprtp_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), wprtp_mc_zt_idx) + call pbuf_add_field('wpthlp_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), wpthlp_mc_zt_idx) + call pbuf_add_field('rtpthlp_mc_zt', 'global', dtype_r8, (/pcols,nzt_clubb/), rtpthlp_mc_zt_idx) ! Only in clubb_intr.F90, these are safe to dimensions (ngrdcol,nzm_clubb) or (ngrdcol,nzt_clubb) @@ -607,55 +606,46 @@ subroutine clubb_register_cam( ) call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2up2_idx) call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2vp2_idx) - call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp/), upwp_idx) - call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp/), vpwp_idx) - call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp/), wpthlp_idx) - call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,pverp/), wprtp_idx) - call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp/), rtpthlp_idx) - call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp/), rtp2_idx) - call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp/), thlp2_idx) - - call pbuf_add_field('TTEND_CLUBB_MC', 'physpkg', dtype_r8, (/pcols,pverp/), ttend_clubb_mc_idx) - call pbuf_add_field('UPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_mc_idx) - call pbuf_add_field('VPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_mc_idx) - call pbuf_add_field('THLP2_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_mc_idx) - call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_mc_idx) - - call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thvp_idx) - call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pver/), rcm_idx) - call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2rtp_idx) - call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thlp_idx) - call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpup2_idx) - call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpvp2_idx) - - call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pver/), um_idx) - call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pver/), vm_idx) + call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,nzm_clubb/), upwp_idx) + call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,nzm_clubb/), vpwp_idx) + call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), wpthlp_idx) + call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), wprtp_idx) + call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), rtpthlp_idx) + call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), rtp2_idx) + call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), thlp2_idx) + + call pbuf_add_field('TTEND_CLUBB_MC', 'physpkg', dtype_r8, (/pcols,nzt_clubb/), ttend_clubb_mc_idx) + call pbuf_add_field('UPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), upwp_clubb_gw_mc_idx) + call pbuf_add_field('VPWP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), vpwp_clubb_gw_mc_idx) + call pbuf_add_field('THLP2_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), thlp2_clubb_gw_mc_idx) + call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), wpthlp_clubb_gw_mc_idx) + + call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thvp_idx) + call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,nzt_clubb/), rcm_idx) + call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,nzt_clubb/), thlm_idx) + call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2rtp_idx) + call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thlp_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpvp2_idx) + + call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,nzt_clubb/), um_idx) + call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,nzt_clubb/), vm_idx) call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,nzt_clubb/), rtp3_idx) call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,nzt_clubb/), thlp3_idx) call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,nzt_clubb/), up3_idx) call pbuf_add_field('VP3', 'global', dtype_r8, (/pcols,nzt_clubb/), vp3_idx) + call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,nzt_clubb/), wp3_idx) + + call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), up2_idx) + call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), vp2_idx) + call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2_idx) call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pver/), cloud_frac_idx) ! Only in clubb_intr.F90 or SILHS - call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,pver/), ice_supersat_idx) - call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) - call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pver/), thlm_idx) - call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pver/), rtm_idx) - - - ! Only in clubb_intr.F90, these are safe to dimensions (ngrdcol,nzm_clubb) or (ngrdcol,nzt_clubb) - call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp/), up2_idx) - call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp/), vp2_idx) - call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pver/), wp3_idx) - + call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) + call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,nzt_clubb/), rtm_idx) - ! Used in clubb intr and microp_aero? - call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx) - - - - #endif end subroutine clubb_register_cam @@ -2211,7 +2201,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: thlm_pbuf ! mean temperature [K] real(r8), pointer, dimension(:,:) :: rtm_pbuf ! mean moisture mixing ratio [kg/kg] real(r8), pointer, dimension(:,:) :: rcm_pbuf ! CLUBB cloud water mixing ratio [kg/kg] - real(r8), pointer, dimension(:) :: ztodtptr_pbuf ! timestep to send to SILHS real(r8), pointer, dimension(:,:) :: um_pbuf ! mean east-west wind [m/s] real(r8), pointer, dimension(:,:) :: vm_pbuf ! mean north-south wind [m/s] real(r8), pointer, dimension(:,:) :: cld_pbuf ! cloud fraction [fraction] @@ -2330,18 +2319,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K] rfrzm, & - um_in, & ! meridional wind [m/s] - vm_in, & ! zonal wind [m/s] - thlm_in, & ! liquid water potential temperature (thetal) [K] rvm_in, & ! water vapor mixing ratio [kg/kg] - rtm_in, & ! total water mixing ratio [kg/kg] - wp3_in, & ! third moment vertical velocity [m^3/s^3] rtp2_zt, & ! CLUBB R-tot variance on thermo levs thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2] wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2] - rcm_inout, & ! CLUBB output of liquid water mixing ratio [kg/kg] cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction] - ice_supersat_frac_inout, & um_pert_inout, & ! Perturbed U wind [m/s] vm_pert_inout, & ! Perturbed V wind [m/s] khzt_out, & ! eddy diffusivity on thermo grids [m^2/s] @@ -2376,16 +2358,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] - upwp_in, & ! meridional wind flux [m^2/s^2] - vpwp_in, & ! zonal wind flux [m^2/s^2] - up2_in, & ! meridional wind variance [m^2/s^2] - vp2_in, & ! zonal wind variance [m^2/s^2] - wprtp_in, & ! turbulent flux of total water [kg/kg m/s] - wpthlp_in, & ! turbulent flux of thetal [K m/s] - wp2_in, & ! vertical velocity variance (CLUBB) [m^2/s^2] - rtp2_in, & ! total water variance [kg^2/kg^2] - thlp2_in, & ! thetal variance [K^2] - rtpthlp_in, & ! covariance of thetal and qt [kg/kg K] upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] khzm_out, & ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] @@ -2511,7 +2483,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rcm_output, & rtm_output, & thlm_output, & - cloud_frac_output, & um_output, & vm_output @@ -2634,7 +2605,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & itim_old = pbuf_old_tim_idx() ! Establish associations between pointers and physics buffer fields - call pbuf_get_field(pbuf, wp2_idx, wp2_pbuf, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wp2_idx, wp2_pbuf ) call pbuf_get_field(pbuf, wp3_idx, wp3_pbuf ) call pbuf_get_field(pbuf, wpthlp_idx, wpthlp_pbuf ) call pbuf_get_field(pbuf, wprtp_idx, wprtp_pbuf ) @@ -2696,7 +2667,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan_pbuf) call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_pbuf) call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac_pbuf) - call pbuf_get_field(pbuf, ztodt_idx, ztodtptr_pbuf) call pbuf_get_field(pbuf, relvar_idx, relvar_pbuf) call pbuf_get_field(pbuf, dp_frac_idx, deepcu_pbuf) call pbuf_get_field(pbuf, sh_frac_idx, shalcu_pbuf) @@ -2837,7 +2807,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif ! Initialize the apply_const variable (note special logic is due to eulerian backstepping) - if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp_pbuf(1:ncol,1:pver) == 0._r8))) then + if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp_pbuf(1:ncol,:) == 0._r8))) then apply_const = 0._r8 ! On first time through do not remove constant ! from moments since it has not been added yet endif @@ -2845,7 +2815,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !--------------------- Initializations -------------------- ! Set the ztodt timestep in pbuf for SILHS, this is needed because hdtime is not input to silhs - ztodtptr_pbuf(:) = 1.0_r8 * hdtime + ztodt = 1.0_r8 * hdtime call t_stopf('clubb_tend_cam:NAR') call t_startf('clubb_tend_cam:acc_copyin') @@ -2860,8 +2830,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc wp2_pbuf, wp3_pbuf, rtp2_pbuf, thlp2_pbuf, rtp3_pbuf, thlp3_pbuf, thlm_pbuf, rtm_pbuf, wprtp_pbuf, wpthlp_pbuf, rtpthlp_pbuf, & !$acc pdf_zm_w_1_pbuf, pdf_zm_w_2_pbuf, pdf_zm_varnce_w_1_pbuf, pdf_zm_varnce_w_2_pbuf, pdf_zm_mixt_frac_pbuf, & !$acc cloud_frac_pbuf, wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & - !$acc ttend_clubb_mc_pbuf, upwp_clubb_gw_mc_pbuf, vpwp_clubb_gw_mc_pbuf, thlp2_clubb_gw_mc_pbuf, wpthlp_clubb_gw_mc_pbuf, & - !$acc ttend_clubb_pbuf, upwp_clubb_gw_pbuf, vpwp_clubb_gw_pbuf, thlp2_clubb_gw_pbuf, wpthlp_clubb_gw_pbuf, & !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf, & !$acc pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & @@ -2870,11 +2838,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc rcm_pbuf, khzm_pbuf, qclvar, thv, dz_g, & !$acc clubbtop, se_dis, eleak, clubb_s ) & !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & - !$acc fcor, um_in, vm_in, upwp_in, vpwp_in, & - !$acc up2_in, vp2_in, wp2_in, wp3_in, rtp2_in, thlp2_in, & - !$acc thlp3_in, thlm_in, rtm_in, rvm_in, wprtp_in, wpthlp_in, rtpthlp_in, cloud_frac_inout, & - !$acc rcm_inout, uprcp_inout, vprcp_inout, & - !$acc ice_supersat_frac_inout, pre_in, kappa_zt, qc_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & + !$acc fcor, & + !$acc thlp3_in, rvm_in, cloud_frac_inout, & + !$acc uprcp_inout, vprcp_inout, & + !$acc pre_in, kappa_zt, qc_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & !$acc invrs_exner_zm, cloud_cover_out, rcm_in_layer, wprcp_out, & !$acc qclvar_out, w_up_in_cloud_out, cloudy_downdraft_frac_out, & !$acc w_down_in_cloud_out, invrs_tau_zm_out, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & @@ -3080,20 +3047,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - ! need to initialize macmic coupling to zero - if ( macmic_it == 1 ) then - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pverp - do i = 1, ncol - ttend_clubb_mc_pbuf(i,k) = 0._r8 - upwp_clubb_gw_mc_pbuf(i,k) = 0._r8 - vpwp_clubb_gw_mc_pbuf(i,k) = 0._r8 - thlp2_clubb_gw_mc_pbuf(i,k) = 0._r8 - wpthlp_clubb_gw_mc_pbuf(i,k) = 0._r8 - end do - end do - end if - if (clubb_do_icesuper) then ! -------------------------------------- ! @@ -3163,17 +3116,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Note that some of the moments below can be positive or negative. ! Remove a constant that was added to prevent dynamics from clipping ! them to prevent dynamics from making them positive. - do k = 1, pver + do k = 1, nzm_clubb-1 do i = 1, ncol - thlp2_pbuf(i,k) = state1%q(i,k,ixthlp2) - rtp2_pbuf(i,k) = state1%q(i,k,ixrtp2) - rtpthlp_pbuf(i,k) = state1%q(i,k,ixrtpthlp) - ( rtpthlp_const * apply_const ) - wpthlp_pbuf(i,k) = state1%q(i,k,ixwpthlp) - ( wpthlp_const * apply_const ) - wprtp_pbuf(i,k) = state1%q(i,k,ixwprtp) - ( wprtp_const * apply_const ) - wp2_pbuf(i,k) = state1%q(i,k,ixwp2) - wp3_pbuf(i,k) = state1%q(i,k,ixwp3) - ( wp3_const * apply_const ) - up2_pbuf(i,k) = state1%q(i,k,ixup2) - vp2_pbuf(i,k) = state1%q(i,k,ixvp2) + k_cam = top_lev - 1 + k + thlp2_pbuf(i,k) = state1%q(i,k_cam, ixthlp2) + rtp2_pbuf(i,k) = state1%q(i,k_cam, ixrtp2) + rtpthlp_pbuf(i,k) = state1%q(i,k_cam,ixrtpthlp) - ( rtpthlp_const * apply_const ) + wpthlp_pbuf(i,k) = state1%q(i,k_cam, ixwpthlp) - ( wpthlp_const * apply_const ) + wprtp_pbuf(i,k) = state1%q(i,k_cam, ixwprtp) - ( wprtp_const * apply_const ) + wp2_pbuf(i,k) = state1%q(i,k_cam, ixwp2) + wp3_pbuf(i,k) = state1%q(i,k_cam, ixwp3) - ( wp3_const * apply_const ) + up2_pbuf(i,k) = state1%q(i,k_cam, ixup2) + vp2_pbuf(i,k) = state1%q(i,k_cam, ixvp2) enddo enddo @@ -3188,14 +3142,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif do i = 1, ncol - thlp2_pbuf(i,pverp) = thlp2_pbuf(i,pver) - rtp2_pbuf(i,pverp) = rtp2_pbuf(i,pver) - rtpthlp_pbuf(i,pverp) = rtpthlp_pbuf(i,pver) - wpthlp_pbuf(i,pverp) = wpthlp_pbuf(i,pver) - wprtp_pbuf(i,pverp) = wprtp_pbuf(i,pver) - wp2_pbuf(i,pverp) = wp2_pbuf(i,pver) - up2_pbuf(i,pverp) = up2_pbuf(i,pver) - vp2_pbuf(i,pverp) = vp2_pbuf(i,pver) + thlp2_pbuf(i,nzm_clubb) = thlp2_pbuf(i,nzm_clubb-1) + rtp2_pbuf(i,nzm_clubb) = rtp2_pbuf(i,nzm_clubb-1) + rtpthlp_pbuf(i,nzm_clubb) = rtpthlp_pbuf(i,nzm_clubb-1) + wpthlp_pbuf(i,nzm_clubb) = wpthlp_pbuf(i,nzm_clubb-1) + wprtp_pbuf(i,nzm_clubb) = wprtp_pbuf(i,nzm_clubb-1) + wp2_pbuf(i,nzm_clubb) = wp2_pbuf(i,nzm_clubb-1) + up2_pbuf(i,nzm_clubb) = up2_pbuf(i,nzm_clubb-1) + vp2_pbuf(i,nzm_clubb) = vp2_pbuf(i,nzm_clubb-1) end do endif @@ -3223,14 +3177,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dz_g(i,k) = state1%zi(i,k) - state1%zi(i,k+1) ! compute thickness - ! At each CLUBB call, initialize mean momentum and thermo CLUBB state - ! from the CAM state - rtm_pbuf(i,k) = state1%q(i,k,ixq) + state1%q(i,k,ixcldliq) - um_pbuf(i,k) = state1%u(i,k) - vm_pbuf(i,k) = state1%v(i,k) - thlm_pbuf(i,k) = ( state1%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state1%q(i,k,ixcldliq) ) & - * inv_exner_clubb(i,k) - enddo enddo @@ -3243,6 +3189,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k + ! At each CLUBB call, initialize mean momentum and thermo CLUBB state + ! from the CAM state + rtm_pbuf(i,k) = state1%q(i,k_cam,ixq) + state1%q(i,k_cam,ixcldliq) + + thlm_pbuf(i,k) = ( state1%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) * state1%q(i,k_cam,ixcldliq) ) & + * inv_exner_clubb(i,k_cam) + + um_pbuf(i,k) = state1%u(i,k_cam) + vm_pbuf(i,k) = state1%v(i,k_cam) + ! Define the CLUBB thermodynamic grid (in units of m) zt_g(i,k) = state1%zm(i,k_cam) - state1%zi(i,pverp) @@ -3343,15 +3299,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef SILHS ! Add forcings for SILHS covariance contributions - rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt_pbuf(1:ncol,top_lev:pver) ) - thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt_pbuf(1:ncol,top_lev:pver) ) - wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt_pbuf(1:ncol,top_lev:pver) ) - wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt_pbuf(1:ncol,top_lev:pver) ) - rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt_pbuf(1:ncol,top_lev:pver) ) + rtp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_mc_zt_pbuf(1:ncol,:) ) + thlp2_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_mc_zt_pbuf(1:ncol,:) ) + wprtp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wprtp_mc_zt_pbuf(1:ncol,:) ) + wpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, wpthlp_mc_zt_pbuf(1:ncol,:) ) + rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt_pbuf(1:ncol,:) ) ! Zero out SILHS covariance contribution terms !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pver + do k = 1, nzt_clubb do i = 1, pcols rtp2_mc_zt_pbuf(i,k) = 0.0_r8 thlp2_mc_zt_pbuf(i,k) = 0.0_r8 @@ -3405,7 +3361,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif ! Compute surface wind (ubar) - ubar = sqrt(um_pbuf(1,pver)**2+vm_pbuf(1,pver)**2) + ubar = sqrt(um_pbuf(1,nzt_clubb)**2+vm_pbuf(1,nzt_clubb)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 ! Below denotes case specifics for surface momentum @@ -3435,8 +3391,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif ! Compute the surface momentum fluxes, if this is a SCAM simulation - upwp_sfc(1) = -um_pbuf(1,pver)*ustar**2/ubar - vpwp_sfc(1) = -vm_pbuf(1,pver)*ustar**2/ubar + upwp_sfc(1) = -um_pbuf(1,nzt_clubb)*ustar**2/ubar + vpwp_sfc(1) = -vm_pbuf(1,nzt_clubb)*ustar**2/ubar end if @@ -3468,8 +3424,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i=1,ncol - upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,nzm_clubb) ! Surface meridional momentum flux - vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,nzm_clubb) ! Surface zonal momentum flux + upwp_sfc(i) = cam_in%wsx(i) / rho_ds_zm(i,nzm_clubb) ! Surface meridional momentum flux + vpwp_sfc(i) = cam_in%wsy(i) / rho_ds_zm(i,nzm_clubb) ! Surface zonal momentum flux end do endif @@ -3481,35 +3437,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol k_cam = top_lev - 1 + k - um_in(i,k) = um_pbuf(i,k_cam) - vm_in(i,k) = vm_pbuf(i,k_cam) - wp3_in(i,k) = wp3_pbuf(i,k_cam) - thlm_in(i,k) = thlm_pbuf(i,k_cam) - rtm_in(i,k) = rtm_pbuf(i,k_cam) - cloud_frac_inout(i,k) = cloud_frac_pbuf(i,k_cam) - ice_supersat_frac_inout(i,k) = ice_supersat_frac_pbuf(i,k_cam) - pre_in(i,k) = prer_evap_pbuf(i,k_cam) - - rcm_inout(i,k) = state1%q(i,k_cam,ixcldliq) - rvm_in(i,k) = state1%q(i,k_cam,ixq) - end do - end do - - ! Need to flip zm arrays around for CLUBB core - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzm_clubb - do i = 1, ncol - k_cam = top_lev - 1 + k - upwp_in(i,k) = upwp_pbuf(i,k_cam) - vpwp_in(i,k) = vpwp_pbuf(i,k_cam) - up2_in(i,k) = up2_pbuf(i,k_cam) - vp2_in(i,k) = vp2_pbuf(i,k_cam) - wp2_in(i,k) = wp2_pbuf(i,k_cam) - rtp2_in(i,k) = rtp2_pbuf(i,k_cam) - thlp2_in(i,k) = thlp2_pbuf(i,k_cam) - wprtp_in(i,k) = wprtp_pbuf(i,k_cam) - wpthlp_in(i,k) = wpthlp_pbuf(i,k_cam) - rtpthlp_in(i,k) = rtpthlp_pbuf(i,k_cam) + cloud_frac_inout(i,k) = cloud_frac_pbuf(i,k_cam) + pre_in(i,k) = prer_evap_pbuf(i,k_cam) + rcm_pbuf(i,k) = state1%q(i,k_cam,ixcldliq) + rvm_in(i,k) = state1%q(i,k_cam,ixq) end do end do @@ -3559,11 +3490,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if ( clubb_do_adv .and. macmic_it == 1 ) then do k = 1, nzm_clubb do i = 1, ncol - thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) ) - rtp2_in(i,k) = max( rt_tol**2, rtp2_in(i,k) ) - wp2_in(i,k) = max( w_tol_sqd, wp2_in(i,k) ) - up2_in(i,k) = max( w_tol_sqd, up2_in(i,k) ) - vp2_in(i,k) = max( w_tol_sqd, vp2_in(i,k) ) + thlp2_pbuf(i,k) = max( thl_tol**2, thlp2_pbuf(i,k) ) + rtp2_pbuf(i,k) = max( rt_tol**2, rtp2_pbuf(i,k) ) + wp2_pbuf(i,k) = max( w_tol_sqd, wp2_pbuf(i,k) ) + up2_pbuf(i,k) = max( w_tol_sqd, up2_pbuf(i,k) ) + vp2_pbuf(i,k) = max( w_tol_sqd, vp2_pbuf(i,k) ) end do end do end if @@ -3594,8 +3525,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzt_clubb do i=1, ncol k_cam = top_lev - 1 + k - edsclr_in(i,k,icnt+1) = thlm_pbuf(i,k_cam) - edsclr_in(i,k,icnt+2) = rtm_pbuf(i,k_cam) + edsclr_in(i,k,icnt+1) = thlm_pbuf(i,k) + edsclr_in(i,k,icnt+2) = rtm_pbuf(i,k) end do end do @@ -3625,8 +3556,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm_in ) - thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm_in ) + rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm_pbuf(:ncol,:) ) + thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm_pbuf(:ncol,:) ) !--------------------------------------- integrate_mf call and flip --------------------------------------- ! integrate_mf assumes an ascending grid, which is the opposide of the cam grid that @@ -3635,15 +3566,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Ideally, integrate_mf would operate in descending mode, then we could remove the flipping. ! If the column loop gets pushed into it, we can also avoid the array slicing. - dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) - um_in = um_in(:,nzt_clubb:1:-1) - vm_in = vm_in(:,nzt_clubb:1:-1) - thlm_in = thlm_in(:,nzt_clubb:1:-1) - rtm_in = rtm_in(:,nzt_clubb:1:-1) + um_pbuf = um_pbuf(:,nzt_clubb:1:-1) + vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) + thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) + rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) - thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) + dz_g(:,top_lev:pver) = dz_g(:,pver:top_lev:-1) + thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) ! Flip zm inputs zi_g = zi_g(:,nzm_clubb:1:-1) @@ -3655,7 +3586,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i=1, ncol call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv(i,1:nzt_clubb), & ! input + um_pbuf(i,:), vm_pbuf(i,:), thlm_pbuf(i,:), rtm_pbuf(i,:), thv(i,1:nzt_clubb), & ! input thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics @@ -3673,15 +3604,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! Flip zt inputs back - dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) - um_in = um_in(:,nzt_clubb:1:-1) - vm_in = vm_in(:,nzt_clubb:1:-1) - thlm_in = thlm_in(:,nzt_clubb:1:-1) - rtm_in = rtm_in(:,nzt_clubb:1:-1) + um_pbuf = um_pbuf(:,nzt_clubb:1:-1) + vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) + thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) + rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) - thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) + dz_g(:,top_lev:pver) = dz_g(:,pver:top_lev:-1) + thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) ! Flip zm inputs back zi_g = zi_g(:,nzm_clubb:1:-1) @@ -3764,25 +3695,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) exner = exner(:,nzt_clubb:1:-1) rfrzm = rfrzm(:,nzt_clubb:1:-1) - um_in = um_in(:,nzt_clubb:1:-1) - vm_in = vm_in(:,nzt_clubb:1:-1) + um_pbuf = um_pbuf(:,nzt_clubb:1:-1) + vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) - wp3_in = wp3_in(:,nzt_clubb:1:-1) + wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) - rcm_inout = rcm_inout(:,nzt_clubb:1:-1) + rcm_pbuf = rcm_pbuf(:,nzt_clubb:1:-1) cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) - ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) + ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) - rtm_in = rtm_in(:,nzt_clubb:1:-1) - thlm_in = thlm_in(:,nzt_clubb:1:-1) + rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) + thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) @@ -3794,16 +3725,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) - upwp_in = upwp_in(:,nzm_clubb:1:-1) - vpwp_in = vpwp_in(:,nzm_clubb:1:-1) - up2_in = up2_in(:,nzm_clubb:1:-1) - vp2_in = vp2_in(:,nzm_clubb:1:-1) - wprtp_in = wprtp_in(:,nzm_clubb:1:-1) - wpthlp_in = wpthlp_in(:,nzm_clubb:1:-1) - wp2_in = wp2_in(:,nzm_clubb:1:-1) - rtp2_in = rtp2_in(:,nzm_clubb:1:-1) - thlp2_in = thlp2_in(:,nzm_clubb:1:-1) - rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) + upwp_pbuf = upwp_pbuf(:,nzm_clubb:1:-1) + vpwp_pbuf = vpwp_pbuf(:,nzm_clubb:1:-1) + up2_pbuf = up2_pbuf(:,nzm_clubb:1:-1) + vp2_pbuf = vp2_pbuf(:,nzm_clubb:1:-1) + wprtp_pbuf = wprtp_pbuf(:,nzm_clubb:1:-1) + wpthlp_pbuf = wpthlp_pbuf(:,nzm_clubb:1:-1) + wp2_pbuf = wp2_pbuf(:,nzm_clubb:1:-1) + rtp2_pbuf = rtp2_pbuf(:,nzm_clubb:1:-1) + thlp2_pbuf = thlp2_pbuf(:,nzm_clubb:1:-1) + rtpthlp_pbuf = rtpthlp_pbuf(:,nzm_clubb:1:-1) wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) @@ -3836,11 +3767,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid ! only because these are need to be stored for restarts - pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + if ( clubb_config_flags%l_call_pdf_closure_twice ) then + pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + end if ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid ! only for pdfp_rtp2_output calc @@ -3929,19 +3862,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & clubb_config_flags, & stats_metadata, & stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! inouts - um_in(:ncol,:), vm_in(:ncol,:), upwp_in(:ncol,:), vpwp_in(:ncol,:), up2_in(:ncol,:), vp2_in(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & - thlm_in(:ncol,:), rtm_in(:ncol,:), wprtp_in(:ncol,:), wpthlp_in(:ncol,:), & - wp2_in(:ncol,:), wp3_in(:ncol,:), rtp2_in(:ncol,:), rtp3_pbuf(:ncol,:), thlp2_in(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_in(:ncol,:), & + um_pbuf(:ncol,:), vm_pbuf(:ncol,:), upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), up2_pbuf(:ncol,:), vp2_pbuf(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & + thlm_pbuf(:ncol,:), rtm_pbuf(:ncol,:), wprtp_pbuf(:ncol,:), wpthlp_pbuf(:ncol,:), & + wp2_pbuf(:ncol,:), wp3_pbuf(:ncol,:), rtp2_pbuf(:ncol,:), rtp3_pbuf(:ncol,:), thlp2_pbuf(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_pbuf(:ncol,:), & sclrm(:ncol,:,:), & sclrp2(:ncol,:,:), sclrp3(:ncol,:,:), sclrprtp(:ncol,:,:), sclrpthlp(:ncol,:,:), & wpsclrp(:ncol,:,:), edsclr_in(:ncol,:,:), err_info, & - rcm_inout(:ncol,:), cloud_frac_inout(:ncol,:), & + rcm_pbuf(:ncol,:), cloud_frac_inout(:ncol,:), & wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & sclrpthvp_inout(:ncol,:,:), & wp2rtp_pbuf(:ncol,:), wp2thlp_pbuf(:ncol,:), uprcp_pbuf(:ncol,:), & vprcp_pbuf(:ncol,:), rc_coef_zm_pbuf(:ncol,:), & wp4_pbuf(:ncol,:), wpup2_pbuf(:ncol,:), wpvp2_pbuf(:ncol,:), & - wp2up2_pbuf(:ncol,:), wp2vp2_pbuf(:ncol,:), ice_supersat_frac_inout(:ncol,:), & + wp2up2_pbuf(:ncol,:), wp2vp2_pbuf(:ncol,:), ice_supersat_frac_pbuf(:ncol,:), & um_pert_inout(:ncol,:), vm_pert_inout(:ncol,:), upwp_pert_inout(:ncol,:), vpwp_pert_inout(:ncol,:), & pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & pdf_implicit_coefs_terms_chnk(lchnk), & @@ -3978,14 +3911,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) exner = exner(:,nzt_clubb:1:-1) rfrzm = rfrzm(:,nzt_clubb:1:-1) - um_in = um_in(:,nzt_clubb:1:-1) - vm_in = vm_in(:,nzt_clubb:1:-1) + um_pbuf = um_pbuf(:,nzt_clubb:1:-1) + vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) - wp3_in = wp3_in(:,nzt_clubb:1:-1) + wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) - rcm_inout = rcm_inout(:,nzt_clubb:1:-1) + rcm_pbuf = rcm_pbuf(:,nzt_clubb:1:-1) cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) @@ -3998,12 +3931,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & cloudy_updraft_frac_out = cloudy_updraft_frac_out(:,nzt_clubb:1:-1) cloudy_downdraft_frac_out = cloudy_downdraft_frac_out(:,nzt_clubb:1:-1) rcm_in_layer = rcm_in_layer(:,nzt_clubb:1:-1) - ice_supersat_frac_inout = ice_supersat_frac_inout(:,nzt_clubb:1:-1) + ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) - rtm_in = rtm_in(:,nzt_clubb:1:-1) - thlm_in = thlm_in(:,nzt_clubb:1:-1) + rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) + thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) Lscale = Lscale(:,nzt_clubb:1:-1) wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) @@ -4016,16 +3949,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) - upwp_in = upwp_in(:,nzm_clubb:1:-1) - vpwp_in = vpwp_in(:,nzm_clubb:1:-1) - up2_in = up2_in(:,nzm_clubb:1:-1) - vp2_in = vp2_in(:,nzm_clubb:1:-1) - wprtp_in = wprtp_in(:,nzm_clubb:1:-1) - wpthlp_in = wpthlp_in(:,nzm_clubb:1:-1) - wp2_in = wp2_in(:,nzm_clubb:1:-1) - rtp2_in = rtp2_in(:,nzm_clubb:1:-1) - thlp2_in = thlp2_in(:,nzm_clubb:1:-1) - rtpthlp_in = rtpthlp_in(:,nzm_clubb:1:-1) + upwp_pbuf = upwp_pbuf(:,nzm_clubb:1:-1) + vpwp_pbuf = vpwp_pbuf(:,nzm_clubb:1:-1) + up2_pbuf = up2_pbuf(:,nzm_clubb:1:-1) + vp2_pbuf = vp2_pbuf(:,nzm_clubb:1:-1) + wprtp_pbuf = wprtp_pbuf(:,nzm_clubb:1:-1) + wpthlp_pbuf = wpthlp_pbuf(:,nzm_clubb:1:-1) + wp2_pbuf = wp2_pbuf(:,nzm_clubb:1:-1) + rtp2_pbuf = rtp2_pbuf(:,nzm_clubb:1:-1) + thlp2_pbuf = thlp2_pbuf(:,nzm_clubb:1:-1) + rtpthlp_pbuf = rtpthlp_pbuf(:,nzm_clubb:1:-1) wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) @@ -4062,11 +3995,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid ! only because these are need to be stored for restarts - pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) - pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + if ( clubb_config_flags%l_call_pdf_closure_twice ) then + pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%w_2 = pdf_params_zm_chnk(lchnk)%w_2 (:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_1 = pdf_params_zm_chnk(lchnk)%varnce_w_1(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%varnce_w_2 = pdf_params_zm_chnk(lchnk)%varnce_w_2(:,nzm_clubb:1:-1) + pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) + end if ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid ! only for pdfp_rtp2_output calc @@ -4123,12 +4058,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzt_clubb do i=1,ncol - rvm_in(i,k) = rtm_in(i,k) - rcm_inout(i,k) + rvm_in(i,k) = rtm_pbuf(i,k) - rcm_pbuf(i,k) end do end do call update_xp2_mc_api( gr, nzm_clubb, nzt_clubb, ncol, dtime, cloud_frac_inout, & - rcm_inout, rvm_in, thlm_in, wm_zt, & + rcm_pbuf(:ncol,:), rvm_in, thlm_pbuf(:ncol,:), wm_zt, & exner, pre_in, pdf_params_chnk(lchnk), & rtp2_mc_out, thlp2_mc_out, & wprtp_mc_out, wpthlp_mc_out, & @@ -4139,10 +4074,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dum1 = (1._r8 - cam_in%landfrac(i)) ! update turbulent moments based on rain evaporation - rtp2_in(i,k) = rtp2_in(i,k) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,k) * dtime - thlp2_in(i,k) = thlp2_in(i,k) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,k) * dtime - wprtp_in(i,k) = wprtp_in(i,k) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,k) * dtime - wpthlp_in(i,k) = wpthlp_in(i,k) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,k) * dtime + rtp2_pbuf(i,k) = rtp2_pbuf(i,k) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,k) * dtime + thlp2_pbuf(i,k) = thlp2_pbuf(i,k) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,k) * dtime + wprtp_pbuf(i,k) = wprtp_pbuf(i,k) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,k) * dtime + wpthlp_pbuf(i,k) = wpthlp_pbuf(i,k) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,k) * dtime end do end do @@ -4164,12 +4099,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr, & - rcm_inout, thlprcp_out, qrl_clubb, clubb_params, & + rcm_pbuf(:ncol,:), thlprcp_out, qrl_clubb, clubb_params, & thlp2_rad ) do k=1,nzm_clubb do i=1, ncol - thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) + thlp2_rad(i,k) * dtime ) + thlp2_pbuf(i,k) = max( thl_tol**2, thlp2_pbuf(i,k) + thlp2_rad(i,k) * dtime ) end do end do @@ -4195,11 +4130,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if ( clubb_do_adv .and. macmic_it == cld_macmic_num_steps ) then do k=1,nzm_clubb do i=1, ncol - thlp2_in(i,k) = max( thl_tol**2, thlp2_in(i,k) ) - rtp2_in(i,k) = max( rt_tol**2, rtp2_in(i,k) ) - wp2_in(i,k) = max( w_tol_sqd, wp2_in(i,k) ) - up2_in(i,k) = max( w_tol_sqd, up2_in(i,k) ) - vp2_in(i,k) = max( w_tol_sqd, vp2_in(i,k) ) + thlp2_pbuf(i,k) = max( thl_tol**2, thlp2_pbuf(i,k) ) + rtp2_pbuf(i,k) = max( rt_tol**2, rtp2_pbuf(i,k) ) + wp2_pbuf(i,k) = max( w_tol_sqd, wp2_pbuf(i,k) ) + up2_pbuf(i,k) = max( w_tol_sqd, up2_pbuf(i,k) ) + vp2_pbuf(i,k) = max( w_tol_sqd, vp2_pbuf(i,k) ) end do end do end if @@ -4209,15 +4144,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1, nzt_clubb do i=1, ncol k_cam = top_lev - 1 + k - um_pbuf(i,k_cam) = um_in(i,k) - vm_pbuf(i,k_cam) = vm_in(i,k) - thlm_pbuf(i,k_cam) = thlm_in(i,k) - rtm_pbuf(i,k_cam) = rtm_in(i,k) - wp3_pbuf(i,k_cam) = wp3_in(i,k) - rcm_pbuf(i,k_cam) = rcm_inout(i,k) - cloud_frac_pbuf(i,k_cam) = min(cloud_frac_inout(i,k),1._r8) - ice_supersat_frac_pbuf(i,k_cam) = ice_supersat_frac_inout(i,k) - qclvar(i,k_cam) = min(1._r8,qclvar_out(i,k)) + cloud_frac_pbuf(i,k_cam) = cloud_frac_inout(i,k) + qclvar(i,k_cam) = min( 1._r8, qclvar_out(i,k) ) end do end do @@ -4226,76 +4154,61 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1, nzm_clubb do i=1, ncol k_cam = top_lev - 1 + k - upwp_pbuf(i,k_cam) = upwp_in(i,k) - vpwp_pbuf(i,k_cam) = vpwp_in(i,k) - up2_pbuf(i,k_cam) = up2_in(i,k) - vp2_pbuf(i,k_cam) = vp2_in(i,k) - wprtp_pbuf(i,k_cam) = wprtp_in(i,k) - wpthlp_pbuf(i,k_cam) = wpthlp_in(i,k) - wp2_pbuf(i,k_cam) = wp2_in(i,k) - rtp2_pbuf(i,k_cam) = rtp2_in(i,k) - thlp2_pbuf(i,k_cam) = thlp2_in(i,k) - rtpthlp_pbuf(i,k_cam) = rtpthlp_in(i,k) khzm_pbuf(i,k_cam) = khzm_out(i,k) ! pdf_params_zm_chnk is already persistent across calls, but we ! save a pbuf version for restarts - pdf_zm_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_1(i,k) - pdf_zm_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_2(i,k) - pdf_zm_varnce_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) - pdf_zm_varnce_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) - pdf_zm_mixt_frac_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) + if ( clubb_config_flags%l_call_pdf_closure_twice ) then + pdf_zm_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_1(i,k) + pdf_zm_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_2(i,k) + pdf_zm_varnce_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) + pdf_zm_varnce_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) + pdf_zm_mixt_frac_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) + end if end do end do call t_stopf('clubb_tend_cam:flip-index') - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, pverp - do i=1, ncol - - ! Accumulate vars through macmic subcycle - upwp_clubb_gw_mc_pbuf(i,k) = upwp_clubb_gw_mc_pbuf(i,k) + upwp_pbuf(i,k) - vpwp_clubb_gw_mc_pbuf(i,k) = vpwp_clubb_gw_mc_pbuf(i,k) + vpwp_pbuf(i,k) - thlp2_clubb_gw_mc_pbuf(i,k) = thlp2_clubb_gw_mc_pbuf(i,k) + thlp2_pbuf(i,k) - wpthlp_clubb_gw_mc_pbuf(i,k) = wpthlp_clubb_gw_mc_pbuf(i,k) + wpthlp_pbuf(i,k) - - ! And average at last macmic step - if (macmic_it == cld_macmic_num_steps) then - upwp_clubb_gw_pbuf(i,k) = upwp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) - vpwp_clubb_gw_pbuf(i,k) = vpwp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) - thlp2_clubb_gw_pbuf(i,k) = thlp2_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) - wpthlp_clubb_gw_pbuf(i,k) = wpthlp_clubb_gw_mc_pbuf(i,k)/REAL(cld_macmic_num_steps,r8) - end if - - end do - end do - ! Values to use above top_lev, for variables that have not already been ! set up there. These are mostly fill values that should not actually be ! used in the run, but may end up in diagnostic output. !$acc parallel loop gang vector collapse(2) default(present) do k=1, top_lev-1 do i=1, ncol - upwp_pbuf(i,k) = 0._r8 - vpwp_pbuf(i,k) = 0._r8 - rcm_pbuf(i,k) = 0._r8 cloud_frac_pbuf(i,k) = 0._r8 khzm_pbuf(i,k) = 0._r8 - qclvar(i,k) = 2._r8 + qclvar(i,k) = 2._r8 end do end do +!---- TODO: there seems to a an above top_lev interaction here that changes answers. +! The error occured because we were zeroing out the [1:top_lev-1] values in +! in rcm_pbuf (when it still contained those levels), when it should've been +! set to state1%q(:,:,ixcldliq) and unchanged by clubb. ! Compute static energy using CLUBB's variables !$acc parallel loop gang vector collapse(2) default(present) - do k=1,pver - do i=1, ncol - clubb_s(i,k) = cpairv(i,k,lchnk) * thlm_pbuf(i,k) / inv_exner_clubb(i,k) & - + latvap * rcm_pbuf(i,k) & + do k = 1, top_lev-1 + do i = 1, ncol + clubb_s(i,k) = cpairv(i,k,lchnk) * ( ( state1%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state1%q(i,k,ixcldliq) ) & + * inv_exner_clubb(i,k) ) / inv_exner_clubb(i,k) & + + latvap * 0._r8 & ! error kept for BFBness + !+ latvap * state1%q(i,k,ixcldliq) & ! correct line + gravit * state1%zm(i,k) + state1%phis(i) end do end do + !$acc parallel loop gang vector collapse(2) default(present) + do k = top_lev, pver + do i = 1, ncol + k_clubb = k + 1 - top_lev + clubb_s(i,k) = cpairv(i,k,lchnk) * thlm_pbuf(i,k_clubb) / inv_exner_clubb(i,k) & + + latvap * rcm_pbuf(i,k_clubb) & + + gravit * state1%zm(i,k) + state1%phis(i) + end do + end do +!--------------------------------- END TODO --------------------------------- + ! Section below is concentrated on energy fixing for conservation. ! because CLUBB and CAM's thermodynamic variables are different. @@ -4304,8 +4217,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i=1, ncol clubbtop(i) = top_lev - do while ((rtp2_pbuf(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm_pbuf(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver) + k_clubb = clubbtop(i) + 1 - top_lev + do while ((rtp2_pbuf(i,k_clubb) <= 1.e-15_r8 .and. rcm_pbuf(i,k_clubb) == 0._r8) .and. clubbtop(i) < pver) clubbtop(i) = clubbtop(i) + 1 + k_clubb = clubbtop(i) + 1 - top_lev end do end do @@ -4322,14 +4237,31 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wv_b = 0._r8 wl_b = 0._r8 - do k=1,pver +!---- TODO: there seems to a an above top_lev interaction here that changes answers. +! The error occured because we were zeroing out the [1:top_lev-1] values in +! in rcm_pbuf (when it still contained those levels), when it should've been +! set to state1%q(:,:,ixcldliq) and unchanged by clubb. + do k = 1, top_lev - 1 ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water ! after CLUBB is called. This is for energy conservation purposes. se_a = se_a + clubb_s(i,k)*state1%pdel(i,k)*rga - ke_a = ke_a + 0.5_r8*(um_pbuf(i,k)**2+vm_pbuf(i,k)**2)*state1%pdel(i,k)*rga - wv_a = wv_a + (rtm_pbuf(i,k)-rcm_pbuf(i,k))*state1%pdeldry(i,k)*rga - wl_a = wl_a + (rcm_pbuf(i,k))*state1%pdeldry(i,k)*rga + ke_a = ke_a + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)*rga + wv_a = wv_a + ( state1%q(i,k,ixq) + state1%q(i,k,ixcldliq) ) * state1%pdeldry(i,k) * rga ! error kept for BFBness + wl_a = wl_a + 0.0_r8 ! error kept for BFBness + !wv_a = wv_a + state1%q(i,k,ixq)*state1%pdeldry(i,k)*rga ! correct way + !wl_a = wl_a + state1%q(i,k,ixcldliq)*state1%pdeldry(i,k)*rga ! correct way + end do + + ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water + ! after CLUBB is called. This is for energy conservation purposes. + do k = top_lev, pver + k_clubb = k + 1 - top_lev + se_a = se_a + clubb_s(i,k)*state1%pdel(i,k)*rga + ke_a = ke_a + 0.5_r8*(um_pbuf(i,k_clubb)**2+vm_pbuf(i,k_clubb)**2)*state1%pdel(i,k)*rga + wv_a = wv_a + (rtm_pbuf(i,k_clubb)-rcm_pbuf(i,k_clubb))*state1%pdeldry(i,k)*rga + wl_a = wl_a + (rcm_pbuf(i,k_clubb))*state1%pdeldry(i,k)*rga end do +!--------------------------------- END TODO --------------------------------- ! Based on these integrals, compute the total energy after CLUBB call te_a = se_a + ke_a + (latvap+latice) * wv_a + latice * wl_a @@ -4394,24 +4326,45 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_init( ptend_loc, state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq ) +!---- TODO: there seems to a an above top_lev interaction here that changes answers. +! The error occured because we were zeroing out the [1:top_lev-1] values in +! in rcm_pbuf (when it still contained those levels), when it should've been +! set to state1%q(:,:,ixcldliq) and unchanged by clubb. Had it been set correctly +! the ptend_loc%q terms would simplify to zero. I've left the (erroneous?) interaction +! for now to maintain BFBness + do k = 1, top_lev-1 + do i=1, ncol + ptend_loc%u(i,k) = 0.0_r8 + ptend_loc%v(i,k) = 0.0_r8 + ptend_loc%q(i,k,ixq) = ( state1%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness + ptend_loc%q(i,k,ixcldliq) = ( - state1%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness + ! ptend_loc%q(i,k,ixq) = 0.0_r8 ! correct line + ! ptend_loc%q(i,k,ixcldliq) = 0.0_r8 ! correct line + ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy + end do + end do - do k=1, pver + do k = top_lev, pver + do i=1, ncol + k_clubb = k + 1 - top_lev + ptend_loc%u(i,k) = (um_pbuf(i,k_clubb) - state1%u(i,k)) * invrs_hdtime ! east-west wind + ptend_loc%v(i,k) = (vm_pbuf(i,k_clubb) - state1%v(i,k)) * invrs_hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = (rtm_pbuf(i,k_clubb) - rcm_pbuf(i,k_clubb)-state1%q(i,k,ixq)) * invrs_hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = (rcm_pbuf(i,k_clubb) - state1%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy + end do + end do +!--------------------------------- END TODO --------------------------------- + + do i=1, ncol ! Now compute the tendencies of CLUBB to CAM rtm_integral_vtend(i) = 0._r8 rtm_integral_ltend(i) = 0._r8 - do i=1, ncol - - ptend_loc%u(i,k) = (um_pbuf(i,k) - state1%u(i,k)) * invrs_hdtime ! east-west wind - ptend_loc%v(i,k) = (vm_pbuf(i,k) - state1%v(i,k)) * invrs_hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = (rtm_pbuf(i,k) - rcm_pbuf(i,k)-state1%q(i,k,ixq)) * invrs_hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = (rcm_pbuf(i,k) - state1%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy - - rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k) - rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k) - + do k=1, pver + rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq) * state1%pdel(i,k) + rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k, ixq) * state1%pdel(i,k) end do rtm_integral_ltend(i) = rtm_integral_ltend(i)/gravit @@ -4420,42 +4373,72 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do - ! Accumulate Air Temperature Tendency (TTEND) for Gravity Wave parameterization - do k=1, pver - do i=1, ncol - ttend_clubb_mc_pbuf(i,k) = ttend_clubb_mc_pbuf(i,k) + ptend_loc%s(i,k)/cpair - - ! Average at last macmic step - if (macmic_it == cld_macmic_num_steps) then - ttend_clubb_pbuf(i,k) = ttend_clubb_mc_pbuf(i,k) / REAL(cld_macmic_num_steps,r8) - end if + ! need to initialize macmic coupling to zero + if ( macmic_it == 1 ) then + ttend_clubb_mc_pbuf(:,:) = 0._r8 + upwp_clubb_gw_mc_pbuf(:,:) = 0._r8 + vpwp_clubb_gw_mc_pbuf(:,:) = 0._r8 + thlp2_clubb_gw_mc_pbuf(:,:) = 0._r8 + wpthlp_clubb_gw_mc_pbuf(:,:) = 0._r8 + end if - end do - end do + ! Accumulate vars through macmic subcycle for Gravity Wave parameterization + ttend_clubb_mc_pbuf (1:ncol,1:nzt_clubb) = ttend_clubb_mc_pbuf(1:ncol,1:nzt_clubb) + ptend_loc%s(1:ncol,top_lev:pver) / cpair + upwp_clubb_gw_mc_pbuf (1:ncol,1:nzm_clubb) = upwp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) + upwp_pbuf (1:ncol,1:nzm_clubb) + vpwp_clubb_gw_mc_pbuf (1:ncol,1:nzm_clubb) = vpwp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) + vpwp_pbuf (1:ncol,1:nzm_clubb) + thlp2_clubb_gw_mc_pbuf (1:ncol,1:nzm_clubb) = thlp2_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) + thlp2_pbuf (1:ncol,1:nzm_clubb) + wpthlp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) = wpthlp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) + wpthlp_pbuf(1:ncol,1:nzm_clubb) + + ! And average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + ttend_clubb_pbuf (1:ncol,top_lev:pver ) = ttend_clubb_mc_pbuf(1:ncol,1:nzt_clubb) / REAL(cld_macmic_num_steps,r8) + upwp_clubb_gw_pbuf (1:ncol,top_lev:pverp) = upwp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) / REAL(cld_macmic_num_steps,r8) + vpwp_clubb_gw_pbuf (1:ncol,top_lev:pverp) = vpwp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) / REAL(cld_macmic_num_steps,r8) + thlp2_clubb_gw_pbuf (1:ncol,top_lev:pverp) = thlp2_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) / REAL(cld_macmic_num_steps,r8) + wpthlp_clubb_gw_pbuf(1:ncol,top_lev:pverp) = wpthlp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) / REAL(cld_macmic_num_steps,r8) + end if if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then - do k=1, pver + ! Zero above top_lev + do k = 1, top_lev - 1 do i=1, ncol + ptend_loc%q(i,k,ixthlp2) = 0.0_r8 + ptend_loc%q(i,k,ixrtp2) = 0.0_r8 + ptend_loc%q(i,k,ixrtpthlp) = 0.0_r8 + ptend_loc%q(i,k,ixwpthlp) = 0.0_r8 + ptend_loc%q(i,k,ixwprtp) = 0.0_r8 + ptend_loc%q(i,k,ixwp2) = 0.0_r8 + ptend_loc%q(i,k,ixwp3) = 0.0_r8 + ptend_loc%q(i,k,ixup2) = 0.0_r8 + ptend_loc%q(i,k,ixvp2) = 0.0_r8 + + end do + end do + + do k = top_lev, pver + do i=1, ncol + + k_clubb = k + 1 - top_lev ! Here add a constant to moments which can be either positive or ! negative. This is to prevent clipping when dynamics tries to ! make all constituents positive - wp3_pbuf(i,k) = wp3_pbuf(i,k) + wp3_const - rtpthlp_pbuf(i,k) = rtpthlp_pbuf(i,k) + rtpthlp_const - wpthlp_pbuf(i,k) = wpthlp_pbuf(i,k) + wpthlp_const - wprtp_pbuf(i,k) = wprtp_pbuf(i,k) + wprtp_const - - ptend_loc%q(i,k,ixthlp2) = (thlp2_pbuf(i,k) - state1%q(i,k,ixthlp2)) * invrs_hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2) = (rtp2_pbuf(i,k) - state1%q(i,k,ixrtp2)) * invrs_hdtime ! RTP Variance - ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp_pbuf(i,k) - state1%q(i,k,ixrtpthlp)) * invrs_hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp) = (wpthlp_pbuf(i,k) - state1%q(i,k,ixwpthlp)) * invrs_hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp) = (wprtp_pbuf(i,k) - state1%q(i,k,ixwprtp)) * invrs_hdtime ! WPRTP - ptend_loc%q(i,k,ixwp2) = (wp2_pbuf(i,k) - state1%q(i,k,ixwp2)) * invrs_hdtime ! WP2 - ptend_loc%q(i,k,ixwp3) = (wp3_pbuf(i,k) - state1%q(i,k,ixwp3)) * invrs_hdtime ! WP3 - ptend_loc%q(i,k,ixup2) = (up2_pbuf(i,k) - state1%q(i,k,ixup2)) * invrs_hdtime ! UP2 - ptend_loc%q(i,k,ixvp2) = (vp2_pbuf(i,k) - state1%q(i,k,ixvp2)) * invrs_hdtime ! VP2 + wp3_pbuf(i,k_clubb) = wp3_pbuf(i,k_clubb) + wp3_const + rtpthlp_pbuf(i,k_clubb) = rtpthlp_pbuf(i,k_clubb) + rtpthlp_const + wpthlp_pbuf(i,k_clubb) = wpthlp_pbuf(i,k_clubb) + wpthlp_const + wprtp_pbuf(i,k_clubb) = wprtp_pbuf(i,k_clubb) + wprtp_const + + ptend_loc%q(i,k,ixthlp2) = (thlp2_pbuf(i,k_clubb) - state1%q(i,k,ixthlp2)) * invrs_hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = (rtp2_pbuf(i,k_clubb) - state1%q(i,k,ixrtp2)) * invrs_hdtime ! RTP Variance + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp_pbuf(i,k_clubb) - state1%q(i,k,ixrtpthlp)) * invrs_hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = (wpthlp_pbuf(i,k_clubb) - state1%q(i,k,ixwpthlp)) * invrs_hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = (wprtp_pbuf(i,k_clubb) - state1%q(i,k,ixwprtp)) * invrs_hdtime ! WPRTP + ptend_loc%q(i,k,ixwp2) = (wp2_pbuf(i,k_clubb) - state1%q(i,k,ixwp2)) * invrs_hdtime ! WP2 + ptend_loc%q(i,k,ixwp3) = (wp3_pbuf(i,k_clubb) - state1%q(i,k,ixwp3)) * invrs_hdtime ! WP3 + ptend_loc%q(i,k,ixup2) = (up2_pbuf(i,k_clubb) - state1%q(i,k,ixup2)) * invrs_hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = (vp2_pbuf(i,k_clubb) - state1%q(i,k,ixvp2)) * invrs_hdtime ! VP2 end do end do @@ -4701,9 +4684,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (deep_scheme .ne. 'CLUBB_SGS') then do i = 1, ncol - do k = 1, pver - if ( rcm_pbuf(i,k) /= 0 .and. qclvar(i,k) /= 0 ) then - relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm_pbuf(i,k)**2 / qclvar(i,k) ) ) + do k = top_lev, pver + k_clubb = k + 1 - top_lev + if ( rcm_pbuf(i,k_clubb) /= 0 .and. qclvar(i,k) /= 0 ) then + relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm_pbuf(i,k_clubb)**2 / qclvar(i,k) ) ) end if end do end do @@ -4712,11 +4696,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! ------------------------------------------------- ! ! Optional Accretion enhancement factor ! ! ------------------------------------------------- ! - accre_enhan_pbuf(:ncol,:pver) = 1._r8 - - do k=1,pverp - do i=1,ncol - tke_pbuf(i,k) = 0.5_r8 * ( up2_pbuf(i,k) + vp2_pbuf(i,k) + wp2_pbuf(i,k) ) ! turbulent kinetic energy + accre_enhan_pbuf(:ncol,:pver) = 1._r8 + + ! turbulent kinetic energy + do k = top_lev, pverp + do i = 1, ncol + k_clubb = k + 1 - top_lev + tke_pbuf(i,k) = 0.5_r8 * ( up2_pbuf(i,k_clubb) + vp2_pbuf(i,k_clubb) + wp2_pbuf(i,k_clubb) ) enddo enddo @@ -4731,10 +4717,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & alst_pbuf(:,:) = 0.0_r8 qlst_pbuf(:,:) = 0.0_r8 - do k=1,pver - do i=1,ncol + do k = top_lev, pver + do i = 1, ncol + k_clubb = k + 1 - top_lev alst_pbuf(i,k) = cloud_frac_pbuf(i,k) - qlst_pbuf(i,k) = rcm_pbuf(i,k)/max(0.01_r8,alst_pbuf(i,k)) ! Incloud stratus condensate mixing ratio + qlst_pbuf(i,k) = rcm_pbuf(i,k_clubb) / max( 0.01_r8, alst_pbuf(i,k) ) ! Incloud stratus condensate mixing ratio enddo enddo @@ -4949,39 +4936,38 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & zi_output(i,k) = zi_g(i,k_clubb) - wp2_output(i,k) = wp2_pbuf(i,k) - up2_output(i,k) = up2_pbuf(i,k) - vp2_output(i,k) = vp2_pbuf(i,k) - upwp_output(i,k) = upwp_pbuf(i,k) - vpwp_output(i,k) = vpwp_pbuf(i,k) - rtp2_output(i,k) = rtp2_pbuf(i,k) + wp2_output(i,k) = wp2_pbuf(i,k_clubb) + up2_output(i,k) = up2_pbuf(i,k_clubb) + vp2_output(i,k) = vp2_pbuf(i,k_clubb) + upwp_output(i,k) = upwp_pbuf(i,k_clubb) + vpwp_output(i,k) = vpwp_pbuf(i,k_clubb) + rtp2_output(i,k) = rtp2_pbuf(i,k_clubb) wprcp_clubb_output(i,k) = wprcp_out(i,k_clubb) * latvap wpthvp_clubb_output(i,k) = wpthvp_pbuf(i,k_clubb) * cpair - thlp2_output(i,k) = thlp2_pbuf(i,k) + thlp2_output(i,k) = thlp2_pbuf(i,k_clubb) - wpthlp_output(i,k) = (wpthlp_pbuf(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux - wprtp_output(i,k) = (wprtp_pbuf(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux - rtpthlp_output(i,k) = rtpthlp_pbuf(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output + wpthlp_output(i,k) = (wpthlp_pbuf(i,k_clubb)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux + wprtp_output(i,k) = (wprtp_pbuf(i,k_clubb)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux + rtpthlp_output(i,k) = rtpthlp_pbuf(i,k_clubb)-(apply_const*rtpthlp_const) ! rtpthlp output end do end do ! Convert RTP2 and THLP2 to thermo grid for output - rtp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_in ) - thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_in ) - wp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_in ) + rtp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, rtp2_pbuf(:ncol,:) ) + thl2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, thlp2_pbuf(:ncol,:) ) + wp2_zt = zm2zt_api( nzm_clubb, nzt_clubb, ncol, gr, wp2_pbuf(:ncol,:) ) do k = top_lev, pver do i = 1, ncol k_clubb = k + 1 - top_lev - rcm_output(i,k) = rcm_pbuf(i,k) - rtm_output(i,k) = rtm_pbuf(i,k) - thlm_output(i,k) = thlm_pbuf(i,k) - cloud_frac_output(i,k) = cloud_frac_pbuf(i,k) - um_output(i,k) = um_pbuf(i,k) - vm_output(i,k) = vm_pbuf(i,k) + rcm_output(i,k) = rcm_pbuf(i,k_clubb) + rtm_output(i,k) = rtm_pbuf(i,k_clubb) + thlm_output(i,k) = thlm_pbuf(i,k_clubb) + um_output(i,k) = um_pbuf(i,k_clubb) + vm_output(i,k) = vm_pbuf(i,k_clubb) rcm_in_layer_output(i,k) = rcm_in_layer(i,k_clubb) zt_output(i,k) = zt_g(i,k_clubb) @@ -4991,7 +4977,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thl2_zt_output(i,k) = thl2_zt(i,k_clubb) wp2_zt_output(i,k) = wp2_zt(i,k_clubb) - wp3_output(i,k) = wp3_pbuf(i,k) - (apply_const*wp3_const) ! wp3 output + wp3_output(i,k) = wp3_pbuf(i,k_clubb) - (apply_const*wp3_const) ! wp3 output end do end do @@ -5033,7 +5019,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rcm_output(i,k) = 0._r8 rtm_output(i,k) = 0._r8 thlm_output(i,k) = 0._r8 - cloud_frac_output(i,k) = 0._r8 um_output(i,k) = 0._r8 vm_output(i,k) = 0._r8 zi_output(i,k) = 0._r8 @@ -5069,7 +5054,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'pdfp_rtp2_output_CLUBB', pdfp_rtp2_output, pcols, lchnk ) call outfld( 'THLP2_CLUBB', thlp2_output, pcols, lchnk ) call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer_output, pcols, lchnk ) - call outfld( 'CLOUDCOVER_CLUBB', cloud_frac_output, pcols, lchnk ) + call outfld( 'CLOUDCOVER_CLUBB', cloud_frac_pbuf, pcols, lchnk ) call outfld( 'ZT_CLUBB', zt_output, pcols, lchnk ) call outfld( 'ZM_CLUBB', zi_output, pcols, lchnk ) call outfld( 'UM_CLUBB', um_output, pcols, lchnk ) diff --git a/src/physics/cam/microp_aero.F90 b/src/physics/cam/microp_aero.F90 index d14d4d5967..50609acf02 100644 --- a/src/physics/cam/microp_aero.F90 +++ b/src/physics/cam/microp_aero.F90 @@ -658,9 +658,10 @@ subroutine microp_aero_run ( & call pbuf_get_field(pbuf, tke_idx, tke) case ('CLUBB_SGS') itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/),kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, wp2_idx, wp2 ) allocate(tke(pcols,pverp)) - tke(:ncol,:) = (3._r8/2._r8)*wp2(:ncol,:) + tke(:ncol,top_lev:pverp) = (3._r8/2._r8)*wp2(:ncol,1:pverp-top_lev+1) + tke(:ncol,1:top_lev-1) = 0._r8 case default call pbuf_get_field(pbuf, kvh_idx, kvh) diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 477aa49f05..ffed8cd3dd 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -86,9 +86,9 @@ module subcol_SILHS ixnumsnow= 0 ! Pbuf indicies - integer :: thlm_idx, rtm_idx, ice_supersat_idx, & + integer :: rtm_idx, ice_supersat_idx, & alst_idx, cld_idx, qrain_idx, qsnow_idx, & - nrain_idx, nsnow_idx, ztodt_idx, tke_idx, kvh_idx, & + nrain_idx, nsnow_idx, tke_idx, kvh_idx, & prec_pcw_idx, snow_pcw_idx, prec_str_idx, snow_str_idx, & qcsedten_idx, qrsedten_idx, qisedten_idx, qssedten_idx, & vtrmc_idx, umr_idx, vtrmi_idx, ums_idx, qcsevap_idx, qisevap_idx @@ -118,7 +118,6 @@ module subcol_SILHS ! subcol_SILHS_c11b, subcol_SILHS_gamma_coef, & ! subcol_SILHS_mult_coef, subcol_SILHS_mu - real(r8) :: ztodt ! model timestep #ifdef CLUBB_SGS #ifdef SILHS type(hmp2_ip_on_hmm2_ip_slope_type) :: subcol_SILHS_hmp2_ip_on_hmm2_ip_slope @@ -417,11 +416,9 @@ subroutine subcol_init_SILHS(pbuf2d) call cnst_get_ind('NUMSNO', ixnumsnow, abort=.false.) ! Get physics buffer indexes - thlm_idx = pbuf_get_index('THLM') rtm_idx = pbuf_get_index('RTM') cld_idx = pbuf_get_index('CLD') alst_idx = pbuf_get_index('ALST') ! SILHS expects clubb's cloud_frac liq stratus fraction - ztodt_idx = pbuf_get_index('ZTODT') ice_supersat_idx = pbuf_get_index('ISS_FRAC') tke_idx = pbuf_get_index('tke') kvh_idx = pbuf_get_index('kvh') @@ -530,8 +527,6 @@ subroutine subcol_init_SILHS(pbuf2d) 'Monte Carlo estimate of Kessler autoconversion') call addfld('INVS_EXNER', (/ 'lev' /), 'I', 'none', & 'inverse EXNER function from state in subcol_SILHS') - call addfld('SILHS_ZTODT', horiz_only, 'I', 's', & - 'Length of Physics timestep (for debugging)') if ( subcol_SILHS_constrainmn ) then call addfld('SILHS_MSC_CLDICE', (/ 'lev' /), 'A', 'kg/kg', & 'Mean Cloud Ice across subcolumns') @@ -607,6 +602,9 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) #ifdef CLUBB_SGS #ifdef SILHS + use clubb_intr, only: , & + ztodt ! model timestep + use clubb_api_module, only : setup_pdf_parameters_api, & zm2zt_api, setup_grid_heights_api, & @@ -692,7 +690,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx real(r8), dimension(state%ngrdcol, nzt_clubb) :: Nc_in_cloud - real(r8), dimension(state%ngrdcol, nzt_clubb) :: ice_supersat_frac_in real(r8), dimension(state%ngrdcol, nzm_clubb, hydromet_dim) :: hydrometp2 @@ -825,8 +822,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Pointers !---------------- - real(r8), pointer, dimension(:) :: ztodt_ptr - real(r8), pointer, dimension(:,:) :: thlm ! Mean temperature real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! ice cloud fraction real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio real(r8), pointer, dimension(:,:) :: cld ! CAM cloud fraction @@ -842,7 +837,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) logical, parameter :: l_est_kessler_microphys = .false. logical, parameter :: l_outfld_subcol = .false. - type(grid) :: gr, gr_a + type(grid) :: gr type(precipitation_fractions) :: precip_fracs @@ -922,8 +917,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Establish associations between pointers and physics buffer fields !---------------- - call pbuf_get_field(pbuf, thlm_idx, thlm) - call pbuf_get_field(pbuf, ztodt_idx, ztodt_ptr) call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) call pbuf_get_field(pbuf, rtm_idx, rtm) call pbuf_get_field(pbuf, alst_idx, alst) @@ -948,7 +941,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Copy state and populate numbers and values of sub-columns !---------------- - ztodt = ztodt_ptr(1) num_subcols = subcol_SILHS_numsubcol ! Calculate sample weights separately at all grid levels when @@ -1078,10 +1070,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) k_cam = top_lev - 1 + k Ncm(i,k) = state%q(i,k_cam,ixnumliq) - - ! Convert from CAM vertical grid to CLUBB - ice_supersat_frac_in(i,k) = ice_supersat_frac(i,k_cam) - + cld_frac_in(i,k) = alst(i,k_cam) ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS @@ -1103,72 +1092,9 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end do end do - - !======================================== ASCENDING MODE CODE ======================================== - - !---------------------------------- FLIPPING ---------------------------------- - ! ice_supersat_frac_in = ice_supersat_frac_in(:,nzt_clubb:1:-1) - ! cld_frac_in = cld_frac_in (:,nzt_clubb:1:-1) - ! Nc_in_cloud = Nc_in_cloud (:,nzt_clubb:1:-1) - - ! khzm = khzm (:,nzm_clubb:1:-1) - ! tke = tke (:,nzm_clubb:1:-1) - - ! if ( hydromet_dim > 0 ) then - ! hydromet = hydromet (:,nzt_clubb:1:-1,:) - ! end if - - - ! ! These need always be flipped, as they are always in descending mode - ! pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) - - ! pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) - - ! pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) - - ! if ( l_ascending_grid ) then - ! ! These only need flip these to descending mode - ! pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2(:,nzt_clubb:1:-1) - - ! pdf_params_chnk(lchnk)%cloud_frac_1 = pdf_params_chnk(lchnk)%cloud_frac_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%cloud_frac_2 = pdf_params_chnk(lchnk)%cloud_frac_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%chi_1 = pdf_params_chnk(lchnk)%chi_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%chi_2 = pdf_params_chnk(lchnk)%chi_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%stdev_chi_1 = pdf_params_chnk(lchnk)%stdev_chi_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%stdev_chi_2 = pdf_params_chnk(lchnk)%stdev_chi_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%crt_1 = pdf_params_chnk(lchnk)%crt_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%cthl_1 = pdf_params_chnk(lchnk)%cthl_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%crt_2 = pdf_params_chnk(lchnk)%crt_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%cthl_2 = pdf_params_chnk(lchnk)%cthl_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%ice_supersat_frac_1 = pdf_params_chnk(lchnk)%ice_supersat_frac_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%ice_supersat_frac_2 = pdf_params_chnk(lchnk)%ice_supersat_frac_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%corr_chi_eta_1 = pdf_params_chnk(lchnk)%corr_chi_eta_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2(:,nzt_clubb:1:-1) - ! end if - - ! zi_g = zi_g(:,nzm_clubb:1:-1) - ! zt_g = zt_g(:,nzt_clubb:1:-1) - - ! ! we are in ascending mode, need to calculate ascending grid - ! call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - ! .true., grid_type, & ! intent(in) - ! deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) - ! zi_g, zt_g, & ! intent(in) - ! gr_a, err_info ) ! intent(inout) - !---------------------------------- FLIPPING ---------------------------------- - call setup_pdf_parameters_api( gr, nzm_clubb, nzt_clubb, ngrdcol, pdf_dim, & ! In hydromet_dim, ztodt, Nc_in_cloud, cld_frac_in, khzm, & ! In - ice_supersat_frac_in, hydromet, wphydrometp, & ! In + ice_supersat_frac, hydromet, wphydrometp, & ! In corr_array_n_cloud, corr_array_n_below, & ! In hm_metadata, & ! In pdf_params_chnk(lchnk), & ! In @@ -1242,7 +1168,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Set the seed to the random number generator based on a quantity that ! will be reproducible for restarts. - lh_seed = int( 1.0e4_r8 * rtm(1,pver), kind = genrand_intg ) + lh_seed = int( 1.0e4_r8 * rtm(1,nzt_clubb), kind = genrand_intg ) ! Let's generate some subcolumns!!!!! call generate_silhs_sample_api( & @@ -1282,63 +1208,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') end if - !---------------------------------- FLIPPING ---------------------------------- - ! Flip to descending - ! lh_rt_clipped = lh_rt_clipped(:,:,nzt_clubb:1:-1) - ! lh_rc_clipped = lh_rc_clipped(:,:,nzt_clubb:1:-1) - ! lh_Nc_clipped = lh_Nc_clipped(:,:,nzt_clubb:1:-1) - ! lh_rv_clipped = lh_rv_clipped(:,:,nzt_clubb:1:-1) - ! lh_thl_clipped = lh_thl_clipped(:,:,nzt_clubb:1:-1) - - ! X_nl_all_levs = X_nl_all_levs(:,:,nzt_clubb:1:-1,:) - - ! lh_sample_point_weights = lh_sample_point_weights(:,:,nzt_clubb:1:-1) - - ! precip_fracs%precip_frac = precip_fracs%precip_frac(:,nzt_clubb:1:-1) - - ! ! These need always be flipped, as they are always in descending mode - ! pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) - - ! pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) - - ! pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) - - ! ! Flip these back to avoid making ascending clubb sad - ! pdf_params_chnk(lchnk)%rc_1 = pdf_params_chnk(lchnk)%rc_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%rc_2 = pdf_params_chnk(lchnk)%rc_2(:,nzt_clubb:1:-1) - - ! pdf_params_chnk(lchnk)%cloud_frac_1 = pdf_params_chnk(lchnk)%cloud_frac_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%cloud_frac_2 = pdf_params_chnk(lchnk)%cloud_frac_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%chi_1 = pdf_params_chnk(lchnk)%chi_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%chi_2 = pdf_params_chnk(lchnk)%chi_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%stdev_chi_1 = pdf_params_chnk(lchnk)%stdev_chi_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%stdev_chi_2 = pdf_params_chnk(lchnk)%stdev_chi_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%crt_1 = pdf_params_chnk(lchnk)%crt_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%crt_2 = pdf_params_chnk(lchnk)%crt_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%cthl_1 = pdf_params_chnk(lchnk)%cthl_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%cthl_2 = pdf_params_chnk(lchnk)%cthl_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%ice_supersat_frac_1 = pdf_params_chnk(lchnk)%ice_supersat_frac_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%ice_supersat_frac_2 = pdf_params_chnk(lchnk)%ice_supersat_frac_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%corr_chi_eta_1 = pdf_params_chnk(lchnk)%corr_chi_eta_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1(:,nzt_clubb:1:-1) - ! pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2(:,nzt_clubb:1:-1) - - ! Flip these that are never used... - ! if ( l_est_kessler_microphys ) then - ! AKm = AKm(:,nzt_clubb:1:-1) - ! lh_AKm = lh_AKm(:,nzt_clubb:1:-1) - ! end if - !---------------------------------- FLIPPING ---------------------------------- - - !======================================== END ASCENDING MODE CODE ======================================== - !$acc parallel loop collapse(3) default(present) do k = 1, nzt_clubb do j = 1, num_subcols @@ -1690,8 +1559,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) - call outfld( 'SILHS_RTM', rtm, pcols, lchnk ) - call outfld( 'SILHS_THLM', thlm, pcols, lchnk ) call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) @@ -1703,7 +1570,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) end if call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) - call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) if ( subcol_SILHS_constrainmn ) then call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) @@ -1718,7 +1584,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) end if !$acc end data @@ -1954,21 +1819,12 @@ subroutine subcol_SILHS_var_covar_driver & w_all_clubb(igrdcol,1:ns,top_lev:pver), qctend_clubb(igrdcol,1:ns,top_lev:pver), & qvtend_clubb(igrdcol,1:ns,top_lev:pver), thltend_clubb(igrdcol,1:ns,top_lev:pver), & silhs_config_flags%l_lh_instant_var_covar_src, & - rtp2_mc_zt(igrdcol,top_lev:pver), thlp2_mc_zt(igrdcol,top_lev:pver), & - wprtp_mc_zt(igrdcol,top_lev:pver), wpthlp_mc_zt(igrdcol,top_lev:pver), & - rtpthlp_mc_zt(igrdcol,top_lev:pver) ) + rtp2_mc_zt(igrdcol,:), thlp2_mc_zt(igrdcol,:), & + wprtp_mc_zt(igrdcol,:), wpthlp_mc_zt(igrdcol,:), & + rtpthlp_mc_zt(igrdcol,:) ) ! The *_mc_zt microphysics tendencies are passed out of SILHS and back ! to CLUBB without being used at all in the rest of the host model code. - - ! CLUBB used pver (thermodynamic) vertical levels, but SILHS only uses - ! nzt_clubb (pver-top_lev+1) vertical levels. - ! Fill the upper levels with 0s when necessary. - rtp2_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 - thlp2_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 - wprtp_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 - wpthlp_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 - rtpthlp_mc_zt(igrdcol,1:top_lev-1) = 0.0_r8 end do ! igrdcol = 1, ngrdcol From 0613054b90f6b5273401f306b749b26d4c47c508 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Mon, 24 Nov 2025 14:19:56 -0600 Subject: [PATCH 14/29] Setting l_ascending_grid to false --- src/physics/cam/clubb_intr.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 1ee48b28a1..aa66fb99d7 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -88,7 +88,7 @@ module clubb_intr sclr_idx logical, public, parameter :: & - l_ascending_grid = .true. ! Set clubb to ascending mode, which is opposite of the + l_ascending_grid = .false. ! Set clubb to ascending mode, which is opposite of the ! cam grid the rest of this code uses, thus it requires ! an expensive array flipping step before calling clubb From c03efd52386d8eb176d3d792fb78add4ddb733cb Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Tue, 25 Nov 2025 22:44:57 -0600 Subject: [PATCH 15/29] More simplifications and cleanup, all should be safe --- src/physics/cam/clubb_intr.F90 | 297 ++++++++++++--------------------- 1 file changed, 110 insertions(+), 187 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index aa66fb99d7..81a29b0002 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -439,7 +439,6 @@ module clubb_intr wpvp2_idx, & ! w'v'^2 wp2up2_idx, & ! w'^2 u'^2 wp2vp2_idx, & ! w'^2 v'^2 - cloud_frac_idx, & ! CLUBB's cloud fraction cld_idx, & ! Cloud fraction concld_idx, & ! Convective cloud fraction ast_idx, & ! Stratiform cloud fraction @@ -457,7 +456,6 @@ module clubb_intr fice_idx, & ! fice_idx index in physics buffer cmeliq_idx, & ! cmeliq_idx index in physics buffer relvar_idx, & ! relative cloud water variance - accre_enhan_idx, & ! optional accretion enhancement factor for MG npccn_idx, & ! liquid ccn number concentration naai_idx, & ! ice number concentration prer_evap_idx, & ! rain evaporation rate @@ -640,8 +638,6 @@ subroutine clubb_register_cam( ) call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), vp2_idx) call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,nzm_clubb/), wp2_idx) - call pbuf_add_field('CLOUD_FRAC', 'global', dtype_r8, (/pcols,pver/), cloud_frac_idx) - ! Only in clubb_intr.F90 or SILHS call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,nzt_clubb/), rtm_idx) @@ -1619,7 +1615,6 @@ subroutine clubb_ini_cam(pbuf2d) icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance - accre_enhan_idx = pbuf_get_index('ACCRE_ENHAN') ! accretion enhancement for MG prer_evap_idx = pbuf_get_index('PRER_EVAP') qrl_idx = pbuf_get_index('QRL') cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') @@ -1996,7 +1991,6 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, rtpthvp_idx, 0.0_r8) call pbuf_set_field(pbuf2d, thlpthvp_idx,0.0_r8) call pbuf_set_field(pbuf2d, rcm_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, cloud_frac_idx, 0.0_r8) call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8) call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wp2rtp_idx, 0.0_r8) @@ -2182,7 +2176,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wp2thvp_pbuf ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] real(r8), pointer, dimension(:,:) :: rtpthvp_pbuf ! r_t'th_v' (momentum levels) [kg/kg K] real(r8), pointer, dimension(:,:) :: thlpthvp_pbuf ! th_l'th_v' (momentum levels) [K^2] - real(r8), pointer, dimension(:,:) :: cloud_frac_pbuf ! Cloud fraction (thermodynamic levels) [K^2] real(r8), pointer, dimension(:,:) :: pdf_zm_w_1_pbuf !work pointer for pdf_params_zm real(r8), pointer, dimension(:,:) :: pdf_zm_w_2_pbuf !work pointer for pdf_params_zm real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1_pbuf !work pointer for pdf_params_zm @@ -2218,7 +2211,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: dp_icwmr_pbuf ! deep convection in cloud mixing ratio [kg/kg] real(r8), pointer, dimension(:,:) :: ice_supersat_frac_pbuf ! Cloud fraction of ice clouds (pver)[fraction] real(r8), pointer, dimension(:,:) :: relvar_pbuf ! relative cloud water variance [-] - real(r8), pointer, dimension(:,:) :: accre_enhan_pbuf ! accretion enhancement factor [-] real(r8), pointer, dimension(:,:) :: naai_pbuf real(r8), pointer, dimension(:,:) :: cmeliq_pbuf real(r8), pointer, dimension(:,:) :: cmfmc_sh_pbuf ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] @@ -2338,9 +2330,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qclvar_out, & ! cloud water variance [kg^2/kg^2] zt_g, & ! Thermodynamic grid of CLUBB [m] Lscale, & + dz_g, & ! thickness of layer [m] ! MF local thermodynamic vars - invrs_dzt, & ! thermodynamic grid invrs_exner_zt,& ! thermodynamic grid kappa_zt, qc_zt ! thermodynamic grid @@ -2412,7 +2404,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzt_clubb,edsclr_dim) :: & edsclrm_forcing, & ! Eddy passive scalar forcing [{units vary}/s] - edsclr_in ! Scalars to be diffused through CLUBB [units vary] + edsclr_inout ! Scalars to be diffused through CLUBB [units vary] ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES @@ -2489,8 +2481,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(pcols) :: & rhmini, & rhmaxi, & - rtm_integral_vtend, & - rtm_integral_ltend, & se_dis, & eleak, & ustar2, & ! Surface stress for PBL height [m2/s2] @@ -2510,10 +2500,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qvtend, & qctend, & inctend, & - qclvar, & ! cloud water variance [kg^2/kg^2] - dz_g, & ! thickness of layer [m] clubb_s, & - inv_exner_clubb, & ! Inverse exner function consistent with CLUBB [-] thv, & ! virtual potential temperature [K] th ! potential temperature [K] @@ -2521,6 +2508,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rho ! Midpoint density in CAM [kg/m^3] real(r8) :: & + inv_exner_tmp, & ! Inverse exner function consistent with CLUBB [-] dlf2, & ! Detraining cld H20 from shallow convection [kg/kg/day] dum1, & ! dummy variable [units vary] invrs_hdtime, & @@ -2627,7 +2615,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp_pbuf) call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp_pbuf) call pbuf_get_field(pbuf, rcm_idx, rcm_pbuf) - call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac_pbuf) call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1_pbuf ) call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2_pbuf ) @@ -2664,7 +2651,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, qsatfac_idx, qsatfac_pbuf) call pbuf_get_field(pbuf, prer_evap_idx, prer_evap_pbuf) - call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan_pbuf) call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_pbuf) call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac_pbuf) call pbuf_get_field(pbuf, relvar_idx, relvar_pbuf) @@ -2750,6 +2736,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !--------------------- Scalar Setting -------------------- + ! Set the ztodt timestep in pbuf for SILHS, this is needed because hdtime is not input to silhs + ztodt = 1.0_r8 * hdtime + ! Determine CLUBB time step and make it sub-step friendly ! For now we want CLUBB time step to be 5 min since that is ! what has been scientifically validated. However, there are certain @@ -2812,10 +2801,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! from moments since it has not been added yet endif - !--------------------- Initializations -------------------- - - ! Set the ztodt timestep in pbuf for SILHS, this is needed because hdtime is not input to silhs - ztodt = 1.0_r8 * hdtime + !----------------------------------------- BEGIN GPU SECTION ----------------------------------------- + ! everything within should be functional with the OpenACC code, or be prevented from running + ! with using OpenACC, see the "ifdef _OPENACC" section above for restriction examples call t_stopf('clubb_tend_cam:NAR') call t_startf('clubb_tend_cam:acc_copyin') @@ -2829,13 +2817,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc copy( um_pbuf, vm_pbuf, upwp_pbuf, vpwp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, & !$acc wp2_pbuf, wp3_pbuf, rtp2_pbuf, thlp2_pbuf, rtp3_pbuf, thlp3_pbuf, thlm_pbuf, rtm_pbuf, wprtp_pbuf, wpthlp_pbuf, rtpthlp_pbuf, & !$acc pdf_zm_w_1_pbuf, pdf_zm_w_2_pbuf, pdf_zm_varnce_w_1_pbuf, pdf_zm_varnce_w_2_pbuf, pdf_zm_mixt_frac_pbuf, & - !$acc cloud_frac_pbuf, wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & + !$acc wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf, & !$acc pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & !$acc pdf_params_zm_chnk(lchnk)%mixt_frac ) & - !$acc copyout( temp2d, inv_exner_clubb, & - !$acc rcm_pbuf, khzm_pbuf, qclvar, thv, dz_g, & + !$acc copyout( temp2d, & + !$acc rcm_pbuf, khzm_pbuf, dz_g, & !$acc clubbtop, se_dis, eleak, clubb_s ) & !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & !$acc fcor, & @@ -2903,7 +2891,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc data if( edsclr_dim > 0 ) & !$acc create( wpedsclrp_sfc, edsclrm_forcing ) & - !$acc copy( edsclr_in ) + !$acc copy( edsclr_inout ) !$acc data if( hydromet_dim > 0 ) & !$acc create( wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) & @@ -2911,12 +2899,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, pver - do i = 1, pcols - temp2d(i,k) = 0._r8 - end do - end do + !----------------------------------------- Zeroing ----------------------------------------- !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb @@ -2935,18 +2918,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vm_ref(i,k) = 0.0_r8 ug(i,k) = 0.0_r8 vg(i,k) = 0.0_r8 - end do - end do - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzt_clubb - do i = 1, ncol ! Perturbed winds are not used in CAM um_pert_inout(i,k) = 0.0_r8 vm_pert_inout(i,k) = 0.0_r8 end do end do - + !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzm_clubb do i = 1, ncol @@ -3047,6 +3025,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if + !----------------------------------------- Initializing arrays ----------------------------------------- + if (clubb_do_icesuper) then ! -------------------------------------- ! @@ -3161,25 +3141,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, pver - do i=1, ncol - - ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant - ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent - ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables - ! (such as thlm), use "inv_exner_clubb" otherwise use the exner in state - inv_exner_clubb(i,k) = 1._r8 / ( ( state1%pmid(i,k) / p0_clubb )**( rairv(i,k,lchnk) / cpairv(i,k,lchnk) ) ) - - ! Compute virtual potential temperature, which is needed for CLUBB - thv(i,k) = state1%t(i,k) * inv_exner_clubb(i,k) & - * ( 1._r8 + zvir * state1%q(i,k,ixq) - state1%q(i,k,ixcldliq) ) - - dz_g(i,k) = state1%zi(i,k) - state1%zi(i,k+1) ! compute thickness - - enddo - enddo - ! Compute thermodynamic stuff needed for CLUBB on thermo levels. ! Inputs for the momentum levels are set below setup_clubb core ! Flipped grid calcs @@ -3189,12 +3150,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k + dz_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,k_cam+1) ! compute thickness + ! At each CLUBB call, initialize mean momentum and thermo CLUBB state ! from the CAM state rtm_pbuf(i,k) = state1%q(i,k_cam,ixq) + state1%q(i,k_cam,ixcldliq) + ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant + ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent + ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables + ! (such as thlm), use "invrs_exner_zt" otherwise use the exner in state + invrs_exner_zt(i,k) = 1._r8 / ( ( state1%pmid(i,k_cam) / p0_clubb )**( rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) ) ) + thlm_pbuf(i,k) = ( state1%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) * state1%q(i,k_cam,ixcldliq) ) & - * inv_exner_clubb(i,k_cam) + * invrs_exner_zt(i,k) um_pbuf(i,k) = state1%u(i,k_cam) vm_pbuf(i,k) = state1%v(i,k_cam) @@ -3203,23 +3172,31 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & zt_g(i,k) = state1%zm(i,k_cam) - state1%zi(i,pverp) ! base state (dry) variables - rho_ds_zt(i,k) = rga * ( state1%pdeldry(i,k_cam) / dz_g(i,k_cam) ) + rho_ds_zt(i,k) = rga * ( state1%pdeldry(i,k_cam) / dz_g(i,k) ) invrs_rho_ds_zt(i,k) = 1._r8 / rho_ds_zt(i,k) ! full state (moist) variables p_in_Pa(i,k) = state1%pmid(i,k_cam) - exner(i,k) = 1._r8/inv_exner_clubb(i,k_cam) - thv(i,k) = state1%t(i,k_cam) * inv_exner_clubb(i,k_cam) & - * (1._r8 + zvir * state1%q(i,k_cam,ixq) - state1%q(i,k_cam,ixcldliq)) - rho_zt(i,k) = rga*state1%pdel(i,k_cam)/dz_g(i,k_cam) + exner(i,k) = 1._r8 / invrs_exner_zt(i,k) + rho_zt(i,k) = rga*state1%pdel(i,k_cam)/dz_g(i,k) - ! exception - setting this to moist thv - thv_ds_zt(i,k) = thv(i,k) + ! exception - setting this to moist thv_ds_zt + thv_ds_zt(i,k) = state1%t(i,k_cam) * invrs_exner_zt(i,k) & + * (1._r8 + zvir * state1%q(i,k_cam,ixq) - state1%q(i,k_cam,ixcldliq)) rfrzm(i,k) = state1%q(i,k_cam,ixcldice) ! Compute mean w wind on thermo grid, convert from omega to w wm_zt(i,k) = -1._r8*(state1%omega(i,k_cam)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) + + cloud_frac_inout(i,k) = cld_pbuf(i,k_cam) + pre_in(i,k) = prer_evap_pbuf(i,k_cam) + rvm_in(i,k) = state1%q(i,k_cam,ixq) + + ! TODO: are we sure we want to overwrite this each timestep? it's an inout + ! if so, we can remove it from pbuf + rcm_pbuf(i,k) = state1%q(i,k_cam,ixcldliq) + end do end do @@ -3237,8 +3214,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do - - ! Define the CLUBB momentum grid (in height, units of m) !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzm_clubb @@ -3248,6 +3223,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + !----------------------------------------- Initializing CLUBB grid ----------------------------------------- + ! this needs to preceed anything that uses clubb grid type, "gr", such as zt2zm_api/zm2zt_api + ! Note: these few routines, setup_grid_api, calc_derrived_params_api, and check_parameters_api are not + ! GPUized yet, so we need to copy data to and from the GPU. ! Heights need to be set at each timestep. Therefore, recall ! setup_grid and calc_derrived_params for this. @@ -3296,6 +3275,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc nu_vert_res_dep%nu6) call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') + !----------------------------------------- END CLUBB grid initialization ----------------------------------------- #ifdef SILHS ! Add forcings for SILHS covariance contributions @@ -3340,9 +3320,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Surface fluxes provided by host model !$acc parallel loop gang vector default(present) do i=1,ncol - wpthlp_sfc(i) = cam_in%shf(i) / ( cpairv(i,pver,lchnk) * rho_ds_zm(i,nzm_clubb) ) ! Sensible heat flux - wpthlp_sfc(i) = wpthlp_sfc(i) * inv_exner_clubb(i,pver) ! Potential temperature flux - wprtp_sfc(i) = cam_in%cflx(i,1) / rho_ds_zm(i,nzm_clubb) ! Moisture flux + wpthlp_sfc(i) = cam_in%shf(i) / ( cpairv(i,pver,lchnk) * rho_ds_zm(i,nzm_clubb) ) & ! Sensible heat flux + * invrs_exner_zt(i,nzt_clubb) + wprtp_sfc(i) = cam_in%cflx(i,1) / rho_ds_zm(i,nzm_clubb) ! Moisture flux end do @@ -3430,20 +3410,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif - call t_startf('clubb_tend_cam:flip-index') - - ! Need to flip zt arrays around for CLUBB core - !$acc parallel loop gang vector collapse(2) default(present) - do k = 1, nzt_clubb - do i = 1, ncol - k_cam = top_lev - 1 + k - cloud_frac_inout(i,k) = cloud_frac_pbuf(i,k_cam) - pre_in(i,k) = prer_evap_pbuf(i,k_cam) - rcm_pbuf(i,k) = state1%q(i,k_cam,ixcldliq) - rvm_in(i,k) = state1%q(i,k_cam,ixq) - end do - end do - ! We only need to copy pdf_params from pbuf if this is a restart, we're calling pdf_closure ! at the end of advance_clubb_core, and calling it twice for pdf_params_zm as well if ( is_first_restart_step() & @@ -3471,7 +3437,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k kappa_zt(i,k) = rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) qc_zt(i,k) = state1%q(i,k_cam,ixcldliq) - invrs_exner_zt(i,k) = inv_exner_clubb(i,k_cam) end do end do @@ -3512,7 +3477,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzt_clubb do i=1,ncol k_cam = top_lev - 1 + k - edsclr_in(i,k,icnt) = state1%q(i,k_cam,ixind) + edsclr_inout(i,k,icnt) = state1%q(i,k_cam,ixind) end do end do @@ -3525,8 +3490,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k=1,nzt_clubb do i=1, ncol k_cam = top_lev - 1 + k - edsclr_in(i,k,icnt+1) = thlm_pbuf(i,k) - edsclr_in(i,k,icnt+2) = rtm_pbuf(i,k) + edsclr_inout(i,k,icnt+1) = thlm_pbuf(i,k) + edsclr_inout(i,k,icnt+2) = rtm_pbuf(i,k) end do end do @@ -3534,8 +3499,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - call t_stopf('clubb_tend_cam:flip-index') - + !----------------------------------------- Substepping loop ----------------------------------------- do t=1,nadv ! do needed number of "sub" timesteps for each CAM step ! Increment the statistics then begin stats timestep @@ -3550,12 +3514,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - do k = 1, nzt_clubb - do i=1, ncol - invrs_dzt(i,k) = 1._r8 / dz_g(i,k) - end do - end do - rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm_pbuf(:ncol,:) ) thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm_pbuf(:ncol,:) ) @@ -3566,6 +3524,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Ideally, integrate_mf would operate in descending mode, then we could remove the flipping. ! If the column loop gets pushed into it, we can also avoid the array slicing. + dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) um_pbuf = um_pbuf(:,nzt_clubb:1:-1) @@ -3573,8 +3532,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) - dz_g(:,top_lev:pver) = dz_g(:,pver:top_lev:-1) - thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) + thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) ! Flip zm inputs zi_g = zi_g(:,nzm_clubb:1:-1) @@ -3586,7 +3544,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i=1, ncol call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um_pbuf(i,:), vm_pbuf(i,:), thlm_pbuf(i,:), rtm_pbuf(i,:), thv(i,1:nzt_clubb), & ! input + um_pbuf(i,:), vm_pbuf(i,:), thlm_pbuf(i,:), rtm_pbuf(i,:), thv_ds_zt(i,:), & ! input thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics @@ -3604,6 +3562,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! Flip zt inputs back + dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) um_pbuf = um_pbuf(:,nzt_clubb:1:-1) @@ -3611,8 +3570,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) - dz_g(:,top_lev:pver) = dz_g(:,pver:top_lev:-1) - thv(:,top_lev:pver) = thv(:,pver:top_lev:-1) + thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) ! Flip zm inputs back zi_g = zi_g(:,nzm_clubb:1:-1) @@ -3652,10 +3610,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! pass MF turbulent advection term as CLUBB explicit forcing term do k = 1, nzt_clubb do i = 1, ncol - rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & + rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * ( 1._r8 / dz_g(i,k) ) * & ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k+1) * mf_qtflx(i,k+1))) - thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * ( 1._r8 / dz_g(i,k) ) * & ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k+1) * mf_thlflx(i,k+1))) end do end do @@ -3673,7 +3631,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! we need to flip the fields (in the vertical dimensions) before calling advance_clubb_core ! ! NOTE: We do not neccesarily flip all arrays, only ones that are used within this - ! subroutine (clubb_tend_cam). For example, only the pdf_params fields that + ! subroutine (advance_clubb_core). For example, only the pdf_params fields that ! are used within this subroutine (or used in a subroutine we call) need to ! be flipped. @@ -3748,7 +3706,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) if ( edsclr_dim > 0 ) then - edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) + edsclr_inout = edsclr_inout(:,nzt_clubb:1:-1,:) edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) end if @@ -3765,7 +3723,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) end if - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid. ! only because these are need to be stored for restarts if ( clubb_config_flags%l_call_pdf_closure_twice ) then pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) @@ -3775,7 +3733,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) end if - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid. ! only for pdfp_rtp2_output calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) @@ -3783,7 +3741,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid. ! only for update_xp2_mc_api call pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) @@ -3867,7 +3825,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wp2_pbuf(:ncol,:), wp3_pbuf(:ncol,:), rtp2_pbuf(:ncol,:), rtp3_pbuf(:ncol,:), thlp2_pbuf(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_pbuf(:ncol,:), & sclrm(:ncol,:,:), & sclrp2(:ncol,:,:), sclrp3(:ncol,:,:), sclrprtp(:ncol,:,:), sclrpthlp(:ncol,:,:), & - wpsclrp(:ncol,:,:), edsclr_in(:ncol,:,:), err_info, & + wpsclrp(:ncol,:,:), edsclr_inout(:ncol,:,:), err_info, & rcm_pbuf(:ncol,:), cloud_frac_inout(:ncol,:), & wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & sclrpthvp_inout(:ncol,:,:), & @@ -3976,7 +3934,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & invrs_tau_zm_out = invrs_tau_zm_out(:,nzm_clubb:1:-1) if ( edsclr_dim > 0 ) then - edsclr_in = edsclr_in(:,nzt_clubb:1:-1,:) + edsclr_inout = edsclr_inout(:,nzt_clubb:1:-1,:) edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) end if @@ -4124,8 +4082,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if enddo ! end time loop - - call t_startf('clubb_tend_cam:flip-index') + !----------------------------------------- END substepping loop ----------------------------------------- if ( clubb_do_adv .and. macmic_it == cld_macmic_num_steps ) then do k=1,nzm_clubb @@ -4139,14 +4096,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end if - ! Arrays need to be "flipped" to CAM grid !$acc parallel loop gang vector collapse(2) default(present) do k=1, nzt_clubb do i=1, ncol k_cam = top_lev - 1 + k - cloud_frac_pbuf(i,k_cam) = cloud_frac_inout(i,k) - qclvar(i,k_cam) = min( 1._r8, qclvar_out(i,k) ) - + cld_pbuf(i,k_cam) = cloud_frac_inout(i,k) + qclvar_out(i,k) = min( 1._r8, qclvar_out(i,k) ) end do end do @@ -4168,20 +4123,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - call t_stopf('clubb_tend_cam:flip-index') - - ! Values to use above top_lev, for variables that have not already been - ! set up there. These are mostly fill values that should not actually be - ! used in the run, but may end up in diagnostic output. - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, top_lev-1 - do i=1, ncol - cloud_frac_pbuf(i,k) = 0._r8 - khzm_pbuf(i,k) = 0._r8 - qclvar(i,k) = 2._r8 - end do - end do - !---- TODO: there seems to a an above top_lev interaction here that changes answers. ! The error occured because we were zeroing out the [1:top_lev-1] values in ! in rcm_pbuf (when it still contained those levels), when it should've been @@ -4190,8 +4131,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do k = 1, top_lev-1 do i = 1, ncol + + ! inv_exner has not been calculated for above top_lev yet + inv_exner_tmp = 1._r8 / ( ( state1%pmid(i,k) / p0_clubb )**( rairv(i,k,lchnk) / cpairv(i,k,lchnk) ) ) + + ! This can be simplified algebraically, but left like this to maintain BFBness clubb_s(i,k) = cpairv(i,k,lchnk) * ( ( state1%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state1%q(i,k,ixcldliq) ) & - * inv_exner_clubb(i,k) ) / inv_exner_clubb(i,k) & + * inv_exner_tmp ) / inv_exner_tmp & + latvap * 0._r8 & ! error kept for BFBness !+ latvap * state1%q(i,k,ixcldliq) & ! correct line + gravit * state1%zm(i,k) + state1%phis(i) @@ -4202,7 +4148,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = top_lev, pver do i = 1, ncol k_clubb = k + 1 - top_lev - clubb_s(i,k) = cpairv(i,k,lchnk) * thlm_pbuf(i,k_clubb) / inv_exner_clubb(i,k) & + clubb_s(i,k) = cpairv(i,k,lchnk) * thlm_pbuf(i,k_clubb) / invrs_exner_zt(i,k_clubb) & + latvap * rcm_pbuf(i,k_clubb) & + gravit * state1%zm(i,k) + state1%phis(i) end do @@ -4356,23 +4302,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do !--------------------------------- END TODO --------------------------------- - do i=1, ncol - - ! Now compute the tendencies of CLUBB to CAM - rtm_integral_vtend(i) = 0._r8 - rtm_integral_ltend(i) = 0._r8 - - do k=1, pver - rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq) * state1%pdel(i,k) - rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k, ixq) * state1%pdel(i,k) - end do - - rtm_integral_ltend(i) = rtm_integral_ltend(i)/gravit - rtm_integral_vtend(i) = rtm_integral_vtend(i)/gravit - - end do - - ! need to initialize macmic coupling to zero if ( macmic_it == 1 ) then ttend_clubb_mc_pbuf(:,:) = 0._r8 @@ -4465,7 +4394,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. ! Loading up this array doesn't mean the tendencies are applied. - ! edsclr_in is compressed with just the constituents being used, ptend and state are not compressed + ! edsclr_inout is compressed with just the constituents being used, ptend and state are not compressed icnt=0 do ixind=1,pcnst if (lq(ixind)) then @@ -4476,13 +4405,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then - ! Copy CLUBB's edsclr values - do k=top_lev, pver - do i=1, ncol - k_clubb = k + 1 - top_lev - ptend_loc%q(i,k,ixind) = (edsclr_in(i,k_clubb,icnt)-state1%q(i,k,ixind)) / hdtime ! transported constituents - end do - end do ! Zero out levels above top_lev do k=1, top_lev-1 @@ -4490,6 +4412,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ptend_loc%q(i,k,ixind) = 0._r8 end do end do + + ! Copy CLUBB's edsclr values + do k=top_lev, pver + do i=1, ncol + k_clubb = k + 1 - top_lev + ptend_loc%q(i,k,ixind) = (edsclr_inout(i,k_clubb,icnt)-state1%q(i,k,ixind)) / hdtime ! transported constituents + end do + end do end if end if @@ -4686,18 +4616,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol do k = top_lev, pver k_clubb = k + 1 - top_lev - if ( rcm_pbuf(i,k_clubb) /= 0 .and. qclvar(i,k) /= 0 ) then - relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm_pbuf(i,k_clubb)**2 / qclvar(i,k) ) ) + if ( rcm_pbuf(i,k_clubb) /= 0 .and. qclvar_out(i,k_clubb) /= 0 ) then + relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm_pbuf(i,k_clubb)**2 / qclvar_out(i,k_clubb) ) ) end if end do end do endif - ! ------------------------------------------------- ! - ! Optional Accretion enhancement factor ! - ! ------------------------------------------------- ! - accre_enhan_pbuf(:ncol,:pver) = 1._r8 - ! turbulent kinetic energy do k = top_lev, pverp do i = 1, ncol @@ -4720,7 +4645,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = top_lev, pver do i = 1, ncol k_clubb = k + 1 - top_lev - alst_pbuf(i,k) = cloud_frac_pbuf(i,k) + alst_pbuf(i,k) = cld_pbuf(i,k) qlst_pbuf(i,k) = rcm_pbuf(i,k_clubb) / max( 0.01_r8, alst_pbuf(i,k) ) ! Incloud stratus condensate mixing ratio enddo enddo @@ -4741,7 +4666,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud ! fraction is purely from deep convection scheme. deepcu_pbuf(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh_pbuf(i,k+1))),0.6_r8)) - shalcu_pbuf(i,k) = 0._r8 if (deepcu_pbuf(i,k) <= frac_limit .or. dp_icwmr_pbuf(i,k) < ic_limit) then deepcu_pbuf(i,k) = 0._r8 @@ -4751,9 +4675,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud ! from CLUBB plus the deep convective cloud fraction - concld_pbuf(i,k) = min(cloud_frac_pbuf(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k),0.80_r8) +!----------------- TODO: the way we set alst_pbuf (with clubb's cloud fraction) +! this simplifies to the uncommented version. Seems weird, since it relies +! on only deepcu_pbuf, but not a clear bug + !concld_pbuf(i,k) = min(cloud_frac_pbuf(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k),0.80_r8) + concld_pbuf(i,k) = min(deepcu_pbuf(i,k),0.80_r8) enddo enddo +!------------------------------------------------------------------------------------- if (single_column .and. .not. scm_cambfb_mode) then if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & @@ -4818,24 +4747,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! fraction that was coded in macrop_driver ! ! --------------------------------------------------------------------------------- ! - ! Recompute net stratus fraction using maximum over-lapping assumption, as done - ! in macrophysics code, using alst computed above and aist read in from physics buffer - do k=1,pver do i=1,ncol + + ! Recompute net stratus fraction using maximum over-lapping assumption, as done + ! in macrophysics code, using alst computed above and aist read in from physics buffer ast_pbuf(i,k) = max(alst_pbuf(i,k),aist_pbuf(i,k)) qist_pbuf(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist_pbuf(i,k)) - enddo - enddo - ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just - ! be outputting the shallow convective cloud fraction - do k=1,pver - do i=1,ncol - cloud_frac_pbuf(i,k) = min(ast_pbuf(i,k)+deepcu_pbuf(i,k),1.0_r8) + ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just + ! be outputting the shallow convective cloud fraction + cld_pbuf(i,k) = min(ast_pbuf(i,k)+deepcu_pbuf(i,k),1.0_r8) + enddo enddo + ! --------------------------------------------------------------------------------- ! ! DIAGNOSE THE PBL DEPTH ! ! this is needed for aerosol code ! @@ -4877,7 +4804,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & zi = state1%zi(:ncol,:pverp), & u = state1%u(:ncol,:pver), & v = state1%v(:ncol,:pver), & - cldn = cloud_frac_pbuf(:ncol,:pver), & + cldn = cld_pbuf(:ncol,:pver), & ! Inputs from CLUBB (not HB coefficients) thv = thv(:ncol,:pver), & ustar = ustar2(:ncol), & @@ -4890,13 +4817,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & errmsg = errmsg, & errflg = errflg) - ! Assign the first pver levels of cloud_frac back to cld - cld_pbuf(:,1:pver) = cloud_frac_pbuf(:,1:pver) - ! --------------------------------------------------------------------------------- ! - ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer ! + ! END CLOUD FRACTION DIAGNOSIS ! ! --------------------------------------------------------------------------------- ! + !----------------------------------------- Output section ----------------------------------------- + ! TODO: Do we always want to be outputting all of this? Should we surround some/most of this with a flag? + call outfld( 'DETNLIQTND', detnliquid_output,pcols, lchnk ) ! Output CLUBB tendencies (convert dry basis to wet for consistency with history variable definition) @@ -4921,10 +4848,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld('ELEAK_CLUBB', eleak, pcols, lchnk) call outfld('TFIX_CLUBB', se_dis, pcols, lchnk) - ! ------------------------------------------------- ! - ! Diagnose some output variables ! - ! ------------------------------------------------- ! - ! density rho(1:ncol,1:pver) = rga*state1%pdel(1:ncol,1:pver)/(state1%zi(1:ncol,1:pver)-state1%zi(1:ncol,2:pverp)) rho(1:ncol,pverp) = rho(1:ncol,pver) @@ -5054,7 +4977,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'pdfp_rtp2_output_CLUBB', pdfp_rtp2_output, pcols, lchnk ) call outfld( 'THLP2_CLUBB', thlp2_output, pcols, lchnk ) call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer_output, pcols, lchnk ) - call outfld( 'CLOUDCOVER_CLUBB', cloud_frac_pbuf, pcols, lchnk ) call outfld( 'ZT_CLUBB', zt_output, pcols, lchnk ) call outfld( 'ZM_CLUBB', zi_output, pcols, lchnk ) call outfld( 'UM_CLUBB', um_output, pcols, lchnk ) @@ -5063,6 +4985,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'RELVAR', relvar_pbuf, pcols, lchnk ) call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) + call outfld( 'CLOUDCOVER_CLUBB', cld_pbuf, pcols, lchnk ) call outfld( 'CLOUDFRAC_CLUBB', alst_pbuf, pcols, lchnk ) call outfld( 'CONCLD', concld_pbuf, pcols, lchnk ) call outfld( 'DP_CLD', deepcu_pbuf, pcols, lchnk ) @@ -5195,10 +5118,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif call t_stopf('clubb_tend_cam:NAR') -#endif ! Cleanup err_info call cleanup_err_info_api(err_info) +#endif call t_stopf('clubb_tend_cam') From b2b32322cec25fe3a9d2309c7170c6cb56e29b0c Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Wed, 26 Nov 2025 04:11:30 -0600 Subject: [PATCH 16/29] Mostly cosmetic improvements, some removal of redundant code --- src/physics/cam/clubb_intr.F90 | 2148 +++++++++++++++--------------- src/physics/cam/subcol_SILHS.F90 | 2 +- 2 files changed, 1038 insertions(+), 1112 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 81a29b0002..355b8bb732 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -71,7 +71,7 @@ module clubb_intr clubb_params_single_col ! Adjustable CLUBB parameters (C1, C2 ...) ! Variables that contains all the statistics - type (stats), save, public :: & + type (stats), public :: & stats_zt(pcols), & ! stats_zt grid stats_zm(pcols), & ! stats_zm grid stats_rad_zt(pcols), & ! stats_rad_zt grid @@ -90,7 +90,8 @@ module clubb_intr logical, public, parameter :: & l_ascending_grid = .false. ! Set clubb to ascending mode, which is opposite of the ! cam grid the rest of this code uses, thus it requires - ! an expensive array flipping step before calling clubb + ! an expensive array flipping step before calling clubb. + ! This is mainly for testing integer, public :: & nzm_clubb, & ! Number of vertical levels used by CLUBB momentum variables @@ -263,144 +264,144 @@ module clubb_intr real(r8) :: clubb_z_displace = unset_r8 integer :: & - clubb_iiPDF_type, & ! Selected option for the two-component normal - ! (double Gaussian) PDF type to use for the w, rt, - ! and theta-l (or w, chi, and eta) portion of - ! CLUBB's multivariate, two-component PDF. - clubb_ipdf_call_placement = unset_i, & ! Selected option for the placement of the call to - ! CLUBB's PDF. - clubb_penta_solve_method = unset_i, & ! Specifier for method to solve the penta-diagonal system - clubb_tridiag_solve_method = unset_i,& ! Specifier for method to solve tri-diagonal systems - clubb_saturation_equation = unset_i, & ! Specifier for which saturation formula to use - clubb_grid_remap_method = unset_i, & ! Specifier for which method should be used to - ! map values from one grid to another - ! (starts at 1, so 0 is an invalid option for this flag) - clubb_grid_adapt_in_time_method = unset_i, & ! Specifier for how the grid density method should - ! be constructed if the grid should be adapted over time - ! (set to 0 for no adaptation) - clubb_fill_holes_type = unset_i ! Option for which type of hole filler to use in the - ! fill_holes_vertical procedure + clubb_iiPDF_type, & ! Selected option for the two-component normal + ! (double Gaussian) PDF type to use for the w, rt, + ! and theta-l (or w, chi, and eta) portion of + ! CLUBB's multivariate, two-component PDF. + clubb_ipdf_call_placement = unset_i, & ! Selected option for the placement of the call to + ! CLUBB's PDF. + clubb_penta_solve_method = unset_i, & ! Specifier for method to solve the penta-diagonal system + clubb_tridiag_solve_method = unset_i, & ! Specifier for method to solve tri-diagonal systems + clubb_saturation_equation = unset_i, & ! Specifier for which saturation formula to use + clubb_grid_remap_method = unset_i, & ! Specifier for which method should be used to + ! map values from one grid to another + ! (starts at 1, so 0 is an invalid option for this flag) + clubb_grid_adapt_in_time_method = unset_i, & ! Specifier for how the grid density method should + ! be constructed if the grid should be adapted over time + ! (set to 0 for no adaptation) + clubb_fill_holes_type = unset_i ! Option for which type of hole filler to use in the + ! fill_holes_vertical procedure logical :: & - clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The - ! precipitation fraction is automatically set to 1 when this - ! flag is turned off. - clubb_l_predict_upwp_vpwp, & ! Flag to predict and along with and - ! alongside the advancement of , , , - ! , , and in subroutine - ! advance_xm_wpxp. Otherwise, and are still - ! approximated by eddy diffusivity when and are - ! advanced in subroutine advance_windm_edsclrm. - clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping - ! the overall correlation of w and x (w and rt, as well as w - ! and theta-l) within the limits of -max_mag_correlation_flux - ! to max_mag_correlation_flux. - clubb_l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and - ! thlp2) on keeping the overall correlation of w and x within - ! the limits of -max_mag_correlation_flux to - ! max_mag_correlation_flux. - clubb_l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the - ! turbulent dissipation coefficient, C2. - clubb_l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm - clubb_l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor - clubb_l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 - clubb_l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & - ! sclrpthlp. - clubb_l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtm, thlm, sclrm, um and vm. - clubb_l_uv_nudge, & ! For wind speed nudging. - clubb_l_rtm_nudge, & ! For rtm nudging - clubb_l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. - ! TKE = 1/2 (u'^2 + v'^2 + w'^2) - clubb_l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to - ! compute the varibles that are output from high order - ! closure - clubb_l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the - ! thermodynamic-level variables output from pdf_closure. - clubb_l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three - ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - - ! output from pdf_closure. - clubb_l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call - ! subroutine pdf_closure twice. If true, pdf_closure is - ! called first on thermodynamic levels and then on momentum - ! levels so that each variable is computed on its native - ! level. If false, pdf_closure is only called on - ! thermodynamic levels, and variables which belong on - ! momentum levels are interpolated. - clubb_l_standard_term_ta, & ! Use the standard discretization for the turbulent advection - ! terms. Setting to .false. means that a_1 and a_3 are - ! pulled outside of the derivative in - ! advance_wp2_wp3_module.F90 and in - ! advance_xp2_xpyp_module.F90. - clubb_l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather - ! than a centered discretization for the portion - ! of the wp3 turbulent advection term for ADG1 - ! that is linearized in terms of wp3. - ! (Requires ADG1 PDF and clubb_l_standard_term_ta). - clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent advection terms. - ! It affects wpxp only. - clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent advection terms. It affects - ! xpyp only. - clubb_l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac - ! and rcm to help increase cloudiness at coarser grid - ! resolutions. - clubb_l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones - clubb_l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors - clubb_l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) - clubb_l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) - clubb_l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability - ! correction - clubb_l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of - ! -(2/3)*em/tau_zm, as in Bougeault (1981) - clubb_l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly - clubb_l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values - clubb_l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the - ! mixing length scale as Lscale = tau * tke - clubb_l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number - clubb_l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number - clubb_l_use_shear_Richardson, & ! Use shear in the calculation of Richardson number - clubb_l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in - ! saturated atmospheres (from Durran and Klemp, 1982) - clubb_l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency - clubb_l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water - clubb_l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping - clubb_l_e3sm_config, & ! Run model with E3SM settings - clubb_l_vary_convect_depth, & ! Flag used to calculate convective velocity using - ! a variable estimate of layer depth based on the depth - ! over which wpthlp is positive near the ground when true - ! More information can be found by - ! Looking at issue #905 on the clubb repo - clubb_l_use_tke_in_wp3_pr_turb_term,& ! Use TKE formulation for wp3 pr_turb term - clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3 - clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Flag to activate mods on wp3 limiters for conv test - clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau - clubb_l_modify_limiters_for_cnvg_test, & ! Flag to activate mods on limiters for conv test - clubb_l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats - clubb_l_linearize_pbl_winds, & ! Flag to turn on code to linearize PBL winds - clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and - ! rtpthlp - clubb_l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 - clubb_l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz - clubb_l_update_pressure, & ! Flag for having CLUBB update pressure and exner - clubb_l_mono_flux_lim_thlm, & ! Flag to turn on monotonic flux limiter for thlm - clubb_l_mono_flux_lim_rtm, & ! Flag to turn on monotonic flux limiter for rtm - clubb_l_mono_flux_lim_um, & ! Flag to turn on monotonic flux limiter for um - clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm - clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that - ! eliminates spurious drying tendencies at model top - clubb_l_host_applies_sfc_fluxes, & ! Whether the host model applies the surface fluxes - clubb_l_wp2_fill_holes_tke, & ! Whether TKE is taken from up2 and vp2 to fill holes in wp2 - clubb_l_add_dycore_grid ! Flag to remap values from dycore grid + clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The + ! precipitation fraction is automatically set to 1 when this + ! flag is turned off. + clubb_l_predict_upwp_vpwp, & ! Flag to predict and along with and + ! alongside the advancement of , , , + ! , , and in subroutine + ! advance_xm_wpxp. Otherwise, and are still + ! approximated by eddy diffusivity when and are + ! advanced in subroutine advance_windm_edsclrm. + clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping + ! the overall correlation of w and x (w and rt, as well as w + ! and theta-l) within the limits of -max_mag_correlation_flux + ! to max_mag_correlation_flux. + clubb_l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and + ! thlp2) on keeping the overall correlation of w and x within + ! the limits of -max_mag_correlation_flux to + ! max_mag_correlation_flux. + clubb_l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the + ! turbulent dissipation coefficient, C2. + clubb_l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm + clubb_l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor + clubb_l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 + clubb_l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & + ! sclrpthlp. + clubb_l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtm, thlm, sclrm, um and vm. + clubb_l_uv_nudge, & ! For wind speed nudging. + clubb_l_rtm_nudge, & ! For rtm nudging + clubb_l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. + ! TKE = 1/2 (u'^2 + v'^2 + w'^2) + clubb_l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to + ! compute the varibles that are output from high order + ! closure + clubb_l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the + ! thermodynamic-level variables output from pdf_closure. + clubb_l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three + ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - + ! output from pdf_closure. + clubb_l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call + ! subroutine pdf_closure twice. If true, pdf_closure is + ! called first on thermodynamic levels and then on momentum + ! levels so that each variable is computed on its native + ! level. If false, pdf_closure is only called on + ! thermodynamic levels, and variables which belong on + ! momentum levels are interpolated. + clubb_l_standard_term_ta, & ! Use the standard discretization for the turbulent advection + ! terms. Setting to .false. means that a_1 and a_3 are + ! pulled outside of the derivative in + ! advance_wp2_wp3_module.F90 and in + ! advance_xp2_xpyp_module.F90. + clubb_l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather + ! than a centered discretization for the portion + ! of the wp3 turbulent advection term for ADG1 + ! that is linearized in terms of wp3. + ! (Requires ADG1 PDF and clubb_l_standard_term_ta). + clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. + ! It affects wpxp only. + clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. It affects + ! xpyp only. + clubb_l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac + ! and rcm to help increase cloudiness at coarser grid + ! resolutions. + clubb_l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones + clubb_l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors + clubb_l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) + clubb_l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) + clubb_l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability + ! correction + clubb_l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of + ! -(2/3)*em/tau_zm, as in Bougeault (1981) + clubb_l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly + clubb_l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values + clubb_l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the + ! mixing length scale as Lscale = tau * tke + clubb_l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number + clubb_l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number + clubb_l_use_shear_Richardson, & ! Use shear in the calculation of Richardson number + clubb_l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in + ! saturated atmospheres (from Durran and Klemp, 1982) + clubb_l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency + clubb_l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water + clubb_l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping + clubb_l_e3sm_config, & ! Run model with E3SM settings + clubb_l_vary_convect_depth, & ! Flag used to calculate convective velocity using + ! a variable estimate of layer depth based on the depth + ! over which wpthlp is positive near the ground when true + ! More information can be found by + ! Looking at issue #905 on the clubb repo + clubb_l_use_tke_in_wp3_pr_turb_term, & ! Use TKE formulation for wp3 pr_turb term + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3 + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! Flag to activate mods on wp3 limiters for conv test + clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau + clubb_l_modify_limiters_for_cnvg_test, & ! Flag to activate mods on limiters for conv test + clubb_l_enable_relaxed_clipping, & ! Flag to relax clipping on wpxp in xm_wpxp_clipping_and_stats + clubb_l_linearize_pbl_winds, & ! Flag to turn on code to linearize PBL winds + clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and + ! rtpthlp + clubb_l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 + clubb_l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz + clubb_l_update_pressure, & ! Flag for having CLUBB update pressure and exner + clubb_l_mono_flux_lim_thlm, & ! Flag to turn on monotonic flux limiter for thlm + clubb_l_mono_flux_lim_rtm, & ! Flag to turn on monotonic flux limiter for rtm + clubb_l_mono_flux_lim_um, & ! Flag to turn on monotonic flux limiter for um + clubb_l_mono_flux_lim_vm, & ! Flag to turn on monotonic flux limiter for vm + clubb_l_mono_flux_lim_spikefix, & ! Flag to implement monotonic flux limiter code that + ! eliminates spurious drying tendencies at model top + clubb_l_host_applies_sfc_fluxes, & ! Whether the host model applies the surface fluxes + clubb_l_wp2_fill_holes_tke, & ! Whether TKE is taken from up2 and vp2 to fill holes in wp2 + clubb_l_add_dycore_grid ! Flag to remap values from dycore grid ! ------------------------------------------------------------ ! ! Indices for physics buffer (pbuf) ! @@ -448,9 +449,9 @@ module clubb_intr qist_idx, & ! Physical in-cloud IWC dp_frac_idx, & ! deep convection cloud fraction sh_frac_idx, & ! shallow convection cloud fraction - kvh_idx, & ! CLUBB eddy diffusivity on thermo levels + kvh_idx, & ! CLUBB eddy diffusivity on thermo levels pblh_idx, & ! PBL pbuf - icwmrdp_idx, & ! In cloud mixing ratio for deep convection + icwmrdp_idx, & ! In cloud mixing ratio for deep convection tke_idx, & ! turbulent kinetic energy tpert_idx, & ! temperature perturbation from PBL fice_idx, & ! fice_idx index in physics buffer @@ -486,7 +487,8 @@ module clubb_intr wpthlp_mc_zt_idx, & rtpthlp_mc_zt_idx - integer :: & ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2 + ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2 + integer :: & pdf_zm_w_1_idx, & pdf_zm_w_2_idx, & pdf_zm_varnce_w_1_idx, & @@ -572,10 +574,10 @@ subroutine clubb_register_cam( ) call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx) ! pbuf fields for Gravity Wave scheme - call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver/), ttend_clubb_idx ) - call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx ) - call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx ) - call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx ) + call pbuf_add_field('TTEND_CLUBB', 'physpkg', dtype_r8, (/pcols,pver /), ttend_clubb_idx ) + call pbuf_add_field('UPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), upwp_clubb_gw_idx ) + call pbuf_add_field('VPWP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), vpwp_clubb_gw_idx ) + call pbuf_add_field('THLP2_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), thlp2_clubb_gw_idx ) call pbuf_add_field('WPTHLP_CLUBB_GW', 'physpkg', dtype_r8, (/pcols,pverp/), wpthlp_clubb_gw_idx ) @@ -1280,146 +1282,146 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_uv_nudge") ! Overwrite defaults if they are true - if (clubb_history) stats_metadata%l_stats = .true. - if (clubb_rad_history) stats_metadata%l_output_rad_files = .true. - if (clubb_cloudtop_cooling) do_cldcool = .true. - if (clubb_rainevap_turb) do_rainturb = .true. + if ( clubb_history ) stats_metadata%l_stats = .true. + if ( clubb_rad_history ) stats_metadata%l_output_rad_files = .true. + if ( clubb_cloudtop_cooling ) do_cldcool = .true. + if ( clubb_rainevap_turb ) do_rainturb = .true. ! Check that all namelists have been set - if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") - if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") - - if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set") - if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set") - if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set") - if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set") - if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set") - if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set") - if(clubb_C_uu_shr == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_shr is not set") - if(clubb_C_uu_buoy == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_buoy is not set") - if(clubb_c6rt == unset_r8) call endrun(sub//": FATAL: clubb_c6rt is not set") - if(clubb_c6rtb == unset_r8) call endrun(sub//": FATAL: clubb_c6rtb is not set") - if(clubb_c6rtc == unset_r8) call endrun(sub//": FATAL: clubb_c6rtc is not set") - if(clubb_c6thl == unset_r8) call endrun(sub//": FATAL: clubb_c6thl is not set") - if(clubb_c6thlb == unset_r8) call endrun(sub//": FATAL: clubb_c6thlb is not set") - if(clubb_c6thlc == unset_r8) call endrun(sub//": FATAL: clubb_c6thlc is not set") - if(clubb_wpxp_L_thresh == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_L_thresh is not set") - if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set") - if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set") - if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set") - if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set") - if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set") - if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set") - if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set") - if(clubb_C_wp3_pr_turb == unset_r8) call endrun(sub//": FATAL: clubb_C_wp3_pr_turb is not set") - if(clubb_c_K1 == unset_r8) call endrun(sub//": FATAL: clubb_c_K1 is not set") - if(clubb_c_K2 == unset_r8) call endrun(sub//": FATAL: clubb_c_K2 is not set") - if(clubb_nu2 == unset_r8) call endrun(sub//": FATAL: clubb_nu2 is not set") - if(clubb_c_K8 == unset_r8) call endrun(sub//": FATAL: clubb_c_K8 is not set") - if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set") - if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set") - if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set") - if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set") - if(clubb_C_invrs_tau_bkgnd == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_bkgnd is not set") - if(clubb_C_invrs_tau_sfc == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_sfc is not set") - if(clubb_C_invrs_tau_shear == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_shear is not set") - if(clubb_C_invrs_tau_N2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2 is not set") - if(clubb_C_invrs_tau_N2_wp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wp2 is not set") - if(clubb_C_invrs_tau_N2_xp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_xp2 is not set") - if(clubb_C_invrs_tau_N2_wpxp == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wpxp is not set") - if(clubb_C_invrs_tau_N2_clear_wp3 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_clear_wp3 is not set") - if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set") - if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set") - if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set") - if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set") - if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set") - if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set") - if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") - if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") - if(clubb_up2_sfc_coef == unset_r8) call endrun(sub//": FATAL: clubb_up2_sfc_coef is not set") - if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splat is not set") - if(clubb_bv_efold == unset_r8) call endrun(sub//": FATAL: clubb_bv_efold is not set") - if(clubb_wpxp_Ri_exp == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_Ri_exp is not set") - if(clubb_z_displace == unset_r8) call endrun(sub//": FATAL: clubb_z_displace is not set") - if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set") - if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set") - if(clubb_ipdf_call_placement == unset_i) call endrun(sub//": FATAL: clubb_ipdf_call_placement not set") - if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") - if(clubb_penta_solve_method == unset_i) call endrun(sub//": FATAL: clubb_penta_solve_method not set") - if(clubb_tridiag_solve_method == unset_i) call endrun(sub//": FATAL: clubb_tridiag_solve_method not set") - if(clubb_saturation_equation == unset_i) call endrun(sub//": FATAL: clubb_saturation_equation not set") - if(clubb_grid_remap_method == unset_i) call endrun(sub//": FATAL: clubb_grid_remap_method not set") - if(clubb_grid_adapt_in_time_method == unset_i) call endrun(sub//": FATAL: clubb_grid_adapt_in_time_method not set") - if(clubb_fill_holes_type == unset_i) call endrun(sub//": FATAL: clubb_fill_holes_type not set") - if(clubb_detphase_lowtemp >= meltpt_temp) & - call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") - - call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In - clubb_ipdf_call_placement, & ! In - clubb_penta_solve_method, & ! In - clubb_tridiag_solve_method, & ! In - clubb_saturation_equation, & ! In - clubb_grid_remap_method, & ! In - clubb_grid_adapt_in_time_method, & ! In - clubb_fill_holes_type, & ! In - clubb_l_use_precip_frac, & ! In - clubb_l_predict_upwp_vpwp, & ! In - clubb_l_min_wp2_from_corr_wx, & ! In - clubb_l_min_xp2_from_corr_wx, & ! In - clubb_l_C2_cloud_frac, & ! In - clubb_l_diffuse_rtm_and_thlm, & ! In - clubb_l_stability_correct_Kh_N2_zm, & ! In - clubb_l_calc_thlp2_rad, & ! In - clubb_l_upwind_xpyp_ta, & ! In - clubb_l_upwind_xm_ma, & ! In - clubb_l_uv_nudge, & ! In - clubb_l_rtm_nudge, & ! In - clubb_l_tke_aniso, & ! In - clubb_l_vert_avg_closure, & ! In - clubb_l_trapezoidal_rule_zt, & ! In - clubb_l_trapezoidal_rule_zm, & ! In - clubb_l_call_pdf_closure_twice, & ! In - clubb_l_standard_term_ta, & ! In - clubb_l_partial_upwind_wp3, & ! In - clubb_l_godunov_upwind_wpxp_ta, & ! In - clubb_l_godunov_upwind_xpyp_ta, & ! In - clubb_l_use_cloud_cover, & ! In - clubb_l_diagnose_correlations, & ! In - clubb_l_calc_w_corr, & ! In - clubb_l_const_Nc_in_cloud, & ! In - clubb_l_fix_w_chi_eta_correlations, & ! In - clubb_l_stability_correct_tau_zm, & ! In - clubb_l_damp_wp2_using_em, & ! In - clubb_l_do_expldiff_rtm_thlm, & ! In - clubb_l_Lscale_plume_centered, & ! In - clubb_l_diag_Lscale_from_tau, & ! In - clubb_l_use_C7_Richardson, & ! In - clubb_l_use_C11_Richardson, & ! In - clubb_l_use_shear_Richardson, & ! In - clubb_l_brunt_vaisala_freq_moist, & ! In - clubb_l_use_thvm_in_bv_freq, & ! In - clubb_l_rcm_supersat_adj, & ! In - clubb_l_damp_wp3_Skw_squared, & ! In - clubb_l_prescribed_avg_deltaz, & ! In - clubb_l_lmm_stepping, & ! In - clubb_l_e3sm_config, & ! In - clubb_l_vary_convect_depth, & ! In - clubb_l_use_tke_in_wp3_pr_turb_term, & ! In - clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In - clubb_l_use_wp3_lim_with_smth_Heaviside, & ! In - clubb_l_smooth_Heaviside_tau_wpxp, & ! In - clubb_l_modify_limiters_for_cnvg_test, & ! In - clubb_l_enable_relaxed_clipping, & ! In - clubb_l_linearize_pbl_winds, & ! In - clubb_l_mono_flux_lim_thlm, & ! In - clubb_l_mono_flux_lim_rtm, & ! In - clubb_l_mono_flux_lim_um, & ! In - clubb_l_mono_flux_lim_vm, & ! In - clubb_l_mono_flux_lim_spikefix, & ! In - clubb_l_host_applies_sfc_fluxes, & ! In - clubb_l_wp2_fill_holes_tke, & ! In - clubb_l_add_dycore_grid, & ! In - clubb_config_flags ) ! Out + if ( clubb_timestep == unset_r8 ) call endrun( sub//": FATAL: clubb_timestep is not set") + if ( clubb_rnevap_effic == unset_r8 ) call endrun( sub//": FATAL:clubb_rnevap_effic is not set") + + if ( clubb_c1 == unset_r8 ) call endrun( sub//": FATAL: clubb_c1 is not set") + if ( clubb_c1b == unset_r8 ) call endrun( sub//": FATAL: clubb_c1b is not set") + if ( clubb_C2rt == unset_r8 ) call endrun( sub//": FATAL: clubb_C2rt is not set") + if ( clubb_C2thl == unset_r8 ) call endrun( sub//": FATAL: clubb_C2thl is not set") + if ( clubb_C2rtthl == unset_r8 ) call endrun( sub//": FATAL: clubb_C2rtthl is not set") + if ( clubb_C4 == unset_r8 ) call endrun( sub//": FATAL: clubb_C4 is not set") + if ( clubb_C_uu_shr == unset_r8 ) call endrun( sub//": FATAL: clubb_C_uu_shr is not set") + if ( clubb_C_uu_buoy == unset_r8 ) call endrun( sub//": FATAL: clubb_C_uu_buoy is not set") + if ( clubb_c6rt == unset_r8 ) call endrun( sub//": FATAL: clubb_c6rt is not set") + if ( clubb_c6rtb == unset_r8 ) call endrun( sub//": FATAL: clubb_c6rtb is not set") + if ( clubb_c6rtc == unset_r8 ) call endrun( sub//": FATAL: clubb_c6rtc is not set") + if ( clubb_c6thl == unset_r8 ) call endrun( sub//": FATAL: clubb_c6thl is not set") + if ( clubb_c6thlb == unset_r8 ) call endrun( sub//": FATAL: clubb_c6thlb is not set") + if ( clubb_c6thlc == unset_r8 ) call endrun( sub//": FATAL: clubb_c6thlc is not set") + if ( clubb_wpxp_L_thresh == unset_r8 ) call endrun( sub//": FATAL: clubb_wpxp_L_thresh is not set") + if ( clubb_C8 == unset_r8 ) call endrun( sub//": FATAL: clubb_C8 is not set") + if ( clubb_C8b == unset_r8 ) call endrun( sub//": FATAL: clubb_C8b is not set") + if ( clubb_C7 == unset_r8 ) call endrun( sub//": FATAL: clubb_C7 is not set") + if ( clubb_C7b == unset_r8 ) call endrun( sub//": FATAL: clubb_C7b is not set") + if ( clubb_c11 == unset_r8 ) call endrun( sub//": FATAL: clubb_c11 is not set") + if ( clubb_c11b == unset_r8 ) call endrun( sub//": FATAL: clubb_c11b is not set") + if ( clubb_c14 == unset_r8 ) call endrun( sub//": FATAL: clubb_c14 is not set") + if ( clubb_C_wp3_pr_turb == unset_r8 ) call endrun( sub//": FATAL: clubb_C_wp3_pr_turb is not set") + if ( clubb_c_K1 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K1 is not set") + if ( clubb_c_K2 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K2 is not set") + if ( clubb_nu2 == unset_r8 ) call endrun( sub//": FATAL: clubb_nu2 is not set") + if ( clubb_c_K8 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K8 is not set") + if ( clubb_c_K9 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K9 is not set") + if ( clubb_nu9 == unset_r8 ) call endrun( sub//": FATAL: clubb_nu9 is not set") + if ( clubb_c_K10 == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K10 is not set") + if ( clubb_c_K10h == unset_r8 ) call endrun( sub//": FATAL: clubb_c_K10h is not set") + if ( clubb_C_invrs_tau_bkgnd == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_bkgnd is not set") + if ( clubb_C_invrs_tau_sfc == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_sfc is not set") + if ( clubb_C_invrs_tau_shear == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_shear is not set") + if ( clubb_C_invrs_tau_N2 == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2 is not set") + if ( clubb_C_invrs_tau_N2_wp2 == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2_wp2 is not set") + if ( clubb_C_invrs_tau_N2_xp2 == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2_xp2 is not set") + if ( clubb_C_invrs_tau_N2_wpxp == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2_wpxp is not set") + if ( clubb_C_invrs_tau_N2_clear_wp3 == unset_r8 ) call endrun( sub//": FATAL: clubb_C_invrs_tau_N2_clear_wp3 is not set") + if ( clubb_gamma_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_gamma_coef is not set") + if ( clubb_gamma_coefb == unset_r8 ) call endrun( sub//": FATAL: clubb_gamma_coefb is not set") + if ( clubb_beta == unset_r8 ) call endrun( sub//": FATAL: clubb_beta is not set") + if ( clubb_lambda0_stability_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_lambda0_stability_coef is not set") + if ( clubb_lmin_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_lmin_coef is not set") + if ( clubb_mult_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_mult_coef is not set") + if ( clubb_Skw_denom_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_Skw_denom_coef is not set") + if ( clubb_skw_max_mag == unset_r8 ) call endrun( sub//": FATAL: clubb_skw_max_mag is not set") + if ( clubb_up2_sfc_coef == unset_r8 ) call endrun( sub//": FATAL: clubb_up2_sfc_coef is not set") + if ( clubb_C_wp2_splat == unset_r8 ) call endrun( sub//": FATAL: clubb_C_wp2_splat is not set") + if ( clubb_bv_efold == unset_r8 ) call endrun( sub//": FATAL: clubb_bv_efold is not set") + if ( clubb_wpxp_Ri_exp == unset_r8 ) call endrun( sub//": FATAL: clubb_wpxp_Ri_exp is not set") + if ( clubb_z_displace == unset_r8 ) call endrun( sub//": FATAL: clubb_z_displace is not set") + if ( clubb_detliq_rad == unset_r8 ) call endrun( sub//": FATAL: clubb_detliq_rad not set") + if ( clubb_detice_rad == unset_r8 ) call endrun( sub//": FATAL: clubb_detice_rad not set") + if ( clubb_ipdf_call_placement == unset_i ) call endrun( sub//": FATAL: clubb_ipdf_call_placement not set") + if ( clubb_penta_solve_method == unset_i ) call endrun( sub//": FATAL: clubb_penta_solve_method not set") + if ( clubb_tridiag_solve_method == unset_i ) call endrun( sub//": FATAL: clubb_tridiag_solve_method not set") + if ( clubb_saturation_equation == unset_i ) call endrun( sub//": FATAL: clubb_saturation_equation not set") + if ( clubb_grid_remap_method == unset_i ) call endrun( sub//": FATAL: clubb_grid_remap_method not set") + if ( clubb_grid_adapt_in_time_method == unset_i ) call endrun( sub//": FATAL: clubb_grid_adapt_in_time_method not set") + if ( clubb_fill_holes_type == unset_i ) call endrun( sub//": FATAL: clubb_fill_holes_type not set") + + if ( clubb_detphase_lowtemp == unset_r8 ) call endrun( sub//": FATAL: clubb_detphase_lowtemp not set") + if ( clubb_detphase_lowtemp >= meltpt_temp ) call endrun( sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") + + call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In + clubb_ipdf_call_placement, & ! In + clubb_penta_solve_method, & ! In + clubb_tridiag_solve_method, & ! In + clubb_saturation_equation, & ! In + clubb_grid_remap_method, & ! In + clubb_grid_adapt_in_time_method, & ! In + clubb_fill_holes_type, & ! In + clubb_l_use_precip_frac, & ! In + clubb_l_predict_upwp_vpwp, & ! In + clubb_l_min_wp2_from_corr_wx, & ! In + clubb_l_min_xp2_from_corr_wx, & ! In + clubb_l_C2_cloud_frac, & ! In + clubb_l_diffuse_rtm_and_thlm, & ! In + clubb_l_stability_correct_Kh_N2_zm, & ! In + clubb_l_calc_thlp2_rad, & ! In + clubb_l_upwind_xpyp_ta, & ! In + clubb_l_upwind_xm_ma, & ! In + clubb_l_uv_nudge, & ! In + clubb_l_rtm_nudge, & ! In + clubb_l_tke_aniso, & ! In + clubb_l_vert_avg_closure, & ! In + clubb_l_trapezoidal_rule_zt, & ! In + clubb_l_trapezoidal_rule_zm, & ! In + clubb_l_call_pdf_closure_twice, & ! In + clubb_l_standard_term_ta, & ! In + clubb_l_partial_upwind_wp3, & ! In + clubb_l_godunov_upwind_wpxp_ta, & ! In + clubb_l_godunov_upwind_xpyp_ta, & ! In + clubb_l_use_cloud_cover, & ! In + clubb_l_diagnose_correlations, & ! In + clubb_l_calc_w_corr, & ! In + clubb_l_const_Nc_in_cloud, & ! In + clubb_l_fix_w_chi_eta_correlations, & ! In + clubb_l_stability_correct_tau_zm, & ! In + clubb_l_damp_wp2_using_em, & ! In + clubb_l_do_expldiff_rtm_thlm, & ! In + clubb_l_Lscale_plume_centered, & ! In + clubb_l_diag_Lscale_from_tau, & ! In + clubb_l_use_C7_Richardson, & ! In + clubb_l_use_C11_Richardson, & ! In + clubb_l_use_shear_Richardson, & ! In + clubb_l_brunt_vaisala_freq_moist, & ! In + clubb_l_use_thvm_in_bv_freq, & ! In + clubb_l_rcm_supersat_adj, & ! In + clubb_l_damp_wp3_Skw_squared, & ! In + clubb_l_prescribed_avg_deltaz, & ! In + clubb_l_lmm_stepping, & ! In + clubb_l_e3sm_config, & ! In + clubb_l_vary_convect_depth, & ! In + clubb_l_use_tke_in_wp3_pr_turb_term, & ! In + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In + clubb_l_use_wp3_lim_with_smth_Heaviside, & ! In + clubb_l_smooth_Heaviside_tau_wpxp, & ! In + clubb_l_modify_limiters_for_cnvg_test, & ! In + clubb_l_enable_relaxed_clipping, & ! In + clubb_l_linearize_pbl_winds, & ! In + clubb_l_mono_flux_lim_thlm, & ! In + clubb_l_mono_flux_lim_rtm, & ! In + clubb_l_mono_flux_lim_um, & ! In + clubb_l_mono_flux_lim_vm, & ! In + clubb_l_mono_flux_lim_spikefix, & ! In + clubb_l_host_applies_sfc_fluxes, & ! In + clubb_l_wp2_fill_holes_tke, & ! In + clubb_l_add_dycore_grid, & ! In + clubb_config_flags ) ! Out #endif end subroutine clubb_readnl @@ -1428,7 +1430,7 @@ end subroutine clubb_readnl ! ! ! =============================================================================== ! - subroutine clubb_ini_cam(pbuf2d) + subroutine clubb_ini_cam(pbuf_ini) !------------------------------------------------------------------------------- ! Description: ! Initialize UWM CLUBB. @@ -1481,7 +1483,7 @@ subroutine clubb_ini_cam(pbuf2d) saturation_flatau, & ! Constant for Flatau approximations of saturation saturation_lookup ! Use a lookup table for mixing length - use time_manager, only: is_first_step + use time_manager, only: is_first_step use constituents, only: cnst_get_ind use phys_control, only: phys_getopts use cam_logfile, only: iulog @@ -1492,7 +1494,7 @@ subroutine clubb_ini_cam(pbuf2d) implicit none ! Input Variables - type(physics_buffer_desc), pointer :: pbuf2d(:,:) + type(physics_buffer_desc), pointer :: pbuf_ini(:,:) #ifdef CLUBB_SGS @@ -1604,28 +1606,27 @@ subroutine clubb_ini_cam(pbuf2d) if (stats_metadata%l_stats) stats_metadata%l_stats_samp = .true. ! Define physics buffers indexes - cld_idx = pbuf_get_index('CLD') ! Cloud fraction - concld_idx = pbuf_get_index('CONCLD') ! Convective cloud cover - ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction - alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction - aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction - qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC - qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC - dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction - icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio - sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction - relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance - prer_evap_idx = pbuf_get_index('PRER_EVAP') - qrl_idx = pbuf_get_index('QRL') - cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') - naai_idx = pbuf_get_index('NAAI') - npccn_idx = pbuf_get_index('NPCCN') - - + cld_idx = pbuf_get_index('CLD') ! Cloud fraction + concld_idx = pbuf_get_index('CONCLD') ! Convective cloud cover + ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction + alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction + aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction + qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC + qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC + dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction + icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio + sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction + relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance + prer_evap_idx = pbuf_get_index('PRER_EVAP') + qrl_idx = pbuf_get_index('QRL') + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') + naai_idx = pbuf_get_index('NAAI') + npccn_idx = pbuf_get_index('NPCCN') + + ! Scalars aren't in use, set all indices to -1 sclr_idx%iisclr_rt = -1 sclr_idx%iisclr_thl = -1 sclr_idx%iisclr_CO2 = -1 - sclr_idx%iiedsclr_rt = -1 sclr_idx%iiedsclr_thl = -1 sclr_idx%iiedsclr_CO2 = -1 @@ -1646,58 +1647,58 @@ subroutine clubb_ini_cam(pbuf2d) call init_clubb_params_api( 1, -99, "", & clubb_params_single_col ) - clubb_params_single_col(:,iC2rtthl) = clubb_C2rtthl - clubb_params_single_col(:,iC8) = clubb_C8 - clubb_params_single_col(:,iC11) = clubb_c11 - clubb_params_single_col(:,iC11b) = clubb_c11b - clubb_params_single_col(:,iC14) = clubb_c14 - clubb_params_single_col(:,iC_wp3_pr_turb) = clubb_C_wp3_pr_turb - clubb_params_single_col(:,ic_K10) = clubb_c_K10 - clubb_params_single_col(:,imult_coef) = clubb_mult_coef - clubb_params_single_col(:,iSkw_denom_coef) = clubb_Skw_denom_coef - clubb_params_single_col(:,iC2rt) = clubb_C2rt - clubb_params_single_col(:,iC2thl) = clubb_C2thl - clubb_params_single_col(:,ibeta) = clubb_beta - clubb_params_single_col(:,iC6rt) = clubb_c6rt - clubb_params_single_col(:,iC6rtb) = clubb_c6rtb - clubb_params_single_col(:,iC6rtc) = clubb_c6rtc - clubb_params_single_col(:,iC6thl) = clubb_c6thl - clubb_params_single_col(:,iC6thlb) = clubb_c6thlb - clubb_params_single_col(:,iC6thlc) = clubb_c6thlc - clubb_params_single_col(:,iwpxp_L_thresh) = clubb_wpxp_L_thresh - clubb_params_single_col(:,iC7) = clubb_C7 - clubb_params_single_col(:,iC7b) = clubb_C7b - clubb_params_single_col(:,igamma_coef) = clubb_gamma_coef - clubb_params_single_col(:,ic_K10h) = clubb_c_K10h - clubb_params_single_col(:,ilambda0_stability_coef) = clubb_lambda0_stability_coef - clubb_params_single_col(:,ilmin_coef) = clubb_lmin_coef - clubb_params_single_col(:,iC8b) = clubb_C8b - clubb_params_single_col(:,iskw_max_mag) = clubb_skw_max_mag - clubb_params_single_col(:,iC1) = clubb_C1 - clubb_params_single_col(:,iC1b) = clubb_C1b - clubb_params_single_col(:,igamma_coefb) = clubb_gamma_coefb - clubb_params_single_col(:,iup2_sfc_coef) = clubb_up2_sfc_coef - clubb_params_single_col(:,iC4) = clubb_C4 - clubb_params_single_col(:,iC_uu_shr) = clubb_C_uu_shr - clubb_params_single_col(:,iC_uu_buoy) = clubb_C_uu_buoy - clubb_params_single_col(:,ic_K1) = clubb_c_K1 - clubb_params_single_col(:,ic_K2) = clubb_c_K2 - clubb_params_single_col(:,inu2) = clubb_nu2 - clubb_params_single_col(:,ic_K8) = clubb_c_K8 - clubb_params_single_col(:,ic_K9) = clubb_c_K9 - clubb_params_single_col(:,inu9) = clubb_nu9 - clubb_params_single_col(:,iC_wp2_splat) = clubb_C_wp2_splat - clubb_params_single_col(:,iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd - clubb_params_single_col(:,iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc - clubb_params_single_col(:,iC_invrs_tau_shear) = clubb_C_invrs_tau_shear - clubb_params_single_col(:,iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 - clubb_params_single_col(:,iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 - clubb_params_single_col(:,iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 - clubb_params_single_col(:,iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp - clubb_params_single_col(:,iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 - clubb_params_single_col(:,ibv_efold) = clubb_bv_efold - clubb_params_single_col(:,iwpxp_Ri_exp) = clubb_wpxp_Ri_exp - clubb_params_single_col(:,iz_displace) = clubb_z_displace + clubb_params_single_col(1,iC2rtthl) = clubb_C2rtthl + clubb_params_single_col(1,iC8) = clubb_C8 + clubb_params_single_col(1,iC11) = clubb_c11 + clubb_params_single_col(1,iC11b) = clubb_c11b + clubb_params_single_col(1,iC14) = clubb_c14 + clubb_params_single_col(1,iC_wp3_pr_turb) = clubb_C_wp3_pr_turb + clubb_params_single_col(1,ic_K10) = clubb_c_K10 + clubb_params_single_col(1,imult_coef) = clubb_mult_coef + clubb_params_single_col(1,iSkw_denom_coef) = clubb_Skw_denom_coef + clubb_params_single_col(1,iC2rt) = clubb_C2rt + clubb_params_single_col(1,iC2thl) = clubb_C2thl + clubb_params_single_col(1,ibeta) = clubb_beta + clubb_params_single_col(1,iC6rt) = clubb_c6rt + clubb_params_single_col(1,iC6rtb) = clubb_c6rtb + clubb_params_single_col(1,iC6rtc) = clubb_c6rtc + clubb_params_single_col(1,iC6thl) = clubb_c6thl + clubb_params_single_col(1,iC6thlb) = clubb_c6thlb + clubb_params_single_col(1,iC6thlc) = clubb_c6thlc + clubb_params_single_col(1,iwpxp_L_thresh) = clubb_wpxp_L_thresh + clubb_params_single_col(1,iC7) = clubb_C7 + clubb_params_single_col(1,iC7b) = clubb_C7b + clubb_params_single_col(1,igamma_coef) = clubb_gamma_coef + clubb_params_single_col(1,ic_K10h) = clubb_c_K10h + clubb_params_single_col(1,ilambda0_stability_coef) = clubb_lambda0_stability_coef + clubb_params_single_col(1,ilmin_coef) = clubb_lmin_coef + clubb_params_single_col(1,iC8b) = clubb_C8b + clubb_params_single_col(1,iskw_max_mag) = clubb_skw_max_mag + clubb_params_single_col(1,iC1) = clubb_C1 + clubb_params_single_col(1,iC1b) = clubb_C1b + clubb_params_single_col(1,igamma_coefb) = clubb_gamma_coefb + clubb_params_single_col(1,iup2_sfc_coef) = clubb_up2_sfc_coef + clubb_params_single_col(1,iC4) = clubb_C4 + clubb_params_single_col(1,iC_uu_shr) = clubb_C_uu_shr + clubb_params_single_col(1,iC_uu_buoy) = clubb_C_uu_buoy + clubb_params_single_col(1,ic_K1) = clubb_c_K1 + clubb_params_single_col(1,ic_K2) = clubb_c_K2 + clubb_params_single_col(1,inu2) = clubb_nu2 + clubb_params_single_col(1,ic_K8) = clubb_c_K8 + clubb_params_single_col(1,ic_K9) = clubb_c_K9 + clubb_params_single_col(1,inu9) = clubb_nu9 + clubb_params_single_col(1,iC_wp2_splat) = clubb_C_wp2_splat + clubb_params_single_col(1,iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd + clubb_params_single_col(1,iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc + clubb_params_single_col(1,iC_invrs_tau_shear) = clubb_C_invrs_tau_shear + clubb_params_single_col(1,iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 + clubb_params_single_col(1,iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 + clubb_params_single_col(1,iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 + clubb_params_single_col(1,iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp + clubb_params_single_col(1,iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 + clubb_params_single_col(1,ibv_efold) = clubb_bv_efold + clubb_params_single_col(1,iwpxp_Ri_exp) = clubb_wpxp_Ri_exp + clubb_params_single_col(1,iz_displace) = clubb_z_displace ! Override clubb default if ( trim(subcol_scheme) == 'SILHS' ) then @@ -1745,70 +1746,70 @@ subroutine clubb_ini_cam(pbuf2d) ! ----------------------------------------------------------------- ! ! These are default CLUBB output. Not the higher order history budgets - call addfld ('RHO_CLUBB', (/ 'lev' /), 'A', 'kg/m3', 'Air Density', sampled_on_subcycle=.true.) - call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance', sampled_on_subcycle=.true.) - call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance', sampled_on_subcycle=.true.) - call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance', sampled_on_subcycle=.true.) - call addfld ('WP2_ZT_CLUBB', (/ 'lev' /), 'A', 'm2/s2', 'Vert Vel Variance on zt grid', sampled_on_subcycle=.true.) - call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux', sampled_on_subcycle=.true.) - call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux', sampled_on_subcycle=.true.) - call addfld ('WP3_CLUBB', (/ 'lev' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity', sampled_on_subcycle=.true.) - call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux', sampled_on_subcycle=.true.) - call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux', sampled_on_subcycle=.true.) - call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance', sampled_on_subcycle=.true.) - call addfld ('RTP2_ZT_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','Moisture Variance on zt grid', sampled_on_subcycle=.true.) - call addfld ('pdfp_rtp2_output_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2','PDF Rtot Variance', sampled_on_subcycle=.true.) - call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance', sampled_on_subcycle=.true.) - call addfld ('THLP2_ZT_CLUBB', (/ 'lev' /), 'A', 'K^2', 'Temperature Variance on zt grid', sampled_on_subcycle=.true.) - call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance', sampled_on_subcycle=.true.) - call addfld ('RCM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water Mixing Ratio', sampled_on_subcycle=.true.) - call addfld ('RTM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Total Water Mixing Ratio', sampled_on_subcycle=.true.) - call addfld ('THLM_CLUBB', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature', sampled_on_subcycle=.true.) - call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux', sampled_on_subcycle=.true.) - call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction', sampled_on_subcycle=.true.) - call addfld ('RCMINLAYER_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water in Layer', sampled_on_subcycle=.true.) - call addfld ('CLOUDCOVER_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Cover', sampled_on_subcycle=.true.) - call addfld ('WPTHVP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Buoyancy Flux', sampled_on_subcycle=.true.) - call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Water vapor tendency', sampled_on_subcycle=.true.) - call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'J/(kg s)', 'Static energy tendency', sampled_on_subcycle=.true.) - call addfld ('RCMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Liquid Water Tendency', sampled_on_subcycle=.true.) - call addfld ('RIMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Ice Tendency', sampled_on_subcycle=.true.) - call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency', sampled_on_subcycle=.true.) - call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency', sampled_on_subcycle=.true.) - call addfld ('ZT_CLUBB', (/ 'lev' /), 'A', 'm', 'Thermodynamic Heights', sampled_on_subcycle=.true.) - call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights', sampled_on_subcycle=.true.) - call addfld ('UM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Zonal Wind', sampled_on_subcycle=.true.) - call addfld ('VM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Meridional Wind', sampled_on_subcycle=.true.) - call addfld ('WM_ZT_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Vertical Velocity', sampled_on_subcycle=.true.) - call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height', sampled_on_subcycle=.true.) - call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction', sampled_on_subcycle=.true.) - call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection', sampled_on_subcycle=.true.) - call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) - call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) - call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) - call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) - + call addfld ('RHO_CLUBB', (/ 'lev' /), 'A', 'kg/m3', 'Air Density', sampled_on_subcycle = .true. ) + call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance', sampled_on_subcycle = .true. ) + call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance', sampled_on_subcycle = .true. ) + call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance', sampled_on_subcycle = .true. ) + call addfld ('WP2_ZT_CLUBB', (/ 'lev' /), 'A', 'm2/s2', 'Vert Vel Variance on zt grid', sampled_on_subcycle = .true. ) + call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux', sampled_on_subcycle = .true. ) + call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux', sampled_on_subcycle = .true. ) + call addfld ('WP3_CLUBB', (/ 'lev' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity', sampled_on_subcycle = .true. ) + call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux', sampled_on_subcycle = .true. ) + call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux', sampled_on_subcycle = .true. ) + call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'kg^2/kg^2', 'Moisture Variance', sampled_on_subcycle = .true. ) + call addfld ('RTP2_ZT_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2', 'Moisture Variance on zt grid', sampled_on_subcycle = .true. ) + call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance', sampled_on_subcycle = .true. ) + call addfld ('THLP2_ZT_CLUBB', (/ 'lev' /), 'A', 'K^2', 'Temperature Variance on zt grid', sampled_on_subcycle = .true. ) + call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K kg/kg', 'Temp. Moist. Covariance', sampled_on_subcycle = .true. ) + call addfld ('RCM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water Mixing Ratio', sampled_on_subcycle = .true. ) + call addfld ('RTM_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Total Water Mixing Ratio', sampled_on_subcycle = .true. ) + call addfld ('THLM_CLUBB', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature', sampled_on_subcycle = .true. ) + call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux', sampled_on_subcycle = .true. ) + call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction', sampled_on_subcycle = .true. ) + call addfld ('RCMINLAYER_CLUBB', (/ 'lev' /), 'A', 'kg/kg', 'Cloud Water in Layer', sampled_on_subcycle = .true. ) + call addfld ('CLOUDCOVER_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Cover', sampled_on_subcycle = .true. ) + call addfld ('WPTHVP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Buoyancy Flux', sampled_on_subcycle = .true. ) + call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Water vapor tendency', sampled_on_subcycle = .true. ) + call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'J/(kg s)', 'Static energy tendency', sampled_on_subcycle = .true. ) + call addfld ('RCMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Liquid Water Tendency', sampled_on_subcycle = .true. ) + call addfld ('RIMTEND_CLUBB', (/ 'lev' /), 'A', 'kg/kg /s', 'Cloud Ice Tendency', sampled_on_subcycle = .true. ) + call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency', sampled_on_subcycle = .true. ) + call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency', sampled_on_subcycle = .true. ) + call addfld ('ZT_CLUBB', (/ 'lev' /), 'A', 'm', 'Thermodynamic Heights', sampled_on_subcycle = .true. ) + call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights', sampled_on_subcycle = .true. ) + call addfld ('UM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Zonal Wind', sampled_on_subcycle = .true. ) + call addfld ('VM_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Meridional Wind', sampled_on_subcycle = .true. ) + call addfld ('WM_ZT_CLUBB', (/ 'lev' /), 'A', 'm/s', 'Vertical Velocity', sampled_on_subcycle = .true. ) + call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction', sampled_on_subcycle = .true. ) + call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection', sampled_on_subcycle = .true. ) + call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) + call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) + call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) + call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) + + call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height', sampled_on_subcycle=.true.) + call addfld ('pdfp_rtp2_output_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2', 'PDF Rtot Variance', sampled_on_subcycle=.true.) call addfld ('QCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) call addfld ('NCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) - call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment', sampled_on_subcycle=.true.) + call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment', sampled_on_subcycle=.true.) - call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection', sampled_on_subcycle=.true.) - call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection', sampled_on_subcycle=.true.) - call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment', sampled_on_subcycle=.true.) - call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance', sampled_on_subcycle=.true.) - call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB', sampled_on_subcycle=.true.) + call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection', sampled_on_subcycle=.true.) + call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection', sampled_on_subcycle=.true.) + call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment', sampled_on_subcycle=.true.) + call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance', sampled_on_subcycle=.true.) + call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB', sampled_on_subcycle=.true.) - call addfld ('ZMDLFI', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice water from ZM convection', sampled_on_subcycle=.true.) - call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover', sampled_on_subcycle=.true.) - call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud', sampled_on_subcycle=.true.) - call addfld ('DETNLIQTND', (/ 'lev' /), 'A', '1/kg/s', 'CLDNUM tendency in detrained water', sampled_on_subcycle=.true.) + call addfld ('ZMDLFI', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice water from ZM convection', sampled_on_subcycle=.true.) + call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover', sampled_on_subcycle=.true.) + call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud', sampled_on_subcycle=.true.) + call addfld ('DETNLIQTND', (/ 'lev' /), 'A', '1/kg/s', 'CLDNUM tendency in detrained water', sampled_on_subcycle=.true.) - call addfld ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor', sampled_on_subcycle=.true.) call addfld ('KVH_CLUBB', (/ 'ilev' /), 'A', 'm2/s', 'CLUBB vertical diffusivity of heat/moisture on interface levels', sampled_on_subcycle=.true.) - call addfld ('ELEAK_CLUBB', horiz_only, 'A', 'W/m2', 'CLUBB energy leak', sampled_on_subcycle=.true.) - call addfld ('TFIX_CLUBB', horiz_only, 'A', 'K', 'Temperature increment to conserve energy', sampled_on_subcycle=.true.) + call addfld ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor', sampled_on_subcycle=.true.) + call addfld ('ELEAK_CLUBB', horiz_only, 'A', 'W/m2', 'CLUBB energy leak', sampled_on_subcycle=.true.) + call addfld ('TFIX_CLUBB', horiz_only, 'A', 'K', 'Temperature increment to conserve energy', sampled_on_subcycle=.true.) ! ---------------------------------------------------------------------------- ! ! Below are for detailed analysis of EDMF Scheme ! @@ -1880,48 +1881,48 @@ subroutine clubb_ini_cam(pbuf2d) ! ----------------------------------------------------------------- ! if (clubb_do_adv .or. history_clubb) then - call add_default('RELVAR', 1, ' ') - call add_default('RHO_CLUBB', 1, ' ') - call add_default('UP2_CLUBB', 1, ' ') - call add_default('VP2_CLUBB', 1, ' ') - call add_default('WP2_CLUBB', 1, ' ') - call add_default('WP2_ZT_CLUBB', 1, ' ') - call add_default('WP3_CLUBB', 1, ' ') - call add_default('UPWP_CLUBB', 1, ' ') - call add_default('VPWP_CLUBB', 1, ' ') - call add_default('WPTHLP_CLUBB', 1, ' ') - call add_default('WPRTP_CLUBB', 1, ' ') - call add_default('RTP2_CLUBB', 1, ' ') - call add_default('RTP2_ZT_CLUBB', 1, ' ') - call add_default('pdfp_rtp2_output_CLUBB', 1, ' ') - call add_default('THLP2_CLUBB', 1, ' ') - call add_default('THLP2_ZT_CLUBB', 1, ' ') - call add_default('RTPTHLP_CLUBB', 1, ' ') - call add_default('RCM_CLUBB', 1, ' ') - call add_default('RTM_CLUBB', 1, ' ') - call add_default('THLM_CLUBB', 1, ' ') - call add_default('WPRCP_CLUBB', 1, ' ') - call add_default('CLOUDFRAC_CLUBB', 1, ' ') - call add_default('RCMINLAYER_CLUBB', 1, ' ') - call add_default('CLOUDCOVER_CLUBB', 1, ' ') - call add_default('WPTHVP_CLUBB', 1, ' ') - call add_default('RVMTEND_CLUBB', 1, ' ') - call add_default('STEND_CLUBB', 1, ' ') - call add_default('RCMTEND_CLUBB', 1, ' ') - call add_default('RIMTEND_CLUBB', 1, ' ') - call add_default('UTEND_CLUBB', 1, ' ') - call add_default('VTEND_CLUBB', 1, ' ') - call add_default('ZT_CLUBB', 1, ' ') - call add_default('ZM_CLUBB', 1, ' ') - call add_default('UM_CLUBB', 1, ' ') - call add_default('VM_CLUBB', 1, ' ') - call add_default('WM_ZT_CLUBB', 1, ' ') - call add_default('PBLH', 1, ' ') - call add_default('CONCLD', 1, ' ') + call add_default('RELVAR', 1, ' ') + call add_default('RHO_CLUBB', 1, ' ') + call add_default('UP2_CLUBB', 1, ' ') + call add_default('VP2_CLUBB', 1, ' ') + call add_default('WP2_CLUBB', 1, ' ') + call add_default('WP2_ZT_CLUBB', 1, ' ') + call add_default('WP3_CLUBB', 1, ' ') + call add_default('UPWP_CLUBB', 1, ' ') + call add_default('VPWP_CLUBB', 1, ' ') + call add_default('WPTHLP_CLUBB', 1, ' ') + call add_default('WPRTP_CLUBB', 1, ' ') + call add_default('RTP2_CLUBB', 1, ' ') + call add_default('RTP2_ZT_CLUBB', 1, ' ') + call add_default('pdfp_rtp2_output_CLUBB', 1, ' ') + call add_default('THLP2_CLUBB', 1, ' ') + call add_default('THLP2_ZT_CLUBB', 1, ' ') + call add_default('RTPTHLP_CLUBB', 1, ' ') + call add_default('RCM_CLUBB', 1, ' ') + call add_default('RTM_CLUBB', 1, ' ') + call add_default('THLM_CLUBB', 1, ' ') + call add_default('WPRCP_CLUBB', 1, ' ') + call add_default('CLOUDFRAC_CLUBB', 1, ' ') + call add_default('RCMINLAYER_CLUBB', 1, ' ') + call add_default('CLOUDCOVER_CLUBB', 1, ' ') + call add_default('WPTHVP_CLUBB', 1, ' ') + call add_default('RVMTEND_CLUBB', 1, ' ') + call add_default('STEND_CLUBB', 1, ' ') + call add_default('RCMTEND_CLUBB', 1, ' ') + call add_default('RIMTEND_CLUBB', 1, ' ') + call add_default('UTEND_CLUBB', 1, ' ') + call add_default('VTEND_CLUBB', 1, ' ') + call add_default('ZT_CLUBB', 1, ' ') + call add_default('ZM_CLUBB', 1, ' ') + call add_default('UM_CLUBB', 1, ' ') + call add_default('VM_CLUBB', 1, ' ') + call add_default('WM_ZT_CLUBB', 1, ' ') + call add_default('PBLH', 1, ' ') + call add_default('CONCLD', 1, ' ') endif if (history_amwg) then - call add_default('PBLH', 1, ' ') + call add_default('PBLH', 1, ' ') end if if (do_clubb_mf_diag) then @@ -1969,72 +1970,71 @@ subroutine clubb_ini_cam(pbuf2d) ! Is this the first time step? If so then initialize CLUBB variables as follows if (is_first_step()) then - call pbuf_set_field(pbuf2d, wp2_idx, w_tol_sqd) - call pbuf_set_field(pbuf2d, wp3_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthlp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wprtp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rtpthlp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rtp2_idx, rt_tol**2) - call pbuf_set_field(pbuf2d, thlp2_idx, thl_tol**2) - call pbuf_set_field(pbuf2d, up2_idx, w_tol_sqd) - call pbuf_set_field(pbuf2d, vp2_idx, w_tol_sqd) - - call pbuf_set_field(pbuf2d, rtp3_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlp3_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, up3_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vp3_idx, 0.0_r8) - - call pbuf_set_field(pbuf2d, upwp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vpwp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthvp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2thvp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rtpthvp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlpthvp_idx,0.0_r8) - call pbuf_set_field(pbuf2d, rcm_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2rtp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2thlp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, uprcp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vprcp_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rc_coef_zm_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp4_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpup2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpvp2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2up2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wp2vp2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, ice_supersat_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2_idx, w_tol_sqd) + call pbuf_set_field(pbuf_ini, wp3_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthlp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wprtp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rtpthlp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rtp2_idx, rt_tol**2) + call pbuf_set_field(pbuf_ini, thlp2_idx, thl_tol**2) + call pbuf_set_field(pbuf_ini, up2_idx, w_tol_sqd) + call pbuf_set_field(pbuf_ini, vp2_idx, w_tol_sqd) + + call pbuf_set_field(pbuf_ini, rtp3_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, thlp3_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, up3_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vp3_idx, 0.0_r8) + + call pbuf_set_field(pbuf_ini, upwp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vpwp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthvp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2thvp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rtpthvp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, thlpthvp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rcm_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, tke_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, kvh_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2rtp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2thlp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, uprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rc_coef_zm_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp4_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpup2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpvp2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2up2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wp2vp2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, ice_supersat_idx, 0.0_r8) ! Initialize SILHS covariance contributions - call pbuf_set_field(pbuf2d, rtp2_mc_zt_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlp2_mc_zt_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wprtp_mc_zt_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthlp_mc_zt_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, rtpthlp_mc_zt_idx, 0.0_r8) - - call pbuf_set_field(pbuf2d, pdf_zm_w_1_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, pdf_zm_w_2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_1_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_2_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, pdf_zm_mixt_frac_idx, 0.0_r8) - - call pbuf_set_field(pbuf2d, ttend_clubb_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, upwp_clubb_gw_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vpwp_clubb_gw_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlp2_clubb_gw_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthlp_clubb_gw_idx, 0.0_r8) - - call pbuf_set_field(pbuf2d, ttend_clubb_mc_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, upwp_clubb_gw_mc_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, vpwp_clubb_gw_mc_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, thlp2_clubb_gw_mc_idx, 0.0_r8) - call pbuf_set_field(pbuf2d, wpthlp_clubb_gw_mc_idx, 0.0_r8) - + call pbuf_set_field(pbuf_ini, rtp2_mc_zt_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, thlp2_mc_zt_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wprtp_mc_zt_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthlp_mc_zt_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, rtpthlp_mc_zt_idx, 0.0_r8) + + call pbuf_set_field(pbuf_ini, pdf_zm_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, pdf_zm_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, pdf_zm_varnce_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, pdf_zm_varnce_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, pdf_zm_mixt_frac_idx, 0.0_r8) + + call pbuf_set_field(pbuf_ini, ttend_clubb_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, upwp_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vpwp_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, thlp2_clubb_gw_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthlp_clubb_gw_idx, 0.0_r8) + + call pbuf_set_field(pbuf_ini, ttend_clubb_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, upwp_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, vpwp_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, thlp2_clubb_gw_mc_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, wpthlp_clubb_gw_mc_idx, 0.0_r8) endif ! The following is physpkg, so it needs to be initialized every time - call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8) + call pbuf_set_field(pbuf_ini, fice_idx, 0.0_r8) ! --------------- ! ! End ! @@ -2105,6 +2105,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & init_pdf_params_api, & init_pdf_implicit_coefs_terms_api, & setup_grid_api, & + cleanup_grid_api, & iiPDF_new, & iiPDF_new_hybrid @@ -2157,63 +2158,63 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Pointers for pbuf ! ! ---------------------------------------------------- ! - real(r8), pointer, dimension(:,:) :: wp2_pbuf ! vertical velocity variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: wp3_pbuf ! third moment of vertical velocity [m^3/s^3] - real(r8), pointer, dimension(:,:) :: wpthlp_pbuf ! turbulent flux of thetal [m/s K] - real(r8), pointer, dimension(:,:) :: wprtp_pbuf ! turbulent flux of moisture [m/s kg/kg] - real(r8), pointer, dimension(:,:) :: rtpthlp_pbuf ! covariance of thetal and qt [kg/kg K] - real(r8), pointer, dimension(:,:) :: rtp2_pbuf ! moisture variance [kg^2/kg^2] - real(r8), pointer, dimension(:,:) :: thlp2_pbuf ! temperature variance [K^2] - real(r8), pointer, dimension(:,:) :: rtp3_pbuf ! moisture 3rd order [kg^3/kg^3] - real(r8), pointer, dimension(:,:) :: thlp3_pbuf ! temperature 3rd order [K^3] - real(r8), pointer, dimension(:,:) :: up2_pbuf ! east-west wind variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: vp2_pbuf ! north-south wind variance [m^2/s^2] - real(r8), pointer, dimension(:,:) :: up3_pbuf ! east-west wind 3rd order [m^3/s^3] - real(r8), pointer, dimension(:,:) :: vp3_pbuf ! north-south wind 3rd order [m^3/s^3] - real(r8), pointer, dimension(:,:) :: upwp_pbuf ! east-west momentum flux [m^2/s^2] - real(r8), pointer, dimension(:,:) :: vpwp_pbuf ! north-south momentum flux [m^2/s^2] - real(r8), pointer, dimension(:,:) :: wpthvp_pbuf ! w'th_v' (momentum levels) [m/s K] - real(r8), pointer, dimension(:,:) :: wp2thvp_pbuf ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - real(r8), pointer, dimension(:,:) :: rtpthvp_pbuf ! r_t'th_v' (momentum levels) [kg/kg K] - real(r8), pointer, dimension(:,:) :: thlpthvp_pbuf ! th_l'th_v' (momentum levels) [K^2] - real(r8), pointer, dimension(:,:) :: pdf_zm_w_1_pbuf !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_w_2_pbuf !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1_pbuf !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2_pbuf !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac_pbuf !work pointer for pdf_params_zm - real(r8), pointer, dimension(:,:) :: wp2rtp_pbuf ! w'^2 rt' (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wp2thlp_pbuf ! w'^2 thl' (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: uprcp_pbuf ! < u' r_c' > (momentum levels) - real(r8), pointer, dimension(:,:) :: vprcp_pbuf ! < v' r_c' > (momentum levels) - real(r8), pointer, dimension(:,:) :: rc_coef_zm_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) - real(r8), pointer, dimension(:,:) :: wp4_pbuf ! w'^4 (momentum levels - real(r8), pointer, dimension(:,:) :: wpup2_pbuf ! w'u'^2 (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wpvp2_pbuf ! w'v'^2 (thermodynamic levels) - real(r8), pointer, dimension(:,:) :: wp2up2_pbuf ! w'^2 u'^2 (momentum levels) - real(r8), pointer, dimension(:,:) :: wp2vp2_pbuf ! w'^2 v'^2 (momentum levels) - real(r8), pointer, dimension(:,:) :: thlm_pbuf ! mean temperature [K] - real(r8), pointer, dimension(:,:) :: rtm_pbuf ! mean moisture mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: rcm_pbuf ! CLUBB cloud water mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: um_pbuf ! mean east-west wind [m/s] - real(r8), pointer, dimension(:,:) :: vm_pbuf ! mean north-south wind [m/s] - real(r8), pointer, dimension(:,:) :: cld_pbuf ! cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: concld_pbuf ! convective cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: ast_pbuf ! stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: alst_pbuf ! liquid stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: aist_pbuf ! ice stratiform cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: qlst_pbuf ! Physical in-stratus LWC [kg/kg] - real(r8), pointer, dimension(:,:) :: qist_pbuf ! Physical in-stratus IWC [kg/kg] - real(r8), pointer, dimension(:,:) :: deepcu_pbuf ! deep convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: shalcu_pbuf ! shallow convection cloud fraction [fraction] - real(r8), pointer, dimension(:,:) :: khzm_pbuf ! CLUBB's eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] - real(r8), pointer, dimension(:) :: pblh_pbuf ! planetary boundary layer height [m] - real(r8), pointer, dimension(:,:) :: tke_pbuf ! turbulent kinetic energy [m^2/s^2] - real(r8), pointer, dimension(:,:) :: dp_icwmr_pbuf ! deep convection in cloud mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: ice_supersat_frac_pbuf ! Cloud fraction of ice clouds (pver)[fraction] - real(r8), pointer, dimension(:,:) :: relvar_pbuf ! relative cloud water variance [-] + real(r8), pointer, dimension(:,:) :: wp2_pbuf ! vertical velocity variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wp3_pbuf ! third moment of vertical velocity [m^3/s^3] + real(r8), pointer, dimension(:,:) :: wpthlp_pbuf ! turbulent flux of thetal [m/s K] + real(r8), pointer, dimension(:,:) :: wprtp_pbuf ! turbulent flux of moisture [m/s kg/kg] + real(r8), pointer, dimension(:,:) :: rtpthlp_pbuf ! covariance of thetal and qt [kg/kg K] + real(r8), pointer, dimension(:,:) :: rtp2_pbuf ! moisture variance [kg^2/kg^2] + real(r8), pointer, dimension(:,:) :: thlp2_pbuf ! temperature variance [K^2] + real(r8), pointer, dimension(:,:) :: rtp3_pbuf ! moisture 3rd order [kg^3/kg^3] + real(r8), pointer, dimension(:,:) :: thlp3_pbuf ! temperature 3rd order [K^3] + real(r8), pointer, dimension(:,:) :: up2_pbuf ! east-west wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vp2_pbuf ! north-south wind variance [m^2/s^2] + real(r8), pointer, dimension(:,:) :: up3_pbuf ! east-west wind 3rd order [m^3/s^3] + real(r8), pointer, dimension(:,:) :: vp3_pbuf ! north-south wind 3rd order [m^3/s^3] + real(r8), pointer, dimension(:,:) :: upwp_pbuf ! east-west momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: vpwp_pbuf ! north-south momentum flux [m^2/s^2] + real(r8), pointer, dimension(:,:) :: wpthvp_pbuf ! w'th_v' (momentum levels) [m/s K] + real(r8), pointer, dimension(:,:) :: wp2thvp_pbuf ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] + real(r8), pointer, dimension(:,:) :: rtpthvp_pbuf ! r_t'th_v' (momentum levels) [kg/kg K] + real(r8), pointer, dimension(:,:) :: thlpthvp_pbuf ! th_l'th_v' (momentum levels) [K^2] + real(r8), pointer, dimension(:,:) :: pdf_zm_w_1_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_w_2_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac_pbuf ! work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: wp2rtp_pbuf ! w'^2 rt' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2thlp_pbuf ! w'^2 thl' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: uprcp_pbuf ! < u' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: vprcp_pbuf ! < v' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: rc_coef_zm_pbuf ! Coef. of X'r_c' in Eq. (34) (t-levs.) + real(r8), pointer, dimension(:,:) :: wp4_pbuf ! w'^4 (momentum levels + real(r8), pointer, dimension(:,:) :: wpup2_pbuf ! w'u'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wpvp2_pbuf ! w'v'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2up2_pbuf ! w'^2 u'^2 (momentum levels) + real(r8), pointer, dimension(:,:) :: wp2vp2_pbuf ! w'^2 v'^2 (momentum levels) + real(r8), pointer, dimension(:,:) :: thlm_pbuf ! mean temperature [K] + real(r8), pointer, dimension(:,:) :: rtm_pbuf ! mean moisture mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: rcm_pbuf ! CLUBB cloud water mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: um_pbuf ! mean east-west wind [m/s] + real(r8), pointer, dimension(:,:) :: vm_pbuf ! mean north-south wind [m/s] + real(r8), pointer, dimension(:,:) :: cld_pbuf ! cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: concld_pbuf ! convective cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: ast_pbuf ! stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: alst_pbuf ! liquid stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: aist_pbuf ! ice stratiform cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: qlst_pbuf ! Physical in-stratus LWC [kg/kg] + real(r8), pointer, dimension(:,:) :: qist_pbuf ! Physical in-stratus IWC [kg/kg] + real(r8), pointer, dimension(:,:) :: deepcu_pbuf ! deep convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: shalcu_pbuf ! shallow convection cloud fraction [fraction] + real(r8), pointer, dimension(:,:) :: khzm_pbuf ! CLUBB's eddy diffusivity of heat/moisture on momentum levels [m^2/s] + real(r8), pointer, dimension(:) :: pblh_pbuf ! planetary boundary layer height [m] + real(r8), pointer, dimension(:,:) :: tke_pbuf ! turbulent kinetic energy [m^2/s^2] + real(r8), pointer, dimension(:,:) :: dp_icwmr_pbuf ! deep convection in cloud mixing ratio [kg/kg] + real(r8), pointer, dimension(:,:) :: ice_supersat_frac_pbuf ! Cloud fraction of ice clouds (pver)[fraction] + real(r8), pointer, dimension(:,:) :: relvar_pbuf ! relative cloud water variance [-] real(r8), pointer, dimension(:,:) :: naai_pbuf real(r8), pointer, dimension(:,:) :: cmeliq_pbuf - real(r8), pointer, dimension(:,:) :: cmfmc_sh_pbuf ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] + real(r8), pointer, dimension(:,:) :: cmfmc_sh_pbuf ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/] real(r8), pointer, dimension(:,:) :: qsatfac_pbuf real(r8), pointer, dimension(:,:) :: npccn_pbuf @@ -2260,7 +2261,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & err_info ! err_info struct used in CLUBB containing err_code and err_header type(grid) :: & - gr, gr_a ! CLUBB grid data structure + gr ! CLUBB grid data structure type(nu_vertical_res_dep) :: & nu_vert_res_dep ! Vertical resolution dependent nu values @@ -2268,12 +2269,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,nparams) :: & clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLES SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol) :: & deltaz, & - fcor, & ! Coriolis forcing [s^-1] - sfc_elevation, & ! Elevation of ground [m AMSL][m] + fcor, & ! Coriolis forcing [s^-1] + sfc_elevation, & ! Elevation of ground [m AMSL][m] wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s] wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)] upwp_sfc, & ! u'w' at surface [m^2/s^2] @@ -2289,55 +2288,50 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol,edsclr_dim) :: & wpedsclrp_sfc ! Eddy-scalar flux at surface [{units vary} m/s] - - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzt_clubb) :: & - thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] - rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] - um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] - vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] - wm_zt, & ! w mean wind component on thermo. levels [m/s] - rtm_ref, & ! Initial profile of rtm [kg/kg] - thlm_ref, & ! Initial profile of thlm [K] - um_ref, & ! Initial profile of um [m/s] - vm_ref, & ! Initial profile of vm [m/s] - ug, & ! U geostrophic wind [m/s] - vg, & ! V geostrophic wind [m/s] - p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] - rho_zt, & ! Air density on thermo levels [kg/m^3] - exner, & ! Exner function (thermodynamic levels) [-] - rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] - invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] - thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K] - rfrzm, & - rvm_in, & ! water vapor mixing ratio [kg/kg] - rtp2_zt, & ! CLUBB R-tot variance on thermo levs - thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2] - wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2] - cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction] - um_pert_inout, & ! Perturbed U wind [m/s] - vm_pert_inout, & ! Perturbed V wind [m/s] - khzt_out, & ! eddy diffusivity on thermo grids [m^2/s] - w_up_in_cloud_out, & - w_down_in_cloud_out, & - cloudy_updraft_frac_out, & - cloudy_downdraft_frac_out,& - rcm_in_layer, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] - cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction] - pre_in, & ! input for precip evaporation - qrl_clubb, & - qclvar_out, & ! cloud water variance [kg^2/kg^2] - zt_g, & ! Thermodynamic grid of CLUBB [m] - Lscale, & - dz_g, & ! thickness of layer [m] + thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] + rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] + vm_forcing, & ! v wind forcing (thermodynamic levels) [m/s/s] + wm_zt, & ! w mean wind component on thermo. levels [m/s] + rtm_ref, & ! Initial profile of rtm [kg/kg] + thlm_ref, & ! Initial profile of thlm [K] + um_ref, & ! Initial profile of um [m/s] + vm_ref, & ! Initial profile of vm [m/s] + ug, & ! U geostrophic wind [m/s] + vg, & ! V geostrophic wind [m/s] + p_in_Pa, & ! Air pressure (thermodynamic levels) [Pa] + rho_zt, & ! Air density on thermo levels [kg/m^3] + exner, & ! Exner function (thermodynamic levels) [-] + rho_ds_zt, & ! Dry, static density on thermodynamic levels [kg/m^3] + invrs_rho_ds_zt, & ! Inv. dry, static density on thermo. levels [m^3/kg] + thv_ds_zt, & ! Dry, base-state theta_v on thermo. levels [K] + rfrzm, & + rvm_in, & ! water vapor mixing ratio [kg/kg] + rtp2_zt, & ! CLUBB R-tot variance on thermo levs + thl2_zt, & ! CLUBB Theta-l variance on thermo levs [K^2] + wp2_zt, & ! CLUBB W variance on theromo levs [m^2/s^2] + cloud_frac_inout, & ! CLUBB output of cloud fraction [fraction] + um_pert_inout, & ! Perturbed U wind [m/s] + vm_pert_inout, & ! Perturbed V wind [m/s] + khzt_out, & ! eddy diffusivity on thermo grids [m^2/s] + w_up_in_cloud_out, & + w_down_in_cloud_out, & + cloudy_updraft_frac_out, & + cloudy_downdraft_frac_out, & + rcm_in_layer, & ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] + cloud_cover_out, & ! CLUBB output of in-cloud cloud fraction [fraction] + pre_in, & ! input for precip evaporation + qrl_clubb, & + qclvar_out, & ! cloud water variance [kg^2/kg^2] + zt_g, & ! Thermodynamic grid of CLUBB [m] + Lscale, & + dz_g, & ! thickness of layer [m] ! MF local thermodynamic vars invrs_exner_zt,& ! thermodynamic grid kappa_zt, qc_zt ! thermodynamic grid - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLES SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzm_clubb) :: & thlp2_rad, & wprtp_forcing, & @@ -2345,17 +2339,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtp2_forcing, & thlp2_forcing, & rtpthlp_forcing, & - wm_zm, & ! w mean wind component on momentum levels [m/s] - rho_zm, & ! Air density on momentum levels [kg/m^3] - rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] - invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] - thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] - upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] - vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] - khzm_out, & ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + wm_zm, & ! w mean wind component on momentum levels [m/s] + rho_zm, & ! Air density on momentum levels [kg/m^3] + rho_ds_zm, & ! Dry, static density on momentum levels [kg/m^3] + invrs_rho_ds_zm, & ! Inv. dry, static density on momentum levels [m^3/kg] + thv_ds_zm, & ! Dry, base-state theta_v on momentum levels [K] + upwp_pert_inout, & ! Perturbed u'w' [m^2/s^2] + vpwp_pert_inout, & ! Perturbed v'w' [m^2/s^2] + khzm_out, & ! Eddy diffusivity of heat/moisture on momentum levels [m^2/s] thlprcp_out, & - wprcp_out, & ! CLUBB output of flux of liquid water [kg/kg m/s] - invrs_tau_zm_out, & ! CLUBB output of 1 divided by time-scale [1/s] + wprcp_out, & ! CLUBB output of flux of liquid water [kg/kg m/s] + invrs_tau_zm_out, & ! CLUBB output of 1 divided by time-scale [1/s] rtp2_mc_out, & ! total water tendency from rain evap thlp2_mc_out, & ! thetal tendency from rain evap wprtp_mc_out, & @@ -2363,7 +2357,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtpthlp_mc_out, & uprcp_inout, & ! < u' r_c' > (momentum levels) vprcp_inout, & ! < v' r_c' > (momentum levels) - zi_g, & ! Momentum grid of CLUBB [m] + zi_g, & ! Momentum grid of CLUBB [m] ! MF Plume mf_dry_a, mf_moist_a, & @@ -2384,58 +2378,48 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & kappa_zm, p_in_Pa_zm, & ! momentum grid invrs_exner_zm ! momentum grid - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzt_clubb,sclr_dim) :: & - sclrm_forcing, & ! Passive scalar forcing [{units vary}/s] + sclrm_forcing, & ! Passive scalar forcing [{units vary}/s] sclrm, & ! Passive scalar mean (thermo. levels) [units vary] sclrp3 ! sclr'^3 (thermo. levels) [{units vary}^3] - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzm_clubb,sclr_dim) :: & sclrp2, & ! sclr'^2 (momentum levels) [{units vary}^2] - sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] - sclrpthlp, & ! sclr'thlp' (momentum levels) [{units vary} (K)] + sclrprtp, & ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] + sclrpthlp, & ! sclr'thlp' (momentum levels) [{units vary} (K)] wpsclrp, & ! w'sclr' (momentum levels) [{units vary} m/s] sclrpthvp_inout ! sclr'th_v' (momentum levels) [{units vary} (K)] - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzt_clubb,edsclr_dim) :: & - edsclrm_forcing, & ! Eddy passive scalar forcing [{units vary}/s] + edsclrm_forcing, & ! Eddy passive scalar forcing [{units vary}/s] edsclr_inout ! Scalars to be diffused through CLUBB [units vary] - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzt_clubb,hydromet_dim) :: & wp2hmp, & rtphmp_zt, & thlphmp_zt - ! Local CLUBB variables dimensioned as NCOL (only useful columns) to be sent into the clubb run api - ! NOTE: THESE VARIABLS SHOULD NOT BE USED IN PBUF OR OUTFLD (HISTORY) SUBROUTINES real(r8), dimension(state%ncol,nzm_clubb,hydromet_dim) :: & wphydrometp ! Variables used for output (zm) real(r8), dimension(pcols,pverp) :: & - zi_output, & ! output for momentum CLUBB grid [m] - wpthlp_output, & ! Heat flux output variable [W/m2] - rtpthlp_output, & ! rtpthlp ouptut [K kg/kg] - wprtp_output, & ! Total water flux output variable [W/m2] - wp2_output, & - up2_output, & - vp2_output, & - upwp_output, & - vpwp_output, & - rtp2_output, & - wprcp_clubb_output, & - wpthvp_clubb_output, & - thlp2_output, & - dlf_liq_out, & ! Detrained liquid water from ZM [kg/kg/s] - dlf_ice_out, & ! Detrained ice water from ZM [kg/kg/s] + zi_output, & ! output for momentum CLUBB grid [m] + wpthlp_output, & ! Heat flux output variable [W/m2] + rtpthlp_output, & ! rtpthlp ouptut [K kg/kg] + wprtp_output, & ! Total water flux output variable [W/m2] + wp2_output, & + up2_output, & + vp2_output, & + upwp_output, & + vpwp_output, & + rtp2_output, & + wprcp_clubb_output, & + wpthvp_clubb_output, & + thlp2_output, & + dlf_liq_out, & ! Detrained liquid water from ZM [kg/kg/s] + dlf_ice_out, & ! Detrained ice water from ZM [kg/kg/s] ! MF outputs to outfld ! NOTE: Arrays of size PCOLS (all possible columns) can be used to access State, PBuf and History Subroutines @@ -2445,7 +2429,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dry_thl_output, mf_moist_thl_output, & mf_dry_u_output, mf_moist_u_output, & mf_dry_v_output, mf_moist_v_output, & - mf_moist_qc_output, & + mf_moist_qc_output, & s_ae_output, s_aw_output, & s_awthl_output, s_awqt_output, & s_awql_output, s_awqi_output, & @@ -2454,77 +2438,78 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Variables used for output (zt) real(r8), dimension(pcols,pver) :: & - rvmtend_clubb_output, & - rcmtend_clubb_output, & - rimtend_clubb_output, & - stend_clubb_output, & - utend_clubb_output, & - vtend_clubb_output, & - dpdlfliq_output, & - dpdlfice_output, & - dpdlft_output, & - detnliquid_output, & - zt_output, & ! output for the thermo CLUBB grid [m] - rtp2_zt_output, & ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] - wp3_output, & ! wp3 output [m^3/s^3] - thl2_zt_output, & ! CLUBB Theta-l variance on thermo levs - wp2_zt_output, & - rcm_in_layer_output, & ! CLUBB in-cloud liquid water mixing ratio [kg/kg] - pdfp_rtp2_output, & ! Calculated R-tot variance from pdf_params [kg^2/kg^2] - wm_zt_output, & ! CLUBB mean W on thermo levs output [m/s] - rcm_output, & - rtm_output, & - thlm_output, & - um_output, & - vm_output + rvmtend_clubb_output, & + rcmtend_clubb_output, & + rimtend_clubb_output, & + stend_clubb_output, & + utend_clubb_output, & + vtend_clubb_output, & + dpdlfliq_output, & + dpdlfice_output, & + dpdlft_output, & + detnliquid_output, & + zt_output, & ! output for the thermo CLUBB grid [m] + rtp2_zt_output, & ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] + wp3_output, & ! wp3 output [m^3/s^3] + thl2_zt_output, & ! CLUBB Theta-l variance on thermo levs + wp2_zt_output, & + rcm_in_layer_output, & ! CLUBB in-cloud liquid water mixing ratio [kg/kg] + pdfp_rtp2_output, & ! Calculated R-tot variance from pdf_params [kg^2/kg^2] + wm_zt_output, & ! CLUBB mean W on thermo levs output [m/s] + rcm_output, & + rtm_output, & + thlm_output, & + um_output, & + vm_output real(r8), dimension(pcols) :: & - rhmini, & - rhmaxi, & - se_dis, & - eleak, & - ustar2, & ! Surface stress for PBL height [m2/s2] - obklen, & ! Obukov length [m] - kbfs, & ! Kinematic Surface heat flux [K m/s] - kinheat, & ! Kinematic Surface heat flux [K m/s] - rrho, & ! Inverse of air density [1/kg/m^3] - kinwat, & ! Kinematic water vapor flux [m/s] - dummy2, & ! dummy variable [units vary] - dummy3 ! dummy variable [units vary] + rhmini, & + rhmaxi, & + se_dis, & + eleak, & + ustar2, & ! Surface stress for PBL height [m2/s2] + obklen, & ! Obukov length [m] + kbfs, & ! Kinematic Surface heat flux [K m/s] + kinheat, & ! Kinematic Surface heat flux [K m/s] + rrho, & ! Inverse of air density [1/kg/m^3] + kinwat, & ! Kinematic water vapor flux [m/s] + dummy2, & ! dummy variable [units vary] + dummy3 ! dummy variable [units vary] real(r8), dimension(pcols,pver) :: & - temp2d, & ! temporary array for holding scaled outputs - qitend, & - initend, & ! Needed for ice supersaturation adjustment calculation - stend, & - qvtend, & - qctend, & - inctend, & - clubb_s, & - thv, & ! virtual potential temperature [K] - th ! potential temperature [K] + temp2d, & ! temporary array for holding scaled outputs + qitend, & + initend, & ! Needed for ice supersaturation adjustment calculation + stend, & + qvtend, & + qctend, & + inctend, & + clubb_s, & + thv, & ! virtual potential temperature [K] + th ! potential temperature [K] real(r8), dimension(pcols,pverp) :: & - rho ! Midpoint density in CAM [kg/m^3] + rho ! Midpoint density in CAM [kg/m^3] real(r8) :: & - inv_exner_tmp, & ! Inverse exner function consistent with CLUBB [-] - dlf2, & ! Detraining cld H20 from shallow convection [kg/kg/day] - dum1, & ! dummy variable [units vary] - invrs_hdtime, & - lmin, & - mixt_frac_max_mag, & - dtime, & ! CLUBB time step [s] - ubar, & ! surface wind [m/s] - ustar, & ! surface stress [m/s] - bflx22, & ! Variable for buoyancy flux for pbl [K m/s] - zo, & ! roughness height [m] - relvarmax, & - frac_limit, ic_limit, & - mean_rt, & ! Calculated R-tot mean from pdf_params (temp) [kg/kg] - latsub, & - apply_const, & - dl_rad, di_rad, dt_low, & + inv_exner_tmp, & ! Inverse exner function consistent with CLUBB [-] + dlf2, & ! Detraining cld H20 from shallow convection [kg/kg/day] + dum1, & ! dummy variable [units vary] + invrs_hdtime, & + lmin, & + mixt_frac_max_mag, & + dtime, & ! CLUBB time step [s] + ubar, & ! surface wind [m/s] + ustar, & ! surface stress [m/s] + bflx22, & ! Variable for buoyancy flux for pbl [K m/s] + zo, & ! roughness height [m] + relvarmax, & + frac_limit, & + ic_limit, & + mean_rt, & ! Calculated R-tot mean from pdf_params (temp) [kg/kg] + latsub, & + apply_const, & + dl_rad, di_rad, dt_low, & ! Variables below are needed to compute energy integrals for conservation te_a, se_a, ke_a, wv_a, wl_a, & te_b, se_b, ke_b, wv_b, wl_b @@ -2546,11 +2531,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & errflg, & j, k, t, ixind, nadv, n, & ! Loop variables k_cam, k_clubb, sclr, edsclr, & ! Loop variables - ixcldice, ixcldliq, ixnumliq, ixnumice, ixq, & + ixcldice, ixcldliq, ixnumliq, & + ixnumice, ixq, & itim_old, & - ncol, lchnk, & ! # of columns, and chunk identifier + ncol, lchnk, & ! # of columns, and chunk identifier icnt, & - stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] + stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] #endif @@ -2565,9 +2551,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef _OPENACC ! These options have not been GPUized - if ( do_clubb_mf ) call endrun(subr//': do_clubb_mf=.true. not available when compiling with OpenACC') - if ( do_rainturb ) call endrun(subr//': do_rainturb=.true. not available when compiling with OpenACC') - if ( do_cldcool ) call endrun(subr//': do_cldcool=.true. not available when compiling with OpenACC') + if ( do_clubb_mf ) call endrun(subr//': do_clubb_mf=.true. not available when compiling with OpenACC') + if ( do_rainturb ) call endrun(subr//': do_rainturb=.true. not available when compiling with OpenACC') + if ( do_cldcool ) call endrun(subr//': do_cldcool=.true. not available when compiling with OpenACC') if ( clubb_do_icesuper ) call endrun(subr//': clubb_do_icesuper=.true. not available when compiling with OpenACC') if ( single_column .and. .not. scm_cambfb_mode ) then call endrun(subr//': (single_column && !scm_cambfb_mode)=.true. not available when compiling with OpenACC') @@ -2593,28 +2579,28 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & itim_old = pbuf_old_tim_idx() ! Establish associations between pointers and physics buffer fields - call pbuf_get_field(pbuf, wp2_idx, wp2_pbuf ) - call pbuf_get_field(pbuf, wp3_idx, wp3_pbuf ) - call pbuf_get_field(pbuf, wpthlp_idx, wpthlp_pbuf ) - call pbuf_get_field(pbuf, wprtp_idx, wprtp_pbuf ) - call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp_pbuf ) - call pbuf_get_field(pbuf, rtp2_idx, rtp2_pbuf ) - call pbuf_get_field(pbuf, thlp2_idx, thlp2_pbuf ) - call pbuf_get_field(pbuf, up2_idx, up2_pbuf ) - call pbuf_get_field(pbuf, vp2_idx, vp2_pbuf ) - - call pbuf_get_field(pbuf, rtp3_idx, rtp3_pbuf ) - call pbuf_get_field(pbuf, thlp3_idx, thlp3_pbuf ) - call pbuf_get_field(pbuf, up3_idx, up3_pbuf ) - call pbuf_get_field(pbuf, vp3_idx, vp3_pbuf ) - - call pbuf_get_field(pbuf, upwp_idx, upwp_pbuf ) - call pbuf_get_field(pbuf, vpwp_idx, vpwp_pbuf ) - call pbuf_get_field(pbuf, wpthvp_idx, wpthvp_pbuf) - call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp_pbuf) - call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp_pbuf) - call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp_pbuf) - call pbuf_get_field(pbuf, rcm_idx, rcm_pbuf) + call pbuf_get_field(pbuf, wp2_idx, wp2_pbuf ) + call pbuf_get_field(pbuf, wp3_idx, wp3_pbuf ) + call pbuf_get_field(pbuf, wpthlp_idx, wpthlp_pbuf ) + call pbuf_get_field(pbuf, wprtp_idx, wprtp_pbuf ) + call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp_pbuf ) + call pbuf_get_field(pbuf, rtp2_idx, rtp2_pbuf ) + call pbuf_get_field(pbuf, thlp2_idx, thlp2_pbuf ) + call pbuf_get_field(pbuf, up2_idx, up2_pbuf ) + call pbuf_get_field(pbuf, vp2_idx, vp2_pbuf ) + + call pbuf_get_field(pbuf, rtp3_idx, rtp3_pbuf ) + call pbuf_get_field(pbuf, thlp3_idx, thlp3_pbuf ) + call pbuf_get_field(pbuf, up3_idx, up3_pbuf ) + call pbuf_get_field(pbuf, vp3_idx, vp3_pbuf ) + + call pbuf_get_field(pbuf, upwp_idx, upwp_pbuf ) + call pbuf_get_field(pbuf, vpwp_idx, vpwp_pbuf ) + call pbuf_get_field(pbuf, wpthvp_idx, wpthvp_pbuf) + call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp_pbuf) + call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp_pbuf) + call pbuf_get_field(pbuf, thlpthvp_idx, thlpthvp_pbuf) + call pbuf_get_field(pbuf, rcm_idx, rcm_pbuf) call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1_pbuf ) call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2_pbuf ) @@ -2622,20 +2608,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2_pbuf ) call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac_pbuf ) - call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp_pbuf) - call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp_pbuf) - call pbuf_get_field(pbuf, uprcp_idx, uprcp_pbuf) - call pbuf_get_field(pbuf, vprcp_idx, vprcp_pbuf) - call pbuf_get_field(pbuf, rc_coef_zm_idx, rc_coef_zm_pbuf) - call pbuf_get_field(pbuf, wp4_idx, wp4_pbuf) - call pbuf_get_field(pbuf, wpup2_idx, wpup2_pbuf) - call pbuf_get_field(pbuf, wpvp2_idx, wpvp2_pbuf) - call pbuf_get_field(pbuf, wp2up2_idx, wp2up2_pbuf) - call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2_pbuf) - call pbuf_get_field(pbuf, thlm_idx, thlm_pbuf ) - call pbuf_get_field(pbuf, rtm_idx, rtm_pbuf ) - call pbuf_get_field(pbuf, um_idx, um_pbuf ) - call pbuf_get_field(pbuf, vm_idx, vm_pbuf ) + call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp_pbuf ) + call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp_pbuf ) + call pbuf_get_field(pbuf, uprcp_idx, uprcp_pbuf ) + call pbuf_get_field(pbuf, vprcp_idx, vprcp_pbuf ) + call pbuf_get_field(pbuf, rc_coef_zm_idx, rc_coef_zm_pbuf ) + call pbuf_get_field(pbuf, wp4_idx, wp4_pbuf ) + call pbuf_get_field(pbuf, wpup2_idx, wpup2_pbuf ) + call pbuf_get_field(pbuf, wpvp2_idx, wpvp2_pbuf ) + call pbuf_get_field(pbuf, wp2up2_idx, wp2up2_pbuf ) + call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2_pbuf ) + call pbuf_get_field(pbuf, thlm_idx, thlm_pbuf ) + call pbuf_get_field(pbuf, rtm_idx, rtm_pbuf ) + call pbuf_get_field(pbuf, um_idx, um_pbuf ) + call pbuf_get_field(pbuf, vm_idx, vm_pbuf ) call pbuf_get_field(pbuf, tke_idx, tke_pbuf) call pbuf_get_field(pbuf, qrl_idx, qrl_pbuf) @@ -2650,16 +2636,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, qsatfac_idx, qsatfac_pbuf) - call pbuf_get_field(pbuf, prer_evap_idx, prer_evap_pbuf) - call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_pbuf) - call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac_pbuf) - call pbuf_get_field(pbuf, relvar_idx, relvar_pbuf) - call pbuf_get_field(pbuf, dp_frac_idx, deepcu_pbuf) - call pbuf_get_field(pbuf, sh_frac_idx, shalcu_pbuf) - call pbuf_get_field(pbuf, kvh_idx, khzm_pbuf) - call pbuf_get_field(pbuf, pblh_idx, pblh_pbuf) - call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr_pbuf) - call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh_pbuf) + call pbuf_get_field(pbuf, prer_evap_idx, prer_evap_pbuf) + call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_pbuf) + call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac_pbuf) + call pbuf_get_field(pbuf, relvar_idx, relvar_pbuf) + call pbuf_get_field(pbuf, dp_frac_idx, deepcu_pbuf) + call pbuf_get_field(pbuf, sh_frac_idx, shalcu_pbuf) + call pbuf_get_field(pbuf, kvh_idx, khzm_pbuf) + call pbuf_get_field(pbuf, pblh_idx, pblh_pbuf) + call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr_pbuf) + call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh_pbuf) ! SILHS covariance contributions call pbuf_get_field(pbuf, rtp2_mc_zt_idx, rtp2_mc_zt_pbuf) @@ -2907,21 +2893,21 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Define forcings from CAM to CLUBB as zero for momentum and thermo, ! forcings already applied through CAM - thlm_forcing(i,k) = 0._r8 - rtm_forcing(i,k) = 0._r8 - um_forcing(i,k) = 0._r8 - vm_forcing(i,k) = 0._r8 - - rtm_ref(i,k) = 0.0_r8 - thlm_ref(i,k) = 0.0_r8 - um_ref(i,k) = 0.0_r8 - vm_ref(i,k) = 0.0_r8 - ug(i,k) = 0.0_r8 - vg(i,k) = 0.0_r8 + thlm_forcing(i,k) = 0._r8 + rtm_forcing(i,k) = 0._r8 + um_forcing(i,k) = 0._r8 + vm_forcing(i,k) = 0._r8 + + rtm_ref(i,k) = 0.0_r8 + thlm_ref(i,k) = 0.0_r8 + um_ref(i,k) = 0.0_r8 + vm_ref(i,k) = 0.0_r8 + ug(i,k) = 0.0_r8 + vg(i,k) = 0.0_r8 ! Perturbed winds are not used in CAM - um_pert_inout(i,k) = 0.0_r8 - vm_pert_inout(i,k) = 0.0_r8 + um_pert_inout(i,k) = 0.0_r8 + vm_pert_inout(i,k) = 0.0_r8 end do end do @@ -2951,7 +2937,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(3) default(present) do sclr = 1, sclr_dim do k = 1, nzt_clubb - do i=1, ncol + do i = 1, ncol sclrm(i,k,sclr) = 0._r8 sclrp3(i,k,sclr) = 0._r8 sclrm_forcing(i,k,sclr) = 0._r8 @@ -2963,7 +2949,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(3) default(present) do sclr = 1, sclr_dim do k = 1, nzm_clubb - do i=1, ncol + do i = 1, ncol wpsclrp(i,k,sclr) = 0._r8 sclrp2(i,k,sclr) = 0._r8 sclrprtp(i,k,sclr) = 0._r8 @@ -2975,7 +2961,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector collapse(2) default(present) do sclr = 1, sclr_dim - do i=1, ncol + do i = 1, ncol wpsclrp_sfc(i,sclr) = 0._r8 end do end do @@ -3004,9 +2990,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if ( hydromet_dim > 0 ) then !$acc parallel loop gang vector collapse(3) default(present) - do ixind=1, hydromet_dim - do k=1, nzt_clubb - do i=1, ncol + do ixind = 1, hydromet_dim + do k = 1, nzt_clubb + do i = 1, ncol wp2hmp(i,k,ixind) = 0._r8 rtphmp_zt(i,k,ixind) = 0._r8 thlphmp_zt(i,k,ixind) = 0._r8 @@ -3015,9 +3001,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do !$acc parallel loop gang vector collapse(3) default(present) - do ixind=1, hydromet_dim - do k=1, nzm_clubb - do i=1, ncol + do ixind = 1, hydromet_dim + do k = 1, nzm_clubb + do i = 1, ncol wphydrometp(i,k,ixind) = 0._r8 end do end do @@ -3052,11 +3038,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do call t_startf('clubb_tend_cam:ice_macro_tend') - call ice_macro_tend(naai_pbuf(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & - state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), & - state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), & - latsub, hdtime, stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & - qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver), ncol * nzt_clubb ) + call ice_macro_tend( ncol * nzt_clubb, latsub, hdtime, & ! in + naai_pbuf(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & ! in + state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), & ! in + state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), & ! in + stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & ! out + qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver) ) ! out call t_stopf('clubb_tend_cam:ice_macro_tend') ! update local copy of state with the tendencies @@ -3092,22 +3079,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if ( clubb_do_adv ) then if (macmic_it == 1) then - + ! Note that some of the moments below can be positive or negative. ! Remove a constant that was added to prevent dynamics from clipping ! them to prevent dynamics from making them positive. - do k = 1, nzm_clubb-1 + do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - thlp2_pbuf(i,k) = state1%q(i,k_cam, ixthlp2) - rtp2_pbuf(i,k) = state1%q(i,k_cam, ixrtp2) rtpthlp_pbuf(i,k) = state1%q(i,k_cam,ixrtpthlp) - ( rtpthlp_const * apply_const ) wpthlp_pbuf(i,k) = state1%q(i,k_cam, ixwpthlp) - ( wpthlp_const * apply_const ) wprtp_pbuf(i,k) = state1%q(i,k_cam, ixwprtp) - ( wprtp_const * apply_const ) - wp2_pbuf(i,k) = state1%q(i,k_cam, ixwp2) wp3_pbuf(i,k) = state1%q(i,k_cam, ixwp3) - ( wp3_const * apply_const ) - up2_pbuf(i,k) = state1%q(i,k_cam, ixup2) - vp2_pbuf(i,k) = state1%q(i,k_cam, ixvp2) + wp2_pbuf(i,k) = max( w_tol_sqd, state1%q(i,k_cam, ixwp2) ) + thlp2_pbuf(i,k) = max( thl_tol**2, state1%q(i,k_cam, ixthlp2) ) + rtp2_pbuf(i,k) = max( rt_tol**2, state1%q(i,k_cam, ixrtp2) ) + up2_pbuf(i,k) = max( w_tol_sqd, state1%q(i,k_cam, ixup2) ) + vp2_pbuf(i,k) = max( w_tol_sqd, state1%q(i,k_cam, ixvp2) ) enddo enddo @@ -3121,17 +3108,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & apply_const = 0._r8 endif - do i = 1, ncol - thlp2_pbuf(i,nzm_clubb) = thlp2_pbuf(i,nzm_clubb-1) - rtp2_pbuf(i,nzm_clubb) = rtp2_pbuf(i,nzm_clubb-1) - rtpthlp_pbuf(i,nzm_clubb) = rtpthlp_pbuf(i,nzm_clubb-1) - wpthlp_pbuf(i,nzm_clubb) = wpthlp_pbuf(i,nzm_clubb-1) - wprtp_pbuf(i,nzm_clubb) = wprtp_pbuf(i,nzm_clubb-1) - wp2_pbuf(i,nzm_clubb) = wp2_pbuf(i,nzm_clubb-1) - up2_pbuf(i,nzm_clubb) = up2_pbuf(i,nzm_clubb-1) - vp2_pbuf(i,nzm_clubb) = vp2_pbuf(i,nzm_clubb-1) - end do - endif !$acc parallel loop gang vector collapse(2) default(present) @@ -3142,8 +3118,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do ! Compute thermodynamic stuff needed for CLUBB on thermo levels. - ! Inputs for the momentum levels are set below setup_clubb core - ! Flipped grid calcs !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, ncol @@ -3152,21 +3126,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dz_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,k_cam+1) ! compute thickness - ! At each CLUBB call, initialize mean momentum and thermo CLUBB state - ! from the CAM state rtm_pbuf(i,k) = state1%q(i,k_cam,ixq) + state1%q(i,k_cam,ixcldliq) ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables ! (such as thlm), use "invrs_exner_zt" otherwise use the exner in state - invrs_exner_zt(i,k) = 1._r8 / ( ( state1%pmid(i,k_cam) / p0_clubb )**( rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) ) ) + invrs_exner_zt(i,k) = 1._r8 / ( ( state1%pmid(i,k_cam) / p0_clubb ) & + **( rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) ) ) - thlm_pbuf(i,k) = ( state1%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) * state1%q(i,k_cam,ixcldliq) ) & + thlm_pbuf(i,k) = ( state1%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) & + * state1%q(i,k_cam,ixcldliq) ) & * invrs_exner_zt(i,k) - um_pbuf(i,k) = state1%u(i,k_cam) - vm_pbuf(i,k) = state1%v(i,k_cam) ! Define the CLUBB thermodynamic grid (in units of m) zt_g(i,k) = state1%zm(i,k_cam) - state1%zi(i,pverp) @@ -3176,7 +3148,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & invrs_rho_ds_zt(i,k) = 1._r8 / rho_ds_zt(i,k) ! full state (moist) variables - p_in_Pa(i,k) = state1%pmid(i,k_cam) exner(i,k) = 1._r8 / invrs_exner_zt(i,k) rho_zt(i,k) = rga*state1%pdel(i,k_cam)/dz_g(i,k) @@ -3184,17 +3155,19 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thv_ds_zt(i,k) = state1%t(i,k_cam) * invrs_exner_zt(i,k) & * (1._r8 + zvir * state1%q(i,k_cam,ixq) - state1%q(i,k_cam,ixcldliq)) - rfrzm(i,k) = state1%q(i,k_cam,ixcldice) ! Compute mean w wind on thermo grid, convert from omega to w wm_zt(i,k) = -1._r8*(state1%omega(i,k_cam)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) cloud_frac_inout(i,k) = cld_pbuf(i,k_cam) - pre_in(i,k) = prer_evap_pbuf(i,k_cam) - rvm_in(i,k) = state1%q(i,k_cam,ixq) - ! TODO: are we sure we want to overwrite this each timestep? it's an inout - ! if so, we can remove it from pbuf + um_pbuf(i,k) = state1%u(i,k_cam) + vm_pbuf(i,k) = state1%v(i,k_cam) + rfrzm(i,k) = state1%q(i,k_cam,ixcldice) + p_in_Pa(i,k) = state1%pmid(i,k_cam) + + ! TODO: Are we sure we want to overwrite this each timestep? it's an inout. + ! If so, we can remove it from pbuf rcm_pbuf(i,k) = state1%q(i,k_cam,ixcldliq) end do @@ -3203,21 +3176,21 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i = 1, ncol - deltaz(i) = state1%zi(i,pverp-1) - state1%zi(i,pverp) + deltaz(i) = state1%zi(i,pverp-1) - state1%zi(i,pverp) ! For consistency, set surface pressure to p_in_Pa at the first thermo. ! level above the surface (according to the CLUBB ascending grid). - p_sfc(i) = state1%pmid(i,pver) + p_sfc(i) = state1%pmid(i,pver) ! Set the elevation of the surface - sfc_elevation(i) = state1%zi(i,pverp) + sfc_elevation(i) = state1%zi(i,pverp) end do ! Define the CLUBB momentum grid (in height, units of m) !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzm_clubb - do i=1, ncol + do k = 1, nzm_clubb + do i = 1, ncol k_cam = top_lev - 1 + k zi_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,pverp) end do @@ -3240,7 +3213,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Calculate grid assuming a descending grid (cam grid), since we want to ! confine ascending behavior to advance_clubb_core call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - .false., grid_type, & ! intent(in) + .false., grid_type, & ! intent(in) deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) zi_g, zt_g, & ! intent(in) gr, err_info ) ! intent(inout) @@ -3319,7 +3292,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Surface fluxes provided by host model !$acc parallel loop gang vector default(present) - do i=1,ncol + do i = 1, ncol wpthlp_sfc(i) = cam_in%shf(i) / ( cpairv(i,pver,lchnk) * rho_ds_zm(i,nzm_clubb) ) & ! Sensible heat flux * invrs_exner_zt(i,nzt_clubb) wprtp_sfc(i) = cam_in%cflx(i,1) / rho_ds_zm(i,nzm_clubb) ! Moisture flux @@ -3385,7 +3358,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc update host( state1%u, state1%v, state1%t, state1%pmid, cam_in%wsx, cam_in%wsy, rrho ) ! Adjust surface stresses using winds from the prior macmic iteration - do i=1,ncol + do i = 1, ncol ubar = sqrt(state1%u(i,pver)**2+state1%v(i,pver)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 @@ -3403,7 +3376,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & else !$acc parallel loop gang vector default(present) - do i=1,ncol + do i = 1, ncol upwp_sfc(i) = cam_in%wsx(i) / rho_ds_zm(i,nzm_clubb) ! Surface meridional momentum flux vpwp_sfc(i) = cam_in%wsy(i) / rho_ds_zm(i,nzm_clubb) ! Surface zonal momentum flux end do @@ -3432,8 +3405,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! pressure,exner on momentum grid needed for mass flux calc. if (do_clubb_mf) then - do k=1,nzt_clubb - do i=1,ncol + do k = 1, nzt_clubb + do i = 1, ncol k_cam = top_lev - 1 + k kappa_zt(i,k) = rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) qc_zt(i,k) = state1%q(i,k_cam,ixcldliq) @@ -3442,8 +3415,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & kappa_zm = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, kappa_zt ) - do k=1,nzm_clubb - do i=1,ncol + do k = 1, nzm_clubb + do i = 1, ncol k_cam = top_lev - 1 + k p_in_Pa_zm(i,k) = state1%pint(i,k_cam) invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k)/p0_clubb)**kappa_zm(i,k) ) @@ -3452,30 +3425,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - if ( clubb_do_adv .and. macmic_it == 1 ) then - do k = 1, nzm_clubb - do i = 1, ncol - thlp2_pbuf(i,k) = max( thl_tol**2, thlp2_pbuf(i,k) ) - rtp2_pbuf(i,k) = max( rt_tol**2, rtp2_pbuf(i,k) ) - wp2_pbuf(i,k) = max( w_tol_sqd, wp2_pbuf(i,k) ) - up2_pbuf(i,k) = max( w_tol_sqd, up2_pbuf(i,k) ) - vp2_pbuf(i,k) = max( w_tol_sqd, vp2_pbuf(i,k) ) - end do - end do - end if - if ( edsclr_dim > 0 ) then - ! Do the same for tracers + ! Copy the cam version of the tracers to the clubb version + ! NOTE: if clubb_l_do_expldiff_rtm_thlm=.true., then the last two + ! tracers are thlm and rtm, which are added inside clubb icnt=0 - do ixind=1,pcnst + do ixind = 1, pcnst if (lq(ixind)) then icnt = icnt+1 !$acc parallel loop gang vector collapse(2) default(present) - do k=1,nzt_clubb - do i=1,ncol + do k = 1, nzt_clubb + do i = 1, ncol k_cam = top_lev - 1 + k edsclr_inout(i,k,icnt) = state1%q(i,k_cam,ixind) end do @@ -3484,23 +3447,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end do - if (clubb_l_do_expldiff_rtm_thlm) then - - !$acc parallel loop gang vector collapse(2) default(present) - do k=1,nzt_clubb - do i=1, ncol - k_cam = top_lev - 1 + k - edsclr_inout(i,k,icnt+1) = thlm_pbuf(i,k) - edsclr_inout(i,k,icnt+2) = rtm_pbuf(i,k) - end do - end do - - endif - end if !----------------------------------------- Substepping loop ----------------------------------------- - do t=1,nadv ! do needed number of "sub" timesteps for each CAM step + do t = 1, nadv ! do needed number of "sub" timesteps for each CAM step ! Increment the statistics then begin stats timestep if (stats_metadata%l_stats) then @@ -3524,9 +3474,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Ideally, integrate_mf would operate in descending mode, then we could remove the flipping. ! If the column loop gets pushed into it, we can also avoid the array slicing. - dz_g = dz_g(:,nzt_clubb:1:-1) - p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) - invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) + dz_g = dz_g(:,nzt_clubb:1:-1) + p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) + invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) um_pbuf = um_pbuf(:,nzt_clubb:1:-1) vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) @@ -3541,12 +3491,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & thlm_zm_in = thlm_zm_in(:,nzm_clubb:1:-1) rtm_zm_in = rtm_zm_in(:,nzm_clubb:1:-1) - do i=1, ncol + do i = 1, ncol call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um_pbuf(i,:), vm_pbuf(i,:), thlm_pbuf(i,:), rtm_pbuf(i,:), thv_ds_zt(i,:), & ! input - thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input - wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input + p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + um_pbuf(i,:), vm_pbuf(i,:), thlm_pbuf(i,:), rtm_pbuf(i,:), thv_ds_zt(i,:), & ! input + thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input + wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics @@ -3772,76 +3722,73 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2 (:,nzt_clubb:1:-1) - if ( t == 1 ) then - - ! we are in ascending mode, need to calculate ascending grid - call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - l_ascending_grid, grid_type, & ! intent(in) - deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) - zi_g(:,nzm_clubb:1:-1), zt_g(:,nzt_clubb:1:-1), & ! intent(in) - gr_a, err_info ) ! intent(inout) - end if - else - - if ( t == 1 ) then - ! not in ascending mode, so we calculate gr_a the same as gr - call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - l_ascending_grid, grid_type, & ! intent(in) - deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) - zi_g, zt_g, & ! intent(in) - gr_a, err_info ) ! intent(inout) - end if + + call cleanup_grid_api( gr ) + + ! we are in ascending mode, need to recalculate gr in ascending mode + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + l_ascending_grid, grid_type, & ! intent(in) + deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) + zi_g(:,nzm_clubb:1:-1), zt_g(:,nzt_clubb:1:-1), & ! intent(in) + gr, err_info ) ! intent(inout) end if + if ( pcols /= ncol ) then + print *, "pcols /= ncol", pcols, ncol + else + print *, "pcols == ncol", pcols, ncol + end if - call advance_clubb_core_api( gr_a, nzm_clubb, nzt_clubb, ncol, & ! ins - l_implemented, dtime, fcor(:ncol), sfc_elevation(:ncol), & + call advance_clubb_core_api( gr, nzm_clubb, nzt_clubb, ncol, & ! ins + l_implemented, dtime, fcor, sfc_elevation, & hydromet_dim, & sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & - thlm_forcing(:ncol,:), rtm_forcing(:ncol,:), um_forcing(:ncol,:), vm_forcing(:ncol,:), & - sclrm_forcing(:ncol,:,:), edsclrm_forcing(:ncol,:,:), wprtp_forcing(:ncol,:), & - wpthlp_forcing(:ncol,:), rtp2_forcing(:ncol,:), thlp2_forcing(:ncol,:), & - rtpthlp_forcing(:ncol,:), wm_zm(:ncol,:), wm_zt(:ncol,:), & - wpthlp_sfc(:ncol), wprtp_sfc(:ncol), upwp_sfc(:ncol), vpwp_sfc(:ncol), p_sfc(:ncol), & - wpsclrp_sfc(:ncol,:), wpedsclrp_sfc(:ncol,:), & - upwp_sfc_pert(:ncol), vpwp_sfc_pert(:ncol), & - rtm_ref(:ncol,:), thlm_ref(:ncol,:), um_ref(:ncol,:), vm_ref(:ncol,:), ug(:ncol,:), vg(:ncol,:), & - p_in_Pa(:ncol,:), rho_zm(:ncol,:), rho_zt(:ncol,:), exner(:ncol,:), & - rho_ds_zm(:ncol,:), rho_ds_zt(:ncol,:), invrs_rho_ds_zm(:ncol,:), & - invrs_rho_ds_zt(:ncol,:), thv_ds_zm(:ncol,:), thv_ds_zt(:ncol,:), & + thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & + sclrm_forcing, edsclrm_forcing, wprtp_forcing, & + wpthlp_forcing, rtp2_forcing, thlp2_forcing, & + rtpthlp_forcing, wm_zm, wm_zt, & + wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, p_sfc, & + wpsclrp_sfc, wpedsclrp_sfc, & + upwp_sfc_pert, vpwp_sfc_pert, & + rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, & + p_in_Pa, rho_zm, rho_zt, exner, & + rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, & hm_metadata%l_mix_rat_hm, & - rfrzm(:ncol,:), & - wphydrometp(:ncol,:,:), wp2hmp(:ncol,:,:), rtphmp_zt(:ncol,:,:), thlphmp_zt(:ncol,:,:), & - grid_dx(:ncol), grid_dy(:ncol), & - clubb_params(:ncol,:), nu_vert_res_dep, lmin, & + rfrzm, & + wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & + grid_dx, grid_dy, & + clubb_params, nu_vert_res_dep, lmin, & mixt_frac_max_mag, theta0, ts_nudge, & rtm_min, rtm_nudge_max_altitude, & clubb_config_flags, & stats_metadata, & stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! inouts - um_pbuf(:ncol,:), vm_pbuf(:ncol,:), upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), up2_pbuf(:ncol,:), vp2_pbuf(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & + um_pbuf(:ncol,:), vm_pbuf(:ncol,:), upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), & + up2_pbuf(:ncol,:), vp2_pbuf(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & thlm_pbuf(:ncol,:), rtm_pbuf(:ncol,:), wprtp_pbuf(:ncol,:), wpthlp_pbuf(:ncol,:), & - wp2_pbuf(:ncol,:), wp3_pbuf(:ncol,:), rtp2_pbuf(:ncol,:), rtp3_pbuf(:ncol,:), thlp2_pbuf(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_pbuf(:ncol,:), & - sclrm(:ncol,:,:), & - sclrp2(:ncol,:,:), sclrp3(:ncol,:,:), sclrprtp(:ncol,:,:), sclrpthlp(:ncol,:,:), & - wpsclrp(:ncol,:,:), edsclr_inout(:ncol,:,:), err_info, & - rcm_pbuf(:ncol,:), cloud_frac_inout(:ncol,:), & + wp2_pbuf(:ncol,:), wp3_pbuf(:ncol,:), rtp2_pbuf(:ncol,:), rtp3_pbuf(:ncol,:), & + thlp2_pbuf(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_pbuf(:ncol,:), & + sclrm, & + sclrp2, sclrp3, sclrprtp, sclrpthlp, & + wpsclrp, edsclr_inout, err_info, & + rcm_pbuf(:ncol,:), cloud_frac_inout, & wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & - sclrpthvp_inout(:ncol,:,:), & + sclrpthvp_inout, & wp2rtp_pbuf(:ncol,:), wp2thlp_pbuf(:ncol,:), uprcp_pbuf(:ncol,:), & vprcp_pbuf(:ncol,:), rc_coef_zm_pbuf(:ncol,:), & wp4_pbuf(:ncol,:), wpup2_pbuf(:ncol,:), wpvp2_pbuf(:ncol,:), & wp2up2_pbuf(:ncol,:), wp2vp2_pbuf(:ncol,:), ice_supersat_frac_pbuf(:ncol,:), & - um_pert_inout(:ncol,:), vm_pert_inout(:ncol,:), upwp_pert_inout(:ncol,:), vpwp_pert_inout(:ncol,:), & + um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & pdf_implicit_coefs_terms_chnk(lchnk), & - khzm_out(:ncol,:), khzt_out(:ncol,:), & ! outs - qclvar_out(:ncol,:), thlprcp_out(:ncol,:), & - wprcp_out(:ncol,:), w_up_in_cloud_out(:ncol,:), w_down_in_cloud_out(:ncol,:), & - cloudy_updraft_frac_out(:ncol,:), cloudy_downdraft_frac_out(:ncol,:), & - rcm_in_layer(:ncol,:), cloud_cover_out(:ncol,:), invrs_tau_zm_out(:ncol,:), & - Lscale(:ncol,:) ) + khzm_out, khzt_out, & ! outs + qclvar_out, thlprcp_out, & + wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, & + cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & + rcm_in_layer, cloud_cover_out, invrs_tau_zm_out, & + Lscale ) if ( l_ascending_grid ) then @@ -3999,6 +3946,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%corr_chi_eta_2 = pdf_params_chnk(lchnk)%corr_chi_eta_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%corr_w_chi_1 = pdf_params_chnk(lchnk)%corr_w_chi_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%corr_w_chi_2 = pdf_params_chnk(lchnk)%corr_w_chi_2 (:,nzt_clubb:1:-1) + + call cleanup_grid_api( gr ) + + ! recalculate descending grid + call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) + .false., grid_type, & ! intent(in) + deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) + zi_g, zt_g, & ! intent(in) + gr, err_info ) ! intent(inout) end if call t_stopf('clubb_tend_cam:advance_clubb_core_api') @@ -4014,9 +3970,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:do_rainturb') - do k=1,nzt_clubb - do i=1,ncol + do k = 1, nzt_clubb + do i = 1, ncol rvm_in(i,k) = rtm_pbuf(i,k) - rcm_pbuf(i,k) + pre_in(i,k) = prer_evap_pbuf(i,k_cam) end do end do @@ -4027,8 +3984,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_mc_out, wpthlp_mc_out, & rtpthlp_mc_out) - do k=1,nzm_clubb - do i=1,ncol + do k = 1, nzm_clubb + do i = 1, ncol dum1 = (1._r8 - cam_in%landfrac(i)) ! update turbulent moments based on rain evaporation @@ -4060,8 +4017,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rcm_pbuf(:ncol,:), thlprcp_out, qrl_clubb, clubb_params, & thlp2_rad ) - do k=1,nzm_clubb - do i=1, ncol + do k = 1, nzm_clubb + do i = 1, ncol thlp2_pbuf(i,k) = max( thl_tol**2, thlp2_pbuf(i,k) + thlp2_rad(i,k) * dtime ) end do end do @@ -4074,7 +4031,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! output arrays to make them conformable to CAM output if (stats_metadata%l_stats) then call t_startf('clubb_tend_cam:stats_end_timestep_clubb') - do i=1, ncol + do i = 1, ncol call stats_end_timestep_clubb(i, stats_zt(i), stats_zm(i), stats_rad_zt(i), stats_rad_zm(i), stats_sfc(i), & out_zt, out_zm, out_radzt, out_radzm, out_sfc) end do @@ -4084,30 +4041,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo ! end time loop !----------------------------------------- END substepping loop ----------------------------------------- - if ( clubb_do_adv .and. macmic_it == cld_macmic_num_steps ) then - do k=1,nzm_clubb - do i=1, ncol - thlp2_pbuf(i,k) = max( thl_tol**2, thlp2_pbuf(i,k) ) - rtp2_pbuf(i,k) = max( rt_tol**2, rtp2_pbuf(i,k) ) - wp2_pbuf(i,k) = max( w_tol_sqd, wp2_pbuf(i,k) ) - up2_pbuf(i,k) = max( w_tol_sqd, up2_pbuf(i,k) ) - vp2_pbuf(i,k) = max( w_tol_sqd, vp2_pbuf(i,k) ) - end do - end do - end if - !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzt_clubb - do i=1, ncol + do k = 1, nzt_clubb + do i = 1, ncol k_cam = top_lev - 1 + k - cld_pbuf(i,k_cam) = cloud_frac_inout(i,k) - qclvar_out(i,k) = min( 1._r8, qclvar_out(i,k) ) + qclvar_out(i,k) = min( 1._r8, qclvar_out(i,k) ) ! We should move this clipping inside clubb end do end do !$acc parallel loop gang vector collapse(2) default(present) - do k=1, nzm_clubb - do i=1, ncol + do k = 1, nzm_clubb + do i = 1, ncol k_cam = top_lev - 1 + k khzm_pbuf(i,k_cam) = khzm_out(i,k) @@ -4161,7 +4105,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Initialize clubbtop to top_lev, for finding the highlest level CLUBB is ! active for informing where to apply the energy fixer. !$acc parallel loop gang vector default(present) - do i=1, ncol + do i = 1, ncol clubbtop(i) = top_lev k_clubb = clubbtop(i) + 1 - top_lev do while ((rtp2_pbuf(i,k_clubb) <= 1.e-15_r8 .and. rcm_pbuf(i,k_clubb) == 0._r8) .and. clubbtop(i) < pver) @@ -4171,7 +4115,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do !$acc parallel loop gang vector default(present) - do i=1, ncol + do i = 1, ncol se_a = 0._r8 ke_a = 0._r8 @@ -4187,7 +4131,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! The error occured because we were zeroing out the [1:top_lev-1] values in ! in rcm_pbuf (when it still contained those levels), when it should've been ! set to state1%q(:,:,ixcldliq) and unchanged by clubb. - do k = 1, top_lev - 1 + do k = 1, top_lev-1 ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water ! after CLUBB is called. This is for energy conservation purposes. se_a = se_a + clubb_s(i,k)*state1%pdel(i,k)*rga @@ -4212,7 +4156,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Based on these integrals, compute the total energy after CLUBB call te_a = se_a + ke_a + (latvap+latice) * wv_a + latice * wl_a - do k=1, pver + do k = 1, pver ! Do the same as above, but for before CLUBB was called. se_b = se_b + state1%s(i,k)*state1%pdel(i,k)*rga ke_b = ke_b + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)*rga @@ -4244,9 +4188,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (clubb_do_energyfix) then !$acc parallel loop gang vector default(present) - do i=1, ncol + do i = 1, ncol - do k=clubbtop(i),pver + do k = clubbtop(i), pver clubb_s(i,k) = clubb_s(i,k) - se_dis(i)*gravit end do ! convert to units of +ve [K] @@ -4279,7 +4223,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! the ptend_loc%q terms would simplify to zero. I've left the (erroneous?) interaction ! for now to maintain BFBness do k = 1, top_lev-1 - do i=1, ncol + do i = 1, ncol ptend_loc%u(i,k) = 0.0_r8 ptend_loc%v(i,k) = 0.0_r8 ptend_loc%q(i,k,ixq) = ( state1%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness @@ -4291,13 +4235,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do do k = top_lev, pver - do i=1, ncol + do i = 1, ncol k_clubb = k + 1 - top_lev - ptend_loc%u(i,k) = (um_pbuf(i,k_clubb) - state1%u(i,k)) * invrs_hdtime ! east-west wind - ptend_loc%v(i,k) = (vm_pbuf(i,k_clubb) - state1%v(i,k)) * invrs_hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = (rtm_pbuf(i,k_clubb) - rcm_pbuf(i,k_clubb)-state1%q(i,k,ixq)) * invrs_hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = (rcm_pbuf(i,k_clubb) - state1%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy + ptend_loc%u(i,k) = ( um_pbuf(i,k_clubb) - state1%u(i,k)) * invrs_hdtime ! east-west wind + ptend_loc%v(i,k) = ( vm_pbuf(i,k_clubb) - state1%v(i,k)) * invrs_hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = ( rtm_pbuf(i,k_clubb) - rcm_pbuf(i,k_clubb) & + -state1%q(i,k,ixq) ) * invrs_hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = ( rcm_pbuf(i,k_clubb) - state1%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = ( clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy end do end do !--------------------------------- END TODO --------------------------------- @@ -4330,64 +4275,38 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then - ! Zero above top_lev - do k = 1, top_lev - 1 - do i=1, ncol - ptend_loc%q(i,k,ixthlp2) = 0.0_r8 - ptend_loc%q(i,k,ixrtp2) = 0.0_r8 - ptend_loc%q(i,k,ixrtpthlp) = 0.0_r8 - ptend_loc%q(i,k,ixwpthlp) = 0.0_r8 - ptend_loc%q(i,k,ixwprtp) = 0.0_r8 - ptend_loc%q(i,k,ixwp2) = 0.0_r8 - ptend_loc%q(i,k,ixwp3) = 0.0_r8 - ptend_loc%q(i,k,ixup2) = 0.0_r8 - ptend_loc%q(i,k,ixvp2) = 0.0_r8 - - end do - end do - do k = top_lev, pver - do i=1, ncol + do i = 1, ncol k_clubb = k + 1 - top_lev + thlp2_pbuf(i,k_clubb) = max( thl_tol**2, thlp2_pbuf(i,k_clubb) ) + rtp2_pbuf (i,k_clubb) = max( rt_tol**2, rtp2_pbuf(i,k_clubb) ) + wp2_pbuf (i,k_clubb) = max( w_tol_sqd, wp2_pbuf(i,k_clubb) ) + up2_pbuf (i,k_clubb) = max( w_tol_sqd, up2_pbuf(i,k_clubb) ) + vp2_pbuf (i,k_clubb) = max( w_tol_sqd, vp2_pbuf(i,k_clubb) ) + ! Here add a constant to moments which can be either positive or ! negative. This is to prevent clipping when dynamics tries to ! make all constituents positive - wp3_pbuf(i,k_clubb) = wp3_pbuf(i,k_clubb) + wp3_const + wp3_pbuf (i,k_clubb) = wp3_pbuf(i,k_clubb) + wp3_const rtpthlp_pbuf(i,k_clubb) = rtpthlp_pbuf(i,k_clubb) + rtpthlp_const - wpthlp_pbuf(i,k_clubb) = wpthlp_pbuf(i,k_clubb) + wpthlp_const - wprtp_pbuf(i,k_clubb) = wprtp_pbuf(i,k_clubb) + wprtp_const - - ptend_loc%q(i,k,ixthlp2) = (thlp2_pbuf(i,k_clubb) - state1%q(i,k,ixthlp2)) * invrs_hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2) = (rtp2_pbuf(i,k_clubb) - state1%q(i,k,ixrtp2)) * invrs_hdtime ! RTP Variance - ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp_pbuf(i,k_clubb) - state1%q(i,k,ixrtpthlp)) * invrs_hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp) = (wpthlp_pbuf(i,k_clubb) - state1%q(i,k,ixwpthlp)) * invrs_hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp) = (wprtp_pbuf(i,k_clubb) - state1%q(i,k,ixwprtp)) * invrs_hdtime ! WPRTP - ptend_loc%q(i,k,ixwp2) = (wp2_pbuf(i,k_clubb) - state1%q(i,k,ixwp2)) * invrs_hdtime ! WP2 - ptend_loc%q(i,k,ixwp3) = (wp3_pbuf(i,k_clubb) - state1%q(i,k,ixwp3)) * invrs_hdtime ! WP3 - ptend_loc%q(i,k,ixup2) = (up2_pbuf(i,k_clubb) - state1%q(i,k,ixup2)) * invrs_hdtime ! UP2 - ptend_loc%q(i,k,ixvp2) = (vp2_pbuf(i,k_clubb) - state1%q(i,k,ixvp2)) * invrs_hdtime ! VP2 + wpthlp_pbuf (i,k_clubb) = wpthlp_pbuf(i,k_clubb) + wpthlp_const + wprtp_pbuf (i,k_clubb) = wprtp_pbuf(i,k_clubb) + wprtp_const + + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp_pbuf(i,k_clubb) - state1%q(i,k,ixrtpthlp) ) * invrs_hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = ( wpthlp_pbuf(i,k_clubb) - state1%q(i,k,ixwpthlp) ) * invrs_hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = ( wprtp_pbuf(i,k_clubb) - state1%q(i,k,ixwprtp) ) * invrs_hdtime ! WPRTP + ptend_loc%q(i,k,ixwp3) = ( wp3_pbuf(i,k_clubb) - state1%q(i,k,ixwp3) ) * invrs_hdtime ! WP3 + ptend_loc%q(i,k,ixwp2) = ( wp2_pbuf(i,k_clubb) - state1%q(i,k,ixwp2) ) * invrs_hdtime ! WP2 + ptend_loc%q(i,k,ixthlp2) = ( thlp2_pbuf(i,k_clubb) - state1%q(i,k,ixthlp2) ) * invrs_hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = ( rtp2_pbuf(i,k_clubb) - state1%q(i,k,ixrtp2) ) * invrs_hdtime ! RTP Variance + ptend_loc%q(i,k,ixup2) = ( up2_pbuf(i,k_clubb) - state1%q(i,k,ixup2) ) * invrs_hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = ( vp2_pbuf(i,k_clubb) - state1%q(i,k,ixvp2) ) * invrs_hdtime ! VP2 end do end do - else - - do k=1, pver - do i=1, ncol - ptend_loc%q(i,k,ixthlp2) = 0._r8 - ptend_loc%q(i,k,ixrtp2) = 0._r8 - ptend_loc%q(i,k,ixrtpthlp) = 0._r8 - ptend_loc%q(i,k,ixwpthlp) = 0._r8 - ptend_loc%q(i,k,ixwprtp) = 0._r8 - ptend_loc%q(i,k,ixwp2) = 0._r8 - ptend_loc%q(i,k,ixwp3) = 0._r8 - ptend_loc%q(i,k,ixup2) = 0._r8 - ptend_loc%q(i,k,ixvp2) = 0._r8 - end do - end do - end if end if @@ -4396,7 +4315,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Loading up this array doesn't mean the tendencies are applied. ! edsclr_inout is compressed with just the constituents being used, ptend and state are not compressed icnt=0 - do ixind=1,pcnst + do ixind = 1, pcnst if (lq(ixind)) then icnt=icnt+1 if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& @@ -4407,15 +4326,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Zero out levels above top_lev - do k=1, top_lev-1 - do i=1, ncol + do k = 1, top_lev-1 + do i = 1, ncol ptend_loc%q(i,k,ixind) = 0._r8 end do end do ! Copy CLUBB's edsclr values - do k=top_lev, pver - do i=1, ncol + do k = top_lev, pver + do i = 1, ncol k_clubb = k + 1 - top_lev ptend_loc%q(i,k,ixind) = (edsclr_inout(i,k_clubb,icnt)-state1%q(i,k,ixind)) / hdtime ! transported constituents end do @@ -4425,13 +4344,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end do - rvmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - rcmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - rimtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - stend_clubb_output(:ncol,:pver) = ptend_loc%s(:ncol,:pver) - utend_clubb_output(:ncol,:pver) = ptend_loc%u(:ncol,:pver) - vtend_clubb_output(:ncol,:pver) = ptend_loc%v(:ncol,:pver) - cmeliq_pbuf(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + rvmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq) * state1%pdeldry(:ncol,:pver) / state1%pdel(:ncol,:pver) + rcmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq) * state1%pdeldry(:ncol,:pver) / state1%pdel(:ncol,:pver) + rimtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice) * state1%pdeldry(:ncol,:pver) / state1%pdel(:ncol,:pver) + cmeliq_pbuf (:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq) * state1%pdeldry(:ncol,:pver) / state1%pdel(:ncol,:pver) + stend_clubb_output (:ncol,:pver) = ptend_loc%s(:ncol,:pver) + utend_clubb_output (:ncol,:pver) = ptend_loc%u(:ncol,:pver) + vtend_clubb_output (:ncol,:pver) = ptend_loc%v(:ncol,:pver) ! ! set pbuf field so that HB scheme is only applied above CLUBB top @@ -4445,6 +4364,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! and compute output, etc ! ! ------------------------------------------------- ! + + print *, "ptend_all%ls = ", ptend_all%ls + print *, "ptend_all%llus = ", ptend_all%lu + print *, "ptend_all%lv = ", ptend_all%lv + print *, "ptend_all%lq = ", ptend_all%lq + call physics_ptend_sum(ptend_loc,ptend_all,ncol) call physics_update(state1,ptend_loc,hdtime) @@ -4537,8 +4462,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice) - do k=1,pver - do i=1,ncol + do k = 1, pver + do i = 1, ncol if( state1%t(i,k) > meltpt_temp ) then dum1 = 0.0_r8 @@ -4570,8 +4495,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep ! track of the integrals of ice and static energy that is effected from conversion to ice ! so that the energy checker doesn't complain. - det_s(i) = det_s(i) + ptend_loc%s(i,k)*state1%pdel(i,k)*rga - det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state1%pdeldry(i,k)*rga + det_s(i) = det_s(i) + ptend_loc%s(i,k) * state1%pdel(i,k) * rga + det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice) * state1%pdeldry(i,k) * rga enddo enddo @@ -4624,7 +4549,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif ! turbulent kinetic energy - do k = top_lev, pverp + do k = top_lev, pverp do i = 1, ncol k_clubb = k + 1 - top_lev tke_pbuf(i,k) = 0.5_r8 * ( up2_pbuf(i,k_clubb) + vp2_pbuf(i,k_clubb) + wp2_pbuf(i,k_clubb) ) @@ -4645,8 +4570,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = top_lev, pver do i = 1, ncol k_clubb = k + 1 - top_lev - alst_pbuf(i,k) = cld_pbuf(i,k) - qlst_pbuf(i,k) = rcm_pbuf(i,k_clubb) / max( 0.01_r8, alst_pbuf(i,k) ) ! Incloud stratus condensate mixing ratio + cld_pbuf (i,k) = cloud_frac_inout(i,k_clubb) + alst_pbuf(i,k) = cld_pbuf(i,k) + qlst_pbuf(i,k) = rcm_pbuf(i,k_clubb) / max( 0.01_r8, alst_pbuf(i,k) ) ! Incloud stratus condensate mixing ratio enddo enddo @@ -4659,8 +4585,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & deepcu_pbuf(:,:) = 0.0_r8 shalcu_pbuf(:,:) = 0.0_r8 - do k=1,pver-1 - do i=1,ncol + do k = 1, pver-1 + do i = 1, ncol ! diagnose the deep convective cloud fraction, as done in macrophysics based on the ! deep convective mass flux, read in from pbuf. Since shallow convection is never ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud @@ -4747,8 +4673,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! fraction that was coded in macrop_driver ! ! --------------------------------------------------------------------------------- ! - do k=1,pver - do i=1,ncol + do k = 1, pver + do i = 1, ncol ! Recompute net stratus fraction using maximum over-lapping assumption, as done ! in macrophysics code, using alst computed above and aist read in from physics buffer @@ -4767,8 +4693,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! DIAGNOSE THE PBL DEPTH ! ! this is needed for aerosol code ! ! --------------------------------------------------------------------------------- ! - do i=1,ncol - do k=1,pver + do i = 1, ncol + do k = 1, pver !subroutine pblind expects "Stull" definition of Exner th(i,k) = state1%t(i,k)*state1%exner(i,k) !thv should have condensate loading to be consistent with earlier def's in this module @@ -4905,8 +4831,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do - do k=1, nzt_clubb - do i=1, ncol + do k = 1, nzt_clubb + do i = 1, ncol mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) & * pdf_params_chnk(lchnk)%rt_1(i,k) & @@ -5084,7 +5010,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Output CLUBB history here if (stats_metadata%l_stats) then - do j=1,stats_zt(1)%num_output_fields + do j = 1, stats_zt(1)%num_output_fields temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name) sub = temp1 @@ -5093,7 +5019,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk ) enddo - do j=1,stats_zm(1)%num_output_fields + do j = 1, stats_zm(1)%num_output_fields temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name) sub = temp1 @@ -5103,16 +5029,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo if (stats_metadata%l_output_rad_files) then - do j=1,stats_rad_zt(1)%num_output_fields + do j = 1, stats_rad_zt(1)%num_output_fields call outfld(trim(stats_rad_zt(1)%file%grid_avg_var(j)%name), out_radzt(:,:,j), pcols, lchnk) enddo - do j=1,stats_rad_zm(1)%num_output_fields + do j = 1, stats_rad_zm(1)%num_output_fields call outfld(trim(stats_rad_zm(1)%file%grid_avg_var(j)%name), out_radzm(:,:,j), pcols, lchnk) enddo endif - do j=1,stats_sfc(1)%num_output_fields + do j = 1, stats_sfc(1)%num_output_fields call outfld(trim(stats_sfc(1)%file%grid_avg_var(j)%name), out_sfc(:,:,j), pcols, lchnk) enddo @@ -5171,12 +5097,12 @@ subroutine clubb_emissions_cam (state, cam_in, ptend) call physics_ptend_init(ptend,state%psetcols, "clubb emissions", lq=lq) ! Apply tracer fluxes to lowest model level (except water vapor) - do m = 2,pcnst + do m = 2, pcnst ptend%q(:ncol,pver,m) = cam_in%cflx(:ncol,m)*state%rpdel(:ncol,pver)*gravit end do ! Convert tendencies of dry constituents to dry basis. - do m = 2,pcnst + do m = 2, pcnst if (cnst_type(m).eq.'dry') then ptend%q(:ncol,pver,m) = ptend%q(:ncol,pver,m)*state%pdel(:ncol,pver)*state%rpdeldry(:ncol,pver) endif @@ -5190,7 +5116,9 @@ end subroutine clubb_emissions_cam ! Saturation adjustment for ice ! Add ice mass if supersaturated -subroutine ice_macro_tend(naai_pbuf,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend,nitend,vlen) +subroutine ice_macro_tend(vlen,xxls,deltat, & + naai_pbuf,t,p,qv,qi,ni,& + stend,qvtend,qitend,nitend) use wv_sat_methods, only: wv_sat_qsat_ice @@ -5242,81 +5170,79 @@ subroutine ice_macro_tend(naai_pbuf,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,qitend end subroutine ice_macro_tend #ifdef CLUBB_SGS -! ---------------------------------------------------------------------- -! -! DISCLAIMER : this code appears to be correct but has not been -! very thouroughly tested. If you do notice any -! anomalous behaviour then please contact Andy and/or -! Bjorn -! -! Function diag_ustar: returns value of ustar using the below -! similarity functions and a specified buoyancy flux (bflx) given in -! kinematic units -! -! phi_m (zeta > 0) = (1 + am * zeta) -! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4) -! -! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar) -! -! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface -! Layer, in Workshop on Micormeteorology, pages 67-100. -! -! Code writen March, 1999 by Bjorn Stevens -! - -real(r8) function diag_ustar( z, bflx, wnd, z0 ) - -use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g + ! ---------------------------------------------------------------------- + ! + ! DISCLAIMER : this code appears to be correct but has not been + ! very thouroughly tested. If you do notice any + ! anomalous behaviour then please contact Andy and/or + ! Bjorn + ! + ! Function diag_ustar: returns value of ustar using the below + ! similarity functions and a specified buoyancy flux (bflx) given in + ! kinematic units + ! + ! phi_m (zeta > 0) = (1 + am * zeta) + ! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4) + ! + ! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar) + ! + ! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface + ! Layer, in Workshop on Micormeteorology, pages 67-100. + ! + ! Code writen March, 1999 by Bjorn Stevens + ! -implicit none + real(r8) function diag_ustar( z, bflx, wnd, z0 ) -real(r8), parameter :: am = 4.8_r8 ! " " " -real(r8), parameter :: bm = 19.3_r8 ! " " " + use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g -real(r8), parameter :: grav = shr_const_g -real(r8), parameter :: vonk = shr_const_karman -real(r8), parameter :: pi = shr_const_pi + implicit none -real(r8), intent (in) :: z ! height where u locates -real(r8), intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) -real(r8), intent (in) :: wnd ! wind speed at z -real(r8), intent (in) :: z0 ! momentum roughness height + real(r8), parameter :: am = 4.8_r8 ! " " " + real(r8), parameter :: bm = 19.3_r8 ! " " " + real(r8), parameter :: grav = shr_const_g + real(r8), parameter :: vonk = shr_const_karman + real(r8), parameter :: pi = shr_const_pi -integer :: iterate -real(r8) :: lnz, klnz, c1, x, psi1, zeta, lmo, ustar + real(r8), intent (in) :: z ! height where u locates + real(r8), intent (in) :: bflx ! surface buoyancy flux (m^2/s^3) + real(r8), intent (in) :: wnd ! wind speed at z + real(r8), intent (in) :: z0 ! momentum roughness height -lnz = log( z / z0 ) -klnz = vonk/lnz -c1 = pi / 2.0_r8 - 3.0_r8*log( 2.0_r8 ) -ustar = wnd*klnz -if (abs(bflx) > 1.e-6_r8) then - do iterate=1,4 + integer :: iterate + real(r8) :: lnz, klnz, c1, x, psi1, zeta, lmo, ustar - if (ustar > 1.e-6_r8) then - lmo = -ustar**3 / ( vonk * bflx ) - zeta = z/lmo - if (zeta > 0._r8) then - ustar = vonk*wnd /(lnz + am*zeta) - else - x = sqrt( sqrt( 1.0_r8 - bm*zeta ) ) - psi1 = 2._r8*log( 1.0_r8+x ) + log( 1.0_r8+x*x ) - 2._r8*atan( x ) + c1 - ustar = wnd*vonk/(lnz - psi1) - end if + lnz = log( z / z0 ) + klnz = vonk/lnz + c1 = pi / 2.0_r8 - 3.0_r8*log( 2.0_r8 ) - endif + ustar = wnd*klnz + if (abs(bflx) > 1.e-6_r8) then + do iterate = 1, 4 - end do -end if + if (ustar > 1.e-6_r8) then + lmo = -ustar**3 / ( vonk * bflx ) + zeta = z/lmo + if (zeta > 0._r8) then + ustar = vonk*wnd /(lnz + am*zeta) + else + x = sqrt( sqrt( 1.0_r8 - bm*zeta ) ) + psi1 = 2._r8*log( 1.0_r8+x ) + log( 1.0_r8+x*x ) - 2._r8*atan( x ) + c1 + ustar = wnd*vonk/(lnz - psi1) + end if + endif -diag_ustar = ustar + end do + end if -return + diag_ustar = ustar + return -end function diag_ustar + end function diag_ustar #endif ! =============================================================================== ! @@ -5979,8 +5905,8 @@ subroutine stats_avg( kk, num_output_fields, x, n ) ! Compute averages - do m=1,num_output_fields - do k=1,kk + do m = 1, num_output_fields + do k = 1, kk if ( n(1,1,k,m) > 0 ) then x(1,1,k,m) = x(1,1,k,m) / real( n(1,1,k,m) ) @@ -6012,7 +5938,7 @@ subroutine grid_size(state, grid_dx, grid_dy) integer :: i ! determine the column area in radians - do i=1,state%ncol + do i = 1, state%ncol column_area = get_area_p(state%lchnk,i) degree = sqrt(column_area)*(180._r8/shr_const_pi) diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index ffed8cd3dd..850f25802e 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -602,7 +602,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) #ifdef CLUBB_SGS #ifdef SILHS - use clubb_intr, only: , & + use clubb_intr, only: & ztodt ! model timestep use clubb_api_module, only : setup_pdf_parameters_api, & From a28d1e14d9879e4793cb0eecaa4bb854f74a89a7 Mon Sep 17 00:00:00 2001 From: Gunther Huebler Date: Thu, 27 Nov 2025 12:20:14 -0600 Subject: [PATCH 17/29] Fixing GPU code so that it runs to completion, correctness on GPU not confirmed yet. --- src/physics/cam/clubb_intr.F90 | 251 +++++++++++++++++---------------- 1 file changed, 126 insertions(+), 125 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 355b8bb732..28ec83a800 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1788,7 +1788,7 @@ subroutine clubb_ini_cam(pbuf_ini) call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle = .true. ) call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height', sampled_on_subcycle=.true.) - call addfld ('pdfp_rtp2_output_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2', 'PDF Rtot Variance', sampled_on_subcycle=.true.) + call addfld ('PDFP_RTP2_CLUBB', (/ 'lev' /), 'A', 'kg^2/kg^2', 'PDF Rtot Variance', sampled_on_subcycle=.true.) call addfld ('QCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) call addfld ('NCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment', sampled_on_subcycle=.true.) @@ -1894,7 +1894,7 @@ subroutine clubb_ini_cam(pbuf_ini) call add_default('WPRTP_CLUBB', 1, ' ') call add_default('RTP2_CLUBB', 1, ' ') call add_default('RTP2_ZT_CLUBB', 1, ' ') - call add_default('pdfp_rtp2_output_CLUBB', 1, ' ') + call add_default('PDFP_RTP2_CLUBB', 1, ' ') call add_default('THLP2_CLUBB', 1, ' ') call add_default('THLP2_ZT_CLUBB', 1, ' ') call add_default('RTPTHLP_CLUBB', 1, ' ') @@ -2330,7 +2330,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! MF local thermodynamic vars invrs_exner_zt,& ! thermodynamic grid - kappa_zt, qc_zt ! thermodynamic grid + kappa_zt ! thermodynamic grid real(r8), dimension(state%ncol,nzm_clubb) :: & thlp2_rad, & @@ -2355,8 +2355,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wprtp_mc_out, & wpthlp_mc_out, & rtpthlp_mc_out, & - uprcp_inout, & ! < u' r_c' > (momentum levels) - vprcp_inout, & ! < v' r_c' > (momentum levels) zi_g, & ! Momentum grid of CLUBB [m] ! MF Plume @@ -2794,38 +2792,35 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:NAR') call t_startf('clubb_tend_cam:acc_copyin') !$acc data copyin( sclr_idx, clubb_params_single_col, grid_dx, grid_dy, rairv, cpairv, qrl_pbuf, & - !$acc pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & + !$acc pdf_params_chnk(lchnk), & !$acc state1, state1%q, state1%u, state1%v, state1%t, state1%pmid, state1%s, state1%pint, & !$acc state1%zm, state1%zi, state1%pdeldry, state1%pdel, state1%omega, state1%phis, & !$acc cam_in, cam_in%shf, cam_in%wsx, cam_in%wsy, cam_in%cflx, & - !$acc rrho, prer_evap_pbuf, rtp2_mc_zt_pbuf, thlp2_mc_zt_pbuf, wprtp_mc_zt_pbuf, wpthlp_mc_zt_pbuf, rtpthlp_mc_zt_pbuf, & + !$acc prer_evap_pbuf, cld_pbuf, & + !$acc rtp2_mc_zt_pbuf, thlp2_mc_zt_pbuf, wprtp_mc_zt_pbuf, wpthlp_mc_zt_pbuf, rtpthlp_mc_zt_pbuf, & !$acc err_info, err_info%err_header ) & !$acc copy( um_pbuf, vm_pbuf, upwp_pbuf, vpwp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, & !$acc wp2_pbuf, wp3_pbuf, rtp2_pbuf, thlp2_pbuf, rtp3_pbuf, thlp3_pbuf, thlm_pbuf, rtm_pbuf, wprtp_pbuf, wpthlp_pbuf, rtpthlp_pbuf, & - !$acc pdf_zm_w_1_pbuf, pdf_zm_w_2_pbuf, pdf_zm_varnce_w_1_pbuf, pdf_zm_varnce_w_2_pbuf, pdf_zm_mixt_frac_pbuf, & !$acc wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & - !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf, & - !$acc pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & - !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & - !$acc pdf_params_zm_chnk(lchnk)%mixt_frac ) & - !$acc copyout( temp2d, & - !$acc rcm_pbuf, khzm_pbuf, dz_g, & - !$acc clubbtop, se_dis, eleak, clubb_s ) & + !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) & + !$acc copyout( rcm_pbuf, khzm_pbuf, qclvar_out, rcm_in_layer, & + !$acc clubbtop, se_dis, eleak, clubb_s, cloud_frac_inout, wprcp_out, zi_g, & + !$acc zt_g, wm_zt, pdf_params_chnk(lchnk)%mixt_frac, pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & + !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2 ) & !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & - !$acc fcor, & - !$acc thlp3_in, rvm_in, cloud_frac_inout, & - !$acc uprcp_inout, vprcp_inout, & - !$acc pre_in, kappa_zt, qc_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & - !$acc invrs_exner_zm, cloud_cover_out, rcm_in_layer, wprcp_out, & - !$acc qclvar_out, w_up_in_cloud_out, cloudy_downdraft_frac_out, & + !$acc fcor, dz_g, & + !$acc rvm_in, & + !$acc pre_in, kappa_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & + !$acc invrs_exner_zm, cloud_cover_out, & + !$acc w_up_in_cloud_out, cloudy_downdraft_frac_out, & !$acc w_down_in_cloud_out, invrs_tau_zm_out, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & !$acc thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & !$acc wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, & - !$acc rtpthlp_forcing, wm_zm, wm_zt, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, & + !$acc rtpthlp_forcing, wm_zm, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, & !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, & !$acc wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & - !$acc thlprcp_out, deltaz, zi_g, zt_g, qrl_clubb, p_sfc, & + !$acc thlprcp_out, deltaz, qrl_clubb, p_sfc, & !$acc err_info%err_code, & !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & @@ -2848,8 +2843,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc pdf_params_chnk(lchnk)%corr_chi_eta_2, pdf_params_chnk(lchnk)%rsatl_1, & !$acc pdf_params_chnk(lchnk)%rsatl_2, pdf_params_chnk(lchnk)%rc_1, pdf_params_chnk(lchnk)%rc_2, & !$acc pdf_params_chnk(lchnk)%cloud_frac_1, pdf_params_chnk(lchnk)%cloud_frac_2, & - !$acc pdf_params_chnk(lchnk)%mixt_frac, pdf_params_chnk(lchnk)%ice_supersat_frac_1, & - !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_2, & + !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_1, & + !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_2 ) + + !$acc data if ( clubb_config_flags%l_call_pdf_closure_twice ) & + !$acc copyin( pdf_params_zm_chnk(lchnk) ) & + !$acc copy( pdf_zm_w_1_pbuf, pdf_zm_w_2_pbuf, pdf_zm_varnce_w_1_pbuf, pdf_zm_varnce_w_2_pbuf, pdf_zm_mixt_frac_pbuf ) & + !$acc create( pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & + !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & + !$acc pdf_params_zm_chnk(lchnk)%mixt_frac, & !$acc pdf_params_zm_chnk(lchnk)%rt_1, pdf_params_zm_chnk(lchnk)%rt_2, & !$acc pdf_params_zm_chnk(lchnk)%varnce_rt_1, pdf_params_zm_chnk(lchnk)%varnce_rt_2, & !$acc pdf_params_zm_chnk(lchnk)%thl_1, pdf_params_zm_chnk(lchnk)%thl_2, & @@ -3124,9 +3126,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k - dz_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,k_cam+1) ! compute thickness + ! Define the CLUBB thermodynamic grid (in units of m) + zt_g(i,k) = state1%zm(i,k_cam) - state1%zi(i,pverp) - rtm_pbuf(i,k) = state1%q(i,k_cam,ixq) + state1%q(i,k_cam,ixcldliq) + dz_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,k_cam+1) ! compute thickness ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent @@ -3135,14 +3138,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & invrs_exner_zt(i,k) = 1._r8 / ( ( state1%pmid(i,k_cam) / p0_clubb ) & **( rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) ) ) - thlm_pbuf(i,k) = ( state1%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) & - * state1%q(i,k_cam,ixcldliq) ) & - * invrs_exner_zt(i,k) - - - ! Define the CLUBB thermodynamic grid (in units of m) - zt_g(i,k) = state1%zm(i,k_cam) - state1%zi(i,pverp) - ! base state (dry) variables rho_ds_zt(i,k) = rga * ( state1%pdeldry(i,k_cam) / dz_g(i,k) ) invrs_rho_ds_zt(i,k) = 1._r8 / rho_ds_zt(i,k) @@ -3159,17 +3154,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Compute mean w wind on thermo grid, convert from omega to w wm_zt(i,k) = -1._r8*(state1%omega(i,k_cam)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) + rfrzm(i,k) = state1%q(i,k_cam,ixcldice) + p_in_Pa(i,k) = state1%pmid(i,k_cam) + cloud_frac_inout(i,k) = cld_pbuf(i,k_cam) + ! If we're overwriting these each call, there's no need to store them in pbuf. Right? um_pbuf(i,k) = state1%u(i,k_cam) vm_pbuf(i,k) = state1%v(i,k_cam) - rfrzm(i,k) = state1%q(i,k_cam,ixcldice) - p_in_Pa(i,k) = state1%pmid(i,k_cam) - - ! TODO: Are we sure we want to overwrite this each timestep? it's an inout. - ! If so, we can remove it from pbuf rcm_pbuf(i,k) = state1%q(i,k_cam,ixcldliq) + rtm_pbuf(i,k) = state1%q(i,k_cam,ixq) + state1%q(i,k_cam,ixcldliq) + + thlm_pbuf(i,k) = ( state1%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) & + * state1%q(i,k_cam,ixcldliq) ) & + * invrs_exner_zt(i,k) + end do end do @@ -3409,7 +3409,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol k_cam = top_lev - 1 + k kappa_zt(i,k) = rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) - qc_zt(i,k) = state1%q(i,k_cam,ixcldliq) end do end do @@ -4054,18 +4053,23 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol k_cam = top_lev - 1 + k khzm_pbuf(i,k_cam) = khzm_out(i,k) + end do + end do - ! pdf_params_zm_chnk is already persistent across calls, but we - ! save a pbuf version for restarts - if ( clubb_config_flags%l_call_pdf_closure_twice ) then + ! pdf_params_zm_chnk is already persistent across calls, but we + ! save a pbuf version for restarts + if ( clubb_config_flags%l_call_pdf_closure_twice ) then + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzm_clubb + do i = 1, ncol pdf_zm_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_1(i,k) pdf_zm_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%w_2(i,k) pdf_zm_varnce_w_1_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) pdf_zm_varnce_w_2_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) pdf_zm_mixt_frac_pbuf(i,k) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) - end if + end do end do - end do + end if !---- TODO: there seems to a an above top_lev interaction here that changes answers. ! The error occured because we were zeroing out the [1:top_lev-1] values in @@ -4209,6 +4213,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc end data !$acc end data !$acc end data + !$acc end data call t_stopf('clubb_tend_cam:acc_copyout') call t_startf('clubb_tend_cam:NAR') @@ -4776,28 +4781,27 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! density rho(1:ncol,1:pver) = rga*state1%pdel(1:ncol,1:pver)/(state1%zi(1:ncol,1:pver)-state1%zi(1:ncol,2:pverp)) - rho(1:ncol,pverp) = rho(1:ncol,pver) + rho(1:ncol,pverp) = rho(1:ncol,pver) do k = top_lev, pverp do i = 1, ncol k_clubb = k + 1 - top_lev - zi_output(i,k) = zi_g(i,k_clubb) - - wp2_output(i,k) = wp2_pbuf(i,k_clubb) - up2_output(i,k) = up2_pbuf(i,k_clubb) - vp2_output(i,k) = vp2_pbuf(i,k_clubb) - upwp_output(i,k) = upwp_pbuf(i,k_clubb) - vpwp_output(i,k) = vpwp_pbuf(i,k_clubb) - rtp2_output(i,k) = rtp2_pbuf(i,k_clubb) - wprcp_clubb_output(i,k) = wprcp_out(i,k_clubb) * latvap - wpthvp_clubb_output(i,k) = wpthvp_pbuf(i,k_clubb) * cpair - thlp2_output(i,k) = thlp2_pbuf(i,k_clubb) - - wpthlp_output(i,k) = (wpthlp_pbuf(i,k_clubb)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux - wprtp_output(i,k) = (wprtp_pbuf(i,k_clubb)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux - rtpthlp_output(i,k) = rtpthlp_pbuf(i,k_clubb)-(apply_const*rtpthlp_const) ! rtpthlp output + zi_output(i,k) = zi_g(i,k_clubb) + wp2_output(i,k) = wp2_pbuf(i,k_clubb) + up2_output(i,k) = up2_pbuf(i,k_clubb) + vp2_output(i,k) = vp2_pbuf(i,k_clubb) + upwp_output(i,k) = upwp_pbuf(i,k_clubb) + vpwp_output(i,k) = vpwp_pbuf(i,k_clubb) + rtp2_output(i,k) = rtp2_pbuf(i,k_clubb) + wprcp_clubb_output(i,k) = wprcp_out(i,k_clubb) * latvap + wpthvp_clubb_output(i,k) = wpthvp_pbuf(i,k_clubb) * cpair + thlp2_output(i,k) = thlp2_pbuf(i,k_clubb) + + wpthlp_output(i,k) = ( wpthlp_pbuf(i,k_clubb) - (apply_const * wpthlp_const) ) * rho(i,k) * cpair ! liquid water potential temperature flux + wprtp_output(i,k) = ( wprtp_pbuf(i,k_clubb) - (apply_const * wprtp_const) ) * rho(i,k) * latvap ! total water mixig ratio flux + rtpthlp_output(i,k) = rtpthlp_pbuf(i,k_clubb) - (apply_const * rtpthlp_const) end do end do @@ -4812,21 +4816,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_clubb = k + 1 - top_lev - rcm_output(i,k) = rcm_pbuf(i,k_clubb) - rtm_output(i,k) = rtm_pbuf(i,k_clubb) - thlm_output(i,k) = thlm_pbuf(i,k_clubb) - um_output(i,k) = um_pbuf(i,k_clubb) - vm_output(i,k) = vm_pbuf(i,k_clubb) - - rcm_in_layer_output(i,k) = rcm_in_layer(i,k_clubb) - zt_output(i,k) = zt_g(i,k_clubb) - wm_zt_output(i,k) = wm_zt(i,k_clubb) - - rtp2_zt_output(i,k) = rtp2_zt(i,k_clubb) - thl2_zt_output(i,k) = thl2_zt(i,k_clubb) - wp2_zt_output(i,k) = wp2_zt(i,k_clubb) - - wp3_output(i,k) = wp3_pbuf(i,k_clubb) - (apply_const*wp3_const) ! wp3 output + rcm_output(i,k) = rcm_pbuf(i,k_clubb) + rtm_output(i,k) = rtm_pbuf(i,k_clubb) + thlm_output(i,k) = thlm_pbuf(i,k_clubb) + um_output(i,k) = um_pbuf(i,k_clubb) + vm_output(i,k) = vm_pbuf(i,k_clubb) + rcm_in_layer_output(i,k) = rcm_in_layer(i,k_clubb) + zt_output(i,k) = zt_g(i,k_clubb) + wm_zt_output(i,k) = wm_zt(i,k_clubb) + rtp2_zt_output(i,k) = rtp2_zt(i,k_clubb) + thl2_zt_output(i,k) = thl2_zt(i,k_clubb) + wp2_zt_output(i,k) = wp2_zt(i,k_clubb) + wp3_output(i,k) = wp3_pbuf(i,k_clubb) - (apply_const*wp3_const) end do end do @@ -4852,32 +4853,32 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, top_lev-1 do i = 1, ncol - wp2_output(i,k) = 0._r8 - up2_output(i,k) = 0._r8 - vp2_output(i,k) = 0._r8 - rtp2_output(i,k) = 0._r8 - thlp2_output(i,k) = 0._r8 - zt_output(i,k) = 0._r8 - rtp2_zt_output(i,k) = 0._r8 - wp3_output(i,k) = 0._r8 - thl2_zt_output(i,k) = 0._r8 - wp2_zt_output(i,k) = 0._r8 - rcm_in_layer_output(i,k) = 0._r8 - pdfp_rtp2_output(i,k) = 0._r8 - wm_zt_output(i,k) = 0._r8 - rcm_output(i,k) = 0._r8 - rtm_output(i,k) = 0._r8 - thlm_output(i,k) = 0._r8 - um_output(i,k) = 0._r8 - vm_output(i,k) = 0._r8 - zi_output(i,k) = 0._r8 - wpthlp_output(i,k) = 0._r8 - rtpthlp_output(i,k) = 0._r8 - wprtp_output(i,k) = 0._r8 - upwp_output(i,k) = 0._r8 - vpwp_output(i,k) = 0._r8 - wprcp_clubb_output(i,k) = 0._r8 - wpthvp_clubb_output(i,k) = 0._r8 + wp2_output(i,k) = 0._r8 + up2_output(i,k) = 0._r8 + vp2_output(i,k) = 0._r8 + rtp2_output(i,k) = 0._r8 + thlp2_output(i,k) = 0._r8 + zt_output(i,k) = 0._r8 + rtp2_zt_output(i,k) = 0._r8 + wp3_output(i,k) = 0._r8 + thl2_zt_output(i,k) = 0._r8 + wp2_zt_output(i,k) = 0._r8 + rcm_in_layer_output(i,k) = 0._r8 + pdfp_rtp2_output(i,k) = 0._r8 + wm_zt_output(i,k) = 0._r8 + rcm_output(i,k) = 0._r8 + rtm_output(i,k) = 0._r8 + thlm_output(i,k) = 0._r8 + um_output(i,k) = 0._r8 + vm_output(i,k) = 0._r8 + zi_output(i,k) = 0._r8 + wpthlp_output(i,k) = 0._r8 + rtpthlp_output(i,k) = 0._r8 + wprtp_output(i,k) = 0._r8 + upwp_output(i,k) = 0._r8 + vpwp_output(i,k) = 0._r8 + wprcp_clubb_output(i,k) = 0._r8 + wpthvp_clubb_output(i,k) = 0._r8 end do end do @@ -4885,40 +4886,40 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld( 'WP2_CLUBB', wp2_output, pcols, lchnk ) call outfld( 'UP2_CLUBB', up2_output, pcols, lchnk ) call outfld( 'VP2_CLUBB', vp2_output, pcols, lchnk ) - call outfld( 'WP3_CLUBB', wp3_output, pcols, lchnk ) + call outfld( 'WP3_CLUBB', wp3_output, pcols, lchnk ) call outfld( 'UPWP_CLUBB', upwp_output, pcols, lchnk ) call outfld( 'VPWP_CLUBB', vpwp_output, pcols, lchnk ) - call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) - call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) + call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk ) + call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk ) call outfld( 'RTP2_CLUBB', rtp2_output, pcols, lchnk ) - call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) + call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk ) call outfld( 'RCM_CLUBB', rcm_output, pcols, lchnk ) call outfld( 'RTM_CLUBB', rtm_output, pcols, lchnk ) call outfld( 'THLM_CLUBB', thlm_output, pcols, lchnk ) call outfld( 'WPRCP_CLUBB', wprcp_clubb_output, pcols, lchnk ) call outfld( 'WPTHVP_CLUBB', wpthvp_clubb_output, pcols, lchnk ) - call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_output, pcols, lchnk ) - call outfld( 'THLP2_ZT_CLUBB', thl2_zt_output, pcols, lchnk ) - call outfld( 'WP2_ZT_CLUBB', wp2_zt_output, pcols, lchnk ) - call outfld( 'pdfp_rtp2_output_CLUBB', pdfp_rtp2_output, pcols, lchnk ) + call outfld( 'RTP2_ZT_CLUBB', rtp2_zt_output, pcols, lchnk ) + call outfld( 'THLP2_ZT_CLUBB', thl2_zt_output, pcols, lchnk ) + call outfld( 'WP2_ZT_CLUBB', wp2_zt_output, pcols, lchnk ) + call outfld( 'PDFP_RTP2_CLUBB', pdfp_rtp2_output, pcols, lchnk ) call outfld( 'THLP2_CLUBB', thlp2_output, pcols, lchnk ) call outfld( 'RCMINLAYER_CLUBB', rcm_in_layer_output, pcols, lchnk ) - call outfld( 'ZT_CLUBB', zt_output, pcols, lchnk ) - call outfld( 'ZM_CLUBB', zi_output, pcols, lchnk ) + call outfld( 'ZT_CLUBB', zt_output, pcols, lchnk ) + call outfld( 'ZM_CLUBB', zi_output, pcols, lchnk ) call outfld( 'UM_CLUBB', um_output, pcols, lchnk ) call outfld( 'VM_CLUBB', vm_output, pcols, lchnk ) - call outfld( 'WM_ZT_CLUBB', wm_zt_output, pcols, lchnk ) - - call outfld( 'RELVAR', relvar_pbuf, pcols, lchnk ) - call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) - call outfld( 'CLOUDCOVER_CLUBB', cld_pbuf, pcols, lchnk ) - call outfld( 'CLOUDFRAC_CLUBB', alst_pbuf, pcols, lchnk ) - call outfld( 'CONCLD', concld_pbuf, pcols, lchnk ) - call outfld( 'DP_CLD', deepcu_pbuf, pcols, lchnk ) - call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk ) - call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) - call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) - call outfld( 'QSATFAC', qsatfac_pbuf, pcols, lchnk) + call outfld( 'WM_ZT_CLUBB', wm_zt_output, pcols, lchnk ) + + call outfld( 'RELVAR', relvar_pbuf, pcols, lchnk ) + call outfld( 'RHO_CLUBB', rho(:,1:pver), pcols, lchnk ) + call outfld( 'CLOUDCOVER_CLUBB', cld_pbuf, pcols, lchnk ) + call outfld( 'CLOUDFRAC_CLUBB', alst_pbuf, pcols, lchnk ) + call outfld( 'CONCLD', concld_pbuf, pcols, lchnk ) + call outfld( 'DP_CLD', deepcu_pbuf, pcols, lchnk ) + call outfld( 'ZMDLF', dlf_liq_out, pcols, lchnk ) + call outfld( 'ZMDLFI', dlf_ice_out, pcols, lchnk ) + call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk ) + call outfld( 'QSATFAC', qsatfac_pbuf, pcols, lchnk ) ! --------------------------------------------------------------- ! From c4f203412787785781cd3f4f3eb548e08b055868 Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Mon, 1 Dec 2025 16:06:49 -0700 Subject: [PATCH 18/29] Removing some unccesary stuff from pbuf and moving a little code around. --- src/physics/cam/clubb_intr.F90 | 574 +++++++++++++++---------------- src/physics/cam/subcol_SILHS.F90 | 9 +- 2 files changed, 280 insertions(+), 303 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 28ec83a800..8f232ddb27 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -422,10 +422,6 @@ module clubb_intr vp3_idx, & ! north-south wind 3rd order upwp_idx, & ! east-west momentum flux vpwp_idx, & ! north-south momentum flux - thlm_idx, & ! mean thetal - rtm_idx, & ! mean total water mixing ratio - um_idx, & ! mean of east-west wind - vm_idx, & ! mean of north-south wind wpthvp_idx, & ! buoyancy flux wp2thvp_idx, & ! second order buoyancy term rtpthvp_idx, & ! moisture buoyancy correlation @@ -463,7 +459,6 @@ module clubb_intr qrl_idx, & ! longwave cooling rate qsatfac_idx, & ! subgrid cloud water saturation scaling factor ice_supersat_idx, & ! ice cloud fraction for SILHS - rcm_idx, & ! Cloud water mixing ratio for SILHS clubbtop_idx ! level index for CLUBB top ! For Gravity Wave code @@ -621,15 +616,11 @@ subroutine clubb_register_cam( ) call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), wpthlp_clubb_gw_mc_idx) call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thvp_idx) - call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,nzt_clubb/), rcm_idx) - call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,nzt_clubb/), thlm_idx) call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2rtp_idx) call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thlp_idx) call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpup2_idx) call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpvp2_idx) - call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,nzt_clubb/), um_idx) - call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,nzt_clubb/), vm_idx) call pbuf_add_field('RTP3', 'global', dtype_r8, (/pcols,nzt_clubb/), rtp3_idx) call pbuf_add_field('THLP3', 'global', dtype_r8, (/pcols,nzt_clubb/), thlp3_idx) call pbuf_add_field('UP3', 'global', dtype_r8, (/pcols,nzt_clubb/), up3_idx) @@ -642,7 +633,6 @@ subroutine clubb_register_cam( ) ! Only in clubb_intr.F90 or SILHS call pbuf_add_field('ISS_FRAC', 'global', dtype_r8, (/pcols,nzt_clubb/), ice_supersat_idx) - call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,nzt_clubb/), rtm_idx) #endif @@ -1991,7 +1981,6 @@ subroutine clubb_ini_cam(pbuf_ini) call pbuf_set_field(pbuf_ini, wp2thvp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, rtpthvp_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, thlpthvp_idx, 0.0_r8) - call pbuf_set_field(pbuf_ini, rcm_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, tke_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, kvh_idx, 0.0_r8) call pbuf_set_field(pbuf_ini, wp2rtp_idx, 0.0_r8) @@ -2192,11 +2181,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: wpvp2_pbuf ! w'v'^2 (thermodynamic levels) real(r8), pointer, dimension(:,:) :: wp2up2_pbuf ! w'^2 u'^2 (momentum levels) real(r8), pointer, dimension(:,:) :: wp2vp2_pbuf ! w'^2 v'^2 (momentum levels) - real(r8), pointer, dimension(:,:) :: thlm_pbuf ! mean temperature [K] - real(r8), pointer, dimension(:,:) :: rtm_pbuf ! mean moisture mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: rcm_pbuf ! CLUBB cloud water mixing ratio [kg/kg] - real(r8), pointer, dimension(:,:) :: um_pbuf ! mean east-west wind [m/s] - real(r8), pointer, dimension(:,:) :: vm_pbuf ! mean north-south wind [m/s] real(r8), pointer, dimension(:,:) :: cld_pbuf ! cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: concld_pbuf ! convective cloud fraction [fraction] real(r8), pointer, dimension(:,:) :: ast_pbuf ! stratiform cloud fraction [fraction] @@ -2254,7 +2238,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & character(len=*), parameter :: subr='clubb_tend_cam' - type(physics_state) :: state1 ! Local copy of state variable + type(physics_state) :: state_loc ! Local copy of state variable type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all type(err_info_type) :: & @@ -2289,6 +2273,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpedsclrp_sfc ! Eddy-scalar flux at surface [{units vary} m/s] real(r8), dimension(state%ncol,nzt_clubb) :: & + rtm, & ! mean moisture mixing ratio [kg/kg] + thlm, & ! mean temperature [K] + rcm, & ! CLUBB cloud water mixing ratio [kg/kg] + um, & ! mean east-west wind [m/s] + vm, & ! mean north-south wind [m/s] thlm_forcing, & ! theta_l forcing (thermodynamic levels) [K/s] rtm_forcing, & ! r_t forcing (thermodynamic levels) [(kg/kg)/s] um_forcing, & ! u wind forcing (thermodynamic levels) [m/s/s] @@ -2598,7 +2587,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp_pbuf) call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp_pbuf) call pbuf_get_field(pbuf, thlpthvp_idx, thlpthvp_pbuf) - call pbuf_get_field(pbuf, rcm_idx, rcm_pbuf) call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1_pbuf ) call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2_pbuf ) @@ -2616,10 +2604,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, wpvp2_idx, wpvp2_pbuf ) call pbuf_get_field(pbuf, wp2up2_idx, wp2up2_pbuf ) call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2_pbuf ) - call pbuf_get_field(pbuf, thlm_idx, thlm_pbuf ) - call pbuf_get_field(pbuf, rtm_idx, rtm_pbuf ) - call pbuf_get_field(pbuf, um_idx, um_pbuf ) - call pbuf_get_field(pbuf, vm_idx, vm_pbuf ) call pbuf_get_field(pbuf, tke_idx, tke_pbuf) call pbuf_get_field(pbuf, qrl_idx, qrl_pbuf) @@ -2672,12 +2656,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Initialize physics tendency arrays call physics_ptend_init(ptend_all, state%psetcols, 'clubb') - ! Copy the state to state1 array to use in this routine - call physics_state_copy(state, state1) + ! Copy the state to state_loc array to use in this routine + call physics_state_copy(state, state_loc) ! Constituents are all treated as dry mmr by clubb. Convert the water species to ! a dry basis. - call set_wet_to_dry(state1, convert_cnst_type='wet') + call set_wet_to_dry(state_loc, convert_cnst_type='wet') if (clubb_do_liqsupersat) then call pbuf_get_field(pbuf, npccn_idx, npccn_pbuf) @@ -2686,7 +2670,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Define the grid box size. CLUBB needs this information to determine what ! the maximum length scale should be. This depends on the column for ! variable mesh grids and lat-lon grids - call grid_size(state1, grid_dx, grid_dy) + call grid_size(state_loc, grid_dx, grid_dy) ! Determine number of columns and which chunk computation is to be performed on ncol = state%ncol @@ -2716,7 +2700,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if ! Initialize err_info with parallelization and geographical info - call init_err_info_api(ncol, lchnk, iam, state1%lat*rad2deg, state1%lon*rad2deg, err_info) + call init_err_info_api(ncol, lchnk, iam, state_loc%lat*rad2deg, state_loc%lon*rad2deg, err_info) !--------------------- Scalar Setting -------------------- @@ -2793,17 +2777,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:acc_copyin') !$acc data copyin( sclr_idx, clubb_params_single_col, grid_dx, grid_dy, rairv, cpairv, qrl_pbuf, & !$acc pdf_params_chnk(lchnk), & - !$acc state1, state1%q, state1%u, state1%v, state1%t, state1%pmid, state1%s, state1%pint, & - !$acc state1%zm, state1%zi, state1%pdeldry, state1%pdel, state1%omega, state1%phis, & + !$acc state_loc, state_loc%q, state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, state_loc%s, state_loc%pint, & + !$acc state_loc%zm, state_loc%zi, state_loc%pdeldry, state_loc%pdel, state_loc%omega, state_loc%phis, & !$acc cam_in, cam_in%shf, cam_in%wsx, cam_in%wsy, cam_in%cflx, & !$acc prer_evap_pbuf, cld_pbuf, & !$acc rtp2_mc_zt_pbuf, thlp2_mc_zt_pbuf, wprtp_mc_zt_pbuf, wpthlp_mc_zt_pbuf, rtpthlp_mc_zt_pbuf, & !$acc err_info, err_info%err_header ) & - !$acc copy( um_pbuf, vm_pbuf, upwp_pbuf, vpwp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, & - !$acc wp2_pbuf, wp3_pbuf, rtp2_pbuf, thlp2_pbuf, rtp3_pbuf, thlp3_pbuf, thlm_pbuf, rtm_pbuf, wprtp_pbuf, wpthlp_pbuf, rtpthlp_pbuf, & + !$acc copy( um, vm, upwp_pbuf, vpwp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, & + !$acc wp2_pbuf, wp3_pbuf, rtp2_pbuf, thlp2_pbuf, rtp3_pbuf, thlp3_pbuf, thlm, rtm, wprtp_pbuf, wpthlp_pbuf, rtpthlp_pbuf, & !$acc wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) & - !$acc copyout( rcm_pbuf, khzm_pbuf, qclvar_out, rcm_in_layer, & + !$acc copyout( rcm, khzm_pbuf, qclvar_out, rcm_in_layer, & !$acc clubbtop, se_dis, eleak, clubb_s, cloud_frac_inout, wprcp_out, zi_g, & !$acc zt_g, wm_zt, pdf_params_chnk(lchnk)%mixt_frac, pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2 ) & @@ -3041,9 +3025,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:ice_macro_tend') call ice_macro_tend( ncol * nzt_clubb, latsub, hdtime, & ! in - naai_pbuf(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & ! in - state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,1), & ! in - state1%q(1:ncol,top_lev:pver,ixcldice), state1%q(1:ncol,top_lev:pver,ixnumice), & ! in + naai_pbuf(1:ncol,top_lev:pver), state_loc%t(1:ncol,top_lev:pver), & ! in + state_loc%pmid(1:ncol,top_lev:pver), state_loc%q(1:ncol,top_lev:pver,1), & ! in + state_loc%q(1:ncol,top_lev:pver,ixcldice), state_loc%q(1:ncol,top_lev:pver,ixnumice), & ! in stend(1:ncol,top_lev:pver), qvtend(1:ncol,top_lev:pver), & ! out qitend(1:ncol,top_lev:pver), initend(1:ncol,top_lev:pver) ) ! out call t_stopf('clubb_tend_cam:ice_macro_tend') @@ -3062,7 +3046,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_sum(ptend_loc, ptend_all, ncol) ! ptend_loc is reset to zero by this call - call physics_update(state1, ptend_loc, hdtime) + call physics_update(state_loc, ptend_loc, hdtime) ! Write output for tendencies: do i = 1, ncol @@ -3088,15 +3072,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - rtpthlp_pbuf(i,k) = state1%q(i,k_cam,ixrtpthlp) - ( rtpthlp_const * apply_const ) - wpthlp_pbuf(i,k) = state1%q(i,k_cam, ixwpthlp) - ( wpthlp_const * apply_const ) - wprtp_pbuf(i,k) = state1%q(i,k_cam, ixwprtp) - ( wprtp_const * apply_const ) - wp3_pbuf(i,k) = state1%q(i,k_cam, ixwp3) - ( wp3_const * apply_const ) - wp2_pbuf(i,k) = max( w_tol_sqd, state1%q(i,k_cam, ixwp2) ) - thlp2_pbuf(i,k) = max( thl_tol**2, state1%q(i,k_cam, ixthlp2) ) - rtp2_pbuf(i,k) = max( rt_tol**2, state1%q(i,k_cam, ixrtp2) ) - up2_pbuf(i,k) = max( w_tol_sqd, state1%q(i,k_cam, ixup2) ) - vp2_pbuf(i,k) = max( w_tol_sqd, state1%q(i,k_cam, ixvp2) ) + rtpthlp_pbuf(i,k) = state_loc%q(i,k_cam,ixrtpthlp) - ( rtpthlp_const * apply_const ) + wpthlp_pbuf(i,k) = state_loc%q(i,k_cam, ixwpthlp) - ( wpthlp_const * apply_const ) + wprtp_pbuf(i,k) = state_loc%q(i,k_cam, ixwprtp) - ( wprtp_const * apply_const ) + wp3_pbuf(i,k) = state_loc%q(i,k_cam, ixwp3) - ( wp3_const * apply_const ) + wp2_pbuf(i,k) = max( w_tol_sqd, state_loc%q(i,k_cam, ixwp2) ) + thlp2_pbuf(i,k) = max( thl_tol**2, state_loc%q(i,k_cam, ixthlp2) ) + rtp2_pbuf(i,k) = max( rt_tol**2, state_loc%q(i,k_cam, ixrtp2) ) + up2_pbuf(i,k) = max( w_tol_sqd, state_loc%q(i,k_cam, ixup2) ) + vp2_pbuf(i,k) = max( w_tol_sqd, state_loc%q(i,k_cam, ixvp2) ) enddo enddo @@ -3127,47 +3111,45 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_cam = top_lev - 1 + k ! Define the CLUBB thermodynamic grid (in units of m) - zt_g(i,k) = state1%zm(i,k_cam) - state1%zi(i,pverp) + zt_g(i,k) = state_loc%zm(i,k_cam) - state_loc%zi(i,pverp) - dz_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,k_cam+1) ! compute thickness + dz_g(i,k) = state_loc%zi(i,k_cam) - state_loc%zi(i,k_cam+1) ! compute thickness ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables ! (such as thlm), use "invrs_exner_zt" otherwise use the exner in state - invrs_exner_zt(i,k) = 1._r8 / ( ( state1%pmid(i,k_cam) / p0_clubb ) & + invrs_exner_zt(i,k) = 1._r8 / ( ( state_loc%pmid(i,k_cam) / p0_clubb ) & **( rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) ) ) ! base state (dry) variables - rho_ds_zt(i,k) = rga * ( state1%pdeldry(i,k_cam) / dz_g(i,k) ) + rho_ds_zt(i,k) = rga * ( state_loc%pdeldry(i,k_cam) / dz_g(i,k) ) invrs_rho_ds_zt(i,k) = 1._r8 / rho_ds_zt(i,k) ! full state (moist) variables exner(i,k) = 1._r8 / invrs_exner_zt(i,k) - rho_zt(i,k) = rga*state1%pdel(i,k_cam)/dz_g(i,k) + rho_zt(i,k) = rga*state_loc%pdel(i,k_cam)/dz_g(i,k) ! exception - setting this to moist thv_ds_zt - thv_ds_zt(i,k) = state1%t(i,k_cam) * invrs_exner_zt(i,k) & - * (1._r8 + zvir * state1%q(i,k_cam,ixq) - state1%q(i,k_cam,ixcldliq)) + thv_ds_zt(i,k) = state_loc%t(i,k_cam) * invrs_exner_zt(i,k) & + * (1._r8 + zvir * state_loc%q(i,k_cam,ixq) - state_loc%q(i,k_cam,ixcldliq)) ! Compute mean w wind on thermo grid, convert from omega to w - wm_zt(i,k) = -1._r8*(state1%omega(i,k_cam)-state1%omega(i,pver))/(rho_zt(i,k)*gravit) + wm_zt(i,k) = -1._r8*(state_loc%omega(i,k_cam)-state_loc%omega(i,pver))/(rho_zt(i,k)*gravit) - rfrzm(i,k) = state1%q(i,k_cam,ixcldice) - p_in_Pa(i,k) = state1%pmid(i,k_cam) + rfrzm(i,k) = state_loc%q(i,k_cam,ixcldice) + p_in_Pa(i,k) = state_loc%pmid(i,k_cam) cloud_frac_inout(i,k) = cld_pbuf(i,k_cam) - ! If we're overwriting these each call, there's no need to store them in pbuf. Right? - um_pbuf(i,k) = state1%u(i,k_cam) - vm_pbuf(i,k) = state1%v(i,k_cam) - rcm_pbuf(i,k) = state1%q(i,k_cam,ixcldliq) + um(i,k) = state_loc%u(i,k_cam) + vm(i,k) = state_loc%v(i,k_cam) + rcm(i,k) = state_loc%q(i,k_cam,ixcldliq) + rtm(i,k) = state_loc%q(i,k_cam,ixq) + state_loc%q(i,k_cam,ixcldliq) - rtm_pbuf(i,k) = state1%q(i,k_cam,ixq) + state1%q(i,k_cam,ixcldliq) - - thlm_pbuf(i,k) = ( state1%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) & - * state1%q(i,k_cam,ixcldliq) ) & + thlm(i,k) = ( state_loc%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) & + * state_loc%q(i,k_cam,ixcldliq) ) & * invrs_exner_zt(i,k) end do @@ -3176,14 +3158,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc parallel loop gang vector default(present) do i = 1, ncol - deltaz(i) = state1%zi(i,pverp-1) - state1%zi(i,pverp) + deltaz(i) = state_loc%zi(i,pverp-1) - state_loc%zi(i,pverp) ! For consistency, set surface pressure to p_in_Pa at the first thermo. ! level above the surface (according to the CLUBB ascending grid). - p_sfc(i) = state1%pmid(i,pver) + p_sfc(i) = state_loc%pmid(i,pver) ! Set the elevation of the surface - sfc_elevation(i) = state1%zi(i,pverp) + sfc_elevation(i) = state_loc%zi(i,pverp) end do @@ -3192,7 +3174,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - zi_g(i,k) = state1%zi(i,k_cam) - state1%zi(i,pverp) + zi_g(i,k) = state_loc%zi(i,k_cam) - state_loc%zi(i,pverp) end do end do @@ -3314,7 +3296,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif ! Compute surface wind (ubar) - ubar = sqrt(um_pbuf(1,nzt_clubb)**2+vm_pbuf(1,nzt_clubb)**2) + ubar = sqrt(um(1,nzt_clubb)**2+vm(1,nzt_clubb)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 ! Below denotes case specifics for surface momentum @@ -3344,8 +3326,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif ! Compute the surface momentum fluxes, if this is a SCAM simulation - upwp_sfc(1) = -um_pbuf(1,nzt_clubb)*ustar**2/ubar - vpwp_sfc(1) = -vm_pbuf(1,nzt_clubb)*ustar**2/ubar + upwp_sfc(1) = -um(1,nzt_clubb)*ustar**2/ubar + vpwp_sfc(1) = -vm(1,nzt_clubb)*ustar**2/ubar end if @@ -3355,18 +3337,18 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:ACCR') call t_startf('clubb_tend_cam:NAR') - !$acc update host( state1%u, state1%v, state1%t, state1%pmid, cam_in%wsx, cam_in%wsy, rrho ) + !$acc update host( state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, cam_in%wsx, cam_in%wsy, rrho ) ! Adjust surface stresses using winds from the prior macmic iteration do i = 1, ncol - ubar = sqrt(state1%u(i,pver)**2+state1%v(i,pver)**2) + ubar = sqrt(state_loc%u(i,pver)**2+state_loc%v(i,pver)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 - rrho(i) = calc_ideal_gas_rrho(rair, state1%t(i,pver), state1%pmid(i,pver)) + rrho(i) = calc_ideal_gas_rrho(rair, state_loc%t(i,pver), state_loc%pmid(i,pver)) ustar = calc_friction_velocity(cam_in%wsx(i), cam_in%wsy(i), rrho(i)) - upwp_sfc(i) = -state1%u(i,pver)*ustar**2/ubar - vpwp_sfc(i) = -state1%v(i,pver)*ustar**2/ubar + upwp_sfc(i) = -state_loc%u(i,pver)*ustar**2/ubar + vpwp_sfc(i) = -state_loc%v(i,pver)*ustar**2/ubar end do !$acc update device( upwp_sfc, vpwp_sfc ) @@ -3417,7 +3399,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzm_clubb do i = 1, ncol k_cam = top_lev - 1 + k - p_in_Pa_zm(i,k) = state1%pint(i,k_cam) + p_in_Pa_zm(i,k) = state_loc%pint(i,k_cam) invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k)/p0_clubb)**kappa_zm(i,k) ) end do end do @@ -3439,7 +3421,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol k_cam = top_lev - 1 + k - edsclr_inout(i,k,icnt) = state1%q(i,k_cam,ixind) + edsclr_inout(i,k,icnt) = state_loc%q(i,k_cam,ixind) end do end do @@ -3463,8 +3445,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (do_clubb_mf) then call t_startf('clubb_tend_cam:do_clubb_mf') - rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm_pbuf(:ncol,:) ) - thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm_pbuf(:ncol,:) ) + rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) + thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) !--------------------------------------- integrate_mf call and flip --------------------------------------- ! integrate_mf assumes an ascending grid, which is the opposide of the cam grid that @@ -3476,10 +3458,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) - um_pbuf = um_pbuf(:,nzt_clubb:1:-1) - vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) - thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) - rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) + um = um(:,nzt_clubb:1:-1) + vm = vm(:,nzt_clubb:1:-1) + thlm = thlm(:,nzt_clubb:1:-1) + rtm = rtm(:,nzt_clubb:1:-1) thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) @@ -3493,7 +3475,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um_pbuf(i,:), vm_pbuf(i,:), thlm_pbuf(i,:), rtm_pbuf(i,:), thv_ds_zt(i,:), & ! input + um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics @@ -3514,10 +3496,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) - um_pbuf = um_pbuf(:,nzt_clubb:1:-1) - vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) - thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) - rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) + um = um(:,nzt_clubb:1:-1) + vm = vm(:,nzt_clubb:1:-1) + thlm = thlm(:,nzt_clubb:1:-1) + rtm = rtm(:,nzt_clubb:1:-1) thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) @@ -3602,14 +3584,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) exner = exner(:,nzt_clubb:1:-1) rfrzm = rfrzm(:,nzt_clubb:1:-1) - um_pbuf = um_pbuf(:,nzt_clubb:1:-1) - vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) + um = um(:,nzt_clubb:1:-1) + vm = vm(:,nzt_clubb:1:-1) up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) - rcm_pbuf = rcm_pbuf(:,nzt_clubb:1:-1) + rcm = rcm(:,nzt_clubb:1:-1) cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) @@ -3619,8 +3601,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) - rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) - thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) + rtm = rtm(:,nzt_clubb:1:-1) + thlm = thlm(:,nzt_clubb:1:-1) wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) @@ -3764,15 +3746,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & clubb_config_flags, & stats_metadata, & stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! inouts - um_pbuf(:ncol,:), vm_pbuf(:ncol,:), upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), & + um(:ncol,:), vm(:ncol,:), upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), & up2_pbuf(:ncol,:), vp2_pbuf(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & - thlm_pbuf(:ncol,:), rtm_pbuf(:ncol,:), wprtp_pbuf(:ncol,:), wpthlp_pbuf(:ncol,:), & + thlm(:ncol,:), rtm(:ncol,:), wprtp_pbuf(:ncol,:), wpthlp_pbuf(:ncol,:), & wp2_pbuf(:ncol,:), wp3_pbuf(:ncol,:), rtp2_pbuf(:ncol,:), rtp3_pbuf(:ncol,:), & thlp2_pbuf(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_pbuf(:ncol,:), & sclrm, & sclrp2, sclrp3, sclrprtp, sclrpthlp, & wpsclrp, edsclr_inout, err_info, & - rcm_pbuf(:ncol,:), cloud_frac_inout, & + rcm(:ncol,:), cloud_frac_inout, & wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & sclrpthvp_inout, & wp2rtp_pbuf(:ncol,:), wp2thlp_pbuf(:ncol,:), uprcp_pbuf(:ncol,:), & @@ -3815,14 +3797,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) exner = exner(:,nzt_clubb:1:-1) rfrzm = rfrzm(:,nzt_clubb:1:-1) - um_pbuf = um_pbuf(:,nzt_clubb:1:-1) - vm_pbuf = vm_pbuf(:,nzt_clubb:1:-1) + um = um(:,nzt_clubb:1:-1) + vm = vm(:,nzt_clubb:1:-1) up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) - rcm_pbuf = rcm_pbuf(:,nzt_clubb:1:-1) + rcm = rcm(:,nzt_clubb:1:-1) cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) @@ -3839,8 +3821,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) - rtm_pbuf = rtm_pbuf(:,nzt_clubb:1:-1) - thlm_pbuf = thlm_pbuf(:,nzt_clubb:1:-1) + rtm = rtm(:,nzt_clubb:1:-1) + thlm = thlm(:,nzt_clubb:1:-1) Lscale = Lscale(:,nzt_clubb:1:-1) wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) @@ -3971,13 +3953,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol - rvm_in(i,k) = rtm_pbuf(i,k) - rcm_pbuf(i,k) + rvm_in(i,k) = rtm(i,k) - rcm(i,k) pre_in(i,k) = prer_evap_pbuf(i,k_cam) end do end do call update_xp2_mc_api( gr, nzm_clubb, nzt_clubb, ncol, dtime, cloud_frac_inout, & - rcm_pbuf(:ncol,:), rvm_in, thlm_pbuf(:ncol,:), wm_zt, & + rcm(:ncol,:), rvm_in, thlm(:ncol,:), wm_zt, & exner, pre_in, pdf_params_chnk(lchnk), & rtp2_mc_out, thlp2_mc_out, & wprtp_mc_out, wpthlp_mc_out, & @@ -4008,12 +3990,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol k_cam = top_lev - 1 + k - qrl_clubb(i,k) = qrl_pbuf(i,k_cam) / ( cpairv(i,k_cam,lchnk) * state1%pdeldry(i,k_cam) ) + qrl_clubb(i,k) = qrl_pbuf(i,k_cam) / ( cpairv(i,k_cam,lchnk) * state_loc%pdeldry(i,k_cam) ) end do end do call calculate_thlp2_rad_api( ncol, nzm_clubb, nzt_clubb, gr, & - rcm_pbuf(:ncol,:), thlprcp_out, qrl_clubb, clubb_params, & + rcm(:ncol,:), thlprcp_out, qrl_clubb, clubb_params, & thlp2_rad ) do k = 1, nzm_clubb @@ -4073,22 +4055,22 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !---- TODO: there seems to a an above top_lev interaction here that changes answers. ! The error occured because we were zeroing out the [1:top_lev-1] values in -! in rcm_pbuf (when it still contained those levels), when it should've been -! set to state1%q(:,:,ixcldliq) and unchanged by clubb. +! in rcm (when it still contained those levels), when it should've been +! set to state_loc%q(:,:,ixcldliq) and unchanged by clubb. ! Compute static energy using CLUBB's variables !$acc parallel loop gang vector collapse(2) default(present) do k = 1, top_lev-1 do i = 1, ncol ! inv_exner has not been calculated for above top_lev yet - inv_exner_tmp = 1._r8 / ( ( state1%pmid(i,k) / p0_clubb )**( rairv(i,k,lchnk) / cpairv(i,k,lchnk) ) ) + inv_exner_tmp = 1._r8 / ( ( state_loc%pmid(i,k) / p0_clubb )**( rairv(i,k,lchnk) / cpairv(i,k,lchnk) ) ) ! This can be simplified algebraically, but left like this to maintain BFBness - clubb_s(i,k) = cpairv(i,k,lchnk) * ( ( state1%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state1%q(i,k,ixcldliq) ) & + clubb_s(i,k) = cpairv(i,k,lchnk) * ( ( state_loc%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state_loc%q(i,k,ixcldliq) ) & * inv_exner_tmp ) / inv_exner_tmp & + latvap * 0._r8 & ! error kept for BFBness - !+ latvap * state1%q(i,k,ixcldliq) & ! correct line - + gravit * state1%zm(i,k) + state1%phis(i) + !+ latvap * state_loc%q(i,k,ixcldliq) & ! correct line + + gravit * state_loc%zm(i,k) + state_loc%phis(i) end do end do @@ -4096,9 +4078,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = top_lev, pver do i = 1, ncol k_clubb = k + 1 - top_lev - clubb_s(i,k) = cpairv(i,k,lchnk) * thlm_pbuf(i,k_clubb) / invrs_exner_zt(i,k_clubb) & - + latvap * rcm_pbuf(i,k_clubb) & - + gravit * state1%zm(i,k) + state1%phis(i) + clubb_s(i,k) = cpairv(i,k,lchnk) * thlm(i,k_clubb) / invrs_exner_zt(i,k_clubb) & + + latvap * rcm(i,k_clubb) & + + gravit * state_loc%zm(i,k) + state_loc%phis(i) end do end do !--------------------------------- END TODO --------------------------------- @@ -4112,7 +4094,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol clubbtop(i) = top_lev k_clubb = clubbtop(i) + 1 - top_lev - do while ((rtp2_pbuf(i,k_clubb) <= 1.e-15_r8 .and. rcm_pbuf(i,k_clubb) == 0._r8) .and. clubbtop(i) < pver) + do while ((rtp2_pbuf(i,k_clubb) <= 1.e-15_r8 .and. rcm(i,k_clubb) == 0._r8) .and. clubbtop(i) < pver) clubbtop(i) = clubbtop(i) + 1 k_clubb = clubbtop(i) + 1 - top_lev end do @@ -4133,27 +4115,27 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !---- TODO: there seems to a an above top_lev interaction here that changes answers. ! The error occured because we were zeroing out the [1:top_lev-1] values in -! in rcm_pbuf (when it still contained those levels), when it should've been -! set to state1%q(:,:,ixcldliq) and unchanged by clubb. +! in rcm (when it still contained those levels), when it should've been +! set to state_loc%q(:,:,ixcldliq) and unchanged by clubb. do k = 1, top_lev-1 ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water ! after CLUBB is called. This is for energy conservation purposes. - se_a = se_a + clubb_s(i,k)*state1%pdel(i,k)*rga - ke_a = ke_a + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)*rga - wv_a = wv_a + ( state1%q(i,k,ixq) + state1%q(i,k,ixcldliq) ) * state1%pdeldry(i,k) * rga ! error kept for BFBness + se_a = se_a + clubb_s(i,k)*state_loc%pdel(i,k)*rga + ke_a = ke_a + 0.5_r8*(state_loc%u(i,k)**2+state_loc%v(i,k)**2)*state_loc%pdel(i,k)*rga + wv_a = wv_a + ( state_loc%q(i,k,ixq) + state_loc%q(i,k,ixcldliq) ) * state_loc%pdeldry(i,k) * rga ! error kept for BFBness wl_a = wl_a + 0.0_r8 ! error kept for BFBness - !wv_a = wv_a + state1%q(i,k,ixq)*state1%pdeldry(i,k)*rga ! correct way - !wl_a = wl_a + state1%q(i,k,ixcldliq)*state1%pdeldry(i,k)*rga ! correct way + !wv_a = wv_a + state_loc%q(i,k,ixq)*state_loc%pdeldry(i,k)*rga ! correct way + !wl_a = wl_a + state_loc%q(i,k,ixcldliq)*state_loc%pdeldry(i,k)*rga ! correct way end do ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water ! after CLUBB is called. This is for energy conservation purposes. do k = top_lev, pver k_clubb = k + 1 - top_lev - se_a = se_a + clubb_s(i,k)*state1%pdel(i,k)*rga - ke_a = ke_a + 0.5_r8*(um_pbuf(i,k_clubb)**2+vm_pbuf(i,k_clubb)**2)*state1%pdel(i,k)*rga - wv_a = wv_a + (rtm_pbuf(i,k_clubb)-rcm_pbuf(i,k_clubb))*state1%pdeldry(i,k)*rga - wl_a = wl_a + (rcm_pbuf(i,k_clubb))*state1%pdeldry(i,k)*rga + se_a = se_a + clubb_s(i,k)*state_loc%pdel(i,k)*rga + ke_a = ke_a + 0.5_r8*(um(i,k_clubb)**2+vm(i,k_clubb)**2)*state_loc%pdel(i,k)*rga + wv_a = wv_a + (rtm(i,k_clubb)-rcm(i,k_clubb))*state_loc%pdeldry(i,k)*rga + wl_a = wl_a + (rcm(i,k_clubb))*state_loc%pdeldry(i,k)*rga end do !--------------------------------- END TODO --------------------------------- @@ -4162,10 +4144,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, pver ! Do the same as above, but for before CLUBB was called. - se_b = se_b + state1%s(i,k)*state1%pdel(i,k)*rga - ke_b = ke_b + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)*rga - wv_b = wv_b + state1%q(i,k,ixq)*state1%pdeldry(i,k)*rga - wl_b = wl_b + state1%q(i,k,ixcldliq)*state1%pdeldry(i,k)*rga + se_b = se_b + state_loc%s(i,k)*state_loc%pdel(i,k)*rga + ke_b = ke_b + 0.5_r8*(state_loc%u(i,k)**2+state_loc%v(i,k)**2)*state_loc%pdel(i,k)*rga + wv_b = wv_b + state_loc%q(i,k,ixq)*state_loc%pdeldry(i,k)*rga + wl_b = wl_b + state_loc%q(i,k,ixcldliq)*state_loc%pdeldry(i,k)*rga end do ! Based on these integrals, compute the total energy before CLUBB call @@ -4176,7 +4158,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & te_b = te_b + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime ! Compute the disbalance of total energy, over depth where CLUBB is active - se_dis(i) = ( te_a - te_b ) / ( state1%pint(i,pverp) - state1%pint(i,clubbtop(i)) ) + se_dis(i) = ( te_a - te_b ) / ( state_loc%pint(i,pverp) - state_loc%pint(i,clubbtop(i)) ) eleak(i) = ( te_a - te_b ) * invrs_hdtime @@ -4218,36 +4200,139 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_startf('clubb_tend_cam:NAR') + ! ------------------------------------------------- ! + ! Diagnose relative cloud water variance ! + ! ------------------------------------------------- ! + + if (deep_scheme == 'CLUBB_SGS') then + relvarmax = 2.0_r8 + else + relvarmax = 10.0_r8 + endif + + do i = 1, ncol + do k = 1, pver + relvar_pbuf(i,k) = relvarmax ! default + end do + end do + + if (deep_scheme .ne. 'CLUBB_SGS') then + do i = 1, ncol + do k = top_lev, pver + k_clubb = k + 1 - top_lev + if ( rcm(i,k_clubb) /= 0 .and. qclvar_out(i,k_clubb) /= 0 ) then + relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm(i,k_clubb)**2 / qclvar_out(i,k_clubb) ) ) + end if + end do + end do + endif + + ! turbulent kinetic energy + do k = top_lev, pverp + do i = 1, ncol + k_clubb = k + 1 - top_lev + tke_pbuf(i,k) = 0.5_r8 * ( up2_pbuf(i,k_clubb) + vp2_pbuf(i,k_clubb) + wp2_pbuf(i,k_clubb) ) + enddo + enddo + + ! --------------------------------------------------------------------------------- ! + ! Diagnose some quantities that are computed in macrop_tend here. ! + ! These are inputs required for the microphysics calculation. ! + ! ! + ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION ! + ! --------------------------------------------------------------------------------- ! + + ! initialize variables + alst_pbuf(:,:) = 0.0_r8 + qlst_pbuf(:,:) = 0.0_r8 + + do k = top_lev, pver + do i = 1, ncol + k_clubb = k + 1 - top_lev + cld_pbuf (i,k) = cloud_frac_inout(i,k_clubb) + alst_pbuf(i,k) = cld_pbuf(i,k) + qlst_pbuf(i,k) = rcm(i,k_clubb) / max( 0.01_r8, alst_pbuf(i,k) ) ! Incloud stratus condensate mixing ratio + enddo + enddo + + ! --------------------------------------------------------------------------------- ! + ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! + ! --------------------------------------------------------------------------------- ! + + frac_limit = 0.01_r8 + ic_limit = 1.e-12_r8 + deepcu_pbuf(:,:) = 0.0_r8 + shalcu_pbuf(:,:) = 0.0_r8 + + do k = 1, pver-1 + do i = 1, ncol + ! diagnose the deep convective cloud fraction, as done in macrophysics based on the + ! deep convective mass flux, read in from pbuf. Since shallow convection is never + ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud + ! fraction is purely from deep convection scheme. + deepcu_pbuf(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh_pbuf(i,k+1))),0.6_r8)) + + if (deepcu_pbuf(i,k) <= frac_limit .or. dp_icwmr_pbuf(i,k) < ic_limit) then + deepcu_pbuf(i,k) = 0._r8 + endif + + ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable + ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation + ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud + ! from CLUBB plus the deep convective cloud fraction +!----------------- TODO: the way we set alst_pbuf (with clubb's cloud fraction) +! this simplifies to the uncommented version. Seems weird, since it relies +! on only deepcu_pbuf, but not a clear bug + !concld_pbuf(i,k) = min(cloud_frac_pbuf(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k),0.80_r8) + concld_pbuf(i,k) = min(deepcu_pbuf(i,k),0.80_r8) + enddo + enddo +!------------------------------------------------------------------------------------- + + if (single_column .and. .not. scm_cambfb_mode) then + if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & + trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. & + trim(scm_clubb_iop_name) == 'DYCOMSrf01_4day' .or. & + trim(scm_clubb_iop_name) == 'DYCOMSrf02_06hr' .or. & + trim(scm_clubb_iop_name) == 'RICO_3day' .or. & + trim(scm_clubb_iop_name) == 'ARM_CC') then + + deepcu_pbuf(:,:) = 0.0_r8 + concld_pbuf(:,:) = 0.0_r8 + + endif + endif + call physics_ptend_init( ptend_loc, state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq ) !---- TODO: there seems to a an above top_lev interaction here that changes answers. ! The error occured because we were zeroing out the [1:top_lev-1] values in -! in rcm_pbuf (when it still contained those levels), when it should've been -! set to state1%q(:,:,ixcldliq) and unchanged by clubb. Had it been set correctly +! in rcm (when it still contained those levels), when it should've been +! set to state_loc%q(:,:,ixcldliq) and unchanged by clubb. Had it been set correctly ! the ptend_loc%q terms would simplify to zero. I've left the (erroneous?) interaction ! for now to maintain BFBness do k = 1, top_lev-1 do i = 1, ncol ptend_loc%u(i,k) = 0.0_r8 ptend_loc%v(i,k) = 0.0_r8 - ptend_loc%q(i,k,ixq) = ( state1%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness - ptend_loc%q(i,k,ixcldliq) = ( - state1%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness + ptend_loc%q(i,k,ixq) = ( state_loc%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness + ptend_loc%q(i,k,ixcldliq) = ( - state_loc%q(i,k,ixcldliq)) * invrs_hdtime ! error kept for BFBness ! ptend_loc%q(i,k,ixq) = 0.0_r8 ! correct line ! ptend_loc%q(i,k,ixcldliq) = 0.0_r8 ! correct line - ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy + ptend_loc%s(i,k) = (clubb_s(i,k) - state_loc%s(i,k)) * invrs_hdtime ! Tendency of static energy end do end do do k = top_lev, pver do i = 1, ncol k_clubb = k + 1 - top_lev - ptend_loc%u(i,k) = ( um_pbuf(i,k_clubb) - state1%u(i,k)) * invrs_hdtime ! east-west wind - ptend_loc%v(i,k) = ( vm_pbuf(i,k_clubb) - state1%v(i,k)) * invrs_hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = ( rtm_pbuf(i,k_clubb) - rcm_pbuf(i,k_clubb) & - -state1%q(i,k,ixq) ) * invrs_hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = ( rcm_pbuf(i,k_clubb) - state1%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = ( clubb_s(i,k) - state1%s(i,k)) * invrs_hdtime ! Tendency of static energy + ptend_loc%u(i,k) = ( um(i,k_clubb) - state_loc%u(i,k)) * invrs_hdtime ! east-west wind + ptend_loc%v(i,k) = ( vm(i,k_clubb) - state_loc%v(i,k)) * invrs_hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = ( rtm(i,k_clubb) - rcm(i,k_clubb) & + -state_loc%q(i,k,ixq) ) * invrs_hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = ( rcm(i,k_clubb) - state_loc%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = ( clubb_s(i,k) - state_loc%s(i,k)) * invrs_hdtime ! Tendency of static energy end do end do !--------------------------------- END TODO --------------------------------- @@ -4299,15 +4384,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & wpthlp_pbuf (i,k_clubb) = wpthlp_pbuf(i,k_clubb) + wpthlp_const wprtp_pbuf (i,k_clubb) = wprtp_pbuf(i,k_clubb) + wprtp_const - ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp_pbuf(i,k_clubb) - state1%q(i,k,ixrtpthlp) ) * invrs_hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp) = ( wpthlp_pbuf(i,k_clubb) - state1%q(i,k,ixwpthlp) ) * invrs_hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp) = ( wprtp_pbuf(i,k_clubb) - state1%q(i,k,ixwprtp) ) * invrs_hdtime ! WPRTP - ptend_loc%q(i,k,ixwp3) = ( wp3_pbuf(i,k_clubb) - state1%q(i,k,ixwp3) ) * invrs_hdtime ! WP3 - ptend_loc%q(i,k,ixwp2) = ( wp2_pbuf(i,k_clubb) - state1%q(i,k,ixwp2) ) * invrs_hdtime ! WP2 - ptend_loc%q(i,k,ixthlp2) = ( thlp2_pbuf(i,k_clubb) - state1%q(i,k,ixthlp2) ) * invrs_hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2) = ( rtp2_pbuf(i,k_clubb) - state1%q(i,k,ixrtp2) ) * invrs_hdtime ! RTP Variance - ptend_loc%q(i,k,ixup2) = ( up2_pbuf(i,k_clubb) - state1%q(i,k,ixup2) ) * invrs_hdtime ! UP2 - ptend_loc%q(i,k,ixvp2) = ( vp2_pbuf(i,k_clubb) - state1%q(i,k,ixvp2) ) * invrs_hdtime ! VP2 + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp_pbuf(i,k_clubb) - state_loc%q(i,k,ixrtpthlp) ) * invrs_hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = ( wpthlp_pbuf(i,k_clubb) - state_loc%q(i,k,ixwpthlp) ) * invrs_hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = ( wprtp_pbuf(i,k_clubb) - state_loc%q(i,k,ixwprtp) ) * invrs_hdtime ! WPRTP + ptend_loc%q(i,k,ixwp3) = ( wp3_pbuf(i,k_clubb) - state_loc%q(i,k,ixwp3) ) * invrs_hdtime ! WP3 + ptend_loc%q(i,k,ixwp2) = ( wp2_pbuf(i,k_clubb) - state_loc%q(i,k,ixwp2) ) * invrs_hdtime ! WP2 + ptend_loc%q(i,k,ixthlp2) = ( thlp2_pbuf(i,k_clubb) - state_loc%q(i,k,ixthlp2) ) * invrs_hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = ( rtp2_pbuf(i,k_clubb) - state_loc%q(i,k,ixrtp2) ) * invrs_hdtime ! RTP Variance + ptend_loc%q(i,k,ixup2) = ( up2_pbuf(i,k_clubb) - state_loc%q(i,k,ixup2) ) * invrs_hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = ( vp2_pbuf(i,k_clubb) - state_loc%q(i,k,ixvp2) ) * invrs_hdtime ! VP2 end do end do @@ -4341,7 +4426,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = top_lev, pver do i = 1, ncol k_clubb = k + 1 - top_lev - ptend_loc%q(i,k,ixind) = (edsclr_inout(i,k_clubb,icnt)-state1%q(i,k,ixind)) / hdtime ! transported constituents + ptend_loc%q(i,k,ixind) = (edsclr_inout(i,k_clubb,icnt)-state_loc%q(i,k,ixind)) / hdtime ! transported constituents end do end do @@ -4349,10 +4434,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end do - rvmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq) * state1%pdeldry(:ncol,:pver) / state1%pdel(:ncol,:pver) - rcmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq) * state1%pdeldry(:ncol,:pver) / state1%pdel(:ncol,:pver) - rimtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice) * state1%pdeldry(:ncol,:pver) / state1%pdel(:ncol,:pver) - cmeliq_pbuf (:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq) * state1%pdeldry(:ncol,:pver) / state1%pdel(:ncol,:pver) + rvmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq) * state_loc%pdeldry(:ncol,:pver) / state_loc%pdel(:ncol,:pver) + rcmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq) * state_loc%pdeldry(:ncol,:pver) / state_loc%pdel(:ncol,:pver) + rimtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice) * state_loc%pdeldry(:ncol,:pver) / state_loc%pdel(:ncol,:pver) + cmeliq_pbuf (:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq) * state_loc%pdeldry(:ncol,:pver) / state_loc%pdel(:ncol,:pver) stend_clubb_output (:ncol,:pver) = ptend_loc%s(:ncol,:pver) utend_clubb_output (:ncol,:pver) = ptend_loc%u(:ncol,:pver) vtend_clubb_output (:ncol,:pver) = ptend_loc%v(:ncol,:pver) @@ -4376,7 +4461,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & print *, "ptend_all%lq = ", ptend_all%lq call physics_ptend_sum(ptend_loc,ptend_all,ncol) - call physics_update(state1,ptend_loc,hdtime) + call physics_update(state_loc,ptend_loc,hdtime) ! Due to the order of operation of CLUBB, which closes on liquid first, ! then advances it's predictive equations second, this can lead to @@ -4404,9 +4489,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & qctend(:ncol,:)=0._r8 inctend(:ncol,:)=0._r8 - call liquid_macro_tend(npccn_pbuf(1:ncol,top_lev:pver), state1%t(1:ncol,top_lev:pver), & - state1%pmid(1:ncol,top_lev:pver), state1%q(1:ncol,top_lev:pver,ixq), & - state1%q(1:ncol,top_lev:pver,ixcldliq), state1%q(1:ncol,top_lev:pver,ixnumliq), & + call liquid_macro_tend(npccn_pbuf(1:ncol,top_lev:pver), state_loc%t(1:ncol,top_lev:pver), & + state_loc%pmid(1:ncol,top_lev:pver), state_loc%q(1:ncol,top_lev:pver,ixq), & + state_loc%q(1:ncol,top_lev:pver,ixcldliq), state_loc%q(1:ncol,top_lev:pver,ixnumliq), & latvap, hdtime, stend(1:ncol,top_lev:pver),qvtend(1:ncol,top_lev:pver), & qctend(1:ncol,top_lev:pver), inctend(1:ncol,top_lev:pver), ncol * nzt_clubb ) @@ -4420,7 +4505,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_sum(ptend_loc, ptend_all, ncol) ! ptend_loc is reset to zero by this call - call physics_update(state1, ptend_loc, hdtime) + call physics_update(state_loc, ptend_loc, hdtime) ! Write output for tendencies: ! oufld: QVTENDICE,QCTENDICE,NCTENDICE,FQTENDICE @@ -4470,12 +4555,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, pver do i = 1, ncol - if( state1%t(i,k) > meltpt_temp ) then + if( state_loc%t(i,k) > meltpt_temp ) then dum1 = 0.0_r8 - elseif ( state1%t(i,k) < dt_low ) then + elseif ( state_loc%t(i,k) < dt_low ) then dum1 = 1.0_r8 else - dum1 = ( meltpt_temp - state1%t(i,k) ) / ( meltpt_temp - dt_low ) + dum1 = ( meltpt_temp - state_loc%t(i,k) ) / ( meltpt_temp - dt_low ) endif ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 ) @@ -4494,25 +4579,25 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dlf_ice_out(i,k) = dlf(i,k) * dum1 ! convert moist dlf tendencies to dry - ptend_loc%q(i,k,ixcldliq) = ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/state1%pdeldry(i,k) - ptend_loc%q(i,k,ixcldice) = ptend_loc%q(i,k,ixcldice)*state1%pdel(i,k)/state1%pdeldry(i,k) + ptend_loc%q(i,k,ixcldliq) = ptend_loc%q(i,k,ixcldliq)*state_loc%pdel(i,k)/state_loc%pdeldry(i,k) + ptend_loc%q(i,k,ixcldice) = ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/state_loc%pdeldry(i,k) ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep ! track of the integrals of ice and static energy that is effected from conversion to ice ! so that the energy checker doesn't complain. - det_s(i) = det_s(i) + ptend_loc%s(i,k) * state1%pdel(i,k) * rga - det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice) * state1%pdeldry(i,k) * rga + det_s(i) = det_s(i) + ptend_loc%s(i,k) * state_loc%pdel(i,k) * rga + det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice) * state_loc%pdeldry(i,k) * rga enddo enddo det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water - dpdlfliq_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) - dpdlfice_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state1%pdeldry(:ncol,:pver)/state1%pdel(:ncol,:pver) + dpdlfliq_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state_loc%pdeldry(:ncol,:pver)/state_loc%pdel(:ncol,:pver) + dpdlfice_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state_loc%pdeldry(:ncol,:pver)/state_loc%pdel(:ncol,:pver) dpdlft_output(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk) detnliquid_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixnumliq) call physics_ptend_sum(ptend_loc,ptend_all,ncol) - call physics_update(state1,ptend_loc,hdtime) + call physics_update(state_loc,ptend_loc,hdtime) ! ptend_all now has all accumulated tendencies. Convert the tendencies for the ! wet constituents to wet air basis. @@ -4520,115 +4605,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if (lq(ixind) .and. cnst_type(ixind) == 'wet') then do k = 1, pver do i = 1, ncol - ptend_all%q(i,k,ixind) = ptend_all%q(i,k,ixind)*state1%pdeldry(i,k)/state1%pdel(i,k) + ptend_all%q(i,k,ixind) = ptend_all%q(i,k,ixind)*state_loc%pdeldry(i,k)/state_loc%pdel(i,k) end do end do end if end do - ! ------------------------------------------------- ! - ! Diagnose relative cloud water variance ! - ! ------------------------------------------------- ! - - if (deep_scheme == 'CLUBB_SGS') then - relvarmax = 2.0_r8 - else - relvarmax = 10.0_r8 - endif - - do i = 1, ncol - do k = 1, pver - relvar_pbuf(i,k) = relvarmax ! default - end do - end do - - if (deep_scheme .ne. 'CLUBB_SGS') then - do i = 1, ncol - do k = top_lev, pver - k_clubb = k + 1 - top_lev - if ( rcm_pbuf(i,k_clubb) /= 0 .and. qclvar_out(i,k_clubb) /= 0 ) then - relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm_pbuf(i,k_clubb)**2 / qclvar_out(i,k_clubb) ) ) - end if - end do - end do - endif - - ! turbulent kinetic energy - do k = top_lev, pverp - do i = 1, ncol - k_clubb = k + 1 - top_lev - tke_pbuf(i,k) = 0.5_r8 * ( up2_pbuf(i,k_clubb) + vp2_pbuf(i,k_clubb) + wp2_pbuf(i,k_clubb) ) - enddo - enddo - - ! --------------------------------------------------------------------------------- ! - ! Diagnose some quantities that are computed in macrop_tend here. ! - ! These are inputs required for the microphysics calculation. ! - ! ! - ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION ! - ! --------------------------------------------------------------------------------- ! - - ! initialize variables - alst_pbuf(:,:) = 0.0_r8 - qlst_pbuf(:,:) = 0.0_r8 - - do k = top_lev, pver - do i = 1, ncol - k_clubb = k + 1 - top_lev - cld_pbuf (i,k) = cloud_frac_inout(i,k_clubb) - alst_pbuf(i,k) = cld_pbuf(i,k) - qlst_pbuf(i,k) = rcm_pbuf(i,k_clubb) / max( 0.01_r8, alst_pbuf(i,k) ) ! Incloud stratus condensate mixing ratio - enddo - enddo - - ! --------------------------------------------------------------------------------- ! - ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! - ! --------------------------------------------------------------------------------- ! - - frac_limit = 0.01_r8 - ic_limit = 1.e-12_r8 - deepcu_pbuf(:,:) = 0.0_r8 - shalcu_pbuf(:,:) = 0.0_r8 - - do k = 1, pver-1 - do i = 1, ncol - ! diagnose the deep convective cloud fraction, as done in macrophysics based on the - ! deep convective mass flux, read in from pbuf. Since shallow convection is never - ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud - ! fraction is purely from deep convection scheme. - deepcu_pbuf(i,k) = max(0.0_r8,min(dp1*log(1.0_r8+dp2*(cmfmc(i,k+1)-cmfmc_sh_pbuf(i,k+1))),0.6_r8)) - - if (deepcu_pbuf(i,k) <= frac_limit .or. dp_icwmr_pbuf(i,k) < ic_limit) then - deepcu_pbuf(i,k) = 0._r8 - endif - - ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable - ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation - ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud - ! from CLUBB plus the deep convective cloud fraction -!----------------- TODO: the way we set alst_pbuf (with clubb's cloud fraction) -! this simplifies to the uncommented version. Seems weird, since it relies -! on only deepcu_pbuf, but not a clear bug - !concld_pbuf(i,k) = min(cloud_frac_pbuf(i,k)-alst_pbuf(i,k)+deepcu_pbuf(i,k),0.80_r8) - concld_pbuf(i,k) = min(deepcu_pbuf(i,k),0.80_r8) - enddo - enddo -!------------------------------------------------------------------------------------- - - if (single_column .and. .not. scm_cambfb_mode) then - if (trim(scm_clubb_iop_name) == 'ATEX_48hr' .or. & - trim(scm_clubb_iop_name) == 'BOMEX_5day' .or. & - trim(scm_clubb_iop_name) == 'DYCOMSrf01_4day' .or. & - trim(scm_clubb_iop_name) == 'DYCOMSrf02_06hr' .or. & - trim(scm_clubb_iop_name) == 'RICO_3day' .or. & - trim(scm_clubb_iop_name) == 'ARM_CC') then - - deepcu_pbuf(:,:) = 0.0_r8 - concld_pbuf(:,:) = 0.0_r8 - - endif - endif - ! --------------------------------------------------------------------------------- ! ! COMPUTE THE ICE CLOUD FRACTION PORTION ! ! use the aist_vector function to compute the ice cloud fraction ! @@ -4661,11 +4643,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end where if ( trim(subcol_scheme) == 'SILHS' ) then - call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & - state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist_pbuf(:,k),ncol ) + call aist_vector(state_loc%q(:,k,ixq),state_loc%t(:,k),state_loc%pmid(:,k),state_loc%q(:,k,ixcldice), & + state_loc%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist_pbuf(:,k),ncol ) else - call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & - state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist_pbuf(:,k),ncol,& + call aist_vector(state_loc%q(:,k,ixq),state_loc%t(:,k),state_loc%pmid(:,k),state_loc%q(:,k,ixcldice), & + state_loc%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist_pbuf(:,k),ncol,& qsatfac_out=qsatfac_pbuf(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) endif enddo @@ -4684,7 +4666,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Recompute net stratus fraction using maximum over-lapping assumption, as done ! in macrophysics code, using alst computed above and aist read in from physics buffer ast_pbuf(i,k) = max(alst_pbuf(i,k),aist_pbuf(i,k)) - qist_pbuf(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist_pbuf(i,k)) + qist_pbuf(i,k) = state_loc%q(i,k,ixcldice)/max(0.01_r8,aist_pbuf(i,k)) ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just ! be outputting the shallow convective cloud fraction @@ -4701,14 +4683,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol do k = 1, pver !subroutine pblind expects "Stull" definition of Exner - th(i,k) = state1%t(i,k)*state1%exner(i,k) + th(i,k) = state_loc%t(i,k)*state_loc%exner(i,k) !thv should have condensate loading to be consistent with earlier def's in this module - thv(i,k) = th(i,k)*(1.0_r8+zvir*state1%q(i,k,ixq) - state1%q(i,k,ixcldliq)) + thv(i,k) = th(i,k)*(1.0_r8+zvir*state_loc%q(i,k,ixq) - state_loc%q(i,k,ixcldliq)) enddo enddo ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth) - rrho (1:ncol) = calc_ideal_gas_rrho(rair, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver)) + rrho (1:ncol) = calc_ideal_gas_rrho(rair, state_loc%t(1:ncol,pver), state_loc%pmid(1:ncol,pver)) ustar2 (1:ncol) = calc_friction_velocity(cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), rrho(1:ncol)) ! use correct qflux from coupler kinheat(1:ncol) = calc_kinematic_heat_flux(cam_in%shf(1:ncol), rrho(1:ncol), cpair) @@ -4731,10 +4713,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pver = pver, & pverp = pverp, & gravit = gravit, & - z = state1%zm(:ncol,:pver), & - zi = state1%zi(:ncol,:pverp), & - u = state1%u(:ncol,:pver), & - v = state1%v(:ncol,:pver), & + z = state_loc%zm(:ncol,:pver), & + zi = state_loc%zi(:ncol,:pverp), & + u = state_loc%u(:ncol,:pver), & + v = state_loc%v(:ncol,:pver), & cldn = cld_pbuf(:ncol,:pver), & ! Inputs from CLUBB (not HB coefficients) thv = thv(:ncol,:pver), & @@ -4780,7 +4762,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld('TFIX_CLUBB', se_dis, pcols, lchnk) ! density - rho(1:ncol,1:pver) = rga*state1%pdel(1:ncol,1:pver)/(state1%zi(1:ncol,1:pver)-state1%zi(1:ncol,2:pverp)) + rho(1:ncol,1:pver) = rga*state_loc%pdel(1:ncol,1:pver)/(state_loc%zi(1:ncol,1:pver)-state_loc%zi(1:ncol,2:pverp)) rho(1:ncol,pverp) = rho(1:ncol,pver) do k = top_lev, pverp @@ -4816,11 +4798,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & k_clubb = k + 1 - top_lev - rcm_output(i,k) = rcm_pbuf(i,k_clubb) - rtm_output(i,k) = rtm_pbuf(i,k_clubb) - thlm_output(i,k) = thlm_pbuf(i,k_clubb) - um_output(i,k) = um_pbuf(i,k_clubb) - vm_output(i,k) = vm_pbuf(i,k_clubb) + rcm_output(i,k) = rcm(i,k_clubb) + rtm_output(i,k) = rtm(i,k_clubb) + thlm_output(i,k) = thlm(i,k_clubb) + um_output(i,k) = um(i,k_clubb) + vm_output(i,k) = vm(i,k_clubb) rcm_in_layer_output(i,k) = rcm_in_layer(i,k_clubb) zt_output(i,k) = zt_g(i,k_clubb) wm_zt_output(i,k) = wm_zt(i,k_clubb) @@ -5118,13 +5100,13 @@ end subroutine clubb_emissions_cam ! Saturation adjustment for ice ! Add ice mass if supersaturated subroutine ice_macro_tend(vlen,xxls,deltat, & - naai_pbuf,t,p,qv,qi,ni,& + naai,t,p,qv,qi,ni,& stend,qvtend,qitend,nitend) use wv_sat_methods, only: wv_sat_qsat_ice integer, intent(in) :: vlen - real(r8), dimension(vlen), intent(in) :: naai_pbuf !Activated number of ice nuclei + real(r8), dimension(vlen), intent(in) :: naai !Activated number of ice nuclei real(r8), dimension(vlen), intent(in) :: t !temperature (k) real(r8), dimension(vlen), intent(in) :: p !pressure (pa) real(r8), dimension(vlen), intent(in) :: qv !water vapor mixing ratio @@ -5154,7 +5136,7 @@ subroutine ice_macro_tend(vlen,xxls,deltat, & end do do i = 1, vlen - if (naai_pbuf(i) > 1.e-18_r8 .and. qv(i) > QSI(i)) then + if (naai(i) > 1.e-18_r8 .and. qv(i) > QSI(i)) then qitend(i) = (qv(i)-QSI(i))/deltat qvtend(i) = 0._r8 - qitend(i) diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 850f25802e..fef38d4b84 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -86,7 +86,7 @@ module subcol_SILHS ixnumsnow= 0 ! Pbuf indicies - integer :: rtm_idx, ice_supersat_idx, & + integer :: ice_supersat_idx, & alst_idx, cld_idx, qrain_idx, qsnow_idx, & nrain_idx, nsnow_idx, tke_idx, kvh_idx, & prec_pcw_idx, snow_pcw_idx, prec_str_idx, snow_str_idx, & @@ -416,7 +416,6 @@ subroutine subcol_init_SILHS(pbuf2d) call cnst_get_ind('NUMSNO', ixnumsnow, abort=.false.) ! Get physics buffer indexes - rtm_idx = pbuf_get_index('RTM') cld_idx = pbuf_get_index('CLD') alst_idx = pbuf_get_index('ALST') ! SILHS expects clubb's cloud_frac liq stratus fraction ice_supersat_idx = pbuf_get_index('ISS_FRAC') @@ -509,8 +508,6 @@ subroutine subcol_init_SILHS(pbuf2d) call addfld('NR_IN_LH', (/ 'lev' /), 'I', 'm^-3', & 'Num Rain Conc as input to SILHS') - call addfld('SILHS_RTM', (/ 'ilev' /), 'I', 'kg/kg', & - 'Input total water mixing ratio') call addfld('SILHS_THLM', (/ 'ilev' /), 'I', 'K', & 'Input liquid water potential temperature') call addfld('SILHS_QC_IN', (/ 'lev' /), 'I', 'kg/kg', & @@ -823,7 +820,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Pointers !---------------- real(r8), pointer, dimension(:,:) :: ice_supersat_frac ! ice cloud fraction - real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio real(r8), pointer, dimension(:,:) :: cld ! CAM cloud fraction real(r8), pointer, dimension(:,:) :: alst ! CLUBB liq cloud fraction real(r8), pointer, dimension(:,:) :: qrain ! micro_mg rain from previous step @@ -918,7 +914,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Establish associations between pointers and physics buffer fields !---------------- call pbuf_get_field(pbuf, ice_supersat_idx, ice_supersat_frac) - call pbuf_get_field(pbuf, rtm_idx, rtm) call pbuf_get_field(pbuf, alst_idx, alst) call pbuf_get_field(pbuf, cld_idx, cld) call pbuf_get_field(pbuf, qrain_idx, qrain) @@ -1168,7 +1163,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Set the seed to the random number generator based on a quantity that ! will be reproducible for restarts. - lh_seed = int( 1.0e4_r8 * rtm(1,nzt_clubb), kind = genrand_intg ) + lh_seed = int( 1.0e4_r8 * tke(1,nzm_clubb), kind = genrand_intg ) ! Let's generate some subcolumns!!!!! call generate_silhs_sample_api( & From 319bee6515d89859db4d299283202d0a45708769 Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Wed, 3 Dec 2025 01:08:58 -0700 Subject: [PATCH 19/29] Small BFB improvements --- src/physics/cam/clubb_intr.F90 | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 8f232ddb27..968001c03f 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -3458,10 +3458,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dz_g = dz_g(:,nzt_clubb:1:-1) p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) - um = um(:,nzt_clubb:1:-1) - vm = vm(:,nzt_clubb:1:-1) - thlm = thlm(:,nzt_clubb:1:-1) - rtm = rtm(:,nzt_clubb:1:-1) + um = um(:,nzt_clubb:1:-1) + vm = vm(:,nzt_clubb:1:-1) + thlm = thlm(:,nzt_clubb:1:-1) + rtm = rtm(:,nzt_clubb:1:-1) thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) @@ -3473,11 +3473,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtm_zm_in = rtm_zm_in(:,nzm_clubb:1:-1) do i = 1, ncol - call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input - p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input - um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input - thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input - wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input + call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + um(i,:), vm(i,:), thlm(i,:), rtm(i,:), thv_ds_zt(i,:), & ! input + thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input + wpthlp_sfc(i), wprtp_sfc(i), pblh_pbuf(i), & ! input mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics @@ -4249,8 +4249,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = top_lev, pver do i = 1, ncol k_clubb = k + 1 - top_lev - cld_pbuf (i,k) = cloud_frac_inout(i,k_clubb) - alst_pbuf(i,k) = cld_pbuf(i,k) + alst_pbuf(i,k) = cloud_frac_inout(i,k_clubb) qlst_pbuf(i,k) = rcm(i,k_clubb) / max( 0.01_r8, alst_pbuf(i,k) ) ! Incloud stratus condensate mixing ratio enddo enddo @@ -4330,9 +4329,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ptend_loc%u(i,k) = ( um(i,k_clubb) - state_loc%u(i,k)) * invrs_hdtime ! east-west wind ptend_loc%v(i,k) = ( vm(i,k_clubb) - state_loc%v(i,k)) * invrs_hdtime ! north-south wind ptend_loc%q(i,k,ixq) = ( rtm(i,k_clubb) - rcm(i,k_clubb) & - -state_loc%q(i,k,ixq) ) * invrs_hdtime ! water vapor + -state_loc%q(i,k,ixq) ) * invrs_hdtime ! water vapor ptend_loc%q(i,k,ixcldliq) = ( rcm(i,k_clubb) - state_loc%q(i,k,ixcldliq)) * invrs_hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = ( clubb_s(i,k) - state_loc%s(i,k)) * invrs_hdtime ! Tendency of static energy + ptend_loc%s(i,k) = ( clubb_s(i,k) - state_loc%s(i,k)) * invrs_hdtime ! Tendency of static energy end do end do !--------------------------------- END TODO --------------------------------- From cb4ccb3293f2a33a0cd9762ee4820812015e74c4 Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Tue, 9 Dec 2025 13:18:48 -0700 Subject: [PATCH 20/29] Removing print statements and a little cleanup --- src/physics/cam/clubb_intr.F90 | 365 +++++++++++++++++---------------- 1 file changed, 187 insertions(+), 178 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 968001c03f..2e9664a87d 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -17,8 +17,6 @@ module clubb_intr ! ! !----------------------------------------------------------------------------------------------------- ! - use ref_pres, only: trop_cloud_top_press - use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pver, pverp, pcols, begchunk, endchunk use phys_control, only: phys_getopts @@ -2538,6 +2536,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef _OPENACC ! These options have not been GPUized + if ( l_ascending_grid ) call endrun(subr//': l_ascending_grid=.true. not available when compiling with OpenACC') if ( do_clubb_mf ) call endrun(subr//': do_clubb_mf=.true. not available when compiling with OpenACC') if ( do_rainturb ) call endrun(subr//': do_rainturb=.true. not available when compiling with OpenACC') if ( do_cldcool ) call endrun(subr//': do_cldcool=.true. not available when compiling with OpenACC') @@ -2550,8 +2549,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !-----------------------------------------------------------------------------------! ! MAIN COMPUTATION BEGINS HERE ! !-----------------------------------------------------------------------------------! - print *, "top_lev = ", top_lev - print *, "trop_cloud_top_press = ", trop_cloud_top_press call t_startf('clubb_tend_cam:NAR') @@ -3584,57 +3581,57 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) exner = exner(:,nzt_clubb:1:-1) rfrzm = rfrzm(:,nzt_clubb:1:-1) - um = um(:,nzt_clubb:1:-1) - vm = vm(:,nzt_clubb:1:-1) - up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) - vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) - wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) - rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) - thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) - rcm = rcm(:,nzt_clubb:1:-1) + um = um(:,nzt_clubb:1:-1) + vm = vm(:,nzt_clubb:1:-1) + up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) + vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) + wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) + rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) + thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) + rcm = rcm(:,nzt_clubb:1:-1) cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) - wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) - wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) - wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) - wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) - ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) + wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) + wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) + wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) + wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) + ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) - wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) - rtm = rtm(:,nzt_clubb:1:-1) - thlm = thlm(:,nzt_clubb:1:-1) - - wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) - wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) - rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) - thlp2_forcing = thlp2_forcing(:,nzm_clubb:1:-1) - rtpthlp_forcing = rtpthlp_forcing(:,nzm_clubb:1:-1) - wm_zm = wm_zm(:,nzm_clubb:1:-1) - rho_zm = rho_zm(:,nzm_clubb:1:-1) - rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) - invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) - thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) - upwp_pbuf = upwp_pbuf(:,nzm_clubb:1:-1) - vpwp_pbuf = vpwp_pbuf(:,nzm_clubb:1:-1) - up2_pbuf = up2_pbuf(:,nzm_clubb:1:-1) - vp2_pbuf = vp2_pbuf(:,nzm_clubb:1:-1) - wprtp_pbuf = wprtp_pbuf(:,nzm_clubb:1:-1) - wpthlp_pbuf = wpthlp_pbuf(:,nzm_clubb:1:-1) - wp2_pbuf = wp2_pbuf(:,nzm_clubb:1:-1) - rtp2_pbuf = rtp2_pbuf(:,nzm_clubb:1:-1) - thlp2_pbuf = thlp2_pbuf(:,nzm_clubb:1:-1) - rtpthlp_pbuf = rtpthlp_pbuf(:,nzm_clubb:1:-1) - wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) - rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) - thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) - uprcp_pbuf = uprcp_pbuf(:,nzm_clubb:1:-1) - vprcp_pbuf = vprcp_pbuf(:,nzm_clubb:1:-1) - rc_coef_zm_pbuf = rc_coef_zm_pbuf(:,nzm_clubb:1:-1) - wp4_pbuf = wp4_pbuf(:,nzm_clubb:1:-1) - wp2up2_pbuf = wp2up2_pbuf(:,nzm_clubb:1:-1) - wp2vp2_pbuf = wp2vp2_pbuf(:,nzm_clubb:1:-1) - upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) - vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) + wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) + rtm = rtm(:,nzt_clubb:1:-1) + thlm = thlm(:,nzt_clubb:1:-1) + + wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) + wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) + rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) + thlp2_forcing = thlp2_forcing(:,nzm_clubb:1:-1) + rtpthlp_forcing = rtpthlp_forcing(:,nzm_clubb:1:-1) + wm_zm = wm_zm(:,nzm_clubb:1:-1) + rho_zm = rho_zm(:,nzm_clubb:1:-1) + rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) + invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) + thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) + upwp_pbuf = upwp_pbuf(:,nzm_clubb:1:-1) + vpwp_pbuf = vpwp_pbuf(:,nzm_clubb:1:-1) + up2_pbuf = up2_pbuf(:,nzm_clubb:1:-1) + vp2_pbuf = vp2_pbuf(:,nzm_clubb:1:-1) + wprtp_pbuf = wprtp_pbuf(:,nzm_clubb:1:-1) + wpthlp_pbuf = wpthlp_pbuf(:,nzm_clubb:1:-1) + wp2_pbuf = wp2_pbuf(:,nzm_clubb:1:-1) + rtp2_pbuf = rtp2_pbuf(:,nzm_clubb:1:-1) + thlp2_pbuf = thlp2_pbuf(:,nzm_clubb:1:-1) + rtpthlp_pbuf = rtpthlp_pbuf(:,nzm_clubb:1:-1) + wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) + rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) + thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) + uprcp_pbuf = uprcp_pbuf(:,nzm_clubb:1:-1) + vprcp_pbuf = vprcp_pbuf(:,nzm_clubb:1:-1) + rc_coef_zm_pbuf = rc_coef_zm_pbuf(:,nzm_clubb:1:-1) + wp4_pbuf = wp4_pbuf(:,nzm_clubb:1:-1) + wp2up2_pbuf = wp2up2_pbuf(:,nzm_clubb:1:-1) + wp2vp2_pbuf = wp2vp2_pbuf(:,nzm_clubb:1:-1) + upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) + vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) if ( edsclr_dim > 0 ) then edsclr_inout = edsclr_inout(:,nzt_clubb:1:-1,:) @@ -3642,16 +3639,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if if ( sclr_dim > 0 ) then - - sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) - sclrm = sclrm(:,nzt_clubb:1:-1,:) - sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) - - sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) - sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) - sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) - wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) - sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) + + sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) + sclrm = sclrm(:,nzt_clubb:1:-1,:) + sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) + + sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) + sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) + sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) + wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) + sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) end if ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid. @@ -3666,9 +3663,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid. ! only for pdfp_rtp2_output calc - pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) @@ -3678,8 +3675,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1 (:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) @@ -3715,13 +3712,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - if ( pcols /= ncol ) then - print *, "pcols /= ncol", pcols, ncol - else - print *, "pcols == ncol", pcols, ncol - end if - - call advance_clubb_core_api( gr, nzm_clubb, nzt_clubb, ncol, & ! ins + ! These updates are required because the pbuf variables are dimensioned with pcols, when + ! we only need ncol. This requires us to slice the arrays when inputting to advance_clubb_core_api, + ! which happens on the CPU, so we need the CPU version of these to be correct. + ! REMOVECAM: This will be unnecessary once pbuf is gone and these are dimensioned ncol. + !$acc update host( upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & + !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & + !$acc wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & + !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) + + call advance_clubb_core_api( gr, nzm_clubb, nzt_clubb, ncol, & ! Inputs l_implemented, dtime, fcor, sfc_elevation, & hydromet_dim, & sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & @@ -3745,8 +3746,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtm_min, rtm_nudge_max_altitude, & clubb_config_flags, & stats_metadata, & - stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! inouts - um(:ncol,:), vm(:ncol,:), upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), & + stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! InOuts + um, vm, upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), & up2_pbuf(:ncol,:), vp2_pbuf(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & thlm(:ncol,:), rtm(:ncol,:), wprtp_pbuf(:ncol,:), wpthlp_pbuf(:ncol,:), & wp2_pbuf(:ncol,:), wp3_pbuf(:ncol,:), rtp2_pbuf(:ncol,:), rtp3_pbuf(:ncol,:), & @@ -3764,12 +3765,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & pdf_implicit_coefs_terms_chnk(lchnk), & - khzm_out, khzt_out, & ! outs + khzm_out, khzt_out, & ! Outputs qclvar_out, thlprcp_out, & wprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, & cloudy_updraft_frac_out, cloudy_downdraft_frac_out, & rcm_in_layer, cloud_cover_out, invrs_tau_zm_out, & Lscale ) + + ! The "unslice" copyback step updates the CPU (host) variables, so we need to copy those back to GPU. + ! REMOVECAM: This will be unnecessary once pbuf is gone and these are dimensioned ncol. + !$acc update device( upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & + !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & + !$acc wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & + !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) if ( l_ascending_grid ) then @@ -3778,104 +3787,104 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! so we need to flip them back. This section should flip every array that was flipped ! before the advance_clubb_core call. - thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) - rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) - um_forcing = um_forcing(:,nzt_clubb:1:-1) - vm_forcing = vm_forcing(:,nzt_clubb:1:-1) - wm_zt = wm_zt(:,nzt_clubb:1:-1) - rho_zt = rho_zt(:,nzt_clubb:1:-1) - rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) - invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) - thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) - khzt_out = khzt_out(:,nzt_clubb:1:-1) - rtm_ref = rtm_ref(:,nzt_clubb:1:-1) - thlm_ref = thlm_ref(:,nzt_clubb:1:-1) - um_ref = um_ref(:,nzt_clubb:1:-1) - vm_ref = vm_ref(:,nzt_clubb:1:-1) - ug = ug(:,nzt_clubb:1:-1) - vg = vg(:,nzt_clubb:1:-1) - p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) - exner = exner(:,nzt_clubb:1:-1) - rfrzm = rfrzm(:,nzt_clubb:1:-1) - um = um(:,nzt_clubb:1:-1) - vm = vm(:,nzt_clubb:1:-1) - up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) - vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) - wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) - rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) - thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) - rcm = rcm(:,nzt_clubb:1:-1) - cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) - wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) - wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) - wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) - wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) - qclvar_out = qclvar_out(:,nzt_clubb:1:-1) - cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) - w_up_in_cloud_out = w_up_in_cloud_out(:,nzt_clubb:1:-1) - w_down_in_cloud_out = w_down_in_cloud_out(:,nzt_clubb:1:-1) - cloudy_updraft_frac_out = cloudy_updraft_frac_out(:,nzt_clubb:1:-1) - cloudy_downdraft_frac_out = cloudy_downdraft_frac_out(:,nzt_clubb:1:-1) - rcm_in_layer = rcm_in_layer(:,nzt_clubb:1:-1) - ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) - um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) - vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) - wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) - rtm = rtm(:,nzt_clubb:1:-1) - thlm = thlm(:,nzt_clubb:1:-1) - Lscale = Lscale(:,nzt_clubb:1:-1) - - wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) - wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) - rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) - thlp2_forcing = thlp2_forcing(:,nzm_clubb:1:-1) - rtpthlp_forcing = rtpthlp_forcing(:,nzm_clubb:1:-1) - wm_zm = wm_zm(:,nzm_clubb:1:-1) - rho_zm = rho_zm(:,nzm_clubb:1:-1) - rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) - invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) - thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) - upwp_pbuf = upwp_pbuf(:,nzm_clubb:1:-1) - vpwp_pbuf = vpwp_pbuf(:,nzm_clubb:1:-1) - up2_pbuf = up2_pbuf(:,nzm_clubb:1:-1) - vp2_pbuf = vp2_pbuf(:,nzm_clubb:1:-1) - wprtp_pbuf = wprtp_pbuf(:,nzm_clubb:1:-1) - wpthlp_pbuf = wpthlp_pbuf(:,nzm_clubb:1:-1) - wp2_pbuf = wp2_pbuf(:,nzm_clubb:1:-1) - rtp2_pbuf = rtp2_pbuf(:,nzm_clubb:1:-1) - thlp2_pbuf = thlp2_pbuf(:,nzm_clubb:1:-1) - rtpthlp_pbuf = rtpthlp_pbuf(:,nzm_clubb:1:-1) - wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) - rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) - thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) - uprcp_pbuf = uprcp_pbuf(:,nzm_clubb:1:-1) - vprcp_pbuf = vprcp_pbuf(:,nzm_clubb:1:-1) - rc_coef_zm_pbuf = rc_coef_zm_pbuf(:,nzm_clubb:1:-1) - wp4_pbuf = wp4_pbuf(:,nzm_clubb:1:-1) - wp2up2_pbuf = wp2up2_pbuf(:,nzm_clubb:1:-1) - wp2vp2_pbuf = wp2vp2_pbuf(:,nzm_clubb:1:-1) - upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) - vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) - khzm_out = khzm_out(:,nzm_clubb:1:-1) - thlprcp_out = thlprcp_out(:,nzm_clubb:1:-1) - wprcp_out = wprcp_out(:,nzm_clubb:1:-1) - invrs_tau_zm_out = invrs_tau_zm_out(:,nzm_clubb:1:-1) + thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) + rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) + um_forcing = um_forcing(:,nzt_clubb:1:-1) + vm_forcing = vm_forcing(:,nzt_clubb:1:-1) + wm_zt = wm_zt(:,nzt_clubb:1:-1) + rho_zt = rho_zt(:,nzt_clubb:1:-1) + rho_ds_zt = rho_ds_zt(:,nzt_clubb:1:-1) + invrs_rho_ds_zt = invrs_rho_ds_zt(:,nzt_clubb:1:-1) + thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) + khzt_out = khzt_out(:,nzt_clubb:1:-1) + rtm_ref = rtm_ref(:,nzt_clubb:1:-1) + thlm_ref = thlm_ref(:,nzt_clubb:1:-1) + um_ref = um_ref(:,nzt_clubb:1:-1) + vm_ref = vm_ref(:,nzt_clubb:1:-1) + ug = ug(:,nzt_clubb:1:-1) + vg = vg(:,nzt_clubb:1:-1) + p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) + exner = exner(:,nzt_clubb:1:-1) + rfrzm = rfrzm(:,nzt_clubb:1:-1) + um = um(:,nzt_clubb:1:-1) + vm = vm(:,nzt_clubb:1:-1) + up3_pbuf = up3_pbuf(:,nzt_clubb:1:-1) + vp3_pbuf = vp3_pbuf(:,nzt_clubb:1:-1) + wp3_pbuf = wp3_pbuf(:,nzt_clubb:1:-1) + rtp3_pbuf = rtp3_pbuf(:,nzt_clubb:1:-1) + thlp3_pbuf = thlp3_pbuf(:,nzt_clubb:1:-1) + rcm = rcm(:,nzt_clubb:1:-1) + cloud_frac_inout = cloud_frac_inout(:,nzt_clubb:1:-1) + wpup2_pbuf = wpup2_pbuf(:,nzt_clubb:1:-1) + wpvp2_pbuf = wpvp2_pbuf(:,nzt_clubb:1:-1) + wp2rtp_pbuf = wp2rtp_pbuf(:,nzt_clubb:1:-1) + wp2thlp_pbuf = wp2thlp_pbuf(:,nzt_clubb:1:-1) + qclvar_out = qclvar_out(:,nzt_clubb:1:-1) + cloud_cover_out = cloud_cover_out(:,nzt_clubb:1:-1) + w_up_in_cloud_out = w_up_in_cloud_out(:,nzt_clubb:1:-1) + w_down_in_cloud_out = w_down_in_cloud_out(:,nzt_clubb:1:-1) + cloudy_updraft_frac_out = cloudy_updraft_frac_out(:,nzt_clubb:1:-1) + cloudy_downdraft_frac_out = cloudy_downdraft_frac_out(:,nzt_clubb:1:-1) + rcm_in_layer = rcm_in_layer(:,nzt_clubb:1:-1) + ice_supersat_frac_pbuf = ice_supersat_frac_pbuf(:,nzt_clubb:1:-1) + um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) + vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) + wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) + rtm = rtm(:,nzt_clubb:1:-1) + thlm = thlm(:,nzt_clubb:1:-1) + Lscale = Lscale(:,nzt_clubb:1:-1) + + wprtp_forcing = wprtp_forcing(:,nzm_clubb:1:-1) + wpthlp_forcing = wpthlp_forcing(:,nzm_clubb:1:-1) + rtp2_forcing = rtp2_forcing(:,nzm_clubb:1:-1) + thlp2_forcing = thlp2_forcing(:,nzm_clubb:1:-1) + rtpthlp_forcing = rtpthlp_forcing(:,nzm_clubb:1:-1) + wm_zm = wm_zm(:,nzm_clubb:1:-1) + rho_zm = rho_zm(:,nzm_clubb:1:-1) + rho_ds_zm = rho_ds_zm(:,nzm_clubb:1:-1) + invrs_rho_ds_zm = invrs_rho_ds_zm(:,nzm_clubb:1:-1) + thv_ds_zm = thv_ds_zm(:,nzm_clubb:1:-1) + upwp_pbuf = upwp_pbuf(:,nzm_clubb:1:-1) + vpwp_pbuf = vpwp_pbuf(:,nzm_clubb:1:-1) + up2_pbuf = up2_pbuf(:,nzm_clubb:1:-1) + vp2_pbuf = vp2_pbuf(:,nzm_clubb:1:-1) + wprtp_pbuf = wprtp_pbuf(:,nzm_clubb:1:-1) + wpthlp_pbuf = wpthlp_pbuf(:,nzm_clubb:1:-1) + wp2_pbuf = wp2_pbuf(:,nzm_clubb:1:-1) + rtp2_pbuf = rtp2_pbuf(:,nzm_clubb:1:-1) + thlp2_pbuf = thlp2_pbuf(:,nzm_clubb:1:-1) + rtpthlp_pbuf = rtpthlp_pbuf(:,nzm_clubb:1:-1) + wpthvp_pbuf = wpthvp_pbuf(:,nzm_clubb:1:-1) + rtpthvp_pbuf = rtpthvp_pbuf(:,nzm_clubb:1:-1) + thlpthvp_pbuf = thlpthvp_pbuf(:,nzm_clubb:1:-1) + uprcp_pbuf = uprcp_pbuf(:,nzm_clubb:1:-1) + vprcp_pbuf = vprcp_pbuf(:,nzm_clubb:1:-1) + rc_coef_zm_pbuf = rc_coef_zm_pbuf(:,nzm_clubb:1:-1) + wp4_pbuf = wp4_pbuf(:,nzm_clubb:1:-1) + wp2up2_pbuf = wp2up2_pbuf(:,nzm_clubb:1:-1) + wp2vp2_pbuf = wp2vp2_pbuf(:,nzm_clubb:1:-1) + upwp_pert_inout = upwp_pert_inout(:,nzm_clubb:1:-1) + vpwp_pert_inout = vpwp_pert_inout(:,nzm_clubb:1:-1) + khzm_out = khzm_out(:,nzm_clubb:1:-1) + thlprcp_out = thlprcp_out(:,nzm_clubb:1:-1) + wprcp_out = wprcp_out(:,nzm_clubb:1:-1) + invrs_tau_zm_out = invrs_tau_zm_out(:,nzm_clubb:1:-1) if ( edsclr_dim > 0 ) then - edsclr_inout = edsclr_inout(:,nzt_clubb:1:-1,:) - edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) + edsclr_inout = edsclr_inout(:,nzt_clubb:1:-1,:) + edsclrm_forcing = edsclrm_forcing(:,nzt_clubb:1:-1,:) end if if ( sclr_dim > 0 ) then - sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) - sclrm = sclrm(:,nzt_clubb:1:-1,:) - sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) - - sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) - sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) - sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) - wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) + sclrm_forcing = sclrm_forcing(:,nzt_clubb:1:-1,:) + sclrm = sclrm(:,nzt_clubb:1:-1,:) + sclrp3 = sclrp3(:,nzt_clubb:1:-1,:) + + sclrp2 = sclrp2(:,nzm_clubb:1:-1,:) + sclrprtp = sclrprtp(:,nzm_clubb:1:-1,:) + sclrpthlp = sclrpthlp(:,nzm_clubb:1:-1,:) + wpsclrp = wpsclrp(:,nzm_clubb:1:-1,:) sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) end if @@ -3891,20 +3900,20 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid ! only for pdfp_rtp2_output calc - pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%rt_2 = pdf_params_chnk(lchnk)%rt_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid ! only for update_xp2_mc_api call - pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1(:,nzt_clubb:1:-1) - pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2(:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_1 = pdf_params_chnk(lchnk)%varnce_w_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%varnce_w_2 = pdf_params_chnk(lchnk)%varnce_w_2 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_1 = pdf_params_chnk(lchnk)%thl_1 (:,nzt_clubb:1:-1) + pdf_params_chnk(lchnk)%thl_2 = pdf_params_chnk(lchnk)%thl_2 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_1 = pdf_params_chnk(lchnk)%varnce_thl_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_thl_2 = pdf_params_chnk(lchnk)%varnce_thl_2(:,nzt_clubb:1:-1) From bbc43fa2bc1fdaaa93e1e8c4c9b9fe40e8d61f18 Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Tue, 9 Dec 2025 15:41:28 -0700 Subject: [PATCH 21/29] GPU code changes. This passes the ECT test, using top_lev > 1, ne30pg3_ne30pg3_mt232, FHISTC_LTso, and comparing the GPU code to an intel baseline. --- src/physics/cam/clubb_intr.F90 | 190 +++++++++++++++------------------ 1 file changed, 87 insertions(+), 103 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 2e9664a87d..c16ab2aeb5 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2495,6 +2495,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & latsub, & apply_const, & dl_rad, di_rad, dt_low, & + rrho_tmp, & ! Variables below are needed to compute energy integrals for conservation te_a, se_a, ke_a, wv_a, wl_a, & te_b, se_b, ke_b, wv_b, wl_b @@ -2772,99 +2773,93 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:NAR') call t_startf('clubb_tend_cam:acc_copyin') - !$acc data copyin( sclr_idx, clubb_params_single_col, grid_dx, grid_dy, rairv, cpairv, qrl_pbuf, & - !$acc pdf_params_chnk(lchnk), & - !$acc state_loc, state_loc%q, state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, state_loc%s, state_loc%pint, & - !$acc state_loc%zm, state_loc%zi, state_loc%pdeldry, state_loc%pdel, state_loc%omega, state_loc%phis, & - !$acc cam_in, cam_in%shf, cam_in%wsx, cam_in%wsy, cam_in%cflx, & - !$acc prer_evap_pbuf, cld_pbuf, & - !$acc rtp2_mc_zt_pbuf, thlp2_mc_zt_pbuf, wprtp_mc_zt_pbuf, wpthlp_mc_zt_pbuf, rtpthlp_mc_zt_pbuf, & - !$acc err_info, err_info%err_header ) & - !$acc copy( um, vm, upwp_pbuf, vpwp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, & - !$acc wp2_pbuf, wp3_pbuf, rtp2_pbuf, thlp2_pbuf, rtp3_pbuf, thlp3_pbuf, thlm, rtm, wprtp_pbuf, wpthlp_pbuf, rtpthlp_pbuf, & - !$acc wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & - !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) & - !$acc copyout( rcm, khzm_pbuf, qclvar_out, rcm_in_layer, & - !$acc clubbtop, se_dis, eleak, clubb_s, cloud_frac_inout, wprcp_out, zi_g, & - !$acc zt_g, wm_zt, pdf_params_chnk(lchnk)%mixt_frac, pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & - !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2 ) & - !$acc create( upwp_sfc_pert, vpwp_sfc_pert, khzt_out, khzm_out, & - !$acc fcor, dz_g, & - !$acc rvm_in, & - !$acc pre_in, kappa_zt, invrs_exner_zt, kappa_zm, p_in_Pa_zm, & - !$acc invrs_exner_zm, cloud_cover_out, & - !$acc w_up_in_cloud_out, cloudy_downdraft_frac_out, & - !$acc w_down_in_cloud_out, invrs_tau_zm_out, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, & - !$acc thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & - !$acc wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, & - !$acc rtpthlp_forcing, wm_zm, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, & - !$acc invrs_rho_ds_zm, invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, & - !$acc wpthlp_sfc, clubb_params, sfc_elevation, wprtp_sfc, upwp_sfc, vpwp_sfc, & - !$acc rtm_ref, thlm_ref, um_ref, vm_ref, ug, vg, p_in_Pa, exner, um_pert_inout, & - !$acc thlprcp_out, deltaz, qrl_clubb, p_sfc, & - !$acc err_info%err_code, & - !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & - !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & - !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & - !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2, & - !$acc pdf_params_chnk(lchnk)%thl_1, pdf_params_chnk(lchnk)%thl_2, & - !$acc pdf_params_chnk(lchnk)%varnce_thl_1, pdf_params_chnk(lchnk)%varnce_thl_2, & - !$acc pdf_params_chnk(lchnk)%corr_w_rt_1, pdf_params_chnk(lchnk)%corr_w_rt_2, & - !$acc pdf_params_chnk(lchnk)%corr_w_thl_1, pdf_params_chnk(lchnk)%corr_w_thl_2, & - !$acc pdf_params_chnk(lchnk)%corr_rt_thl_1, pdf_params_chnk(lchnk)%corr_rt_thl_2,& - !$acc pdf_params_chnk(lchnk)%alpha_thl, pdf_params_chnk(lchnk)%alpha_rt, & - !$acc pdf_params_chnk(lchnk)%crt_1, pdf_params_chnk(lchnk)%crt_2, pdf_params_chnk(lchnk)%cthl_1, & - !$acc pdf_params_chnk(lchnk)%cthl_2, pdf_params_chnk(lchnk)%chi_1, & - !$acc pdf_params_chnk(lchnk)%chi_2, pdf_params_chnk(lchnk)%stdev_chi_1, & - !$acc pdf_params_chnk(lchnk)%stdev_chi_2, pdf_params_chnk(lchnk)%stdev_eta_1, & - !$acc pdf_params_chnk(lchnk)%stdev_eta_2, pdf_params_chnk(lchnk)%covar_chi_eta_1, & - !$acc pdf_params_chnk(lchnk)%covar_chi_eta_2, pdf_params_chnk(lchnk)%corr_w_chi_1, & - !$acc pdf_params_chnk(lchnk)%corr_w_chi_2, pdf_params_chnk(lchnk)%corr_w_eta_1, & - !$acc pdf_params_chnk(lchnk)%corr_w_eta_2, pdf_params_chnk(lchnk)%corr_chi_eta_1, & - !$acc pdf_params_chnk(lchnk)%corr_chi_eta_2, pdf_params_chnk(lchnk)%rsatl_1, & - !$acc pdf_params_chnk(lchnk)%rsatl_2, pdf_params_chnk(lchnk)%rc_1, pdf_params_chnk(lchnk)%rc_2, & - !$acc pdf_params_chnk(lchnk)%cloud_frac_1, pdf_params_chnk(lchnk)%cloud_frac_2, & - !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_1, & - !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_2 ) - - !$acc data if ( clubb_config_flags%l_call_pdf_closure_twice ) & - !$acc copyin( pdf_params_zm_chnk(lchnk) ) & - !$acc copy( pdf_zm_w_1_pbuf, pdf_zm_w_2_pbuf, pdf_zm_varnce_w_1_pbuf, pdf_zm_varnce_w_2_pbuf, pdf_zm_mixt_frac_pbuf ) & - !$acc create( pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & + !$acc data copyin( pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), sclr_idx, & + !$acc state_loc, state_loc%q, state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, & + !$acc state_loc%zm, state_loc%phis, state_loc%pdel, state_loc%pdeldry, state_loc%s, & + !$acc state_loc%pint, state_loc%zi, state_loc%omega, & + !$acc cam_in, cam_in%wsx, cam_in%wsy, cam_in%cflx, cam_in%shf, & + !$acc err_info, err_info%err_header, & + !$acc cpairv, rairv, se_dis, eleak, cld_pbuf, clubb_params_single_col, grid_dx, grid_dy ) & + !$acc copyout( clubb_s, clubbtop, & + !$acc qclvar_out, wprcp_out, rcm_in_layer, rcm, cloud_frac_inout, thlm, rtm, & + !$acc um, vm, wm_zt, exner, zt_g, zi_g, & + !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & + !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2, & + !$acc pdf_params_chnk(lchnk)%mixt_frac ) & + !$acc copy( khzm_pbuf, upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & + !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, ice_supersat_frac_pbuf, & + !$acc rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, & + !$acc rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, wp2up2_pbuf, wp2vp2_pbuf ) & + !$acc create( um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, khzm_out, & + !$acc khzt_out, thlprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, cloudy_updraft_frac_out, & + !$acc cloudy_downdraft_frac_out, cloud_cover_out, invrs_tau_zm_out, Lscale, & + !$acc invrs_exner_zt, fcor, sfc_elevation, thlm_forcing, rtm_forcing, um_forcing, & + !$acc vm_forcing, wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, & + !$acc rtpthlp_forcing, wm_zm, wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & + !$acc p_sfc, upwp_sfc_pert, vpwp_sfc_pert, rtm_ref, thlm_ref, um_ref, vm_ref, & + !$acc ug, vg, p_in_Pa, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & + !$acc invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, clubb_params, dz_g, deltaz, err_info%err_code, & + !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & + !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & + !$acc pdf_params_chnk(lchnk)%thl_1, pdf_params_chnk(lchnk)%thl_2, & + !$acc pdf_params_chnk(lchnk)%varnce_thl_1, pdf_params_chnk(lchnk)%varnce_thl_2, & + !$acc pdf_params_chnk(lchnk)%corr_w_rt_1, pdf_params_chnk(lchnk)%corr_w_rt_2, & + !$acc pdf_params_chnk(lchnk)%corr_w_thl_1, pdf_params_chnk(lchnk)%corr_w_thl_2, & + !$acc pdf_params_chnk(lchnk)%corr_rt_thl_1, pdf_params_chnk(lchnk)%corr_rt_thl_2,& + !$acc pdf_params_chnk(lchnk)%alpha_thl, pdf_params_chnk(lchnk)%alpha_rt, & + !$acc pdf_params_chnk(lchnk)%crt_1, pdf_params_chnk(lchnk)%crt_2, & + !$acc pdf_params_chnk(lchnk)%cthl_1, pdf_params_chnk(lchnk)%cthl_2, & + !$acc pdf_params_chnk(lchnk)%chi_1, pdf_params_chnk(lchnk)%chi_2, & + !$acc pdf_params_chnk(lchnk)%stdev_chi_1, pdf_params_chnk(lchnk)%stdev_chi_2, & + !$acc pdf_params_chnk(lchnk)%stdev_eta_1, pdf_params_chnk(lchnk)%stdev_eta_2, & + !$acc pdf_params_chnk(lchnk)%covar_chi_eta_1, pdf_params_chnk(lchnk)%covar_chi_eta_2, & + !$acc pdf_params_chnk(lchnk)%corr_w_chi_1, pdf_params_chnk(lchnk)%corr_w_chi_2, & + !$acc pdf_params_chnk(lchnk)%corr_w_eta_1, pdf_params_chnk(lchnk)%corr_w_eta_2, & + !$acc pdf_params_chnk(lchnk)%corr_chi_eta_1, pdf_params_chnk(lchnk)%corr_chi_eta_2, & + !$acc pdf_params_chnk(lchnk)%rsatl_1, pdf_params_chnk(lchnk)%rsatl_2, & + !$acc pdf_params_chnk(lchnk)%rc_1, pdf_params_chnk(lchnk)%rc_2, & + !$acc pdf_params_chnk(lchnk)%cloud_frac_1, pdf_params_chnk(lchnk)%cloud_frac_2, & + !$acc pdf_params_chnk(lchnk)%ice_supersat_frac_1, pdf_params_chnk(lchnk)%ice_supersat_frac_2 ) + + !$acc data if( clubb_config_flags%l_call_pdf_closure_twice ) & + !$acc copy( pdf_zm_w_1_pbuf, pdf_zm_w_2_pbuf, pdf_zm_varnce_w_1_pbuf, pdf_zm_varnce_w_2_pbuf, pdf_zm_mixt_frac_pbuf, & + !$acc pdf_params_zm_chnk(lchnk)%w_1, pdf_params_zm_chnk(lchnk)%w_2, & !$acc pdf_params_zm_chnk(lchnk)%varnce_w_1, pdf_params_zm_chnk(lchnk)%varnce_w_2, & - !$acc pdf_params_zm_chnk(lchnk)%mixt_frac, & - !$acc pdf_params_zm_chnk(lchnk)%rt_1, pdf_params_zm_chnk(lchnk)%rt_2, & - !$acc pdf_params_zm_chnk(lchnk)%varnce_rt_1, pdf_params_zm_chnk(lchnk)%varnce_rt_2, & - !$acc pdf_params_zm_chnk(lchnk)%thl_1, pdf_params_zm_chnk(lchnk)%thl_2, & - !$acc pdf_params_zm_chnk(lchnk)%varnce_thl_1, pdf_params_zm_chnk(lchnk)%varnce_thl_2, & - !$acc pdf_params_zm_chnk(lchnk)%corr_w_rt_1, pdf_params_zm_chnk(lchnk)%corr_w_rt_2, & - !$acc pdf_params_zm_chnk(lchnk)%corr_w_thl_1, pdf_params_zm_chnk(lchnk)%corr_w_thl_2, & - !$acc pdf_params_zm_chnk(lchnk)%corr_rt_thl_1, pdf_params_zm_chnk(lchnk)%corr_rt_thl_2,& - !$acc pdf_params_zm_chnk(lchnk)%alpha_thl, pdf_params_zm_chnk(lchnk)%alpha_rt, & - !$acc pdf_params_zm_chnk(lchnk)%crt_1, pdf_params_zm_chnk(lchnk)%crt_2, pdf_params_zm_chnk(lchnk)%cthl_1, & - !$acc pdf_params_zm_chnk(lchnk)%cthl_2, pdf_params_zm_chnk(lchnk)%chi_1, & - !$acc pdf_params_zm_chnk(lchnk)%chi_2, pdf_params_zm_chnk(lchnk)%stdev_chi_1, & - !$acc pdf_params_zm_chnk(lchnk)%stdev_chi_2, pdf_params_zm_chnk(lchnk)%stdev_eta_1, & - !$acc pdf_params_zm_chnk(lchnk)%stdev_eta_2, pdf_params_zm_chnk(lchnk)%covar_chi_eta_1, & - !$acc pdf_params_zm_chnk(lchnk)%covar_chi_eta_2, pdf_params_zm_chnk(lchnk)%corr_w_chi_1, & - !$acc pdf_params_zm_chnk(lchnk)%corr_w_chi_2, pdf_params_zm_chnk(lchnk)%corr_w_eta_1, & - !$acc pdf_params_zm_chnk(lchnk)%corr_w_eta_2, pdf_params_zm_chnk(lchnk)%corr_chi_eta_1, & - !$acc pdf_params_zm_chnk(lchnk)%corr_chi_eta_2, pdf_params_zm_chnk(lchnk)%rsatl_1, & - !$acc pdf_params_zm_chnk(lchnk)%rsatl_2, pdf_params_zm_chnk(lchnk)%rc_1, pdf_params_zm_chnk(lchnk)%rc_2, & - !$acc pdf_params_zm_chnk(lchnk)%cloud_frac_1, pdf_params_zm_chnk(lchnk)%cloud_frac_2, & + !$acc pdf_params_zm_chnk(lchnk)%mixt_frac ) & + !$acc create( pdf_params_zm_chnk(lchnk)%rt_1, pdf_params_zm_chnk(lchnk)%rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%varnce_rt_1, pdf_params_zm_chnk(lchnk)%varnce_rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%thl_1, pdf_params_zm_chnk(lchnk)%thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%varnce_thl_1, pdf_params_zm_chnk(lchnk)%varnce_thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_rt_1, pdf_params_zm_chnk(lchnk)%corr_w_rt_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_thl_1, pdf_params_zm_chnk(lchnk)%corr_w_thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_rt_thl_1, pdf_params_zm_chnk(lchnk)%corr_rt_thl_2, & + !$acc pdf_params_zm_chnk(lchnk)%alpha_thl, pdf_params_zm_chnk(lchnk)%alpha_rt, & + !$acc pdf_params_zm_chnk(lchnk)%crt_1, pdf_params_zm_chnk(lchnk)%crt_2, & + !$acc pdf_params_zm_chnk(lchnk)%cthl_1, pdf_params_zm_chnk(lchnk)%cthl_2, & + !$acc pdf_params_zm_chnk(lchnk)%chi_1, pdf_params_zm_chnk(lchnk)%chi_2, & + !$acc pdf_params_zm_chnk(lchnk)%stdev_chi_1, pdf_params_zm_chnk(lchnk)%stdev_chi_2, & + !$acc pdf_params_zm_chnk(lchnk)%stdev_eta_1, pdf_params_zm_chnk(lchnk)%stdev_eta_2, & + !$acc pdf_params_zm_chnk(lchnk)%covar_chi_eta_1, pdf_params_zm_chnk(lchnk)%covar_chi_eta_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_chi_1, pdf_params_zm_chnk(lchnk)%corr_w_chi_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_w_eta_1, pdf_params_zm_chnk(lchnk)%corr_w_eta_2, & + !$acc pdf_params_zm_chnk(lchnk)%corr_chi_eta_1, pdf_params_zm_chnk(lchnk)%corr_chi_eta_2, & + !$acc pdf_params_zm_chnk(lchnk)%rsatl_1, pdf_params_zm_chnk(lchnk)%rsatl_2, & + !$acc pdf_params_zm_chnk(lchnk)%rc_1, pdf_params_zm_chnk(lchnk)%rc_2, & + !$acc pdf_params_zm_chnk(lchnk)%cloud_frac_1, pdf_params_zm_chnk(lchnk)%cloud_frac_2, & !$acc pdf_params_zm_chnk(lchnk)%ice_supersat_frac_1, pdf_params_zm_chnk(lchnk)%ice_supersat_frac_2 ) !$acc data if( sclr_dim > 0 ) & - !$acc create( wpsclrp_sfc, sclrm_forcing, sclrm, wpsclrp, sclrp2, sclrp3, sclrprtp, sclrpthlp, sclrpthvp_inout) & + !$acc create( wpsclrp_sfc, sclrm_forcing, sclrm, wpsclrp, sclrp2, sclrp3, sclrprtp, sclrpthlp, sclrpthvp_inout ) & !$acc copyin( sclr_tol ) !$acc data if( edsclr_dim > 0 ) & - !$acc create( wpedsclrp_sfc, edsclrm_forcing ) & - !$acc copy( edsclr_inout ) + !$acc copyout( edsclr_inout ) & + !$acc create( wpedsclrp_sfc, edsclrm_forcing ) !$acc data if( hydromet_dim > 0 ) & - !$acc create( wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) & - !$acc copyin( hm_metadata, hm_metadata%l_mix_rat_hm ) + !$acc copyin( hm_metadata, hm_metadata%l_mix_rat_hm ) & + !$acc create( wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) call t_stopf('clubb_tend_cam:acc_copyin') call t_startf('clubb_tend_cam:ACCR') @@ -3238,7 +3233,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtpthlp_forcing = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtpthlp_mc_zt_pbuf(1:ncol,:) ) ! Zero out SILHS covariance contribution terms - !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, pcols rtp2_mc_zt_pbuf(i,k) = 0.0_r8 @@ -3334,15 +3328,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:ACCR') call t_startf('clubb_tend_cam:NAR') - !$acc update host( state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, cam_in%wsx, cam_in%wsy, rrho ) + !$acc update host( state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, cam_in%wsx, cam_in%wsy ) ! Adjust surface stresses using winds from the prior macmic iteration do i = 1, ncol ubar = sqrt(state_loc%u(i,pver)**2+state_loc%v(i,pver)**2) if (ubar < 0.25_r8) ubar = 0.25_r8 - rrho(i) = calc_ideal_gas_rrho(rair, state_loc%t(i,pver), state_loc%pmid(i,pver)) - ustar = calc_friction_velocity(cam_in%wsx(i), cam_in%wsy(i), rrho(i)) + rrho_tmp = calc_ideal_gas_rrho(rair, state_loc%t(i,pver), state_loc%pmid(i,pver)) + ustar = calc_friction_velocity(cam_in%wsx(i), cam_in%wsy(i), rrho_tmp) upwp_sfc(i) = -state_loc%u(i,pver)*ustar**2/ubar vpwp_sfc(i) = -state_loc%v(i,pver)*ustar**2/ubar @@ -3749,13 +3743,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & ! InOuts um, vm, upwp_pbuf(:ncol,:), vpwp_pbuf(:ncol,:), & up2_pbuf(:ncol,:), vp2_pbuf(:ncol,:), up3_pbuf(:ncol,:), vp3_pbuf(:ncol,:), & - thlm(:ncol,:), rtm(:ncol,:), wprtp_pbuf(:ncol,:), wpthlp_pbuf(:ncol,:), & + thlm, rtm, wprtp_pbuf(:ncol,:), wpthlp_pbuf(:ncol,:), & wp2_pbuf(:ncol,:), wp3_pbuf(:ncol,:), rtp2_pbuf(:ncol,:), rtp3_pbuf(:ncol,:), & thlp2_pbuf(:ncol,:), thlp3_pbuf(:ncol,:), rtpthlp_pbuf(:ncol,:), & sclrm, & sclrp2, sclrp3, sclrprtp, sclrpthlp, & wpsclrp, edsclr_inout, err_info, & - rcm(:ncol,:), cloud_frac_inout, & + rcm, cloud_frac_inout, & wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & sclrpthvp_inout, & wp2rtp_pbuf(:ncol,:), wp2thlp_pbuf(:ncol,:), uprcp_pbuf(:ncol,:), & @@ -4028,9 +4022,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:stats_end_timestep_clubb') end if - enddo ! end time loop + end do ! end time loop !----------------------------------------- END substepping loop ----------------------------------------- + !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb do i = 1, ncol @@ -4071,12 +4066,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, top_lev-1 do i = 1, ncol - ! inv_exner has not been calculated for above top_lev yet - inv_exner_tmp = 1._r8 / ( ( state_loc%pmid(i,k) / p0_clubb )**( rairv(i,k,lchnk) / cpairv(i,k,lchnk) ) ) - ! This can be simplified algebraically, but left like this to maintain BFBness - clubb_s(i,k) = cpairv(i,k,lchnk) * ( ( state_loc%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state_loc%q(i,k,ixcldliq) ) & - * inv_exner_tmp ) / inv_exner_tmp & + clubb_s(i,k) = cpairv(i,k,lchnk) * ( state_loc%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state_loc%q(i,k,ixcldliq) ) & + latvap * 0._r8 & ! error kept for BFBness !+ latvap * state_loc%q(i,k,ixcldliq) & ! correct line + gravit * state_loc%zm(i,k) + state_loc%phis(i) @@ -4195,7 +4186,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif - call t_stopf('clubb_tend_cam:ACCR') call t_startf('clubb_tend_cam:acc_copyout') @@ -4462,12 +4452,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! and compute output, etc ! ! ------------------------------------------------- ! - - print *, "ptend_all%ls = ", ptend_all%ls - print *, "ptend_all%llus = ", ptend_all%lu - print *, "ptend_all%lv = ", ptend_all%lv - print *, "ptend_all%lq = ", ptend_all%lq - call physics_ptend_sum(ptend_loc,ptend_all,ncol) call physics_update(state_loc,ptend_loc,hdtime) From c9e9d97e07ea4b5e34fdb4f77bcd7ea4dc8298cf Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Wed, 10 Dec 2025 12:21:18 -0700 Subject: [PATCH 22/29] Improving description of possible options for clubb_fill_holes_type --- bld/namelist_files/namelist_definition.xml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index a108088cbc..384231e1dd 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3950,6 +3950,14 @@ Valid values: 0 (no grid adaptation), 1 (use Lscale and wp2) group="clubb_params_nl" valid_values="0,1,2,3,4,5,6" > Selects which algorithm the fill_holes routine uses to correct below threshold values in field solutions. +0: off - Skip the mass conservative hole filling step, rely on blunt clipping +1: global - Fast but minimally local, most methods use this as a fallback step +2: sliding_window - Expensive but highly local when possible, falls back to global fill if needed +3: widening_windows - Slightly parallelizable, local when possible, falls back to global if needed +4: smart_window - Uses hueristics to determine ranges to fill, fast and highly local when possible, falls back to global if needed +5: smart_window_smooth - Same as smart_window, but with experimental smoothing features that slightly increases cost, NO GLOBAL FALLBACK +6: parallel_fill - Highly local when possible, completely parallelizable but computationally wasteful, falls back to global if needed +See CLUBB_core/model_flags.F90 or CLUBB_core/fill_holes.F90 for more detail. Date: Wed, 10 Dec 2025 14:16:12 -0700 Subject: [PATCH 23/29] Renaming l_ascending_grid to clubb_l_ascending_grid and adding it to the namelist files --- bld/build-namelist | 1 + bld/namelist_files/namelist_defaults_cam.xml | 1 + bld/namelist_files/namelist_definition.xml | 7 +++ src/physics/cam/clubb_intr.F90 | 64 +++++++++++--------- src/physics/cam/subcol_SILHS.F90 | 1 - 5 files changed, 43 insertions(+), 31 deletions(-) diff --git a/bld/build-namelist b/bld/build-namelist index b3e566f2c9..a18f8420f2 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3503,6 +3503,7 @@ if ($clubb_sgs =~ /$TRUE/io) { die "$ProgName - ERROR: clubb_history = .true. with multiple threads is not supported. \n"; } + add_default($nl, 'clubb_l_ascending_grid'); add_default($nl, 'clubb_do_icesuper'); add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_cloudtop_cooling'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 696147d27e..5f853335cf 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2120,6 +2120,7 @@ 300.0D0 1.0D0 .false. + .false. diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 384231e1dd..e28c502bcd 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3672,6 +3672,13 @@ Switch for CLUBB_ADV parameter that turns on advection of CLUBB pdf moments by the dynamics core. Very experimental. + +Causes advance_clubb_core to run in ascending mode, where the surface is at k=1, which is opposite +of the descending cam grid. This is mainly a testing/debugging option - it requires an expensive +data flipping step and should not change answers significantly. + + diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index c16ab2aeb5..3022cc0dec 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -85,12 +85,6 @@ module clubb_intr type (sclr_idx_type), public :: & sclr_idx - logical, public, parameter :: & - l_ascending_grid = .false. ! Set clubb to ascending mode, which is opposite of the - ! cam grid the rest of this code uses, thus it requires - ! an expensive array flipping step before calling clubb. - ! This is mainly for testing - integer, public :: & nzm_clubb, & ! Number of vertical levels used by CLUBB momentum variables nzt_clubb ! Number of vertical levels used by CLUBB thermodynamic variables @@ -166,6 +160,12 @@ module clubb_intr logical :: & clubb_l_intr_sfc_flux_smooth = .false. ! Add a locally calculated roughness to upwp and vpwp sfc fluxes + logical :: & + clubb_l_ascending_grid = .false. ! Run clubb in ascending mode, which is opposite of the + ! cam grid the rest of this code uses, thus it requires + ! an expensive array flipping step before calling advance_clubb_core. + ! This is mainly for testing, it should not significantly change answers + logical :: lq(pcnst) logical :: do_rainturb logical :: clubb_do_adv @@ -770,7 +770,8 @@ subroutine clubb_readnl(nlfile) namelist /clubb_his_nl/ clubb_history, clubb_rad_history namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, & clubb_do_adv, clubb_timestep, & - clubb_rnevap_effic,clubb_do_icesuper + clubb_rnevap_effic, clubb_do_icesuper, & + clubb_l_ascending_grid namelist /clubb_params_nl/ clubb_beta, & clubb_bv_efold, & clubb_c1, & @@ -899,6 +900,7 @@ subroutine clubb_readnl(nlfile) stats_metadata%l_output_rad_files = .false. ! Initialize to false do_cldcool = .false. ! Initialize to false do_rainturb = .false. ! Initialize to false + clubb_l_ascending_grid = .false. ! Initialize to false ! Initialize namelist variables to clubb defaults call set_default_clubb_config_flags_api( clubb_iiPDF_type, & ! Out @@ -1018,6 +1020,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rainevap_turb") call mpi_bcast(clubb_do_adv, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_adv") + call mpi_bcast(clubb_l_ascending_grid, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_ascending_grid") call mpi_bcast(clubb_timestep, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_timestep") call mpi_bcast(clubb_rnevap_effic, 1, mpi_real8, mstrid, mpicom, ierr) @@ -1882,7 +1886,7 @@ subroutine clubb_ini_cam(pbuf_ini) call add_default('WPRTP_CLUBB', 1, ' ') call add_default('RTP2_CLUBB', 1, ' ') call add_default('RTP2_ZT_CLUBB', 1, ' ') - call add_default('PDFP_RTP2_CLUBB', 1, ' ') + call add_default('PDFP_RTP2_CLUBB', 1, ' ') call add_default('THLP2_CLUBB', 1, ' ') call add_default('THLP2_ZT_CLUBB', 1, ' ') call add_default('RTPTHLP_CLUBB', 1, ' ') @@ -2537,11 +2541,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & #ifdef _OPENACC ! These options have not been GPUized - if ( l_ascending_grid ) call endrun(subr//': l_ascending_grid=.true. not available when compiling with OpenACC') - if ( do_clubb_mf ) call endrun(subr//': do_clubb_mf=.true. not available when compiling with OpenACC') - if ( do_rainturb ) call endrun(subr//': do_rainturb=.true. not available when compiling with OpenACC') - if ( do_cldcool ) call endrun(subr//': do_cldcool=.true. not available when compiling with OpenACC') - if ( clubb_do_icesuper ) call endrun(subr//': clubb_do_icesuper=.true. not available when compiling with OpenACC') + if ( clubb_l_ascending_grid ) call endrun(subr//': clubb_l_ascending_grid=.true. not available when compiling with OpenACC') + if ( do_clubb_mf ) call endrun(subr//': do_clubb_mf=.true. not available when compiling with OpenACC') + if ( do_rainturb ) call endrun(subr//': do_rainturb=.true. not available when compiling with OpenACC') + if ( do_cldcool ) call endrun(subr//': do_cldcool=.true. not available when compiling with OpenACC') + if ( clubb_do_icesuper ) call endrun(subr//': clubb_do_icesuper=.true. not available when compiling with OpenACC') if ( single_column .and. .not. scm_cambfb_mode ) then call endrun(subr//': (single_column && !scm_cambfb_mode)=.true. not available when compiling with OpenACC') end if @@ -3546,7 +3550,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Advance CLUBB CORE one timestep in the future call t_startf('clubb_tend_cam:advance_clubb_core_api') - if ( l_ascending_grid ) then + if ( clubb_l_ascending_grid ) then ! CLUBB is to be run in ascending mode, which has the surface at k=1, which is ! the opposite of the cam grid that the rest of clubb_intr uses, so @@ -3645,7 +3649,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) end if - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid. + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. ! only because these are need to be stored for restarts if ( clubb_config_flags%l_call_pdf_closure_twice ) then pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) @@ -3655,7 +3659,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) end if - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid. + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. ! only for pdfp_rtp2_output calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1 (:,nzt_clubb:1:-1) @@ -3663,7 +3667,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid. + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid. ! only for update_xp2_mc_api call pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) @@ -3699,7 +3703,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! we are in ascending mode, need to recalculate gr in ascending mode call setup_grid_api( nzm_clubb, ncol, sfc_elevation, l_implemented, & ! intent(in) - l_ascending_grid, grid_type, & ! intent(in) + clubb_l_ascending_grid, grid_type, & ! intent(in) deltaz, zi_g(:,1), zi_g(:,nzm_clubb), & ! intent(in) zi_g(:,nzm_clubb:1:-1), zt_g(:,nzt_clubb:1:-1), & ! intent(in) gr, err_info ) ! intent(inout) @@ -3775,7 +3779,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) - if ( l_ascending_grid ) then + if ( clubb_l_ascending_grid ) then ! If running in ascending mode, we flip the arrays before calling advance_clubb_core ! so we need to flip them back. This section should flip every array that was flipped @@ -3882,7 +3886,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sclrpthvp_inout = sclrpthvp_inout(:,nzm_clubb:1:-1,:) end if - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid ! only because these are need to be stored for restarts if ( clubb_config_flags%l_call_pdf_closure_twice ) then pdf_params_zm_chnk(lchnk)%w_1 = pdf_params_zm_chnk(lchnk)%w_1 (:,nzm_clubb:1:-1) @@ -3892,7 +3896,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_zm_chnk(lchnk)%mixt_frac = pdf_params_zm_chnk(lchnk)%mixt_frac (:,nzm_clubb:1:-1) end if - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid ! only for pdfp_rtp2_output calc pdf_params_chnk(lchnk)%mixt_frac = pdf_params_chnk(lchnk)%mixt_frac (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%rt_1 = pdf_params_chnk(lchnk)%rt_1 (:,nzt_clubb:1:-1) @@ -3900,7 +3904,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & pdf_params_chnk(lchnk)%varnce_rt_1 = pdf_params_chnk(lchnk)%varnce_rt_1(:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%varnce_rt_2 = pdf_params_chnk(lchnk)%varnce_rt_2(:,nzt_clubb:1:-1) - ! These are flipped, ensuring these are stored in descending mode, regardless of l_ascending_grid + ! These are flipped, ensuring these are stored in descending mode, regardless of clubb_l_ascending_grid ! only for update_xp2_mc_api call pdf_params_chnk(lchnk)%w_1 = pdf_params_chnk(lchnk)%w_1 (:,nzt_clubb:1:-1) pdf_params_chnk(lchnk)%w_2 = pdf_params_chnk(lchnk)%w_2 (:,nzt_clubb:1:-1) @@ -5717,8 +5721,8 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st do i = 1, stats_zt%num_output_fields do k = 1, stats_zt%kk - ! The data stored in stats types are ascending if l_ascending_grid = .true. - if ( l_ascending_grid ) then + ! The data stored in stats types are ascending if clubb_l_ascending_grid = .true. + if ( clubb_l_ascending_grid ) then out_zt(thecol,pver+1-k,i) = stats_zt%accum_field_values(1,1,k,i) else out_zt(thecol,top_lev-1+k,i) = stats_zt%accum_field_values(1,1,k,i) @@ -5732,8 +5736,8 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st do i = 1, stats_zm%num_output_fields do k = 1, stats_zm%kk - ! The data stored in stats types are ascending if l_ascending_grid = .true. - if ( l_ascending_grid ) then + ! The data stored in stats types are ascending if clubb_l_ascending_grid = .true. + if ( clubb_l_ascending_grid ) then out_zm(thecol,pverp+1-k,i) = stats_zm%accum_field_values(1,1,k,i) else out_zm(thecol,top_lev-1+k,i) = stats_zm%accum_field_values(1,1,k,i) @@ -5748,8 +5752,8 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st do i = 1, stats_rad_zt%num_output_fields do k = 1, stats_rad_zt%kk - ! The data stored in stats types are ascending if l_ascending_grid = .true. - if ( l_ascending_grid ) then + ! The data stored in stats types are ascending if clubb_l_ascending_grid = .true. + if ( clubb_l_ascending_grid ) then out_radzt(thecol,pver+1-k,i) = stats_rad_zt%accum_field_values(1,1,k,i) else out_radzt(thecol,top_lev-1+k,i) = stats_rad_zt%accum_field_values(1,1,k,i) @@ -5763,8 +5767,8 @@ subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, st do i = 1, stats_rad_zm%num_output_fields do k = 1, stats_rad_zm%kk - ! The data stored in stats types are ascending if l_ascending_grid = .true. - if ( l_ascending_grid ) then + ! The data stored in stats types are ascending if clubb_l_ascending_grid = .true. + if ( clubb_l_ascending_grid ) then out_radzm(thecol,pverp+1-k,i) = stats_rad_zm%accum_field_values(1,1,k,i) else out_radzm(thecol,top_lev-1+k,i) = stats_rad_zm%accum_field_values(1,1,k,i) diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index fef38d4b84..9ed3166c4e 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -26,7 +26,6 @@ module subcol_SILHS hm_metadata, & hydromet_dim, & pdf_dim, & - l_ascending_grid, & nzm_clubb, & nzt_clubb From 996e994ca44fbaab426fedbc0c1e2122475bb453 Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Mon, 15 Dec 2025 22:43:46 -0700 Subject: [PATCH 24/29] Various performance improvements --- src/physics/cam/clubb_intr.F90 | 257 +++++++++++++++++++++------------ 1 file changed, 164 insertions(+), 93 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 3022cc0dec..408c5b8b5b 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -125,7 +125,8 @@ module clubb_intr rtm_nudge_max_altitude = 10000._r8, & ! Highest altitude at which to nudge rtm [m] theta0 = 300._r8, & ! Reference temperature [K] ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s] - p0_clubb = 100000._r8 + p0_clubb = 100000._r8, & + inv_p0_clubb = 1._r8 / 100000._r8 real(r8), parameter :: & wp3_const = 1._r8 ! Constant to add to wp3 when moments are advected @@ -2466,25 +2467,28 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & dummy3 ! dummy variable [units vary] real(r8), dimension(pcols,pver) :: & - temp2d, & ! temporary array for holding scaled outputs - qitend, & - initend, & ! Needed for ice supersaturation adjustment calculation - stend, & - qvtend, & - qctend, & - inctend, & - clubb_s, & - thv, & ! virtual potential temperature [K] - th ! potential temperature [K] + invrs_cpairv, & + temp2d, & ! temporary array for holding scaled outputs + qitend, & + initend, & ! Needed for ice supersaturation adjustment calculation + stend, & + qvtend, & + qctend, & + inctend, & + clubb_s, & + thv, & ! virtual potential temperature [K] + th ! potential temperature [K] real(r8), dimension(pcols,pverp) :: & rho ! Midpoint density in CAM [kg/m^3] real(r8) :: & + invrs_dz_g, & ! Inverse of layer thickness [1/m] inv_exner_tmp, & ! Inverse exner function consistent with CLUBB [-] dlf2, & ! Detraining cld H20 from shallow convection [kg/kg/day] dum1, & ! dummy variable [units vary] invrs_hdtime, & + invrs_macmic_num_steps, & lmin, & mixt_frac_max_mag, & dtime, & ! CLUBB time step [s] @@ -2786,7 +2790,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc cpairv, rairv, se_dis, eleak, cld_pbuf, clubb_params_single_col, grid_dx, grid_dy ) & !$acc copyout( clubb_s, clubbtop, & !$acc qclvar_out, wprcp_out, rcm_in_layer, rcm, cloud_frac_inout, thlm, rtm, & - !$acc um, vm, wm_zt, exner, zt_g, zi_g, & + !$acc um, vm, wm_zt, exner, zt_g, zi_g, invrs_cpairv, & !$acc pdf_params_chnk(lchnk)%rt_1, pdf_params_chnk(lchnk)%rt_2, & !$acc pdf_params_chnk(lchnk)%varnce_rt_1, pdf_params_chnk(lchnk)%varnce_rt_2, & !$acc pdf_params_chnk(lchnk)%mixt_frac ) & @@ -2803,7 +2807,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc rtpthlp_forcing, wm_zm, wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & !$acc p_sfc, upwp_sfc_pert, vpwp_sfc_pert, rtm_ref, thlm_ref, um_ref, vm_ref, & !$acc ug, vg, p_in_Pa, rho_zm, rho_zt, rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - !$acc invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, clubb_params, dz_g, deltaz, err_info%err_code, & + !$acc invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, rfrzm, clubb_params, deltaz, err_info%err_code, & !$acc pdf_params_chnk(lchnk)%w_1, pdf_params_chnk(lchnk)%w_2, & !$acc pdf_params_chnk(lchnk)%varnce_w_1, pdf_params_chnk(lchnk)%varnce_w_2, & !$acc pdf_params_chnk(lchnk)%thl_1, pdf_params_chnk(lchnk)%thl_2, & @@ -2952,8 +2956,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & if ( edsclr_dim > 0 ) then !$acc parallel loop gang vector collapse(3) default(present) do edsclr = 1, edsclr_dim - do i = 1, ncol - do k = 1, nzt_clubb + do k = 1, nzt_clubb + do i = 1, ncol edsclrm_forcing(i,k,edsclr) = 0._r8 end do end do @@ -3010,8 +3014,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 ) - do i = 1, ncol - do k = 1, pver + do k = 1, pver + do i = 1, ncol stend(i,k) = 0._r8 qvtend(i,k) = 0._r8 qitend(i,k) = 0._r8 @@ -3029,8 +3033,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call t_stopf('clubb_tend_cam:ice_macro_tend') ! update local copy of state with the tendencies - do i = 1, ncol - do k = top_lev, pver + do k = top_lev, pver + do i = 1, ncol ptend_loc%q(i,k,1) = qvtend(i,k) ptend_loc%q(i,k,ixcldice) = qitend(i,k) ptend_loc%q(i,k,ixnumice) = initend(i,k) @@ -3045,9 +3049,9 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call physics_update(state_loc, ptend_loc, hdtime) ! Write output for tendencies: - do i = 1, ncol - do k = 1, pver - temp2d(i,k) = stend(i,k) / cpairv(i,k,lchnk) + do k = 1, pver + do i = 1, ncol + temp2d(i,k) = stend(i,k) * invrs_cpairv(i,k) end do end do @@ -3099,6 +3103,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do end do + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, pver + do i = 1, ncol + invrs_cpairv(i,k) = 1._r8 / cpairv(i,k,lchnk) + end do + end do + ! Compute thermodynamic stuff needed for CLUBB on thermo levels. !$acc parallel loop gang vector collapse(2) default(present) do k = 1, nzt_clubb @@ -3109,44 +3120,62 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Define the CLUBB thermodynamic grid (in units of m) zt_g(i,k) = state_loc%zm(i,k_cam) - state_loc%zi(i,pverp) - dz_g(i,k) = state_loc%zi(i,k_cam) - state_loc%zi(i,k_cam+1) ! compute thickness + invrs_dz_g = 1._r8 / ( state_loc%zi(i,k_cam) - state_loc%zi(i,k_cam+1) ) ! compute thickness + + rho_zt(i,k) = rga * state_loc%pdel(i,k_cam) * invrs_dz_g + + rho_ds_zt(i,k) = rga * state_loc%pdeldry(i,k_cam) * invrs_dz_g + + invrs_rho_ds_zt(i,k) = 1._r8 / rho_ds_zt(i,k) + + end do + end do + + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzt_clubb + do i = 1, ncol + k_cam = top_lev - 1 + k + + p_in_Pa(i,k) = state_loc%pmid(i,k_cam) + ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables ! (such as thlm), use "invrs_exner_zt" otherwise use the exner in state - invrs_exner_zt(i,k) = 1._r8 / ( ( state_loc%pmid(i,k_cam) / p0_clubb ) & - **( rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) ) ) + exner(i,k) = ( p_in_Pa(i,k) * inv_p0_clubb )**( rairv(i,k_cam,lchnk) * invrs_cpairv(i,k_cam) ) - ! base state (dry) variables - rho_ds_zt(i,k) = rga * ( state_loc%pdeldry(i,k_cam) / dz_g(i,k) ) - invrs_rho_ds_zt(i,k) = 1._r8 / rho_ds_zt(i,k) - - ! full state (moist) variables - exner(i,k) = 1._r8 / invrs_exner_zt(i,k) - rho_zt(i,k) = rga*state_loc%pdel(i,k_cam)/dz_g(i,k) + invrs_exner_zt(i,k) = 1._r8 / exner(i,k) ! exception - setting this to moist thv_ds_zt - thv_ds_zt(i,k) = state_loc%t(i,k_cam) * invrs_exner_zt(i,k) & - * (1._r8 + zvir * state_loc%q(i,k_cam,ixq) - state_loc%q(i,k_cam,ixcldliq)) + thv_ds_zt(i,k) = state_loc%t(i,k_cam) * invrs_exner_zt(i,k) & + * (1._r8 + zvir * state_loc%q(i,k_cam,ixq) - state_loc%q(i,k_cam,ixcldliq)) + rcm(i,k) = state_loc%q(i,k_cam,ixcldliq) + rtm(i,k) = state_loc%q(i,k_cam,ixq) + state_loc%q(i,k_cam,ixcldliq) - ! Compute mean w wind on thermo grid, convert from omega to w - wm_zt(i,k) = -1._r8*(state_loc%omega(i,k_cam)-state_loc%omega(i,pver))/(rho_zt(i,k)*gravit) + thlm(i,k) = ( state_loc%t(i,k_cam) - ( latvap * invrs_cpairv(i,k_cam) ) & + * state_loc%q(i,k_cam,ixcldliq) ) & + * invrs_exner_zt(i,k) - rfrzm(i,k) = state_loc%q(i,k_cam,ixcldice) - p_in_Pa(i,k) = state_loc%pmid(i,k_cam) + end do + end do + + !$acc parallel loop gang vector collapse(2) default(present) + do k = 1, nzt_clubb + do i = 1, ncol + + k_cam = top_lev - 1 + k + + ! Compute mean w wind on thermo grid, convert from omega to w + wm_zt(i,k) = -1._r8 * ( state_loc%omega(i,k_cam) - state_loc%omega(i,pver) ) / ( rho_zt(i,k) * gravit ) cloud_frac_inout(i,k) = cld_pbuf(i,k_cam) - um(i,k) = state_loc%u(i,k_cam) - vm(i,k) = state_loc%v(i,k_cam) - rcm(i,k) = state_loc%q(i,k_cam,ixcldliq) - rtm(i,k) = state_loc%q(i,k_cam,ixq) + state_loc%q(i,k_cam,ixcldliq) + um(i,k) = state_loc%u(i,k_cam) + vm(i,k) = state_loc%v(i,k_cam) - thlm(i,k) = ( state_loc%t(i,k_cam) - ( latvap / cpairv(i,k_cam,lchnk) ) & - * state_loc%q(i,k_cam,ixcldliq) ) & - * invrs_exner_zt(i,k) + rfrzm(i,k) = state_loc%q(i,k_cam,ixcldice) end do end do @@ -3385,7 +3414,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do k = 1, nzt_clubb do i = 1, ncol k_cam = top_lev - 1 + k - kappa_zt(i,k) = rairv(i,k_cam,lchnk) / cpairv(i,k_cam,lchnk) + kappa_zt(i,k) = rairv(i,k_cam,lchnk) * invrs_cpairv(i,k_cam) + dz_g(i,k) = state_loc%zi(i,k_cam) - state_loc%zi(i,k_cam+1) ! compute thickness end do end do @@ -3395,7 +3425,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol k_cam = top_lev - 1 + k p_in_Pa_zm(i,k) = state_loc%pint(i,k_cam) - invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k)/p0_clubb)**kappa_zm(i,k) ) + invrs_exner_zm(i,k) = 1._r8 / ( (p_in_Pa_zm(i,k)*inv_p0_clubb)**kappa_zm(i,k) ) end do end do @@ -4071,7 +4101,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol ! This can be simplified algebraically, but left like this to maintain BFBness - clubb_s(i,k) = cpairv(i,k,lchnk) * ( state_loc%t(i,k) - ( latvap / cpairv(i,k,lchnk) ) * state_loc%q(i,k,ixcldliq) ) & + clubb_s(i,k) = cpairv(i,k,lchnk) * state_loc%t(i,k) - latvap * state_loc%q(i,k,ixcldliq) & + latvap * 0._r8 & ! error kept for BFBness !+ latvap * state_loc%q(i,k,ixcldliq) & ! correct line + gravit * state_loc%zm(i,k) + state_loc%phis(i) @@ -4181,10 +4211,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & do i = 1, ncol do k = clubbtop(i), pver - clubb_s(i,k) = clubb_s(i,k) - se_dis(i)*gravit + clubb_s(i,k) = clubb_s(i,k) - se_dis(i) * gravit end do ! convert to units of +ve [K] - se_dis(i) = -1._r8*se_dis(i)*gravit/cpairv(i,pver,lchnk) + se_dis(i) = -1._r8 * se_dis(i) * gravit * invrs_cpairv(i,pver) end do @@ -4213,15 +4243,15 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & relvarmax = 10.0_r8 endif - do i = 1, ncol - do k = 1, pver + do k = 1, pver + do i = 1, ncol relvar_pbuf(i,k) = relvarmax ! default end do end do if (deep_scheme .ne. 'CLUBB_SGS') then - do i = 1, ncol - do k = top_lev, pver + do k = top_lev, pver + do i = 1, ncol k_clubb = k + 1 - top_lev if ( rcm(i,k_clubb) /= 0 .and. qclvar_out(i,k_clubb) /= 0 ) then relvar_pbuf(i,k) = min( relvarmax, max(0.001_r8, rcm(i,k_clubb)**2 / qclvar_out(i,k_clubb) ) ) @@ -4339,30 +4369,58 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do !--------------------------------- END TODO --------------------------------- - ! need to initialize macmic coupling to zero - if ( macmic_it == 1 ) then - ttend_clubb_mc_pbuf(:,:) = 0._r8 - upwp_clubb_gw_mc_pbuf(:,:) = 0._r8 - vpwp_clubb_gw_mc_pbuf(:,:) = 0._r8 - thlp2_clubb_gw_mc_pbuf(:,:) = 0._r8 - wpthlp_clubb_gw_mc_pbuf(:,:) = 0._r8 - end if + invrs_macmic_num_steps = 1.0_r8 / REAL(cld_macmic_num_steps,r8) - ! Accumulate vars through macmic subcycle for Gravity Wave parameterization - ttend_clubb_mc_pbuf (1:ncol,1:nzt_clubb) = ttend_clubb_mc_pbuf(1:ncol,1:nzt_clubb) + ptend_loc%s(1:ncol,top_lev:pver) / cpair - upwp_clubb_gw_mc_pbuf (1:ncol,1:nzm_clubb) = upwp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) + upwp_pbuf (1:ncol,1:nzm_clubb) - vpwp_clubb_gw_mc_pbuf (1:ncol,1:nzm_clubb) = vpwp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) + vpwp_pbuf (1:ncol,1:nzm_clubb) - thlp2_clubb_gw_mc_pbuf (1:ncol,1:nzm_clubb) = thlp2_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) + thlp2_pbuf (1:ncol,1:nzm_clubb) - wpthlp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) = wpthlp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) + wpthlp_pbuf(1:ncol,1:nzm_clubb) - - ! And average at last macmic step - if (macmic_it == cld_macmic_num_steps) then - ttend_clubb_pbuf (1:ncol,top_lev:pver ) = ttend_clubb_mc_pbuf(1:ncol,1:nzt_clubb) / REAL(cld_macmic_num_steps,r8) - upwp_clubb_gw_pbuf (1:ncol,top_lev:pverp) = upwp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) / REAL(cld_macmic_num_steps,r8) - vpwp_clubb_gw_pbuf (1:ncol,top_lev:pverp) = vpwp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) / REAL(cld_macmic_num_steps,r8) - thlp2_clubb_gw_pbuf (1:ncol,top_lev:pverp) = thlp2_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) / REAL(cld_macmic_num_steps,r8) - wpthlp_clubb_gw_pbuf(1:ncol,top_lev:pverp) = wpthlp_clubb_gw_mc_pbuf(1:ncol,1:nzm_clubb) / REAL(cld_macmic_num_steps,r8) - end if + do k = top_lev, pver + do i = 1, ncol + + k_clubb = k + 1 - top_lev + + ! need to initialize macmic coupling to zero + if ( macmic_it == 1 ) then + ttend_clubb_mc_pbuf(i,k_clubb) = 0._r8 + end if + + ! Accumulate vars through macmic subcycle for Gravity Wave parameterization + ttend_clubb_mc_pbuf(i,k_clubb) = ttend_clubb_mc_pbuf(i,k_clubb) + ptend_loc%s(i,k) / cpair + + ! And average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + ttend_clubb_pbuf(i,k) = ttend_clubb_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + end if + + end do + end do + + do k = top_lev, pverp + do i = 1, ncol + + k_clubb = k + 1 - top_lev + + ! need to initialize macmic coupling to zero + if ( macmic_it == 1 ) then + upwp_clubb_gw_mc_pbuf(i,k_clubb) = 0._r8 + vpwp_clubb_gw_mc_pbuf(i,k_clubb) = 0._r8 + thlp2_clubb_gw_mc_pbuf(i,k_clubb) = 0._r8 + wpthlp_clubb_gw_mc_pbuf(i,k_clubb) = 0._r8 + end if + + ! Accumulate vars through macmic subcycle for Gravity Wave parameterization + upwp_clubb_gw_mc_pbuf (i,k_clubb) = upwp_clubb_gw_mc_pbuf(i,k_clubb) + upwp_pbuf (i,k_clubb) + vpwp_clubb_gw_mc_pbuf (i,k_clubb) = vpwp_clubb_gw_mc_pbuf(i,k_clubb) + vpwp_pbuf (i,k_clubb) + thlp2_clubb_gw_mc_pbuf (i,k_clubb) = thlp2_clubb_gw_mc_pbuf(i,k_clubb) + thlp2_pbuf (i,k_clubb) + wpthlp_clubb_gw_mc_pbuf(i,k_clubb) = wpthlp_clubb_gw_mc_pbuf(i,k_clubb) + wpthlp_pbuf(i,k_clubb) + + ! And average at last macmic step + if (macmic_it == cld_macmic_num_steps) then + upwp_clubb_gw_pbuf (i,k) = upwp_clubb_gw_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + vpwp_clubb_gw_pbuf (i,k) = vpwp_clubb_gw_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + thlp2_clubb_gw_pbuf (i,k) = thlp2_clubb_gw_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + wpthlp_clubb_gw_pbuf(i,k) = wpthlp_clubb_gw_mc_pbuf(i,k_clubb) * invrs_macmic_num_steps + end if + + end do + end do if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then @@ -4436,13 +4494,17 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if end do - rvmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixq) * state_loc%pdeldry(:ncol,:pver) / state_loc%pdel(:ncol,:pver) - rcmtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq) * state_loc%pdeldry(:ncol,:pver) / state_loc%pdel(:ncol,:pver) - rimtend_clubb_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice) * state_loc%pdeldry(:ncol,:pver) / state_loc%pdel(:ncol,:pver) - cmeliq_pbuf (:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq) * state_loc%pdeldry(:ncol,:pver) / state_loc%pdel(:ncol,:pver) - stend_clubb_output (:ncol,:pver) = ptend_loc%s(:ncol,:pver) - utend_clubb_output (:ncol,:pver) = ptend_loc%u(:ncol,:pver) - vtend_clubb_output (:ncol,:pver) = ptend_loc%v(:ncol,:pver) + do k = 1, pver + do i = 1, ncol + rvmtend_clubb_output(i,k) = ptend_loc%q(i,k,ixq) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + rcmtend_clubb_output(i,k) = ptend_loc%q(i,k,ixcldliq) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + rimtend_clubb_output(i,k) = ptend_loc%q(i,k,ixcldice) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + cmeliq_pbuf (i,k) = ptend_loc%q(i,k,ixcldliq) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + stend_clubb_output (i,k) = ptend_loc%s(i,k) + utend_clubb_output (i,k) = ptend_loc%u(i,k) + vtend_clubb_output (i,k) = ptend_loc%v(i,k) + end do + end do ! ! set pbuf field so that HB scheme is only applied above CLUBB top @@ -4505,7 +4567,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Write output for tendencies: ! oufld: QVTENDICE,QCTENDICE,NCTENDICE,FQTENDICE - temp2d(:ncol,:pver) = stend(:ncol,:pver)/cpairv(:ncol,:pver,lchnk) + temp2d(:ncol,:pver) = stend(:ncol,:pver) * invrs_cpairv(:ncol,:pver) call outfld( 'TTENDICE', temp2d, pcols, lchnk ) call outfld( 'QVTENDICE', qvtend, pcols, lchnk ) call outfld( 'QCTENDICE', qctend, pcols, lchnk ) @@ -4586,11 +4648,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo enddo - det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water - dpdlfliq_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldliq)*state_loc%pdeldry(:ncol,:pver)/state_loc%pdel(:ncol,:pver) - dpdlfice_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixcldice)*state_loc%pdeldry(:ncol,:pver)/state_loc%pdel(:ncol,:pver) - dpdlft_output(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpairv(:ncol,:pver, lchnk) - detnliquid_output(:ncol,:pver) = ptend_loc%q(:ncol,:pver,ixnumliq) + det_ice(:ncol) = det_ice(:ncol) / 1000._r8 ! divide by density of water + + do k = 1, pver + do i = 1, ncol + dpdlfliq_output(i,k) = ptend_loc%q(i,k,ixcldliq) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + dpdlfice_output(i,k) = ptend_loc%q(i,k,ixcldice) * state_loc%pdeldry(i,k) / state_loc%pdel(i,k) + dpdlft_output(i,k) = ptend_loc%s(i,k) * invrs_cpairv(i,k) + detnliquid_output(i,k) = ptend_loc%q(i,k,ixnumliq) + end do + end do call physics_ptend_sum(ptend_loc,ptend_all,ncol) call physics_update(state_loc,ptend_loc,hdtime) @@ -4676,8 +4743,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! DIAGNOSE THE PBL DEPTH ! ! this is needed for aerosol code ! ! --------------------------------------------------------------------------------- ! - do i = 1, ncol - do k = 1, pver + do k = 1, pver + do i = 1, ncol !subroutine pblind expects "Stull" definition of Exner th(i,k) = state_loc%t(i,k)*state_loc%exner(i,k) !thv should have condensate loading to be consistent with earlier def's in this module @@ -4758,7 +4825,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call outfld('TFIX_CLUBB', se_dis, pcols, lchnk) ! density - rho(1:ncol,1:pver) = rga*state_loc%pdel(1:ncol,1:pver)/(state_loc%zi(1:ncol,1:pver)-state_loc%zi(1:ncol,2:pverp)) + do k = 1, pver + do i = 1, ncol + rho(i,k) = rga * state_loc%pdel(i,k) / ( state_loc%zi(i,k) - state_loc%zi(i,k+1) ) + end do + end do rho(1:ncol,pverp) = rho(1:ncol,pver) do k = top_lev, pverp From 4736dd3062579c45728354977735f15374a98f36 Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Mon, 5 Jan 2026 14:19:31 -0700 Subject: [PATCH 25/29] Small updates for timing statements --- src/physics/cam/clubb_intr.F90 | 45 +++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 17 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 408c5b8b5b..ee359d3617 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -2559,7 +2559,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! MAIN COMPUTATION BEGINS HERE ! !-----------------------------------------------------------------------------------! - call t_startf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:non_acc_region') ! Get indicees for cloud and ice mass and cloud and ice number call cnst_get_ind('Q',ixq) @@ -2779,7 +2779,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! everything within should be functional with the OpenACC code, or be prevented from running ! with using OpenACC, see the "ifdef _OPENACC" section above for restriction examples - call t_stopf('clubb_tend_cam:NAR') + call t_stopf('clubb_tend_cam:non_acc_region') call t_startf('clubb_tend_cam:acc_copyin') !$acc data copyin( pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), sclr_idx, & !$acc state_loc, state_loc%q, state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, & @@ -2869,7 +2869,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc copyin( hm_metadata, hm_metadata%l_mix_rat_hm ) & !$acc create( wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt ) call t_stopf('clubb_tend_cam:acc_copyin') - call t_startf('clubb_tend_cam:ACCR') + call t_startf('clubb_tend_cam:acc_region') !----------------------------------------- Zeroing ----------------------------------------- @@ -3213,8 +3213,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! IMPORTANT NOTE: do not make any calls that use CLUBB grid-height ! operators (such as zt2zm_api, etc.) until AFTER the ! call to setup_grid_heights_api. - call t_stopf('clubb_tend_cam:ACCR') - call t_startf('clubb_tend_cam:NAR') + call t_stopf('clubb_tend_cam:acc_region') + call t_startf('clubb_tend_cam:non_acc_region') !$acc update host( deltaz, zi_g, zt_g, clubb_params, sfc_elevation ) ! Calculate grid assuming a descending grid (cam grid), since we want to @@ -3246,7 +3246,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! CLUBB's grid data structure (gr) and nu_vert_res_dep contain arrays that need to ! be copied to the GPU - call t_stopf('clubb_tend_cam:NAR') + call t_stopf('clubb_tend_cam:non_acc_region') call t_startf('clubb_tend_cam:acc_copyin') !$acc data copyin( gr, gr%zm, gr%zt, gr%dzm, gr%dzt, gr%invrs_dzt, gr%invrs_dzm, & !$acc gr%weights_zt2zm, gr%weights_zm2zt, & @@ -3254,7 +3254,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc nu_vert_res_dep%nu1, nu_vert_res_dep%nu8, nu_vert_res_dep%nu10, & !$acc nu_vert_res_dep%nu6) call t_stopf('clubb_tend_cam:acc_copyin') - call t_startf('clubb_tend_cam:ACCR') + call t_startf('clubb_tend_cam:acc_region') !----------------------------------------- END CLUBB grid initialization ----------------------------------------- #ifdef SILHS @@ -3359,8 +3359,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! Other Surface fluxes provided by host model if( (cld_macmic_num_steps > 1) .and. clubb_l_intr_sfc_flux_smooth ) then - call t_stopf('clubb_tend_cam:ACCR') - call t_startf('clubb_tend_cam:NAR') + call t_stopf('clubb_tend_cam:acc_region') + call t_startf('clubb_tend_cam:non_acc_region') !$acc update host( state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, cam_in%wsx, cam_in%wsy ) ! Adjust surface stresses using winds from the prior macmic iteration @@ -3376,8 +3376,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end do !$acc update device( upwp_sfc, vpwp_sfc ) - call t_stopf('clubb_tend_cam:NAR') - call t_startf('clubb_tend_cam:ACCR') + call t_stopf('clubb_tend_cam:non_acc_region') + call t_startf('clubb_tend_cam:acc_region') else @@ -3577,8 +3577,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & end if - ! Advance CLUBB CORE one timestep in the future - call t_startf('clubb_tend_cam:advance_clubb_core_api') if ( clubb_l_ascending_grid ) then @@ -3590,6 +3588,8 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! subroutine (advance_clubb_core). For example, only the pdf_params fields that ! are used within this subroutine (or used in a subroutine we call) need to ! be flipped. + + call t_startf('clubb_tend_cam:ascending_grid_flip') thlm_forcing = thlm_forcing(:,nzt_clubb:1:-1) rtm_forcing = rtm_forcing(:,nzt_clubb:1:-1) @@ -3738,8 +3738,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & zi_g(:,nzm_clubb:1:-1), zt_g(:,nzt_clubb:1:-1), & ! intent(in) gr, err_info ) ! intent(inout) + call t_stopf('clubb_tend_cam:ascending_grid_flip') + end if + ! Advance CLUBB CORE one timestep in the future + call t_startf('clubb_tend_cam:advance_clubb_core_api') + ! These updates are required because the pbuf variables are dimensioned with pcols, when ! we only need ncol. This requires us to slice the arrays when inputting to advance_clubb_core_api, ! which happens on the CPU, so we need the CPU version of these to be correct. @@ -3807,10 +3812,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & !$acc wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) + + call t_stopf('clubb_tend_cam:advance_clubb_core_api') if ( clubb_l_ascending_grid ) then + call t_startf('clubb_tend_cam:ascending_grid_flip') + ! If running in ascending mode, we flip the arrays before calling advance_clubb_core ! so we need to flip them back. This section should flip every array that was flipped ! before the advance_clubb_core call. @@ -3973,9 +3982,11 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & deltaz, zi_g(:,nzm_clubb), zi_g(:,1), & ! intent(in) zi_g, zt_g, & ! intent(in) gr, err_info ) ! intent(inout) + + call t_stopf('clubb_tend_cam:ascending_grid_flip') + end if - call t_stopf('clubb_tend_cam:advance_clubb_core_api') ! Note that CLUBB does not produce an error code specific to any column, and ! one value only for the entire chunk @@ -4220,7 +4231,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & endif - call t_stopf('clubb_tend_cam:ACCR') + call t_stopf('clubb_tend_cam:acc_region') call t_startf('clubb_tend_cam:acc_copyout') !$acc end data @@ -4231,7 +4242,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc end data call t_stopf('clubb_tend_cam:acc_copyout') - call t_startf('clubb_tend_cam:NAR') + call t_startf('clubb_tend_cam:non_acc_region') ! ------------------------------------------------- ! ! Diagnose relative cloud water variance ! @@ -5093,7 +5104,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & enddo endif - call t_stopf('clubb_tend_cam:NAR') + call t_stopf('clubb_tend_cam:non_acc_region') ! Cleanup err_info call cleanup_err_info_api(err_info) From f20fbf153dc10d880e231d1c162bd1e4a106ad74 Mon Sep 17 00:00:00 2001 From: adamrher Date: Thu, 8 Jan 2026 11:16:18 -0700 Subject: [PATCH 26/29] fixed double flipping of 2 clubb_mf output arrays --- src/physics/cam/clubb_intr.F90 | 2 -- src/physics/clubb | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index ee359d3617..6a8d6bbfae 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -3549,8 +3549,6 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dry_v = mf_dry_v(:,nzm_clubb:1:-1) mf_moist_v = mf_moist_v(:,nzm_clubb:1:-1) mf_moist_qc = mf_moist_qc(:,nzm_clubb:1:-1) - mf_thlflx = mf_thlflx(:,nzm_clubb:1:-1) - mf_qtflx = mf_qtflx(:,nzm_clubb:1:-1) s_ae = s_ae(:,nzm_clubb:1:-1) s_aw = s_aw(:,nzm_clubb:1:-1) s_awthl = s_awthl(:,nzm_clubb:1:-1) diff --git a/src/physics/clubb b/src/physics/clubb index 15e802092f..bfd33d6dd7 160000 --- a/src/physics/clubb +++ b/src/physics/clubb @@ -1 +1 @@ -Subproject commit 15e802092f65b3a20e5d67cb32d40f8a2771ca9b +Subproject commit bfd33d6dd7575f1ea1aa509e0d53d27b4d4a66c5 From 42d085fc8d28c7d1cfa4b247212f6e7ad24b1cda Mon Sep 17 00:00:00 2001 From: adamrher Date: Thu, 8 Jan 2026 14:25:35 -0700 Subject: [PATCH 27/29] changes to clubb_mf to operate on descending arrays --- src/physics/cam/clubb_intr.F90 | 80 +++------------------- src/physics/cam/clubb_mf.F90 | 119 +++++++++++++++++---------------- 2 files changed, 69 insertions(+), 130 deletions(-) diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index 6a8d6bbfae..cb72db7b1b 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -3473,30 +3473,10 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & rtm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, rtm(:ncol,:) ) thlm_zm_in = zt2zm_api( nzm_clubb, nzt_clubb, ncol, gr, thlm(:ncol,:) ) - !--------------------------------------- integrate_mf call and flip --------------------------------------- - ! integrate_mf assumes an ascending grid, which is the opposide of the cam grid that - ! clubb_intr now mainly uses, so we need to flip the fields before calling integrate_mf - ! - ! Ideally, integrate_mf would operate in descending mode, then we could remove the flipping. + !--------------------------------------- integrate_mf call --------------------------------------- + ! integrate_mf expects arguments of individual columns. ! If the column loop gets pushed into it, we can also avoid the array slicing. - dz_g = dz_g(:,nzt_clubb:1:-1) - p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) - invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) - um = um(:,nzt_clubb:1:-1) - vm = vm(:,nzt_clubb:1:-1) - thlm = thlm(:,nzt_clubb:1:-1) - rtm = rtm(:,nzt_clubb:1:-1) - - thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) - - ! Flip zm inputs - zi_g = zi_g(:,nzm_clubb:1:-1) - p_in_Pa_zm = p_in_Pa_zm(:,nzm_clubb:1:-1) - invrs_exner_zm = invrs_exner_zm(:,nzm_clubb:1:-1) - thlm_zm_in = thlm_zm_in(:,nzm_clubb:1:-1) - rtm_zm_in = rtm_zm_in(:,nzm_clubb:1:-1) - do i = 1, ncol call integrate_mf( nzm_clubb, nzt_clubb, dz_g(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input @@ -3510,56 +3490,14 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & mf_dry_u(i,:), mf_moist_u(i,:), & ! output - plume diagnostics mf_dry_v(i,:), mf_moist_v(i,:), & ! output - plume diagnostics mf_moist_qc(i,:), & ! output - plume diagnostics - s_ae(i,:), s_aw(i,:), & ! output - plume diagnostics - s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics - s_awql(i,:), s_awqi(i,:), & ! output - plume diagnostics - s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics - mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver + s_ae(i,:), s_aw(i,:), & ! output - plume diagnostics + s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics + s_awql(i,:), s_awqi(i,:), & ! output - plume diagnostics + s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics + mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver end do - - ! Flip zt inputs back - dz_g = dz_g(:,nzt_clubb:1:-1) - p_in_Pa = p_in_Pa(:,nzt_clubb:1:-1) - invrs_exner_zt = invrs_exner_zt(:,nzt_clubb:1:-1) - um = um(:,nzt_clubb:1:-1) - vm = vm(:,nzt_clubb:1:-1) - thlm = thlm(:,nzt_clubb:1:-1) - rtm = rtm(:,nzt_clubb:1:-1) - - thv_ds_zt = thv_ds_zt(:,nzt_clubb:1:-1) - - ! Flip zm inputs back - zi_g = zi_g(:,nzm_clubb:1:-1) - p_in_Pa_zm = p_in_Pa_zm(:,nzm_clubb:1:-1) - invrs_exner_zm = invrs_exner_zm(:,nzm_clubb:1:-1) - thlm_zm_in = thlm_zm_in(:,nzm_clubb:1:-1) - rtm_zm_in = rtm_zm_in(:,nzm_clubb:1:-1) - - ! Flip clubb_mf output, since it assumes an ascending grid currently - mf_dry_a = mf_dry_a(:,nzm_clubb:1:-1) - mf_moist_a = mf_moist_a(:,nzm_clubb:1:-1) - mf_dry_w = mf_dry_w(:,nzm_clubb:1:-1) - mf_moist_w = mf_moist_w(:,nzm_clubb:1:-1) - mf_dry_qt = mf_dry_qt(:,nzm_clubb:1:-1) - mf_moist_qt = mf_moist_qt(:,nzm_clubb:1:-1) - mf_dry_thl = mf_dry_thl(:,nzm_clubb:1:-1) - mf_moist_thl = mf_moist_thl(:,nzm_clubb:1:-1) - mf_dry_u = mf_dry_u(:,nzm_clubb:1:-1) - mf_moist_u = mf_moist_u(:,nzm_clubb:1:-1) - mf_dry_v = mf_dry_v(:,nzm_clubb:1:-1) - mf_moist_v = mf_moist_v(:,nzm_clubb:1:-1) - mf_moist_qc = mf_moist_qc(:,nzm_clubb:1:-1) - s_ae = s_ae(:,nzm_clubb:1:-1) - s_aw = s_aw(:,nzm_clubb:1:-1) - s_awthl = s_awthl(:,nzm_clubb:1:-1) - s_awqt = s_awqt(:,nzm_clubb:1:-1) - s_awql = s_awql(:,nzm_clubb:1:-1) - s_awqi = s_awqi(:,nzm_clubb:1:-1) - s_awu = s_awu(:,nzm_clubb:1:-1) - s_awv = s_awv(:,nzm_clubb:1:-1) - mf_thlflx = mf_thlflx(:,nzm_clubb:1:-1) - mf_qtflx = mf_qtflx(:,nzm_clubb:1:-1) - !--------------------------------------- END integrate_mf call and flip --------------------------------------- + + !--------------------------------------- END integrate_mf call --------------------------------------- ! pass MF turbulent advection term as CLUBB explicit forcing term do k = 1, nzt_clubb diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index 4461502d39..c4e224cf71 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -281,7 +281,7 @@ subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, zcb = zcb_unset pblh = max(pblh,pblhmin) - wthv = wthl+zvir*thv(1)*wqt + wthv = wthl+zvir*thv(nzt)*wqt ! if surface buoyancy is positive then do mass-flux if ( wthv > 0._r8 ) then @@ -290,28 +290,29 @@ subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, ! overide stochastic entrainment with fixent ent(:,:) = fixent else - + ! get entrainment coefficient, dz/L0 do i=1,clubb_mf_nup - do k=1,nzt + !do k=1,nzt + do k=nzt,1,-1 entf(k,i) = dzt(k) / clubb_mf_L0 enddo enddo - + ! get poisson, P(dz/L0) - call poisson( nzt, clubb_mf_nup, entf, enti, u(1:4)) - + call poisson( nzt, clubb_mf_nup, entf, enti, u(nzt:nzt-3:-1)) + ! get entrainment, ent=ent0/dz*P(dz/L0) do i=1,clubb_mf_nup - do k=1,nzt + do k=nzt,1,-1 ent(k,i) = real( enti(k,i))*clubb_mf_ent0/dzt(k) enddo enddo - + end if ! get surface conditions - wstar = max( wstarmin, (gravit/thv(1)*wthv*pblh)**(1._r8/3._r8) ) + wstar = max( wstarmin, (gravit/thv(nzt)*wthv*pblh)**(1._r8/3._r8) ) qstar = wqt / wstar thvstar = wthv / wstar @@ -327,68 +328,68 @@ subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, wlv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * (real(i-1, r8)) wtv = wmin + (wmax-wmin) / (real(clubb_mf_nup,r8)) * real(i,r8) - upw(1,i) = 0.5_r8 * (wlv+wtv) - upa(1,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & + upw(nzm,i) = 0.5_r8 * (wlv+wtv) + upa(nzm,i) = 0.5_r8 * erf( wtv/(sqrt(2._r8)*sigmaw) ) & - 0.5_r8 * erf( wlv/(sqrt(2._r8)*sigmaw) ) - upu(1,i) = u(1) - upv(1,i) = v(1) + upu(nzm,i) = u(nzt) + upv(nzm,i) = v(nzt) - upqt(1,i) = qt(1) + cwqt * upw(1,i) * sigmaqt/sigmaw - upthv(1,i) = thv(1) + cwthv * upw(1,i) * sigmathv/sigmaw - upthl(1,i) = upthv(1,i) / (1._r8+zvir*upqt(1,i)) + upqt(nzm,i) = qt(nzt) + cwqt * upw(nzm,i) * sigmaqt/sigmaw + upthv(nzm,i) = thv(nzt) + cwthv * upw(nzm,i) * sigmathv/sigmaw + upthl(nzm,i) = upthv(nzm,i) / (1._r8+zvir*upqt(nzm,i)) ! get cloud, lowest momentum level if (do_condensation) then - call condensation_mf(upqt(1,i), upthl(1,i), p_zm(1), iexner_zm(1), & + call condensation_mf(upqt(nzm,i), upthl(nzm,i), p_zm(nzm), iexner_zm(nzm), & thvn, qcn, thn, qln, qin, qsn, lmixn) - upthv(1,i) = thvn - upqc(1,i) = qcn - upql(1,i) = qln - upqi(1,i) = qin - upqs(1,i) = qsn - if (qcn > 0._r8) zcb(i) = zm(1) + upthv(nzm,i) = thvn + upqc(nzm,i) = qcn + upql(nzm,i) = qln + upqi(nzm,i) = qin + upqs(nzm,i) = qsn + if (qcn > 0._r8) zcb(i) = zm(nzm) else ! assume no cldliq - upqc(1,i) = 0._r8 + upqc(nzm,i) = 0._r8 end if enddo ! get updraft properties do i=1,clubb_mf_nup - do k=1,nzm-1 - + do k=nzm,2,-1 + ! get microphysics, autoconversion if (do_precip .and. upqc(k,i) > 0._r8) then - call precip_mf(upqs(k,i),upqt(k,i),upw(k,i),dzt(k),zm(k+1)-zcb(i),supqt) + call precip_mf(upqs(k,i),upqt(k,i),upw(k,i),dzt(k-1),zm(k-1)-zcb(i),supqt) - supthl = -1._r8*lmixn*supqt*iexner_zt(k)/cpair + supthl = -1._r8*lmixn*supqt*iexner_zt(k-1)/cpair else supqt = 0._r8 supthl = 0._r8 end if ! integrate updraft - entexp = exp(-ent(k,i)*dzt(k)) - entexpu = exp(-ent(k,i)*dzt(k)/3._r8) + entexp = exp(-ent(k-1,i)*dzt(k-1)) + entexpu = exp(-ent(k-1,i)*dzt(k-1)/3._r8) - qtn = qt(k) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt - thln = thl(k)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl - un = u(k) *(1._r8-entexpu) + upu (k,i)*entexpu - vn = v(k) *(1._r8-entexpu) + upv (k,i)*entexpu + qtn = qt(k-1) *(1._r8-entexp ) + upqt (k,i)*entexp + supqt + thln = thl(k-1)*(1._r8-entexp ) + upthl(k,i)*entexp + supthl + un = u(k-1) *(1._r8-entexpu) + upu (k,i)*entexpu + vn = v(k-1) *(1._r8-entexpu) + upv (k,i)*entexpu ! get cloud, momentum levels if (do_condensation) then - call condensation_mf(qtn, thln, p_zm(k+1), iexner_zm(k+1), & + call condensation_mf(qtn, thln, p_zm(k-1), iexner_zm(k-1), & thvn, qcn, thn, qln, qin, qsn, lmixn) - if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(k+1) + if (zcb(i).eq.zcb_unset .and. qcn > 0._r8) zcb(i) = zm(k-1) else thvn = thln*(1._r8+zvir*qtn) end if ! get buoyancy - B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(k)-1._r8) + B=gravit*(0.5_r8*(thvn + upthv(k,i))/thv(k-1)-1._r8) if (debug) then if ( masterproc ) then write(iulog,*) "B(k,i), k, i ", B, k, i @@ -396,27 +397,27 @@ subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, end if ! get wn^2 - wp = wb*ent(k,i) + wp = wb*ent(k-1,i) if (wp==0._r8) then - wn2 = upw(k,i)**2._r8+2._r8*wa*B*dzt(k) + wn2 = upw(k,i)**2._r8+2._r8*wa*B*dzt(k-1) else - entw = exp(-2._r8*wp*dzt(k)) - wn2 = entw*upw(k,i)**2._r8+wa*B/(wb*ent(k,i))*(1._r8-entw) + entw = exp(-2._r8*wp*dzt(k-1)) + wn2 = entw*upw(k,i)**2._r8+wa*B/(wb*ent(k-1,i))*(1._r8-entw) end if if (wn2>0._r8) then - upw(k+1,i) = sqrt(wn2) - upthv(k+1,i) = thvn - upthl(k+1,i) = thln - upqt(k+1,i) = qtn - upqc(k+1,i) = qcn - upqs(k+1,i) = qsn - upu(k+1,i) = un - upv(k+1,i) = vn - upa(k+1,i) = upa(k,i) - upql(k+1,i) = qln - upqi(k+1,i) = qin - upqv(k+1,i) = qtn - qcn + upw(k-1,i) = sqrt(wn2) + upthv(k-1,i) = thvn + upthl(k-1,i) = thln + upqt(k-1,i) = qtn + upqc(k-1,i) = qcn + upqs(k-1,i) = qsn + upu(k-1,i) = un + upv(k-1,i) = vn + upa(k-1,i) = upa(k,i) + upql(k-1,i) = qln + upqi(k-1,i) = qin + upqv(k-1,i) = qtn - qcn else exit end if @@ -424,8 +425,8 @@ subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, enddo ! writing updraft properties for output - do k=1,nzm - + do k=nzm,1,-1 + ! first sum over all i-updrafts do i=1,clubb_mf_nup if (upqc(k,i)>0._r8) then @@ -478,7 +479,7 @@ subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, enddo - do k=1,nzm + do k=nzm,1,-1 do i=1,clubb_mf_nup ae (k) = ae (k) - upa(k,i) aw (k) = aw (k) + upa(k,i)*upw(k,i) @@ -492,7 +493,7 @@ subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, enddo enddo - do k=1,nzm + do k=nzm,1,-1 thlflx(k)= awthl(k) - aw(k)*thl_zm(k) qtflx(k)= awqt(k) - aw(k)*qt_zm(k) enddo @@ -643,7 +644,7 @@ subroutine poisson(nz,nup,lambda,poi,state) ! Set seed kiss_gen = ShrKissRandGen(tmpseed) - do i=1,nz + do i=nz,1,-1 do j=1,nup call knuth(kiss_gen,lambda(i,j),poi(i,j)) enddo @@ -681,4 +682,4 @@ subroutine knuth(kiss_gen,lambda,kout) end subroutine knuth end module clubb_mf - \ No newline at end of file + From 0f1282372ec3b6310cd0f987df7398b181dc36c2 Mon Sep 17 00:00:00 2001 From: adamrher Date: Thu, 8 Jan 2026 14:40:50 -0700 Subject: [PATCH 28/29] removed comment --- src/physics/cam/clubb_mf.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/physics/cam/clubb_mf.F90 b/src/physics/cam/clubb_mf.F90 index c4e224cf71..de85d1ef70 100644 --- a/src/physics/cam/clubb_mf.F90 +++ b/src/physics/cam/clubb_mf.F90 @@ -293,7 +293,6 @@ subroutine integrate_mf( nzm, nzt, dzt, zm, p_zm, iexner_zm, ! get entrainment coefficient, dz/L0 do i=1,clubb_mf_nup - !do k=1,nzt do k=nzt,1,-1 entf(k,i) = dzt(k) / clubb_mf_L0 enddo From fbcaf321436d680cbe796191326aa1d7d377d416 Mon Sep 17 00:00:00 2001 From: huebleruwm Date: Fri, 9 Jan 2026 19:08:02 -0700 Subject: [PATCH 29/29] Adding code for the new coriolis code in clubb. Also updating the .gitmodules with a new tag --- .gitmodules | 2 +- bld/build-namelist | 2 + bld/namelist_files/namelist_defaults_cam.xml | 2 + bld/namelist_files/namelist_definition.xml | 12 +++++ src/physics/cam/clubb_intr.F90 | 53 +++++++++++++++----- 5 files changed, 57 insertions(+), 14 deletions(-) diff --git a/.gitmodules b/.gitmodules index 8f621bf7c2..dcc3b7cd98 100644 --- a/.gitmodules +++ b/.gitmodules @@ -104,7 +104,7 @@ url = https://github.com/larson-group/clubb_release fxrequired = AlwaysRequired fxsparse = ../.clubb_sparse_checkout - fxtag = clubb_4ncar_20240605_73d60f6_gpufixes_posinf + fxtag = clubb_4ncar_20260109_ddf5110 fxDONOTUSEurl = https://github.com/larson-group/clubb_release [submodule "rtm"] diff --git a/bld/build-namelist b/bld/build-namelist index a18f8420f2..ed87e4bea1 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3623,6 +3623,8 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_l_mono_flux_lim_vm'); add_default($nl, 'clubb_l_partial_upwind_wp3'); add_default($nl, 'clubb_l_predict_upwp_vpwp'); + add_default($nl, 'clubb_l_ho_nontrad_coriolis'); + add_default($nl, 'clubb_l_ho_trad_coriolis'); add_default($nl, 'clubb_l_rcm_supersat_adj'); add_default($nl, 'clubb_l_smooth_Heaviside_tau_wpxp'); add_default($nl, 'clubb_l_stability_correct_tau_zm'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 5f853335cf..17202b3739 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -2220,6 +2220,8 @@ .false. .false. .true. + .false. + .false. .false. .false. .false. diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index e28c502bcd..b6ea1854fc 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -4185,6 +4185,18 @@ horizontal winds um and vm. When this flag is turned off, upwp and vpwp are calculated by down-gradient diffusion. + +Flag to implement the nontraditional Coriolis terms in the +prognostic equations of w'w', u'w', and u'u. + + + +Flag to implement the traditional Coriolis terms in the +prognostic equations of v'w' and u'w'. + + used in adj_low_res_nu. If .true., avg_deltaz = deltaz diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index cb72db7b1b..dbb2340f67 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -20,7 +20,7 @@ module clubb_intr use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pver, pverp, pcols, begchunk, endchunk use phys_control, only: phys_getopts - use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi, rair + use physconst, only: cpair, gravit, rga, latvap, latice, zvir, rh2o, karman, pi, rair, omega use air_composition, only: rairv, cpairv use cam_history_support, only: max_fieldname_len @@ -292,6 +292,10 @@ module clubb_intr ! advance_xm_wpxp. Otherwise, and are still ! approximated by eddy diffusivity when and are ! advanced in subroutine advance_windm_edsclrm. + clubb_l_ho_nontrad_coriolis, & ! Flag to implement the nontraditional Coriolis terms in the + ! prognostic equations of , , and . + clubb_l_ho_trad_coriolis, & ! Flag to implement the traditional Coriolis terms in the + ! prognostic equations of and . clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping ! the overall correlation of w and x (w and rt, as well as w ! and theta-l) within the limits of -max_mag_correlation_flux @@ -423,6 +427,7 @@ module clubb_intr vpwp_idx, & ! north-south momentum flux wpthvp_idx, & ! buoyancy flux wp2thvp_idx, & ! second order buoyancy term + wp2up_idx, & ! w'^2 u' rtpthvp_idx, & ! moisture buoyancy correlation thlpthvp_idx, & ! temperature buoyancy correlation wp2rtp_idx, & ! w'^2 rt' @@ -615,6 +620,7 @@ subroutine clubb_register_cam( ) call pbuf_add_field('WPTHLP_CLUBB_GW_MC', 'physpkg', dtype_r8, (/pcols,nzm_clubb/), wpthlp_clubb_gw_mc_idx) call pbuf_add_field('WP2THVP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thvp_idx) + call pbuf_add_field('WP2UP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2up_idx) call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2rtp_idx) call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,nzt_clubb/), wp2thlp_idx) call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,nzt_clubb/), wpup2_idx) @@ -857,6 +863,8 @@ subroutine clubb_readnl(nlfile) clubb_l_mono_flux_lim_vm, & clubb_l_partial_upwind_wp3, & clubb_l_predict_upwp_vpwp, & + clubb_l_ho_nontrad_coriolis, & + clubb_l_ho_trad_coriolis, & clubb_l_prescribed_avg_deltaz, & clubb_l_rcm_supersat_adj, & clubb_l_rtm_nudge, & @@ -914,6 +922,8 @@ subroutine clubb_readnl(nlfile) clubb_fill_holes_type, & ! Out clubb_l_use_precip_frac, & ! Out clubb_l_predict_upwp_vpwp, & ! Out + clubb_l_ho_nontrad_coriolis, & ! Out + clubb_l_ho_trad_coriolis, & ! Out clubb_l_min_wp2_from_corr_wx, & ! Out clubb_l_min_xp2_from_corr_wx, & ! Out clubb_l_C2_cloud_frac, & ! Out @@ -1165,6 +1175,10 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_damp_wp3_Skw_squared") call mpi_bcast(clubb_l_predict_upwp_vpwp, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_predict_upwp_vpwp") + call mpi_bcast(clubb_l_ho_nontrad_coriolis, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_ho_nontrad_coriolis") + call mpi_bcast(clubb_l_ho_trad_coriolis, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_ho_trad_coriolis") call mpi_bcast(clubb_l_min_wp2_from_corr_wx, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_min_wp2_from_corr_wx") call mpi_bcast(clubb_l_min_xp2_from_corr_wx, 1, mpi_logical, mstrid, mpicom, ierr) @@ -1358,7 +1372,9 @@ subroutine clubb_readnl(nlfile) clubb_grid_adapt_in_time_method, & ! In clubb_fill_holes_type, & ! In clubb_l_use_precip_frac, & ! In - clubb_l_predict_upwp_vpwp, & ! In + clubb_l_predict_upwp_vpwp, & ! In + clubb_l_ho_nontrad_coriolis, & ! In + clubb_l_ho_trad_coriolis, & ! In clubb_l_min_wp2_from_corr_wx, & ! In clubb_l_min_xp2_from_corr_wx, & ! In clubb_l_C2_cloud_frac, & ! In @@ -2167,6 +2183,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), pointer, dimension(:,:) :: vpwp_pbuf ! north-south momentum flux [m^2/s^2] real(r8), pointer, dimension(:,:) :: wpthvp_pbuf ! w'th_v' (momentum levels) [m/s K] real(r8), pointer, dimension(:,:) :: wp2thvp_pbuf ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] + real(r8), pointer, dimension(:,:) :: wp2up_pbuf ! w'^2 u' (thermodynamic levels) [m^3/s^3] real(r8), pointer, dimension(:,:) :: rtpthvp_pbuf ! r_t'th_v' (momentum levels) [kg/kg K] real(r8), pointer, dimension(:,:) :: thlpthvp_pbuf ! th_l'th_v' (momentum levels) [K^2] real(r8), pointer, dimension(:,:) :: pdf_zm_w_1_pbuf ! work pointer for pdf_params_zm @@ -2259,6 +2276,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & real(r8), dimension(state%ncol) :: & deltaz, & fcor, & ! Coriolis forcing [s^-1] + fcor_y, & ! Non-traditional coriolis forcing [s^-1] sfc_elevation, & ! Elevation of ground [m AMSL][m] wpthlp_sfc, & ! w' theta_l' at surface [(m K)/s] wprtp_sfc, & ! w' r_t' at surface [(kg m)/( kg s)] @@ -2591,6 +2609,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & call pbuf_get_field(pbuf, vpwp_idx, vpwp_pbuf ) call pbuf_get_field(pbuf, wpthvp_idx, wpthvp_pbuf) call pbuf_get_field(pbuf, wp2thvp_idx, wp2thvp_pbuf) + call pbuf_get_field(pbuf, wp2up_idx, wp2up_pbuf) call pbuf_get_field(pbuf, rtpthvp_idx, rtpthvp_pbuf) call pbuf_get_field(pbuf, thlpthvp_idx, thlpthvp_pbuf) @@ -2784,7 +2803,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc data copyin( pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), sclr_idx, & !$acc state_loc, state_loc%q, state_loc%u, state_loc%v, state_loc%t, state_loc%pmid, & !$acc state_loc%zm, state_loc%phis, state_loc%pdel, state_loc%pdeldry, state_loc%s, & - !$acc state_loc%pint, state_loc%zi, state_loc%omega, & + !$acc state_loc%pint, state_loc%zi, state_loc%omega, state_loc%lat, & !$acc cam_in, cam_in%wsx, cam_in%wsy, cam_in%cflx, cam_in%shf, & !$acc err_info, err_info%err_header, & !$acc cpairv, rairv, se_dis, eleak, cld_pbuf, clubb_params_single_col, grid_dx, grid_dy ) & @@ -2796,13 +2815,13 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & !$acc pdf_params_chnk(lchnk)%mixt_frac ) & !$acc copy( khzm_pbuf, upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & - !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, ice_supersat_frac_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, wp2up_pbuf, ice_supersat_frac_pbuf, & !$acc rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, & !$acc rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, wp2up2_pbuf, wp2vp2_pbuf ) & !$acc create( um_pert_inout, vm_pert_inout, upwp_pert_inout, vpwp_pert_inout, khzm_out, & !$acc khzt_out, thlprcp_out, w_up_in_cloud_out, w_down_in_cloud_out, cloudy_updraft_frac_out, & !$acc cloudy_downdraft_frac_out, cloud_cover_out, invrs_tau_zm_out, Lscale, & - !$acc invrs_exner_zt, fcor, sfc_elevation, thlm_forcing, rtm_forcing, um_forcing, & + !$acc invrs_exner_zt, fcor, fcor_y, sfc_elevation, thlm_forcing, rtm_forcing, um_forcing, & !$acc vm_forcing, wprtp_forcing, wpthlp_forcing, rtp2_forcing, thlp2_forcing, & !$acc rtpthlp_forcing, wm_zm, wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & !$acc p_sfc, upwp_sfc_pert, vpwp_sfc_pert, rtm_ref, thlm_ref, um_ref, vm_ref, & @@ -2912,10 +2931,16 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & upwp_sfc_pert(i) = 0.0_r8 vpwp_sfc_pert(i) = 0.0_r8 - ! Determine Coriolis force at given latitude. This is never used - ! when CLUBB is implemented in a host model, therefore just set - ! to zero. - fcor(i) = 0._r8 + ! When run in host models, CLUBB does not apply Coriolis tendencies to the + ! mean horizontal wind components (this is controlled by the `l_implemented` + ! flag, which should be hardcoded to .true. in this file). + ! + ! However, enabling `clubb_l_ho_nontrad_coriolis` or `clubb_l_ho_trad_coriolis` + ! introduces Coriolis effects in higher-order moments (e.g., wp2up). + ! Therefore, we still compute the Coriolis parameters here for potential + ! use by those higher-order terms. + fcor(i) = 2._r8 * omega * sin( state_loc%lat(i) ) + fcor_y(i) = 2._r8 * omega * cos( state_loc%lat(i) ) end do if ( sclr_dim > 0 ) then @@ -3562,6 +3587,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) + wp2up_pbuf = wp2up_pbuf(:,nzt_clubb:1:-1) rtm = rtm(:,nzt_clubb:1:-1) thlm = thlm(:,nzt_clubb:1:-1) @@ -3687,12 +3713,12 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! REMOVECAM: This will be unnecessary once pbuf is gone and these are dimensioned ncol. !$acc update host( upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & - !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, wp2up_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & !$acc wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) call advance_clubb_core_api( gr, nzm_clubb, nzt_clubb, ncol, & ! Inputs - l_implemented, dtime, fcor, sfc_elevation, & + l_implemented, dtime, fcor, fcor_y, sfc_elevation, & hydromet_dim, & sclr_dim, sclr_tol, edsclr_dim, sclr_idx, & thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & @@ -3725,7 +3751,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & sclrp2, sclrp3, sclrprtp, sclrpthlp, & wpsclrp, edsclr_inout, err_info, & rcm, cloud_frac_inout, & - wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & + wpthvp_pbuf(:ncol,:), wp2thvp_pbuf(:ncol,:), wp2up_pbuf(:ncol,:), rtpthvp_pbuf(:ncol,:), thlpthvp_pbuf(:ncol,:), & sclrpthvp_inout, & wp2rtp_pbuf(:ncol,:), wp2thlp_pbuf(:ncol,:), uprcp_pbuf(:ncol,:), & vprcp_pbuf(:ncol,:), rc_coef_zm_pbuf(:ncol,:), & @@ -3745,7 +3771,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & ! REMOVECAM: This will be unnecessary once pbuf is gone and these are dimensioned ncol. !$acc update device( upwp_pbuf, vpwp_pbuf, up2_pbuf, vp2_pbuf, up3_pbuf, vp3_pbuf, wprtp_pbuf, & !$acc wpthlp_pbuf, wp2_pbuf, wp3_pbuf, rtp2_pbuf, rtp3_pbuf, thlp2_pbuf, thlp3_pbuf, & - !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & + !$acc rtpthlp_pbuf, wpthvp_pbuf, wp2thvp_pbuf, wp2up_pbuf, rtpthvp_pbuf, thlpthvp_pbuf, wp2rtp_pbuf, & !$acc wp2thlp_pbuf, uprcp_pbuf, vprcp_pbuf, rc_coef_zm_pbuf, wp4_pbuf, wpup2_pbuf, wpvp2_pbuf, & !$acc wp2up2_pbuf, wp2vp2_pbuf, ice_supersat_frac_pbuf ) @@ -3803,6 +3829,7 @@ subroutine clubb_tend_cam( state, ptend_all, pbuf, hdtime, & um_pert_inout = um_pert_inout(:,nzt_clubb:1:-1) vm_pert_inout = vm_pert_inout(:,nzt_clubb:1:-1) wp2thvp_pbuf = wp2thvp_pbuf(:,nzt_clubb:1:-1) + wp2up_pbuf = wp2up_pbuf(:,nzt_clubb:1:-1) rtm = rtm(:,nzt_clubb:1:-1) thlm = thlm(:,nzt_clubb:1:-1) Lscale = Lscale(:,nzt_clubb:1:-1)