diff --git a/CODEOWNERS b/CODEOWNERS index 0d5230f89..b6c597371 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @llpcarson @grantfirl @JulieSchramm +* @DomHeinzeller # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 6c214813b..f03e1d298 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -15,32 +15,37 @@ end subroutine GFS_DCNV_generic_pre_finalize !! \section arg_table_GFS_DCNV_generic_pre_run Argument Table !! \htmlinclude GFS_DCNV_generic_pre_run.html !! - subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplchm,& - gu0, gv0, gt0, gq0_water_vapor, & - save_u, save_v, save_t, save_qv, dqdti, & - errmsg, errflg) + subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplchm, & + gu0, gv0, gt0, gq0, nsamftrac, ntqv, & + save_u, save_v, save_t, save_q, dqdti, clw, & + ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & + ntgnc, cscnv, satmedmf, trans_trac, ras, ntrac, & + dtidx, index_of_process_dcnv, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs + integer, intent(in) :: im, levs, nsamftrac, ntqv, index_of_process_dcnv, dtidx(:,:), & + ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm - real(kind=kind_phys), dimension(:,:), intent(in) :: gu0 - real(kind=kind_phys), dimension(:,:), intent(in) :: gv0 - real(kind=kind_phys), dimension(:,:), intent(in) :: gt0 - real(kind=kind_phys), dimension(:,:), intent(inout) :: gq0_water_vapor - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_u - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_v - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_qv + real(kind=kind_phys), dimension(:,:), intent(in) :: gu0 + real(kind=kind_phys), dimension(:,:), intent(in) :: gv0 + real(kind=kind_phys), dimension(:,:), intent(in) :: gt0 + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 + real(kind=kind_phys), dimension(:,:), intent(inout) :: save_u + real(kind=kind_phys), dimension(:,:), intent(inout) :: save_v + real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: save_q ! dqdti only allocated if cplchm is .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + logical, intent(in) :: cscnv, satmedmf, trans_trac, ras real(kind=kind_phys), parameter :: zero = 0.0d0 - integer :: i, k + real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw + + integer :: i, k, n, tracers ! Initialize CCPP error handling variables errmsg = '' @@ -63,11 +68,26 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc endif if ((ldiag3d.and.qdiag3d) .or. cplchm) then - do k=1,levs - do i=1,im - save_qv(i,k) = gq0_water_vapor(i,k) - enddo - enddo + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + tracers = 2 + do n=2,ntrac + if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & + n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & + n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then + tracers = tracers + 1 + if(dtidx(100+n,index_of_process_dcnv)>0) then + save_q(:,:,n) = clw(:,:,tracers) + endif + endif + enddo + else + do n=2,ntrac + if(dtidx(100+n,index_of_process_dcnv)>0) then + save_q(:,:,n) = gq0(:,:,n) + endif + enddo + endif ! end if_ras or cfscnv or samf + save_q(:,:,ntqv) = gq0(:,:,ntqv) endif if (cplchm) then @@ -91,44 +111,51 @@ end subroutine GFS_DCNV_generic_post_finalize !> \section arg_table_GFS_DCNV_generic_post_run Argument Table !! \htmlinclude GFS_DCNV_generic_post_run.html !! - subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cscnv, & - frain, rain1, dtf, cld1d, save_u, save_v, save_t, save_qv, gu0, gv0, gt0, & - gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & - rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & - cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, errmsg, errflg) + subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & + cscnv, frain, rain1, dtf, cld1d, save_u, save_v, save_t, gu0, gv0, gt0, & + ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, nsamftrac, & + rainc, cldwrk, upd_mf, dwn_mf, det_mf, dtend, dtidx, index_of_process_dcnv, & + index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gq0, save_q, & + cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, & + ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc, ntrac,clw, & + satmedmf, trans_trac, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs + integer, intent(in) :: im, levs, nsamftrac logical, intent(in) :: lssav, ldiag3d, qdiag3d, ras, cscnv logical, intent(in) :: flag_for_dcnv_generic_tend real(kind=kind_phys), intent(in) :: frain, dtf - real(kind=kind_phys), dimension(:), intent(in) :: rain1, cld1d - real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t, save_qv - real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0, gq0_water_vapor - real(kind=kind_phys), dimension(:,:), intent(in) :: ud_mf, dd_mf, dt_mf + real(kind=kind_phys), dimension(:), intent(in) :: rain1, cld1d + real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t + real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0 + real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q + real(kind=kind_phys), dimension(:,:), intent(in) :: ud_mf, dd_mf, dt_mf real(kind=kind_phys), intent(in) :: con_g integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d + logical, intent(in) :: satmedmf, trans_trac - real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cldwrk - ! dt3dt, dq3dt, du3dt, dv3dt upd_mf, dwn_mf, det_mf only allocated if ldiag3d == .true. - real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt, du3dt, dv3dt + real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cldwrk real(kind=kind_phys), dimension(:,:), intent(inout) :: upd_mf, dwn_mf, det_mf real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw, cnvc - ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. - ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, - ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays - ! as long as these do not get used when not allocated (it is still invalid Fortran code, though). + + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_temperature, & + index_of_x_wind, index_of_y_wind, ntqv + integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc + real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw + + real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k + integer :: i, k, n, idtend, tracers ! Initialize CCPP error handling variables errmsg = '' @@ -164,23 +191,56 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs enddo if (ldiag3d .and. flag_for_dcnv_generic_tend) then - do k=1,levs - do i=1,im - dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain - du3dt(i,k) = du3dt(i,k) + (gu0(i,k)-save_u(i,k)) * frain - dv3dt(i,k) = dv3dt(i,k) + (gv0(i,k)-save_v(i,k)) * frain + idtend=dtidx(index_of_temperature,index_of_process_dcnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0-save_t)*frain + endif + + idtend=dtidx(index_of_x_wind,index_of_process_dcnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0-save_u)*frain + endif + + idtend=dtidx(index_of_y_wind,index_of_process_dcnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0-save_v)*frain + endif + + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + tracers = 2 + do n=2,ntrac + if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & + n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & + n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then + tracers = tracers + 1 + idtend = dtidx(100+n,index_of_process_dcnv) + if(idtend>0) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,tracers)-save_q(:,:,n) * frain + endif + endif + enddo + else + do n=2,ntrac + idtend = dtidx(100+n,index_of_process_dcnv) + if(idtend>0) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain + endif enddo - enddo + endif + idtend = dtidx(100+ntqv, index_of_process_dcnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain + endif + + ! convective mass fluxes if(qdiag3d) then - do k=1,levs - do i=1,im - dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k)-save_qv(i,k)) * frain - ! convective mass fluxes - upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) - dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) - det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) - enddo - enddo + do k=1,levs + do i=1,im + upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) + dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) + det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) + enddo + enddo endif endif ! if (ldiag3d) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index ff7933f07..97781f216 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -82,15 +82,31 @@ kind = kind_phys intent = in optional = F -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout optional = F +[nsamftrac] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F [save_u] standard_name = x_wind_save long_name = x-wind before entering a physics scheme @@ -118,14 +134,14 @@ kind = kind_phys intent = inout optional = F -[save_qv] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys - intent = inout + intent = in optional = F [dqdti] standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection @@ -136,6 +152,143 @@ kind = kind_phys intent = inout optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[cscnv] + standard_name = flag_for_Chikira_Sugiyama_deep_convection + long_name = flag for Chikira-Sugiyama convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[trans_trac] + standard_name = flag_for_convective_transport_of_tracers + long_name = flag for convective transport of tracers + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ras] + standard_name = flag_for_ras_deep_convection + long_name = flag for ras convection scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntclamt] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsnc] + standard_name = index_for_snow_number_concentration + long_name = tracer index for snow number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgnc] + standard_name = index_for_graupel_number_concentration + long_name = tracer index for graupel number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -212,14 +365,6 @@ type = logical intent = in optional = F -[cscnv] - standard_name = flag_for_Chikira_Sugiyama_deep_convection - long_name = flag for Chikira-Sugiyama convection - units = flag - dimensions = () - type = logical - intent = in - optional = F [frain] standard_name = dynamics_to_physics_timestep_ratio long_name = ratio of dynamics timestep to physics timestep @@ -283,15 +428,6 @@ kind = kind_phys intent = in optional = F -[save_qv] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [gu0] standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics @@ -319,15 +455,6 @@ kind = kind_phys intent = in optional = F -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [ud_mf] standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt @@ -355,6 +482,81 @@ kind = kind_phys intent = in optional = F +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) + type = real + kind = kind_phys + intent = inout + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -388,6 +590,14 @@ type = integer intent = in optional = F +[nsamftrac] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F [rainc] standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rain at this time step @@ -406,42 +616,6 @@ kind = kind_phys intent = inout optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_deep_convection - long_name = cumulative change in temperature due to deep conv. - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dq3dt] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection - long_name = cumulative change in water vapor specific humidity due to deep conv. - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_deep_convection - long_name = cumulative change in x wind due to deep convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_deep_convection - long_name = cumulative change in y wind due to deep convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [upd_mf] standard_name = cumulative_atmosphere_updraft_convective_mass_flux long_name = cumulative updraft mass flux @@ -513,6 +687,119 @@ type = logical intent = in optional = F +[cscnv] + standard_name = flag_for_Chikira_Sugiyama_deep_convection + long_name = flag for Chikira-Sugiyama convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[trans_trac] + standard_name = flag_for_convective_transport_of_tracers + long_name = flag for convective transport of tracers + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntclamt] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsnc] + standard_name = index_for_snow_number_concentration + long_name = tracer index for snow number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgnc] + standard_name = index_for_graupel_number_concentration + long_name = tracer index for graupel number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index c6bbcb5ea..a2c869e6a 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -23,7 +23,9 @@ subroutine GFS_GWD_generic_pre_run( & & oc, oa4, clx, theta, & & varss, ocss, oa4ss, clxss, & & sigma, gamma, elvmax, lssav, ldiag3d, & - & dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, & + & dtend, dtidx, index_of_temperature, index_of_x_wind, & + & index_of_y_wind, index_of_process_orographic_gwd, & + & dudt, dvdt, dtdt, dtf, & & flag_for_gwd_generic_tend, errmsg, errflg) use machine, only : kind_phys @@ -39,14 +41,16 @@ subroutine GFS_GWD_generic_pre_run( & logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend real(kind=kind_phys), intent(in) :: dtdt(:,:), dudt(:,:), dvdt(:,:) - ! dt3dt only allocated only if ldiag3d is .true. - real(kind=kind_phys), intent(inout) :: dt3dt(:,:), du3dt(:,:), dv3dt(:,:) + ! dtend only allocated only if ldiag3d is .true. + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), index_of_temperature, & + & index_of_x_wind, index_of_y_wind, index_of_process_orographic_gwd real(kind=kind_phys), intent(in) :: dtf character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k + integer :: i, k, idtend ! Initialize CCPP error handling variables errmsg = '' @@ -120,15 +124,20 @@ subroutine GFS_GWD_generic_pre_run( & elvmax = 0 endif ! end if_nmtvr - if (lssav) then - if (ldiag3d .and. flag_for_gwd_generic_tend) then - do k=1,levs - do i=1,im - dt3dt(i,k) = dt3dt(i,k) - dtdt(i,k)*dtf - du3dt(i,k) = du3dt(i,k) - dudt(i,k)*dtf - dv3dt(i,k) = dv3dt(i,k) - dvdt(i,k)*dtf - enddo - enddo + if (lssav .and. ldiag3d .and. flag_for_gwd_generic_tend) then + idtend = dtidx(index_of_temperature, index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) - dtdt*dtf + endif + + idtend = dtidx(index_of_x_wind, index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) - dudt*dtf + endif + + idtend = dtidx(index_of_y_wind, index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) - dvdt*dtf endif endif @@ -160,7 +169,8 @@ end subroutine GFS_GWD_generic_post_init !! \section detailed Detailed Algorithm !! @{ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, dvdt, dtdt, & - & dugwd, dvgwd, du3dt, dv3dt, dt3dt, flag_for_gwd_generic_tend, errmsg, errflg) + & dugwd, dvgwd, flag_for_gwd_generic_tend, dtend, dtidx, index_of_temperature, index_of_x_wind, & + & index_of_y_wind, index_of_process_orographic_gwd, errmsg, errflg) use machine, only : kind_phys implicit none @@ -172,11 +182,17 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:) - real(kind=kind_phys), intent(inout) :: du3dt(:,:), dv3dt(:,:), dt3dt(:,:) + + ! dtend only allocated only if ldiag3d is .true. + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), index_of_temperature, & + & index_of_x_wind, index_of_y_wind, index_of_process_orographic_gwd character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + integer :: idtend + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -186,9 +202,20 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf if (ldiag3d .and. flag_for_gwd_generic_tend) then - du3dt(:,:) = du3dt(:,:) + dudt(:,:) * dtf - dv3dt(:,:) = dv3dt(:,:) + dvdt(:,:) * dtf - dt3dt(:,:) = dt3dt(:,:) + dtdt(:,:) * dtf + idtend = dtidx(index_of_temperature, index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtdt*dtf + endif + + idtend = dtidx(index_of_x_wind, index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dudt*dtf + endif + + idtend = dtidx(index_of_y_wind, index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dvdt*dtf + endif endif endif diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index d12bca331..cd622b243 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -182,32 +182,54 @@ kind = kind_phys intent = in optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in x wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in y wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [dtf] standard_name = time_step_for_dynamics @@ -342,32 +364,54 @@ kind = kind_phys intent = inout optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in zonal wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in meridional wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [flag_for_gwd_generic_tend] standard_name = flag_for_generic_gravity_wave_drag_tendency diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 04450b612..9470caa2b 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -13,7 +13,7 @@ end subroutine GFS_MP_generic_pre_init !! \htmlinclude GFS_MP_generic_pre_run.html !! subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, & - ntrac, gt0, gq0, save_t, save_qv, save_q, errmsg, errflg) + ntrac, gt0, gq0, save_t, save_q, errmsg, errflg) ! use machine, only: kind_phys @@ -23,7 +23,7 @@ subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, real(kind=kind_phys), dimension(:,:), intent(in) :: gt0 real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0 - real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t, save_qv + real(kind=kind_phys), dimension(:,:), intent(inout) :: save_t real(kind=kind_phys), dimension(:,:,:), intent(inout) :: save_q character(len=*), intent(out) :: errmsg @@ -42,16 +42,15 @@ subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, enddo enddo if(qdiag3d) then - do k=1,levs - do i=1,im - ! Here, gq0(...,1) is used instead of gq0_water_vapor - ! to be consistent with the GFS_MP_generic_post_run - ! code. - save_qv(i,k) = gq0(i,k,1) + do n=1,ntrac + do k=1,levs + do i=1,im + save_q(i,k,n) = gq0(i,k,n) + enddo enddo enddo - endif - if(do_aw) then + else if(do_aw) then + ! if qdiag3d, all q are saved already save_q(1:im,:,1) = gq0(1:im,:,1) do n=ntcw,ntcw+nncl-1 save_q(1:im,:,n) = gq0(1:im,:,n) @@ -86,12 +85,14 @@ end subroutine GFS_MP_generic_post_init !> \section gfs_mp_gen GFS MP Generic Post General Algorithm !> @{ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, & - imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires, cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, con_g, dtf, frain, rainc, rain1, & - rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_qv, rain0, ice0, snow0, & + imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, con_g, dtf, frain, rainc, & + rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_q, rain0, ice0, snow0,& graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp, totprcp, totice, & - totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, dt3dt, dq3dt, rain_cpl, rainc_cpl, snow_cpl, pwat, & + totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, pwat, & drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & - graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, errmsg, errflg) + graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, & + dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d, lssav, & + errmsg, errflg) ! use machine, only: kind_phys @@ -100,15 +101,16 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, integer, intent(in) :: im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm + integer, intent(in) :: index_of_temperature,index_of_process_mp real(kind=kind_phys), intent(in) :: dtf, frain, con_g real(kind=kind_phys), dimension(:), intent(in) :: rain1, xlat, xlon, tsfc real(kind=kind_phys), dimension(:), intent(inout) :: ice, snow, graupel, rainc real(kind=kind_phys), dimension(:), intent(in) :: rain0, ice0, snow0, graupel0 real(kind=kind_phys), dimension(:,:), intent(in) :: rann - real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, prsl, save_t, save_qv, del + real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, prsl, save_t, del real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii - real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0 + real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q real(kind=kind_phys), dimension(:), intent(in ) :: sr real(kind=kind_phys), dimension(:), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, & @@ -116,8 +118,8 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, totprcpb, toticeb, totsnwb, totgrpb, pwat real(kind=kind_phys), dimension(:), intent(inout) :: rain_cpl, rainc_cpl, snow_cpl - real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt ! only if ldiag3d - real(kind=kind_phys), dimension(:,:), intent(inout) :: dq3dt ! only if ldiag3d and qdiag3d + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + integer, dimension(:,:), intent(in) :: dtidx ! Stochastic physics / surface perturbations real(kind=kind_phys), dimension(:), intent(inout) :: drain_cpl, dsnow_cpl @@ -148,7 +150,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, real(kind=kind_phys), parameter :: p850 = 85000.0_kind_phys ! *DH - integer :: i, k, ic + integer :: i, k, ic, itrac, idtend real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys real(kind=kind_phys) :: crain, csnow, onebg, tem, total_precip, tem1, tem2 @@ -319,7 +321,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, endif endif - if (lssav) then + if_save_fields: if (lssav) then ! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & ! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & ! 'rain=',Diag%rain(1) @@ -337,21 +339,29 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, totgrpb (i) = totgrpb (i) + graupel(i) enddo - if (ldiag3d) then - do k=1,levs - do i=1,im - dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain - enddo - enddo - if (qdiag3d) then - do k=1,levs - do i=1,im - dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(i,k)) * frain - enddo - enddo - endif - endif - endif + if_tendency_diagnostics: if (ldiag3d) then + idtend = dtidx(index_of_temperature,index_of_process_mp) + if(idtend>=1) then + do k=1,levs + do i=1,im + dtend(i,k,idtend) = dtend(i,k,idtend) + (gt0(i,k)-save_t(i,k)) * frain + enddo + enddo + endif + if_tracer_diagnostics: if (qdiag3d) then + dtend_q: do itrac=1,ntrac + idtend = dtidx(itrac+100,index_of_process_mp) + if(idtend>=1) then + do k=1,levs + do i=1,im + dtend(i,k,idtend) = dtend(i,k,idtend) + (gq0(i,k,itrac)-save_q(i,k,itrac)) * frain + enddo + enddo + endif + enddo dtend_q + endif if_tracer_diagnostics + endif if_tendency_diagnostics + endif if_save_fields if (cplflx .or. cplchm) then do i = 1, im diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index fa4be3ea7..816441086 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -98,15 +98,6 @@ kind = kind_phys intent = inout optional = F -[save_qv] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [save_q] standard_name = tracer_concentration_save long_name = tracer concentration before entering a physics scheme @@ -256,30 +247,6 @@ type = logical intent = in optional = F -[lssav] - standard_name = flag_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ldiag3d] - standard_name = flag_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = logical flag for 3D tracer diagnostics - units = flag - dimensions = () - type = logical - intent = in - optional = F [cplflx] standard_name = flag_for_flux_coupling long_name = flag controlling cplflx collection (default off) @@ -458,14 +425,14 @@ kind = kind_phys intent = in optional = F -[save_qv] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys - intent = in + intent = inout optional = F [rain0] standard_name = lwe_thickness_of_explicit_rain_amount @@ -674,24 +641,6 @@ kind = kind_phys intent = inout optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_microphysics - long_name = cumulative change in temperature due to microphysics - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dq3dt] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_microphysics - long_name = cumulative change in water vapor specific humidity due to microphysics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [rain_cpl] standard_name = lwe_thickness_of_precipitation_amount_for_coupling long_name = total rain precipitation @@ -869,6 +818,63 @@ kind = kind_phys intent = in optional = F +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) + type = real + kind = kind_phys + intent = inout + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_causes) + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_mp] + standard_name = index_of_microphysics_process_process_in_cumulative_change_index + long_name = index of microphysics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = logical flag for 3D tracer diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 5183836ec..029db59fd 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -79,27 +79,28 @@ end subroutine GFS_PBL_generic_pre_finalize !! \section arg_table_GFS_PBL_generic_pre_run Argument Table !! \htmlinclude GFS_PBL_generic_pre_run.html !! - subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, & + subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, & ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, & hybedmf, do_shoc, satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q, & - ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) - + flag_for_pbl_generic_tend, ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) + use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index implicit none integer, parameter :: kp = kind_phys + integer, intent(out) :: rtg_ozone_index integer, intent(in) :: im, levs, nvdiff, ntrac integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc integer, intent(in) :: ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef,ntchs, ntchm logical, intent(in) :: trans_aero, ldiag3d, qdiag3d, lssav integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires - logical, intent(in) :: cplchm, ltaerosol, hybedmf, do_shoc, satmedmf + logical, intent(in) :: cplchm, ltaerosol, hybedmf, do_shoc, satmedmf, flag_for_pbl_generic_tend real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs @@ -120,9 +121,11 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, errmsg = '' errflg = 0 + rtg_ozone_index=-1 !DH: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then vdftra = qgrs + rtg_ozone_index = ntoz else if (imp_physics == imp_physics_wsm6) then ! WSM6 @@ -134,6 +137,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,4) = qgrs(i,k,ntoz) enddo enddo + rtg_ozone_index = 4 ! Ferrier-Aligo elseif (imp_physics == imp_physics_fer_hires) then @@ -147,6 +151,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,6) = qgrs(i,k,ntoz) enddo enddo + rtg_ozone_index = 6 elseif (imp_physics == imp_physics_thompson) then ! Thompson @@ -167,6 +172,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,12) = qgrs(i,k,ntia) enddo enddo + rtg_ozone_index = 10 else do k=1,levs do i=1,im @@ -181,6 +187,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,9) = qgrs(i,k,ntoz) enddo enddo + rtg_ozone_index = 9 endif ! MG elseif (imp_physics == imp_physics_mg) then ! MG3/2 @@ -201,6 +208,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,12) = qgrs(i,k,ntoz) enddo enddo + rtg_ozone_index = 12 else ! MG2 do k=1,levs do i=1,im @@ -216,6 +224,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,10) = qgrs(i,k,ntoz) enddo enddo + rtg_ozone_index = 10 endif elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP @@ -230,6 +239,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,7) = qgrs(i,k,ntoz) enddo enddo + rtg_ozone_index = 7 elseif (imp_physics == imp_physics_zhao_carr) then ! Zhao/Carr/Sundqvist do k=1,levs @@ -239,6 +249,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,3) = qgrs(i,k,ntoz) enddo enddo + rtg_ozone_index = 3 endif ! if (trans_aero) then @@ -270,7 +281,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ! endif - if(ldiag3d .and. lssav) then + if(ldiag3d .and. lssav .and. flag_for_pbl_generic_tend) then do k=1,levs do i=1,im save_t(i,k) = tgrs(i,k) @@ -285,6 +296,13 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, save_q(i,k,ntoz) = qgrs(i,k,ntoz) enddo enddo + if(ntke>0) then + do k=1,levs + do i=1,im + save_q(i,k,ntke) = qgrs(i,k,ntke) + enddo + enddo + endif endif endif @@ -311,12 +329,12 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, trans_aero, ntchs, ntchm, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, imp_physics_mg, & imp_physics_fer_hires, & - ltaerosol, cplflx, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, qdiag3d, lsidea, hybedmf, do_shoc, satmedmf, & + ltaerosol, cplflx, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf, & shinhong, do_ysu, dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & - dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & - dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & - dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & - dq3dt_ozone, rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, kdt, dusfc_cice, dvsfc_cice, & + dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & + index_of_process_pbl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, & + dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, & + rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, kdt, dusfc_cice, dvsfc_cice, & dtsfc_cice, dqsfc_cice, wet, dry, icy, wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac, & ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, errmsg, errflg) @@ -331,7 +349,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires - logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea + logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu integer, intent(in) :: kdt @@ -359,9 +377,11 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays ! as long as these do not get used when not allocated. - real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, dq3dt_ozone real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, & dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_pbl logical, dimension(:),intent(in) :: wet, dry, icy real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci @@ -380,7 +400,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), parameter :: qmin = 1.0e-8_kp integer :: i, k, kk, k1, n real(kind=kind_phys) :: tem, rho - + integer :: idtend + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -606,29 +627,37 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqsfc_diag (i) = dqsfc_diag(i) + dqsfci_diag(i) * dtf enddo - if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then + if (ldiag3d .and. flag_for_pbl_generic_tend) then if (lsidea) then - dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf + idtend = dtidx(index_of_temperature, index_of_process_pbl) + if(idtend>=1) then + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + dtdt(1:im,1:levs)*dtf + endif else - do k=1,levs - do i=1,im - dt3dt(i,k) = dt3dt(i,k) + (tgrs(i,k) - save_t(i,k)) - enddo - enddo + idtend = dtidx(index_of_temperature, index_of_process_pbl) + if(idtend>=1) then + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + (tgrs(1:im,1:levs) - save_t(1:im,1:levs)) + endif endif - do k=1,levs - do i=1,im - du3dt_PBL(i,k) = du3dt_PBL(i,k) + (ugrs(i,k) - save_u(i,k)) - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + (vgrs(i,k) - save_v(i,k)) - enddo - enddo - if(qdiag3d) then - do k=1,levs - do i=1,im - dq3dt (i,k) = dq3dt (i,k) + (qgrs(i,k,ntqv)-save_q(i,k,ntqv)) - dq3dt_ozone(i,k) = dq3dt_ozone(i,k) + (qgrs(i,k,ntoz)-save_q(i,k,ntoz)) - enddo - enddo + idtend = dtidx(index_of_x_wind, index_of_process_pbl) + if(idtend>=1) then + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + (ugrs(1:im,1:levs) - save_u(1:im,1:levs)) + endif + idtend = dtidx(index_of_y_wind, index_of_process_pbl) + if(idtend>=1) then + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + (vgrs(1:im,1:levs) - save_v(1:im,1:levs)) + endif + idtend = dtidx(100+ntqv, index_of_process_pbl) + if(idtend>=1) then + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + qgrs(1:im,1:levs,ntqv) - save_q(1:im,1:levs,ntqv) + endif + idtend = dtidx(100+ntoz, index_of_process_pbl) + if(idtend>=1) then + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + qgrs(1:im,1:levs,ntoz) - save_q(1:im,1:levs,ntoz) + endif + idtend = dtidx(100+ntke, index_of_process_pbl) + if(idtend>=1) then + dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + (qgrs(1:im,1:levs,ntke) - save_q(1:im,1:levs,ntke)) endif endif diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 01f5ec3ce..10a9adc75 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -39,6 +39,14 @@ type = integer intent = in optional = F +[rtg_ozone_index] + standard_name = vertically_diffused_tracer_index_of_ozone + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = out + optional = F [ntqv] standard_name = index_for_water_vapor long_name = tracer index for water vapor (specific humidity) @@ -349,6 +357,14 @@ kind = kind_phys intent = out optional = F +[flag_for_pbl_generic_tend] + standard_name = flag_for_generic_planetary_boundary_layer_tendency + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in + optional = F [ldiag3d] standard_name = flag_diagnostics_3D long_name = flag for 3d diagnostic fields @@ -724,14 +740,6 @@ type = logical intent = in optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F [lsidea] standard_name = flag_idealized_physics long_name = flag for idealized physics @@ -816,6 +824,55 @@ kind = kind_phys intent = in optional = F +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) + type = real + kind = kind_phys + intent = inout + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F [dqsfc1] standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux valid for current call @@ -1041,69 +1098,6 @@ kind = kind_phys intent = inout optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[du3dt_PBL] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[du3dt_OGWD] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in x wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dv3dt_PBL] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dv3dt_OGWD] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in y wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dq3dt] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dq3dt_ozone] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [rd] standard_name = gas_constant_dry_air long_name = ideal gas constant for dry air diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 450f0e5a9..ac77eaa68 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -14,22 +14,28 @@ end subroutine GFS_SCNV_generic_pre_finalize !> \section arg_table_GFS_SCNV_generic_pre_run Argument Table !! \htmlinclude GFS_SCNV_generic_pre_run.html !! - subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, gq0_water_vapor, & - save_u, save_v, save_t, save_qv, flag_for_scnv_generic_tend, errmsg, errflg) + subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, gq0, & + save_u, save_v, save_t, save_q, ntqv, nsamftrac, flag_for_scnv_generic_tend, & + dtidx, index_of_process_scnv, ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc, & + cscnv, satmedmf, trans_trac, ras, ntrac, clw, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs + integer, intent(in) :: im, levs, ntqv, nsamftrac, index_of_process_scnv, dtidx(:,:) + integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc,ntrac logical, intent(in) :: ldiag3d, qdiag3d, flag_for_scnv_generic_tend - real(kind=kind_phys), dimension(:, :), intent(in) :: gu0, gv0, gt0, gq0_water_vapor - - real(kind=kind_phys), dimension(:, :), intent(inout) :: save_u, save_v, save_t, save_qv + real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0 + real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0 + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: save_q + real(kind=kind_phys), dimension(:,:), intent(inout) :: save_u, save_v, save_t character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + logical, intent(in) :: cscnv, satmedmf, trans_trac, ras + real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw - integer :: i, k + integer :: i, k, n, tracers ! Initialize CCPP error handling variables errmsg = '' @@ -44,13 +50,28 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, enddo enddo if (qdiag3d) then - do k=1,levs - do i=1,im - save_qv(i,k) = gq0_water_vapor(i,k) + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + tracers = 2 + do n=2,ntrac + if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & + n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & + n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then + tracers = tracers + 1 + if(dtidx(100+n,index_of_process_scnv)>0) then + save_q(:,:,n) = clw(:,:,tracers) + endif + endif enddo - enddo + else + do n=2,ntrac + if(dtidx(100+n,index_of_process_scnv)>0) then + save_q(:,:,n) = gq0(:,:,n) + endif + enddo + endif ! end if_ras or cfscnv or samf + save_q(:,:,ntqv) = gq0(:,:,ntqv) endif - endif + endif end subroutine GFS_SCNV_generic_pre_run @@ -70,27 +91,34 @@ end subroutine GFS_SCNV_generic_post_finalize !> \section arg_table_GFS_SCNV_generic_post_run Argument Table !! \htmlinclude GFS_SCNV_generic_post_run.html !! - subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cplchm, & - frain, gu0, gv0, gt0, gq0_water_vapor, save_u, save_v, save_t, save_qv, dqdti, du3dt, dv3dt, dt3dt, dq3dt, clw, & - shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, & - rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & - flag_for_scnv_generic_tend, & - imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) + subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & + cplchm, frain, gu0, gv0, gt0, gq0, save_u, save_v, save_t, save_q, dqdti, & + clw, shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, nsamftrac, & + rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & + dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & + index_of_process_scnv, ntqv, flag_for_scnv_generic_tend, & + ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc, & + imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, ntrac, & + cscnv, satmedmf, trans_trac, ras, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, nn + integer, intent(in) :: im, levs, nn, ntqv, nsamftrac + integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc,ntrac logical, intent(in) :: lssav, ldiag3d, qdiag3d, cplchm, flag_for_scnv_generic_tend real(kind=kind_phys), intent(in) :: frain - real(kind=kind_phys), dimension(:, :), intent(in) :: gu0, gv0, gt0, gq0_water_vapor - real(kind=kind_phys), dimension(:, :), intent(in) :: save_u, save_v, save_t, save_qv + real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0 + real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t + real(kind=kind_phys), dimension(:,:,:), intent(in) :: save_q, gq0 - ! dqdti, dt3dt, dq3dt, only allocated if ldiag3d == .true. + ! dtend only allocated if ldiag3d == .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti - real(kind=kind_phys), dimension(:,:), intent(inout) :: du3dt, dv3dt, dt3dt, dq3dt - real(kind=kind_phys), dimension(:, :,:), intent(inout) :: clw + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_scnv + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: clw ! Post code for SAS/SAMF integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d @@ -104,11 +132,12 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl ! as long as these do not get used when not allocated. real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d integer, intent(in) :: imfshalcnv, imfshalcnv_sas, imfshalcnv_samf + logical, intent(in) :: cscnv, satmedmf, trans_trac, ras character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k + integer :: i, k, n, idtend, tracers real(kind=kind_phys) :: tem ! Initialize CCPP error handling variables @@ -138,19 +167,45 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl if (lssav .and. flag_for_scnv_generic_tend) then if (ldiag3d) then - do k=1,levs - do i=1,im - du3dt(i,k) = du3dt(i,k) + (gu0(i,k) - save_u(i,k)) * frain - dv3dt(i,k) = dv3dt(i,k) + (gv0(i,k) - save_v(i,k)) * frain - dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k) - save_t(i,k)) * frain - enddo - enddo - if (qdiag3d) then - do k=1,levs - do i=1,im - dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k) - save_qv(i,k)) * frain - enddo + idtend = dtidx(index_of_temperature, index_of_process_scnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0 - save_t) * frain + endif + + idtend = dtidx(index_of_x_wind, index_of_process_scnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0 - save_u) * frain + endif + + idtend = dtidx(index_of_y_wind, index_of_process_scnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0 - save_v) * frain + endif + + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + tracers = 2 + do n=2,ntrac + if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & + n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & + n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then + tracers = tracers + 1 + idtend = dtidx(100+n,index_of_process_scnv) + if(idtend>0) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,tracers)-save_q(:,:,n) * frain + endif + endif enddo + else + do n=2,ntrac + idtend = dtidx(100+n,index_of_process_scnv) + if(idtend>0) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain + endif + enddo + endif + idtend = dtidx(100+ntqv, index_of_process_scnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain endif endif endif @@ -158,7 +213,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl if (cplchm) then do k=1,levs do i=1,im - tem = (gq0_water_vapor(i,k)-save_qv(i,k)) * frain + tem = (gq0(i,k,ntqv)-save_q(i,k,ntqv)) * frain dqdti(i,k) = dqdti(i,k) + tem enddo enddo diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index dea2f039c..650814d67 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -66,11 +66,11 @@ kind = kind_phys intent = in optional = F -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -102,14 +102,30 @@ kind = kind_phys intent = inout optional = F -[save_qv] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys - intent = inout + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[nsamftrac] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in optional = F [flag_for_scnv_generic_tend] standard_name = flag_for_generic_shallow_convection_tendency @@ -119,6 +135,143 @@ type = logical intent = in optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[cscnv] + standard_name = flag_for_Chikira_Sugiyama_deep_convection + long_name = flag for Chikira-Sugiyama convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[trans_trac] + standard_name = flag_for_convective_transport_of_tracers + long_name = flag for convective transport of tracers + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ras] + standard_name = flag_for_ras_deep_convection + long_name = flag for ras convection scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntclamt] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsnc] + standard_name = index_for_snow_number_concentration + long_name = tracer index for snow number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgnc] + standard_name = index_for_graupel_number_concentration + long_name = tracer index for graupel number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -239,11 +392,11 @@ kind = kind_phys intent = in optional = F -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -275,11 +428,11 @@ kind = kind_phys intent = in optional = F -[save_qv] - standard_name = water_vapor_specific_humidity_save - long_name = water vapor specific humidity before entering a physics scheme +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -293,41 +446,62 @@ kind = kind_phys intent = inout optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_shallow_convection - long_name = cumulative change in x wind due to shallow convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_shallow_convection - long_name = cumulative change in y wind due to shallow convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_shallow_convection - long_name = cumulative change in temperature due to shal conv. - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dq3dt] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shallow_convection - long_name = cumulative change in water vapor specific humidity due to shal conv. - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in optional = F [clw] standard_name = convective_transportable_tracers @@ -397,6 +571,14 @@ kind = kind_phys intent = in optional = F +[nsamftrac] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F [rainc] standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rain at this time step @@ -474,6 +656,118 @@ type = integer intent = in optional = F +[cscnv] + standard_name = flag_for_Chikira_Sugiyama_deep_convection + long_name = flag for Chikira-Sugiyama convection + units = flag + dimensions = () + type = logical + intent = in + optional = F +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[trans_trac] + standard_name = flag_for_convective_transport_of_tracers + long_name = flag for convective transport of tracers + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ras] + standard_name = flag_for_ras_deep_convection + long_name = flag for ras convection scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntclamt] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsnc] + standard_name = index_for_snow_number_concentration + long_name = tracer index for snow number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgnc] + standard_name = index_for_graupel_number_concentration + long_name = tracer index for graupel number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 00e7865ef..567cbbd32 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -420,7 +420,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, integer, intent(out) :: errflg !--- local variables - integer :: impi, iomp, ierr, n + integer :: impi, iomp, ierr, n, idtend, iprocess, itracer integer :: mpirank, mpisize, mpicomm integer :: omprank, ompsize @@ -667,6 +667,16 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%v1 ', Diag%v1) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%chh ', Diag%chh) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cmm ', Diag%cmm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dlwsfci ', Diag%dlwsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ulwsfci ', Diag%ulwsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dswsfci ', Diag%dswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%nswsfci ', Diag%nswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%uswsfci ', Diag%uswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dusfci ', Diag%dusfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvsfci ', Diag%dvsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dtsfci ', Diag%dtsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dqsfci ', Diag%dqsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%gfluxi ', Diag%gfluxi) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%epi ', Diag%epi) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%smcwlt2 ', Diag%smcwlt2) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%smcref2 ', Diag%smcref2) @@ -687,25 +697,21 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%shum_wts ', Diag%shum_wts) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%zmtnblck ', Diag%zmtnblck) if (Model%ldiag3d) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du3dt ', Diag%du3dt) - do n=1,size(Diag%du3dt(1,1,:)) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du3dt_n ', Diag%du3dt(:,:,n)) - end do - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv3dt ', Diag%dv3dt) - do n=1,size(Diag%dv3dt(1,1,:)) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv3dt_n ', Diag%dv3dt(:,:,n)) - end do - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dt3dt ', Diag%dt3dt) - do n=1,size(Diag%dt3dt(1,1,:)) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dt3dt_n ', Diag%dt3dt(:,:,n)) - end do - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dq3dt ', Diag%dq3dt) - do n=1,size(Diag%dq3dt(1,1,:)) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dq3dt_n ', Diag%dq3dt(:,:,n)) - end do - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) + !do itracer=2,Model%ntracp100 + ! do iprocess=1,Model%nprocess + ! idtend = Model%dtidx(itracer,iprocess) + ! if(idtend>=1) then + ! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, & + ! 'dtend_'//Model%dtend_tracer_labels(itracer)//'_' & + ! //Model%dtend_cause_labels(iprocess), Diag%dtend(1,1,idtend)) + ! endif + ! enddo + !enddo + if (Model%qdiag3d) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) + end if end if if(Model%lradar) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%refl_10cm ', Diag%refl_10cm) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 962959327..b793c2902 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,7 +163,8 @@ end subroutine GFS_suite_interstitial_2_finalize subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_cice, shal_cnv, old_monin, mstrat, & do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & - adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & + adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dtend, dtidx, index_of_process_longwave, index_of_process_shortwave, & + index_of_process_pbl, index_of_process_dcnv, index_of_process_scnv, index_of_process_mp, index_of_temperature, & ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, htrlwu, errmsg, errflg) implicit none @@ -187,8 +188,12 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ real(kind=kind_phys), intent(in ), dimension(:) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent(inout), dimension(:) :: adjsfculw - ! These arrays are only allocated if ldiag3d is .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp + ! dtend is only allocated if ldiag3d is .true. + real(kind=kind_phys), optional, intent(inout), dimension(:,:,:) :: dtend + integer, intent(in), dimension(:,:) :: dtidx + integer, intent(in) :: index_of_process_longwave, index_of_process_shortwave, & + index_of_process_pbl, index_of_process_dcnv, index_of_process_scnv, & + index_of_process_mp, index_of_temperature logical, intent(in ), dimension(:) :: dry, icy, wet real(kind=kind_phys), intent(in ), dimension(:) :: frland @@ -199,7 +204,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ ! local variables real(kind=kind_phys), parameter :: czmin = 0.0001_kind_phys ! cos(89.994) - integer :: i, k + integer :: i, k, idtend real(kind=kind_phys) :: tem1, tem2, tem, hocp logical, dimension(im) :: invrsn real(kind=kind_phys), dimension(im) :: tx1, tx2 @@ -277,27 +282,53 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ if (ldiag3d) then if (lsidea) then - do k=1,levs - do i=1,im - dt3dt_lw(i,k) = dt3dt_lw(i,k) + lwhd(i,k,1)*dtf - dt3dt_sw(i,k) = dt3dt_sw(i,k) + lwhd(i,k,2)*dtf - dt3dt_pbl(i,k) = dt3dt_pbl(i,k) + lwhd(i,k,3)*dtf - dt3dt_dcnv(i,k) = dt3dt_dcnv(i,k) + lwhd(i,k,4)*dtf - dt3dt_scnv(i,k) = dt3dt_scnv(i,k) + lwhd(i,k,5)*dtf - dt3dt_mp(i,k) = dt3dt_mp(i,k) + lwhd(i,k,6)*dtf - enddo - enddo + idtend = dtidx(index_of_temperature,index_of_process_longwave) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,1)*dtf + endif + + idtend = dtidx(index_of_temperature,index_of_process_shortwave) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,2)*dtf + endif + + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,3)*dtf + endif + + idtend = dtidx(index_of_temperature,index_of_process_dcnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,4)*dtf + endif + + idtend = dtidx(index_of_temperature,index_of_process_scnv) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,5)*dtf + endif + + idtend = dtidx(index_of_temperature,index_of_process_mp) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,6)*dtf + endif else - do k=1,levs - do i=1,im - if (use_LW_jacobian) then - dt3dt_lw(i,k) = dt3dt_lw(i,k) + htrlwu(i,k)*dtf - else - dt3dt_lw(i,k) = dt3dt_lw(i,k) + htrlw(i,k)*dtf - endif - dt3dt_sw(i,k) = dt3dt_sw(i,k) + htrsw(i,k)*dtf*xmu(i) - enddo - enddo + idtend = dtidx(index_of_temperature,index_of_process_longwave) + if(idtend>=1) then + if (use_LW_jacobian) then + dtend(:,:,idtend) = dtend(:,:,idtend) + htrlwu(:,:)*dtf + else + dtend(:,:,idtend) = dtend(:,:,idtend) + htrlw(:,:)*dtf + endif + endif + + idtend = dtidx(index_of_temperature,index_of_process_shortwave) + if(idtend>=1) then + do k=1,levs + do i=1,im + dtend(i,k,idtend) = dtend(i,k,idtend) + htrsw(i,k)*dtf*xmu(i) + enddo + enddo + endif endif endif endif ! end if_lssav_block @@ -488,10 +519,11 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, & xlon, xlat, gt0, gq0, imp_physics, imp_physics_mg, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_gfdl, imp_physics_thompson, & - imp_physics_wsm6, imp_physics_fer_hires, prsi, & + imp_physics_gfdl, imp_physics_thompson, dtidx, ntlnc, & + imp_physics_wsm6, imp_physics_fer_hires, prsi, ntinc, & prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & - work1, work2, kpbl, kinver, ras, me, & + work1, work2, kpbl, kinver, ras, me, save_lnc, save_inc, & + ldiag3d, qdiag3d, index_of_process_conv_trans, & clw, rhc, save_qc, save_qi, save_tcp, errmsg, errflg) use machine, only: kind_phys @@ -501,10 +533,15 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & ! interface variables integer, intent(in ) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, ntsw,& ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, me + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, me, index_of_process_conv_trans integer, intent(in ), dimension(:) :: islmsk, kpbl, kinver logical, intent(in ) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras + integer, intent(in) :: ntinc, ntlnc + logical, intent(in) :: ldiag3d, qdiag3d + integer, dimension(:,:), intent(in) :: dtidx + real, dimension(:,:), intent(out) :: save_lnc, save_inc + real(kind=kind_phys), intent(in ) :: rhcbot, rhcmax, rhcpbl, rhctop real(kind=kind_phys), intent(in ), dimension(:) :: work1, work2 real(kind=kind_phys), intent(in ), dimension(:,:) :: prsl, prslk @@ -636,6 +673,15 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & enddo endif + if(imp_physics == imp_physics_thompson .and. ldiag3d .and. qdiag3d) then + if(dtidx(100+ntlnc,index_of_process_conv_trans)>0) then + save_lnc = gq0(:,:,ntlnc) + endif + if(dtidx(100+ntinc,index_of_process_conv_trans)>0) then + save_inc = gq0(:,:,ntinc) + endif + endif + end subroutine GFS_suite_interstitial_3_run end module GFS_suite_interstitial_3 @@ -655,8 +701,9 @@ end subroutine GFS_suite_interstitial_4_finalize !! subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, convert_dry_rho, dtf, save_qc, save_qi, con_pi, & - gq0, clw, prsl, save_tcp, con_rd, con_eps, nwfa, spechum, dqdti, errmsg, errflg) + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, convert_dry_rho, dtf, save_qc, save_qi, con_pi, dtidx, dtend,& + index_of_process_conv_trans, gq0, clw, prsl, save_tcp, con_rd, con_eps, nwfa, spechum, dqdti, ldiag3d, & + qdiag3d, save_lnc, save_inc, ntk, ntke, errmsg, errflg) use machine, only: kind_phys use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber @@ -674,14 +721,20 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to real(kind=kind_phys), intent(in ) :: con_pi, dtf real(kind=kind_phys), intent(in ), dimension(:,:) :: save_qc ! save_qi is not allocated for Zhao-Carr MP - real(kind=kind_phys), intent(in ), dimension(:,:) :: save_qi + real(kind=kind_phys), intent(in ), dimension(:,:) :: save_qi, save_lnc, save_inc - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: gq0 - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: clw - real(kind=kind_phys), intent(in ), dimension(:,:) :: prsl - real(kind=kind_phys), intent(in ) :: con_rd, con_eps - real(kind=kind_phys), intent(in ), dimension(:,:) :: nwfa, save_tcp - real(kind=kind_phys), intent(in ), dimension(:,:) :: spechum + ! dtend and dtidx are only allocated if ldiag3d + logical, intent(in) :: ldiag3d, qdiag3d + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + integer, dimension(:,:), intent(in) :: dtidx + integer, intent(in) :: index_of_process_conv_trans,ntk,ntke + + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: clw + real(kind=kind_phys), dimension(:,:), intent(in) :: prsl + real(kind=kind_phys), intent(in) :: con_rd, con_eps + real(kind=kind_phys), dimension(:,:), intent(in) :: nwfa, save_tcp + real(kind=kind_phys), dimension(:,:), intent(in) :: spechum ! dqdti may not be allocated real(kind=kind_phys), intent(inout), dimension(:,:) :: dqdti @@ -691,7 +744,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! local variables real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys - integer :: i,k,n,tracers + integer :: i,k,n,tracers,idtend real(kind=kind_phys) :: rho, orho real(kind=kind_phys), dimension(im,levs) :: qv_mp !< kg kg-1 (dry mixing ratio) @@ -704,6 +757,39 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to errmsg = '' errflg = 0 + if(ldiag3d) then + if(ntk>0 .and. ntk<=size(clw,3)) then + idtend=dtidx(100+ntke,index_of_process_conv_trans) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk)-gq0(:,:,ntk) + endif + endif + if(ntcw>0) then + if (imp_physics == imp_physics_zhao_carr .or. & + imp_physics == imp_physics_zhao_carr_pdf .or. & + imp_physics == imp_physics_gfdl) then + idtend=dtidx(100+ntcw,index_of_process_conv_trans) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)+clw(:,:,2) - gq0(:,:,ntcw) + endif + else if(ntiw>0) then + idtend=dtidx(100+ntiw,index_of_process_conv_trans) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)-gq0(:,:,ntiw) + endif + idtend=dtidx(100+ntcw,index_of_process_conv_trans) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,2)-gq0(:,:,ntcw) + endif + else + idtend=dtidx(100+ntcw,index_of_process_conv_trans) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,1)+clw(:,:,2) - gq0(:,:,ntcw) + endif + endif + endif + endif + ! --- update the tracers due to deep & shallow cumulus convective transport ! (except for suspended water and ice) @@ -715,6 +801,12 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc ) then tracers = tracers + 1 + if(n/=ntk .and. n/=ntlnc .and. n/=ntinc .and. n /= ntcw .and. n /= ntiw) then + idtend=dtidx(100+n,index_of_process_conv_trans) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,tracers)-gq0(:,:,n) + endif + endif do k=1,levs do i=1,im gq0(i,k,n) = clw(i,k,tracers) @@ -790,6 +882,16 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to enddo enddo end if if_convert_dry_rho + if(ldiag3d .and. qdiag3d) then + idtend = dtidx(100+ntlnc,index_of_process_conv_trans) + if(idtend>0) then + dtend(:,:,idtend) = dtend(:,:,idtend) + gq0(:,:,ntlnc) - save_lnc + endif + idtend = dtidx(100+ntinc,index_of_process_conv_trans) + if(idtend>0) then + dtend(:,:,idtend) = dtend(:,:,idtend) + gq0(:,:,ntinc) - save_inc + endif + endif endif else diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index bdcc8f275..0c1189f19 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -664,59 +664,78 @@ kind = kind_phys intent = inout optional = F -[dt3dt_lw] - standard_name = cumulative_change_in_temperature_due_to_longwave_radiation - long_name = cumulative change in temperature due to longwave radiation - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[dt3dt_sw] - standard_name = cumulative_change_in_temperature_due_to_shortwave_radiation - long_name = cumulative change in temperature due to shortwave radiation - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dt3dt_pbl] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_longwave] + standard_name = index_of_longwave_heating_process_in_cumulative_change_index + long_name = index of longwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dt3dt_dcnv] - standard_name = cumulative_change_in_temperature_due_to_deep_convection - long_name = cumulative change in temperature due to deep conv. - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_shortwave] + standard_name = index_of_shortwave_heating_process_in_cumulative_change_index + long_name = index of shortwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dt3dt_scnv] - standard_name = cumulative_change_in_temperature_due_to_shallow_convection - long_name = cumulative change in temperature due to shal conv. - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dt3dt_mp] - standard_name = cumulative_change_in_temperature_due_to_microphysics - long_name = cumulative change in temperature due to microphysics - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_mp] + standard_name = index_of_microphysics_process_process_in_cumulative_change_index + long_name = index of microphysics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [ctei_rml] standard_name = grid_sensitive_critical_cloud_top_entrainment_instability_criteria @@ -1558,6 +1577,72 @@ kind = kind_phys intent = inout optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[index_of_process_conv_trans] + standard_name = index_of_convective_transport_process_in_cumulative_change_index + long_name = index of convective transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[save_lnc] + standard_name = liquid_cloud_number_concentration_save + long_name = liquid cloud number concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[save_inc] + standard_name = ice_cloud_number_concentration_save + long_name = ice cloud number concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1805,6 +1890,24 @@ kind = kind_phys intent = in optional = F +[save_lnc] + standard_name = liquid_cloud_number_concentration_save + long_name = liquid cloud number concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_inc] + standard_name = ice_cloud_number_concentration_save + long_name = ice cloud number concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter @@ -1895,6 +1998,63 @@ kind = kind_phys intent = inout optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) + type = real + kind = kind_phys + intent = inout + optional = F +[ntk] + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy + long_name = tracer index for turbulent kinetic energy + units = index + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[index_of_process_conv_trans] + standard_name = index_of_convective_transport_process_in_cumulative_change_index + long_name = index of convective transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index ee99e0f85..48a4b7808 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -27,7 +27,7 @@ end subroutine GFS_surface_composites_pre_finalize !> \section arg_table_GFS_surface_composites_pre_run Argument Table !! \htmlinclude GFS_surface_composites_pre_run.html !! - subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & + subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & flag_cice, cplflx, cplwav2atm, landfrac, lakefrac, lakedepth, oceanfrac, frland, & dry, icy, use_flake, ocean, wet, hice, cice, zorlo, zorll, zorli, & snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & @@ -43,7 +43,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, ! Interface variables integer, intent(in ) :: im, lkm integer, intent(in ) :: lsm, lsm_noahmp, lsm_ruc - logical, intent(in ) :: flag_init, frac_grid, cplflx, cplwav2atm + logical, intent(in ) :: flag_init, flag_restart, frac_grid, cplflx, cplwav2atm logical, dimension(:), intent(inout) :: flag_cice logical, dimension(:), intent(inout) :: dry, icy, use_flake, ocean, wet real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac @@ -231,7 +231,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, snowd_ice(i) = snowd(i) ep1d_ice(i) = zero gflx_ice(i) = zero - if (iemsflg == 2 .and. .not. flag_init .and. lsm == lsm_ruc) then + if (iemsflg == 2 .and. (.not.flag_init .or. flag_restart) .and. lsm == lsm_ruc) then !-- use emis_ice from RUC LSM with snow effect semis_ice(i) = emis_ice(i) else diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 95f2c6e4e..9caf9db04 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -23,6 +23,14 @@ type = logical intent = in optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [lkm] standard_name = flag_for_lake_surface_scheme long_name = flag for lake surface model diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 38496eeb7..6efce96f5 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -164,7 +164,8 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr dudt_mtb,dudt_ogw, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & dudt, dvdt, dtdt, rdxzb, con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, & con_omega, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & - ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & + dtend, dtidx, index_of_x_wind, index_of_y_wind, index_of_temperature, & + index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, & ldiag3d, lssav, flag_for_gwd_generic_tend, errmsg, errflg) implicit none @@ -190,9 +191,12 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr real(kind=kind_phys), intent(out), dimension(:, :):: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis real(kind=kind_phys), intent(out), dimension(:, :):: dudt_mtb, dudt_ogw, dudt_tms - ! These arrays are only allocated if ldiag=.true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw + ! dtend is only allocated if ldiag=.true. + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), & + index_of_x_wind, index_of_y_wind, index_of_temperature, & + index_of_process_orographic_gwd, index_of_process_nonorographic_gwd + logical, intent(in) :: ldiag3d, lssav ! These arrays only allocated if ldiag_ugwp = .true. @@ -214,7 +218,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr integer, intent(out) :: errflg ! local variables - integer :: i, k + integer :: i, k, idtend real(kind=kind_phys), dimension(im) :: sgh30 real(kind=kind_phys), dimension(im, levs) :: Pdvdt, Pdudt real(kind=kind_phys), dimension(im, levs) :: Pdtdt, Pkdis @@ -288,13 +292,18 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then - do k=1,levs - do i=1,im - ldu3dt_ogw(i,k) = ldu3dt_ogw(i,k) + Pdudt(i,k)*dtp - ldv3dt_ogw(i,k) = ldv3dt_ogw(i,k) + Pdvdt(i,k)*dtp - ldt3dt_ogw(i,k) = ldt3dt_ogw(i,k) + Pdtdt(i,k)*dtp - enddo - enddo + idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp + endif + idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp + endif endif @@ -374,13 +383,18 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr endif if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then - do k=1,levs - do i=1,im - ldu3dt_cgw(i,k) = ldu3dt_cgw(i,k) + (gw_dudt(i,k) - Pdudt(i,k))*dtp - ldv3dt_cgw(i,k) = ldv3dt_cgw(i,k) + (gw_dvdt(i,k) - Pdvdt(i,k))*dtp - ldt3dt_cgw(i,k) = ldt3dt_cgw(i,k) + (gw_dtdt(i,k) - Pdtdt(i,k))*dtp - enddo - enddo + idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dudt - Pdudt)*dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dvdt - Pdvdt)*dtp + endif + idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dtdt - Pdtdt)*dtp + endif endif end subroutine cires_ugwp_run diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index cf9992624..0d93f1820 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -875,59 +875,63 @@ type = integer intent = in optional = F -[ldu3dt_ogw] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in x wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout optional = F -[ldv3dt_ogw] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in y wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[ldt3dt_ogw] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldu3dt_cgw] - standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in x wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldv3dt_cgw] - standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in y wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldt3dt_cgw] - standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag - long_name = cumulative change in temperature due to convective gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_nonorographic_gwd] + standard_name = index_of_nonorographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of nonorographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [ldiag3d] standard_name = flag_diagnostics_3D diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index a07523342..039ff7f75 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -28,9 +28,9 @@ module cu_gf_deep real(kind=kind_phys), parameter :: pgcd = 0.1 ! !> aerosol awareness, do not user yet! - integer, parameter :: autoconv=1 - integer, parameter :: aeroevap=1 - real(kind=kind_phys), parameter :: ccnclean=250. + integer, parameter :: autoconv=2 !1 + integer, parameter :: aeroevap=3 !1 + real(kind=kind_phys), parameter :: scav_factor = 0.5 !> still 16 ensembles for clousres integer, parameter:: maxens3=16 @@ -56,6 +56,7 @@ subroutine cu_gf_deep_run( & ,ichoice & ! choice of closure, use "0" for ensemble average ,ipr & ! this flag can be used for debugging prints ,ccn & ! not well tested yet + ,ccnclean & ,dtime & ! dt over which forcing is applied ,imid & ! flag to turn on mid level convection ,kpbl & ! level of boundary layer height @@ -176,15 +177,15 @@ subroutine cu_gf_deep_run( & q,qo,zuo,zdo,zdm real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & - dx,ccn,z1,psur,xland + dx,z1,psur,xland real(kind=kind_phys), dimension (its:ite) & ,intent (inout ) :: & - mconv + mconv,ccn real(kind=kind_phys) & ,intent (in ) :: & - dtime + dtime,ccnclean ! @@ -291,7 +292,7 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (its:ite) :: & edt,edto,edtm,aa1,aa0,xaa0,hkb, & hkbo,xhkb, & - xmb,pwavo, & + xmb,pwavo,ccnloss, & pwevo,bu,bud,cap_max, & cap_max_increment,closure_n,psum,psumh,sig,sigd real(kind=kind_phys), dimension (its:ite) :: & @@ -305,7 +306,7 @@ subroutine cu_gf_deep_run( & integer :: & iloop,nens3,ki,kk,i,k real(kind=kind_phys) :: & - dz,dzo,mbdt,radius, & + dz,dzo,mbdt,radius,pefc, & zcutdown,depth_min,zkbmax,z_detr,zktop, & dh,cap_maxs,trash,trash2,frh,sig_thresh real(kind=kind_phys) entdo,dp,subin,detdo,entup, & @@ -504,8 +505,8 @@ subroutine cu_gf_deep_run( & ! !--- minimum depth (m), clouds must have ! - depth_min=1000. - if(imid.eq.1)depth_min=500. + depth_min=3000. + if(imid.eq.1)depth_min=2500. ! !--- maximum depth (mb) of capping !--- inversion (larger cap = no convection) @@ -844,8 +845,8 @@ subroutine cu_gf_deep_run( & exit endif enddo - ktop(i)=ktopkeep(i) - if(ierr(i).eq.0)ktop(i)=ktopkeep(i) + !ktop(i)=ktopkeep(i) + !if(ierr(i).eq.0)ktop(i)=ktopkeep(i) enddo do 37 i=its,itf kzdown(i)=0 @@ -947,14 +948,14 @@ subroutine cu_gf_deep_run( & call cup_up_moisture('mid',ierr,zo_cup,qco,qrco,pwo,pwavo, & p_cup,kbcon,ktop,dbyo,clw_all,xland1, & qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & - zqexec,ccn,rho,c1d,tn_cup,up_massentr,up_massdetr,psum,psumh, & + zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, & 1,itf,ktf, & its,ite, kts,kte) else call cup_up_moisture('deep',ierr,zo_cup,qco,qrco,pwo,pwavo, & p_cup,kbcon,ktop,dbyo,clw_all,xland1, & qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & - zqexec,ccn,rho,c1d,tn_cup,up_massentr,up_massdetr,psum,psumh, & + zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, & 1,itf,ktf, & its,ite, kts,kte) endif @@ -1022,8 +1023,8 @@ subroutine cu_gf_deep_run( & exit endif enddo - ktop(i)=ktopkeep(i) - if(ierr(i).eq.0)ktop(i)=ktopkeep(i) + !ktop(i)=ktopkeep(i) + !if(ierr(i).eq.0)ktop(i)=ktopkeep(i) enddo 41 continue do i=its,itf @@ -1478,8 +1479,8 @@ subroutine cu_gf_deep_run( & !> - Call cup_dd_edt() to determine downdraft strength in terms of windshear ! call cup_dd_edt(ierr,us,vs,zo,ktop,kbcon,edt,po,pwavo, & - pwo,ccn,pwevo,edtmax,edtmin,edtc,psum,psumh, & - rho,aeroevap,itf,ktf, & + pwo,ccn,ccnclean,pwevo,edtmax,edtmin,edtc,psum,psumh, & + rho,aeroevap,pefc,itf,ktf, & its,ite, kts,kte) do i=its,itf if(ierr(i)/=0)cycle @@ -1715,6 +1716,14 @@ subroutine cu_gf_deep_run( & xt(i,k)= dellat(i,k)*mbdt+tn(i,k) xt(i,k)=max(190.,xt(i,k)) enddo + + ! Smooth dellas (HCB) + do k=kts+1,ktf + xt(i,k)=tn(i,k)+0.25*(dellat(i,k-1) + 2.*dellat(i,k) + dellat(i,k+1)) * mbdt + xt(i,k)=max(190.,xt(i,k)) + xq(i,k)=max(1.e-16, qo(i,k)+0.25*(dellaq(i,k-1) + 2.*dellaq(i,k) + dellaq(i,k+1)) * mbdt) + xhe(i,k)=heo(i,k)+0.25*(dellah(i,k-1) + 2.*dellah(i,k) + dellah(i,k+1)) * mbdt + enddo endif enddo do i=its,itf @@ -2019,6 +2028,16 @@ subroutine cu_gf_deep_run( & endif enddo endif + + do i=its,itf + if(ierr(i).eq.0) then + if(aeroevap.gt.1)then + ! aerosol scavagening + ccnloss(i)=ccn(i)*pefc*xmb(i) ! HCB + ccn(i) = ccn(i) - ccnloss(i)*scav_factor + endif + endif + enddo ! ! since kinetic energy is being dissipated, add heating accordingly (from ecmwf) ! @@ -2317,8 +2336,8 @@ end subroutine rain_evap_below_cloudbase subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & - pw,ccn,pwev,edtmax,edtmin,edtc,psum2,psumh, & - rho,aeroevap,itf,ktf, & + pw,ccn,ccnclean,pwev,edtmax,edtmin,edtc,psum2,psumh, & + rho,aeroevap,pefc,itf,ktf, & its,ite, kts,kte ) implicit none @@ -2336,15 +2355,22 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & real(kind=kind_phys), dimension (its:ite,1) & ,intent (out ) :: & edtc + real(kind=kind_phys), intent (out ) :: & + pefc real(kind=kind_phys), dimension (its:ite) & ,intent (out ) :: & edt real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & - pwav,pwev,ccn,psum2,psumh,edtmax,edtmin + pwav,pwev,psum2,psumh,edtmax,edtmin integer, dimension (its:ite) & ,intent (in ) :: & ktop,kbcon + real(kind=kind_phys), intent (in ) :: & !HCB + ccnclean + real(kind=kind_phys), dimension (its:ite) & + ,intent (inout ) :: & + ccn integer, dimension (its:ite) & ,intent (inout) :: & ierr @@ -2356,11 +2382,13 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & real(kind=kind_phys) einc,pef,pefb,prezk,zkbc real(kind=kind_phys), dimension (its:ite) :: & vshear,sdp,vws - real(kind=kind_phys) :: prop_c,pefc,aeroadd,alpha3,beta3 - prop_c=8. !10.386 - alpha3 = 1.9 - beta3 = -1.13 + real(kind=kind_phys) :: prop_c,aeroadd,alpha3,beta3 + prop_c=0. !10.386 + alpha3 = 0.75 + beta3 = -0.15 pefc=0. + pefb=0. + pef=0. ! !--- determine downdraft strength in terms of windshear @@ -2410,18 +2438,23 @@ subroutine cup_dd_edt(ierr,us,vs,z,ktop,kbcon,edt,p,pwav, & pefb=1./(1.+prezk) if(pefb.gt.0.9)pefb=0.9 if(pefb.lt.0.1)pefb=0.1 + pefb=pef + edt(i)=1.-.5*(pefb+pef) if(aeroevap.gt.1)then - aeroadd=(ccnclean**beta3)*((psumh(i))**(alpha3-1)) !*1.e6 -! prop_c=.9/aeroadd + aeroadd=0. + if((psumh(i)>0.).and.(psum2(i)>0.))then + aeroadd=((1.e-2*ccnclean)**beta3)*((psumh(i)*1.e0)**(alpha3-1)) prop_c=.5*(pefb+pef)/aeroadd - aeroadd=(ccn(i)**beta3)*((psum2(i))**(alpha3-1)) !*1.e6 + aeroadd=((1.e-2*ccn(i))**beta3)*((psum2(i)*1.e0)**(alpha3-1)) aeroadd=prop_c*aeroadd pefc=aeroadd + if(pefc.gt.0.9)pefc=0.9 if(pefc.lt.0.1)pefc=0.1 edt(i)=1.-pefc if(aeroevap.eq.2)edt(i)=1.-.25*(pefb+pef+2.*pefc) + endif endif @@ -3105,12 +3138,12 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 xf_ens(i,5)=max(0.,xff_ens3(5)) xf_ens(i,6)=max(0.,xff_ens3(6)) xf_ens(i,14)=max(0.,xff_ens3(14)) - a1=max(1.e-5,pr_ens(i,7)) + a1=max(1.e-3,pr_ens(i,7)) xf_ens(i,7)=max(0.,xff_ens3(7)/a1) - a1=max(1.e-5,pr_ens(i,8)) + a1=max(1.e-3,pr_ens(i,8)) xf_ens(i,8)=max(0.,xff_ens3(8)/a1) ! forcing(i,7)=xf_ens(i,8) - a1=max(1.e-5,pr_ens(i,9)) + a1=max(1.e-3,pr_ens(i,9)) xf_ens(i,9)=max(0.,xff_ens3(9)/a1) a1=max(1.e-3,pr_ens(i,15)) xf_ens(i,15)=max(0.,xff_ens3(15)/a1) @@ -3875,7 +3908,7 @@ end subroutine cup_output_ens_3d subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & p_cup,kbcon,ktop,dby,clw_all,xland1, & q,gamma_cup,zu,qes_cup,k22,qe_cup,c0, & - zqexec,ccn,rho,c1d,t, & + zqexec,ccn,ccnclean,rho,c1d,t,autoconv, & up_massentr,up_massdetr,psum,psumh, & itest,itf,ktf, & its,ite, kts,kte ) @@ -3891,6 +3924,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & integer & ,intent (in ) :: & + autoconv, & itest,itf,ktf, & its,ite, kts,kte ! cd= detrainment function @@ -3914,7 +3948,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ,intent (in ) :: & kbcon,ktop,k22,xland1 real(kind=kind_phys), intent (in ) :: & ! HCB - c0 + c0,ccnclean ! ! input and output ! @@ -3937,9 +3971,9 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ,intent (out ) :: & qc,qrc,pw,clw_all real(kind=kind_phys), dimension (its:ite,kts:kte) :: & - qch,qrcb,pwh,clw_allh,c1d,t + qch,qrcb,pwh,clw_allh,c1d,c1d_b,t real(kind=kind_phys), dimension (its:ite) :: & - pwavh + pwavh,kklev real(kind=kind_phys), dimension (its:ite) & ,intent (out ) :: & pwav,psum,psumh @@ -3963,7 +3997,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! prop_b(kts:kte)=0 iall=0 - clwdet=50. + c1d_b=c1d bdsp=bdispm ! !--- no precip for small clouds @@ -4016,11 +4050,12 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! ! if(name == "deep" )then do k=k22(i)+1,kbcon(i) - if(t(i,k) > 273.16) then - c0t = c0 - else - c0t = c0 * exp(0.07 * (t(i,k) - 273.16)) - endif + c0t = c0 + !if(t(i,k) > 273.16) then + ! c0t = c0 + !else + ! c0t = c0 * exp(0.07 * (t(i,k) - 273.16)) + !endif qc(i,k)= (qc(i,k-1)*zu(i,k-1)-.5*up_massdetr(i,k-1)* qc(i,k-1)+ & up_massentr(i,k-1)*q(i,k-1)) / & (zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1)) @@ -4041,13 +4076,12 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & !now do the rest ! do k=kbcon(i)+1,ktop(i) - !c0=.004 HCB tuning - !if(t(i,k).lt.270.)c0=.002 HCB tuning - if(t(i,k) > 273.16) then - c0t = c0 - else - c0t = c0 * exp(0.07 * (t(i,k) - 273.16)) - endif + c0t = c0 + !if(t(i,k) > 273.16) then + ! c0t = c0 + !else + ! c0t = c0 * exp(0.07 * (t(i,k) - 273.16)) + !endif denom=zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1) if(denom.lt.1.e-16)then ierr(i)=51 @@ -4084,13 +4118,19 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! !------- total condensed water before rainout ! + if(name == "deep" )then + clwdet=0.1 ! 05/11/2021 + kklev(i)=maxloc(zu(i,:),1) ! 05/05/2021 + if(k.lt.kklev(i)) clwdet=0. ! 05/05/2021 + else + clwdet=0.1 ! 05/05/2021 + endif + if(k.gt.kbcon(i)+1)c1d(i,k)=clwdet*up_massdetr(i,k-1) + if(k.gt.kbcon(i)+1)c1d_b(i,k)=clwdet*up_massdetr(i,k-1) clw_all(i,k)=max(0.,qc(i,k)-qrch) - qrc(i,k)=max(0.,(qc(i,k)-qrch)) ! /(1.+c0*dz*zu(i,k)) clw_allh(i,k)=max(0.,qch(i,k)-qrch) - qrcb(i,k)=max(0.,(qch(i,k)-qrch)) ! /(1.+c0*dz*zu(i,k)) - if(autoconv.eq.2) then - + if(autoconv.eq.2) then ! ! normalized berry ! @@ -4098,41 +4138,38 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! this will also determine proportionality constant prop_b, which, if applied, ! would give the same results as c0 under these conditions ! - q1=1.e3*rhoc*qrcb(i,k) ! g/m^3 ! g[h2o]/cm^3 - berryc0=q1*q1/(60.0*(5.0 + 0.0366*ccnclean/ & + q1=1.e3*rhoc*clw_allh(i,k) ! g/m^3 ! g[h2o]/cm^3 + berryc0=q1*q1/(60.0*(5.0 + 0.0366*ccnclean/ & ( q1 * bdsp) ) ) !/( - qrcb_h=((qch(i,k)-qrch)*zu(i,k)-qrcb(i,k-1)*(.5*up_massdetr(i,k-1)))/ & - (zu(i,k)+.5*up_massdetr(i,k-1)+c0t*dz*zu(i,k)) - prop_b(k)=c0t*qrcb_h*zu(i,k)/(1.e-3*berryc0) + qrcb_h=(qch(i,k)-qrch)/(1.+(c1d_b(i,k)+c0t)*dz) + prop_b(k)=(c0t*qrcb_h)/max(1.e-8,(1.e-3*berryc0)) + if(prop_b(k)>5.) prop_b(k)=5. pwh(i,k)=zu(i,k)*1.e-3*berryc0*dz*prop_b(k) ! 2. - berryc=qrcb(i,k) - qrcb(i,k)=((qch(i,k)-qrch)*zu(i,k)-pwh(i,k)-qrcb(i,k-1)*(.5*up_massdetr(i,k-1)))/ & - (zu(i,k)+.5*up_massdetr(i,k-1)) + qrcb(i,k)=(max(0.,(qch(i,k)-qrch))*zu(i,k)-pwh(i,k))/(zu(i,k)*(1+c1d_b(i,k)*dz)) if(qrcb(i,k).lt.0.)then - berryc0=(qrcb(i,k-1)*(.5*up_massdetr(i,k-1))-(qch(i,k)-qrch)*zu(i,k))/zu(i,k)*1.e-3*dz*prop_b(k) + berryc0=max(0.,(qch(i,k)-qrch))/(1.e-3*dz*prop_b(k)) pwh(i,k)=zu(i,k)*1.e-3*berryc0*dz*prop_b(k) qrcb(i,k)=0. endif qch(i,k)=qrcb(i,k)+qrch pwavh(i)=pwavh(i)+pwh(i,k) - psumh(i)=psumh(i)+clw_allh(i,k)*zu(i,k) *dz + psumh(i)=psumh(i)+pwh(i,k) ! HCB + !psumh(i)=psumh(i)+clw_allh(i,k)*zu(i,k) *dz ! ! then the real berry ! - q1=1.e3*rhoc*qrc(i,k) ! g/m^3 ! g[h2o]/cm^3 - berryc0=q1*q1/(60.0*(5.0 + 0.0366*ccn(i)/ & + q1=1.e3*rhoc*clw_all(i,k) ! g/m^3 ! g[h2o]/cm^3 + berryc0=q1*q1/(60.0*(5.0 + 0.0366*ccn(i)/ & ( q1 * bdsp) ) ) !/( berryc0=1.e-3*berryc0*dz*prop_b(k) ! 2. - berryc=qrc(i,k) - qrc(i,k)=((qc(i,k)-qrch)*zu(i,k)-zu(i,k)*berryc0-qrc(i,k-1)*(.5*up_massdetr(i,k-1)))/ & - (zu(i,k)+.5*up_massdetr(i,k-1)) + qrc(i,k)=(max(0.,(qc(i,k)-qrch))*zu(i,k)-zu(i,k)*berryc0)/(zu(i,k)*(1+c1d(i,k)*dz)) if(qrc(i,k).lt.0.)then - berryc0=((qc(i,k)-qrch)*zu(i,k)-qrc(i,k-1)*(.5*up_massdetr(i,k-1)))/zu(i,k) + berryc0=max(0.,(qc(i,k)-qrch))/(1.e-3*dz*prop_b(k)) qrc(i,k)=0. endif pw(i,k)=berryc0*zu(i,k) qc(i,k)=qrc(i,k)+qrch -! + ! if not running with berry at all, do the following ! else !c0=.002 @@ -4149,7 +4186,8 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & if(qrc(i,k).lt.0.)then ! hli new test 02/12/19 qrc(i,k)=0. endif - pw(i,k)=c0t*dz*qrc(i,k)*zu(i,k) + pw(i,k)=c0t*dz*qrc(i,k)*zu(i,k) + !-----srf-08aug2017-----begin ! pw(i,k)=(c1d(i,k)+c0)*dz*max(0.,qrc(i,k) -qrc_crit)! units kg[rain]/kg[air] !-----srf-08aug2017-----end @@ -4161,7 +4199,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & qc(i,k)=qrc(i,k)+qrch endif !autoconv pwav(i)=pwav(i)+pw(i,k) - psum(i)=psum(i)+clw_all(i,k)*zu(i,k) *dz + psum(i)=psum(i)+pw(i,k) ! HCB enddo ! k=kbcon,ktop ! do not include liquid/ice in qc do k=k22(i)+1,ktop(i) @@ -4304,6 +4342,7 @@ subroutine rates_up_pdf(rand_vmas,ipr,name,ktop,ierr,p_cup,entr_rate_2d,hkbo,heo kfinalzu=ktf-2 ktop(i)=kfinalzu 412 continue + ktop(i)=ktopdby(i) ! HCB kklev=min(kklev+3,ktop(i)-2) ! ! at least overshoot by one level diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index c17aaec76..4579ed88d 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -7,7 +7,7 @@ module cu_gf_driver ! DH* TODO: replace constants with arguments to cu_gf_driver_run use physcons , g => con_g, cp => con_cp, xlv => con_hvap, r_v => con_rv use machine , only: kind_phys - use cu_gf_deep, only: cu_gf_deep_run,neg_check,autoconv,aeroevap,fct1d3 + use cu_gf_deep, only: cu_gf_deep_run,neg_check,fct1d3 use cu_gf_sh , only: cu_gf_sh_run implicit none @@ -75,15 +75,15 @@ end subroutine cu_gf_driver_finalize !! !>\section gen_gf_driver GSD GF Cumulus Scheme General Algorithm !> @{ - subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & + subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,cactiv,cactiv_m, & forcet,forceqv_spechum,phil,raincv,qv_spechum,t,cld1d, & us,vs,t2di,w,qv2di_spechum,p2di,psuri, & - hbot,htop,kcnv,xland,hfx2,qfx2,cliw,clcw, & + hbot,htop,kcnv,xland,hfx2,qfx2,aod_gf,cliw,clcw, & pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & - du3dt_SCNV,dv3dt_SCNV,dt3dt_SCNV,dq3dt_SCNV, & - du3dt_DCNV,dv3dt_DCNV,dt3dt_DCNV,dq3dt_DCNV, & - ldiag3d,qdiag3d,qci_conv,errmsg,errflg) + dtend,dtidx,ntqv,ntiw,ntcw,index_of_temperature,index_of_x_wind, & + index_of_y_wind,index_of_process_scnv,index_of_process_dcnv, & + ldiag3d,qci_conv,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -97,7 +97,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & !integer, parameter :: ichoicem=5 ! 0 2 5 13 integer, parameter :: ichoicem=13 ! 0 2 5 13 integer, parameter :: ichoice_s=3 ! 0 1 2 3 - real(kind=kind_phys), parameter :: aodccn=0.1 + + real(kind=kind_phys), parameter :: aodc0=0.14 + real(kind=kind_phys), parameter :: aodreturn=30. real(kind=kind_phys) :: dts,fpi,fp integer, parameter :: dicycle=0 ! diurnal cycle flag integer, parameter :: dicycle_m=0 !- diurnal cycle flag @@ -105,8 +107,13 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte integer, intent(in ) :: im,km,ntracer - logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend - logical, intent(in ) :: ldiag3d,qdiag3d + logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend,flag_init + logical, intent(in ) :: ldiag3d + + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), & + index_of_x_wind, index_of_y_wind, index_of_temperature, & + index_of_process_scnv, index_of_process_dcnv, ntqv, ntcw, ntiw real(kind=kind_phys), dimension( : , : ), intent(in ) :: forcet,forceqv_spechum,w,phil real(kind=kind_phys), dimension( : , : ), intent(inout ) :: t,us,vs @@ -114,9 +121,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & real(kind=kind_phys), dimension( : , : ), intent(out ) :: cnvw_moist,cnvc real(kind=kind_phys), dimension( : , : ), intent(inout ) :: cliw, clcw - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: & - du3dt_SCNV,dv3dt_SCNV,dt3dt_SCNV,dq3dt_SCNV, & - du3dt_DCNV,dv3dt_DCNV,dt3dt_DCNV,dq3dt_DCNV + real(kind=kind_phys), allocatable :: clcw_save(:,:), cliw_save(:,:) integer, dimension (:), intent(out) :: hbot,htop,kcnv integer, dimension (:), intent(in) :: xland @@ -130,6 +135,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ! Specific humidity from FV3 real(kind=kind_phys), dimension (:,:), intent(in) :: qv2di_spechum real(kind=kind_phys), dimension (:,:), intent(inout) :: qv_spechum + real(kind=kind_phys), dimension (:), intent(inout) :: aod_gf ! Local water vapor mixing ratios and cloud water mixing ratios real(kind=kind_phys), dimension (im,km) :: qv2di, qv, forceqv, cnvw ! @@ -137,7 +143,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & real(kind=kind_phys), intent(in ) :: dt integer, intent(in ) :: imfshalcnv - integer, dimension(:), intent(inout) :: cactiv + integer, dimension(:), intent(inout) :: cactiv,cactiv_m character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -148,6 +154,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & real(kind=kind_phys), dimension (im,4) :: rand_clos real(kind=kind_phys), dimension (im,km,11) :: gdc,gdc2 real(kind=kind_phys), dimension (im) :: ht + real(kind=kind_phys), dimension (im) :: ccn_gf,ccn_m + real(kind=kind_phys) :: ccnclean real(kind=kind_phys), dimension (im) :: dx real(kind=kind_phys), dimension (im,km) :: outt,outq,outqc,phh,subm,cupclw,cupclws real(kind=kind_phys), dimension (im,km) :: dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm @@ -176,18 +184,18 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! - real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi + real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg - real(kind=kind_phys), dimension (im) :: ccn,z1,psur,cuten,cutens,cutenm + real(kind=kind_phys), dimension (im) :: z1,psur,cuten,cutens,cutenm real(kind=kind_phys), dimension (im) :: umean,vmean,pmean real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv - integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep - integer :: itf,jtf,ktf,iss,jss,nbegin,nend + integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep,uidx,vidx,tidx,qidx + integer :: itf,jtf,ktf,iss,jss,nbegin,nend,cliw_idx,clcw_idx integer :: high_resolution real(kind=kind_phys) :: clwtot,clwtot1,excess,tcrit,tscl_kf,dp,dq,sub_spread,subcenter real(kind=kind_phys) :: dsubclw,dsubclws,dsubclwm,dtime_max,ztm,ztq,hfm,qfm,rkbcon,rktop - real(kind=kind_phys), dimension(km) :: massflx,trcflx_in1,clw_in1,clw_ten1,po_cup + real(kind=kind_phys), dimension(km) :: massflx,trcflx_in1,clw_in1,po_cup ! real(kind=kind_phys), dimension(km) :: trcflx_in2,clw_in2,clw_ten2 real(kind=kind_phys), dimension (im) :: flux_tun,tun_rad_mid,tun_rad_shall,tun_rad_deep character*50 :: ierrc(im),ierrcm(im) @@ -198,6 +206,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ! gf needs them in w/m2. define hfx and qfx after simple unit conversion real(kind=kind_phys), dimension (im) :: hfx,qfx real(kind=kind_phys) tem,tem1,tf,tcr,tcrf + real(kind=kind_phys) :: cliw_shal,clcw_shal,tem_shal, cliw_both, weight_sum + real(kind=kind_phys) :: cliw_deep,clcw_deep,tem_deep, clcw_both + integer :: cliw_deep_idx, clcw_deep_idx, cliw_shal_idx, clcw_shal_idx !parameter (tf=243.16, tcr=270.16, tcrf=1.0/(tcr-tf)) ! FV3 original !parameter (tf=263.16, tcr=273.16, tcrf=1.0/(tcr-tf)) @@ -206,6 +217,30 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ! initialize ccpp error handling variables errmsg = '' errflg = 0 + + if(ldiag3d) then + if(flag_for_dcnv_generic_tend) then + cliw_deep_idx=0 + clcw_deep_idx=0 + else + cliw_deep_idx=dtidx(100+ntiw,index_of_process_dcnv) + clcw_deep_idx=dtidx(100+ntcw,index_of_process_dcnv) + endif + if(flag_for_scnv_generic_tend) then + cliw_shal_idx=0 + clcw_shal_idx=0 + else + cliw_shal_idx=dtidx(100+ntiw,index_of_process_scnv) + clcw_shal_idx=dtidx(100+ntcw,index_of_process_scnv) + endif + if(cliw_deep_idx>=1 .or. clcw_deep_idx>=1 .or. & + cliw_shal_idx>=1 .or. clcw_shal_idx>=1) then + allocate(clcw_save(im,km), cliw_save(im,km)) + clcw_save=clcw + cliw_save=cliw + endif + endif + ! ! Scale specific humidity to dry mixing ratio ! @@ -250,7 +285,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ! dx for scale awareness ! dx=40075000./float(lonf) ! tscl_kf=dx/25000. - ccn(its:ite)=150. if (imfshalcnv == 3) then ishallow_g3 = 1 @@ -305,7 +339,24 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & do i= its,itf forcing(i,:)=0. forcing2(i,:)=0. - ccn(i)=100. + ccn_gf(i) = 0. + ccn_m(i) = 0. + + ! set aod and ccn + if (flag_init) then + aod_gf(i)=aodc0 + else + if((cactiv(i).eq.0) .and. (cactiv_m(i).eq.0))then + if(aodc0>aod_gf(i)) aod_gf(i)=aod_gf(i)+((aodc0-aod_gf(i))*(dt/(aodreturn*60))) + if(aod_gf(i)>aodc0) aod_gf(i)=aodc0 + endif + endif + + ccn_gf(i)=max(5., (aod_gf(i)/0.0027)**(1/0.640)) + ccn_m(i)=ccn_gf(i) + + ccnclean=max(5., (aodc0/0.0027)**(1/0.640)) + hbot(i) =kte htop(i) =kts raincv(i)=0. @@ -528,7 +579,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ,dicycle_m & ,ichoicem & ,ipr & - ,ccn & + ,ccn_m & + ,ccnclean & ,dt & ,imid_gf & ,kpbli & @@ -608,7 +660,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ,dicycle & ,ichoice & ,ipr & - ,ccn & + ,ccn_gf & + ,ccnclean & ,dt & ,0 & @@ -731,7 +784,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & massflx(:)=0. trcflx_in1(:)=0. clw_in1(:)=0. - clw_ten1(:)=0. + do k=kts,ktf + clw_ten(i, k)=0. + enddo po_cup(:)=0. kstop=kts if(ktopm(i).gt.kts .or. ktop(i).gt.kts)kstop=max(ktopm(i),ktop(i)) @@ -821,20 +876,22 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & massflx (1)=0. trcflx_in1(1)=0. call fct1d3 (kstop,kte,dtime_max,po_cup, & - clw_in1,massflx,trcflx_in1,clw_ten1,g) + clw_in1,massflx,trcflx_in1,clw_ten(i,:),g) do k=1,kstop tem = dt*(outqcs(i,k)*cutens(i)+outqc(i,k)*cuten(i) & +outqcm(i,k)*cutenm(i) & - +clw_ten1(k) & + +clw_ten(i,k) & ) - tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) - if (clcw(i,k) .gt. -999.0) then - cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice - clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water - else - cliw(i,k) = max(0.,cliw(i,k) + tem) - endif + !tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) + !if (clcw(i,k) .gt. -999.0) then + ! cliw(i,k) = max(0.,cliw(i,k) + tem * tem1) ! ice + ! clcw(i,k) = max(0.,clcw(i,k) + tem *(1.0-tem1)) ! water + !else + ! cliw(i,k) = max(0.,cliw(i,k) + tem) + !endif + if(t(i,k).le.270.) cliw(i,k) = max(0.,cliw(i,k) + tem) ! HCB + if(t(i,k).gt.270) clcw(i,k) = max(0.,clcw(i,k) + tem) enddo @@ -863,6 +920,29 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & cactiv(i)=0 if(pretm(i).gt.0)raincv(i)=.001*cutenm(i)*pretm(i)*dt endif ! pret > 0 + + if(pretm(i).gt.0)then + cactiv_m(i)=1 + else + cactiv_m(i)=0 + endif + + ! Unify ccn + if(ccn_m(i).lt.ccn_gf(i))then + ccn_gf(i)=ccn_m(i) + endif + + if(ccn_gf(i)<0) ccn_gf(i)=0 + + ! Convert ccn back to aod + aod_gf(i)=0.0027*(ccn_gf(i)**0.64) + if(aod_gf(i)<0.007)then + aod_gf(i)=0.007 + ccn_gf(i)=(aod_gf(i)/0.0027)**(1/0.640) + elseif(aod_gf(i)>aodc0)then + aod_gf(i)=aodc0 + ccn_gf(i)=(aod_gf(i)/0.0027)**(1/0.640) + endif enddo 100 continue ! @@ -875,29 +955,96 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ! if(ldiag3d) then if(ishallow_g3.eq.1 .and. .not.flag_for_scnv_generic_tend) then - do k=kts,ktf - do i=its,itf - du3dt_SCNV(i,k) = du3dt_SCNV(i,k) + cutens(i)*outus(i,k) * dt - dv3dt_SCNV(i,k) = dv3dt_SCNV(i,k) + cutens(i)*outvs(i,k) * dt - dt3dt_SCNV(i,k) = dt3dt_SCNV(i,k) + cutens(i)*outts(i,k) * dt - if(qdiag3d) then + uidx=dtidx(index_of_x_wind,index_of_process_scnv) + vidx=dtidx(index_of_y_wind,index_of_process_scnv) + tidx=dtidx(index_of_temperature,index_of_process_scnv) + qidx=dtidx(100+ntqv,index_of_process_scnv) + if(uidx>=1) then + do k=kts,ktf + dtend(:,k,uidx) = dtend(:,k,uidx) + cutens(:)*outus(:,k) * dt + enddo + endif + if(vidx>=1) then + do k=kts,ktf + dtend(:,k,vidx) = dtend(:,k,vidx) + cutens(:)*outvs(:,k) * dt + enddo + endif + if(tidx>=1) then + do k=kts,ktf + dtend(:,k,tidx) = dtend(:,k,tidx) + cutens(:)*outts(:,k) * dt + enddo + endif + if(qidx>=1) then + do k=kts,ktf + do i=its,itf tem = cutens(i)*outqs(i,k)* dt tem = tem/(1.0_kind_phys+tem) - dq3dt_SCNV(i,k) = dq3dt_SCNV(i,k) + tem - endif + dtend(i,k,qidx) = dtend(i,k,qidx) + tem + enddo enddo - enddo + endif endif if((ideep.eq.1. .or. imid_gf.eq.1) .and. .not.flag_for_dcnv_generic_tend) then + uidx=dtidx(index_of_x_wind,index_of_process_dcnv) + vidx=dtidx(index_of_y_wind,index_of_process_dcnv) + tidx=dtidx(index_of_temperature,index_of_process_dcnv) + if(uidx>=1) then + do k=kts,ktf + dtend(:,k,uidx) = dtend(:,k,uidx) + (cuten*outu(:,k)+cutenm*outum(:,k)) * dt + enddo + endif + if(vidx>=1) then + do k=kts,ktf + dtend(:,k,vidx) = dtend(:,k,vidx) + (cuten*outv(:,k)+cutenm*outvm(:,k)) * dt + enddo + endif + if(tidx>=1) then + do k=kts,ktf + dtend(:,k,tidx) = dtend(:,k,tidx) + (cuten*outt(:,k)+cutenm*outtm(:,k)) * dt + enddo + endif + + qidx=dtidx(100+ntqv,index_of_process_dcnv) + if(qidx>=1) then + do k=kts,ktf + do i=its,itf + tem = (cuten(i)*outq(i,k) + cutenm(i)*outqm(i,k))* dt + tem = tem/(1.0_kind_phys+tem) + dtend(i,k,qidx) = dtend(i,k,qidx) + tem + enddo + enddo + endif + endif + if(allocated(clcw_save)) then do k=kts,ktf do i=its,itf - du3dt_DCNV(i,k) = du3dt_DCNV(i,k) + (cuten(i)*outu(i,k)+cutenm(i)*outum(i,k)) * dt - dv3dt_DCNV(i,k) = dv3dt_DCNV(i,k) + (cuten(i)*outv(i,k)+cutenm(i)*outvm(i,k)) * dt - dt3dt_DCNV(i,k) = dt3dt_DCNV(i,k) + (cuten(i)*outt(i,k)+cutenm(i)*outtm(i,k)) * dt - if(qdiag3d) then - tem = (cuten(i)*outq(i,k) + cutenm(i)*outqm(i,k))* dt - tem = tem/(1.0_kind_phys+tem) - dq3dt_DCNV(i,k) = dq3dt_DCNV(i,k) + tem + tem_shal = dt*(outqcs(i,k)*cutens(i)+outqcm(i,k)*cutenm(i)) + tem_deep = dt*(outqc(i,k)*cuten(i)+clw_ten(i,k)) + tem = tem_shal+tem_deep + tem1 = max(0.0, min(1.0, (tcr-t(i,k))*tcrf)) + weight_sum = abs(tem_shal)+abs(tem_deep) + if(weight_sum<1e-12) then + cycle + endif + + if (clcw_save(i,k) .gt. -999.0) then + cliw_both = max(0.,cliw_save(i,k) + tem * tem1) - cliw_save(i,k) + clcw_both = max(0.,clcw_save(i,k) + tem) - clcw_save(i,k) + else if(cliw_idx>=1) then + cliw_both = max(0.,cliw_save(i,k) + tem) - cliw_save(i,k) + clcw_both = 0 + endif + if(cliw_deep_idx>=1) then + dtend(i,k,cliw_deep_idx) = dtend(i,k,cliw_deep_idx) + abs(tem_deep)/weight_sum*cliw_both + endif + if(clcw_deep_idx>=1) then + dtend(i,k,clcw_deep_idx) = dtend(i,k,clcw_deep_idx) + abs(tem_deep)/weight_sum*clcw_both + endif + if(cliw_shal_idx>=1) then + dtend(i,k,cliw_shal_idx) = dtend(i,k,cliw_shal_idx) + abs(tem_shal)/weight_sum*cliw_both + endif + if(clcw_shal_idx>=1) then + dtend(i,k,clcw_shal_idx) = dtend(i,k,clcw_shal_idx) + abs(tem_shal)/weight_sum*clcw_both endif enddo enddo diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 73ce19754..cb7ceabd9 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -119,6 +119,14 @@ kind = kind_phys intent = in optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F [cactiv] standard_name = conv_activity_counter long_name = convective activity memory @@ -127,6 +135,14 @@ type = integer intent = inout optional = F +[cactiv_m] + standard_name = mid_conv_activity_counter + long_name = mid-level cloud convective activity memory + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = inout + optional = F [forcet] standard_name = temperature_tendency_due_to_dynamics long_name = temperature tendency due to dynamics only @@ -303,6 +319,15 @@ kind = kind_phys intent = in optional = F +[aod_gf] + standard_name = aod_gf_deep + long_name = aerosol optical depth used in Grell-Freitas Convective Parameterization + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [cliw] standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -399,89 +424,90 @@ type = logical intent = in optional = F -[du3dt_SCNV] - standard_name = cumulative_change_in_x_wind_due_to_shallow_convection - long_name = cumulative change in x wind due to shallow convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[dv3dt_SCNV] - standard_name = cumulative_change_in_y_wind_due_to_shallow_convection - long_name = cumulative change in y wind due to shallow convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dt3dt_SCNV] - standard_name = cumulative_change_in_temperature_due_to_shallow_convection - long_name = cumulative change in temperature due to shallow convection - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in optional = F -[dq3dt_SCNV] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shallow_convection - long_name = cumulative change in water vapor specific humidity due to shallow convection - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in optional = F -[du3dt_DCNV] - standard_name = cumulative_change_in_x_wind_due_to_deep_convection - long_name = cumulative change in x wind due to deep convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in optional = F -[dv3dt_DCNV] - standard_name = cumulative_change_in_y_wind_due_to_deep_convection - long_name = cumulative change in y wind due to deep convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dt3dt_DCNV] - standard_name = cumulative_change_in_temperature_due_to_deep_convection - long_name = cumulative change in temperature due to deep convection - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dq3dt_DCNV] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection - long_name = cumulative change in water vapor specific humidity due to deep convection - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldiag3d] - standard_name = flag_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index dimensions = () - type = logical + type = integer intent = in optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields units = flag dimensions = () type = logical diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 1d83fec1c..9b110d689 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -216,7 +216,9 @@ subroutine drag_suite_run( & & g, cp, rd, rv, fv, pi, imx, cdmbgwd, me, master, & & lprnt, ipr, rdxzb, dx, gwd_opt, & & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & - & errmsg, errflg ) + & dtend, dtidx, index_of_process_orographic_gwd, & + & index_of_temperature, index_of_x_wind, & + & index_of_y_wind, ldiag3d, errmsg, errflg) ! ******************************************************************** ! -----> I M P L E M E N T A T I O N V E R S I O N <---------- @@ -319,6 +321,10 @@ subroutine drag_suite_run( & logical, intent(in) :: lprnt integer, intent(in) :: KPBL(:) real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, cdmbgwd(:) + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + logical, intent(in) :: ldiag3d + integer, intent(in) :: dtidx(:,:), index_of_temperature, & + & index_of_process_orographic_gwd, index_of_x_wind, index_of_y_wind integer :: kpblmax integer, parameter :: ims=1, kms=1, its=1, kts=1 @@ -490,14 +496,26 @@ subroutine drag_suite_run( & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + integer :: udtend, vdtend, Tdtend + ! Calculate inverse of gravitational acceleration g_inv = 1./G ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + ! Initialize local variables var_temp2 = 0. + udtend = -1 + vdtend = -1 + Tdtend = -1 + if(ldiag3d) then + udtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) + vdtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) + Tdtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) + endif !-------------------------------------------------------------------- ! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME @@ -1032,6 +1050,12 @@ subroutine drag_suite_run( & dvsfc(i) = dvsfc(i) + vtendwave(i,k) * del(i,k) enddo enddo + if(udtend>0) then + dtend(its:im,kts:km,udtend) = dtend(its:im,kts:km,udtend) + utendwave(its:im,kts:km)*deltim + endif + if(vdtend>0) then + dtend(its:im,kts:km,vdtend) = dtend(its:im,kts:km,vdtend) + vtendwave(its:im,kts:km)*deltim + endif if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then do k = kts,km do i = its,im @@ -1090,6 +1114,12 @@ subroutine drag_suite_run( & dvsfc(i) = dvsfc(i) + vtendform(i,k) * del(i,k) enddo enddo + if(udtend>0) then + dtend(its:im,kts:km,udtend) = dtend(its:im,kts:km,udtend) + utendform(its:im,kts:km)*deltim + endif + if(vdtend>0) then + dtend(its:im,kts:km,vdtend) = dtend(its:im,kts:km,vdtend) + vtendform(its:im,kts:km)*deltim + endif if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then do k = kts,km do i = its,im @@ -1283,6 +1313,26 @@ subroutine drag_suite_run( & dusfc(i) = dusfc(i) + taud_ls(i,k)*xn(i)*del(i,k) + taud_bl(i,k)*xn(i)*del(i,k) dvsfc(i) = dvsfc(i) + taud_ls(i,k)*yn(i)*del(i,k) + taud_bl(i,k)*yn(i)*del(i,k) enddo + if(udtend>0) then + dtend(its:im,k,udtend) = dtend(its:im,k,udtend) + (taud_ls(its:im,k) * xn(its:im) + & + taud_bl(its:im,k) * xn(its:im)) * deltim + endif + if(vdtend>0) then + dtend(its:im,k,vdtend) = dtend(its:im,k,vdtend) + (taud_ls(its:im,k) * yn(its:im) + & + taud_bl(its:im,k) * yn(its:im)) * deltim + endif + if(gsd_diss_ht_opt .EQ. 1 .and. Tdtend>0) then + do i=its,im + ! Calculate dissipation heating + ! Initial kinetic energy (at t0-dt) + eng0 = 0.5*( (rcs*u1(i,k))**2. + (rcs*v1(i,k))**2. ) + ! Kinetic energy after wave-breaking/flow-blocking + eng1 = 0.5*( (rcs*(u1(i,k)+(dtaux+dtauxb)*deltim))**2 + & + (rcs*(v1(i,k)+(dtauy+dtauyb)*deltim))**2 ) + ! Modify theta tendency + dtend(i,k,Tdtend) = dtend(i,k,Tdtend) + max((eng0-eng1),0.0)/cp + enddo + endif enddo ! Finalize dusfc and dvsfc diagnostics diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index 28b0269e9..79f3af325 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -645,6 +645,64 @@ type = logical intent = in optional = F +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) + type = real + kind = kind_phys + active = (flag_diagnostics_3D) + intent = inout + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/gwdc.f b/physics/gwdc.f index acb43b519..086662e73 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -1459,7 +1459,8 @@ end subroutine gwdc_post_init subroutine gwdc_post_run( & & im, levs, lssav, ldiag3d, dtf, dtp, con_cp, & & tauctx, taucty, gwdcu, gwdcv, & - & dugwd, dvgwd, du3dt, dv3dt, gu0, gv0, gt0, & + & dugwd, dvgwd, dtend, dtidx, index_of_x_wind, index_of_y_wind, & + & index_of_process_nonorographic_gwd, gu0, gv0, gt0, & & errmsg, errflg) use machine, only : kind_phys @@ -1471,14 +1472,17 @@ subroutine gwdc_post_run( & real(kind=kind_phys), intent(in) :: & & tauctx(:), taucty(:), gwdcu(:,:), gwdcv(:,:) - real(kind=kind_phys), intent(inout) :: & - & dugwd(:), dvgwd(:), du3dt(:,:), dv3dt(:,:), & + real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:), & & gu0(:,:), gv0(:,:), gt0(:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_of_process_nonorographic_gwd + integer, intent(in) :: index_of_x_wind, index_of_y_wind character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k + integer :: i, k, idtend real(kind=kind_phys) :: eng0, eng1 ! Initialize CCPP error handling variables @@ -1493,8 +1497,16 @@ subroutine gwdc_post_run( & endif ! end if_lssav if (ldiag3d) then - du3dt(:,:) = du3dt(:,:) + gwdcu(:,:) * dtf - dv3dt(:,:) = dv3dt(:,:) + gwdcv(:,:) * dtf + idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_g& + & wd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + gwdcu(:,:) * dtf + endif + idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_g& + & wd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + gwdcv(:,:) * dtf + endif endif ! --- ... update the wind components with gwdc tendencies diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 2fde9c2aa..2298ed2c0 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -590,23 +590,47 @@ kind = kind_phys intent = inout optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in zonal wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in meridional wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_nonorographic_gwd] + standard_name = index_of_nonorographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of nonorographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [gu0] standard_name = x_wind_updated_by_physics diff --git a/physics/h2ophys.f b/physics/h2ophys.f index 863f4f45a..e21417e80 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -38,7 +38,7 @@ end subroutine h2ophys_init !! \section genal_h2ophys GFS H2O Physics Scheme General Algorithm !> @{ subroutine h2ophys_run(im, levs, kh2o, dt, h2o, ph2o, prsl, & - & h2opltc, h2o_coeff, ldiag3d, me, & + & h2opltc, h2o_coeff, me, & & errmsg, errflg) ! ! May 2015 - Shrinivas Moorthi - Adaptation of NRL H2O physics for @@ -56,7 +56,6 @@ subroutine h2ophys_run(im, levs, kh2o, dt, h2o, ph2o, prsl, & real(kind=kind_phys), intent(in) :: ph2o(:) real(kind=kind_phys), intent(in) :: prsl(:,:) real(kind=kind_phys), intent(in) :: h2opltc(:,:,:) - logical , intent(in) :: ldiag3d !real(kind=kind_phys), intent(inout) :: h2op(im,levs,h2o_coeff) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 76451d537..c99e20ad9 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -114,14 +114,6 @@ type = integer intent = in optional = F -[ldiag3d] - standard_name = flag_diagnostics_3D - long_name = flag for calculating 3-D diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F [me] standard_name = mpi_rank long_name = rank of the current MPI task diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index 11cbde679..9010b4cdb 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -55,9 +55,10 @@ SUBROUTINE myjpbl_wrapper_run( & & dusfc,dvsfc,dtsfc,dqsfc, & & dkt,xkzm_m, xkzm_h,xkzm_s, gamt,gamq, & & con_cp,con_g,con_rd, & - & me, lprnt, dt3dt_PBL, du3dt_PBL, dv3dt_PBL, & - & dq3dt_PBL, gen_tend, ldiag3d, qdiag3d, & - & errmsg, errflg ) + & me, lprnt, gen_tend, ldiag3d, dtend, dtidx, & + & index_of_temperature, index_of_x_wind, & + & index_of_y_wind, index_of_process_pbl, & + & ntqv, errmsg, errflg ) ! @@ -92,11 +93,16 @@ SUBROUTINE myjpbl_wrapper_run( & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_of_temperature, index_of_x_wind, & + & index_of_y_wind, index_of_process_pbl, ntqv + !MYJ-1D integer,intent(in) :: im, levs integer,intent(in) :: kdt, me integer,intent(in) :: ntrac,ntke,ntcw,ntiw,ntrw,ntsw,ntgl - logical,intent(in) :: restart,do_myjsfc,lprnt,ldiag3d,qdiag3d,gen_tend + logical,intent(in) :: restart,do_myjsfc,lprnt,ldiag3d,gen_tend real(kind=kind_phys),intent(in) :: con_cp, con_g, con_rd real(kind=kind_phys),intent(in) :: dt_phs, xkzm_m, xkzm_h, xkzm_s @@ -128,8 +134,6 @@ SUBROUTINE myjpbl_wrapper_run( & dudt, dvdt, dtdt real(kind=kind_phys),dimension(:,:),intent(out) :: & dkt - real(kind=kind_phys),dimension(:,:),intent(inout) :: & - du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL !MYJ-4D real(kind=kind_phys),dimension(:,:,:),intent(inout) :: & @@ -172,6 +176,8 @@ SUBROUTINE myjpbl_wrapper_run( & & ,rho,qfc1,gdx,xkzm_hx,xkzm_mx,tx1, tx2 ! real(kind=kind_phys), dimension(im,levs,ntrac) :: & ! & qgrs_myj + real(kind=kind_phys),dimension(im,levs) :: dkt2 + integer :: uidx, vidx, tidx, qidx ! Initialize CCPP error handling variables errmsg = '' @@ -595,22 +601,19 @@ SUBROUTINE myjpbl_wrapper_run( & end do end do if (ldiag3d .and. .not. gen_tend) then + uidx = dtidx(index_of_x_wind,index_of_process_pbl) + vidx = dtidx(index_of_y_wind,index_of_process_pbl) + tidx = dtidx(index_of_temperature,index_of_process_pbl) + qidx = dtidx(ntqv+100,index_of_process_pbl) + ! NOTE: The code that was here before was wrong. It replaced the + ! cumulative value with the instantaneous value. do k=1,levs k1=levs+1-k - do i=1,im - du3dt_PBL(i,k) = rublten(i,k1)*dt_phs - dv3dt_PBL(i,k) = rvblten(i,k1)*dt_phs - dt3dt_PBL(i,k) = rthblten(i,k1)*exner(i,k1)*dt_phs - end do + if(uidx>=1) dtend(:,k,uidx)=dtend(:,k,uidx)+rublten(:,k1)*dt_phs + if(vidx>=1) dtend(:,k,vidx)=dtend(:,k,vidx)+rvblten(:,k1)*dt_phs + if(tidx>=1) dtend(:,k,tidx)=dtend(:,k,tidx)+rthblten(:,k1)*exner(:,k1)*dt_phs + if(qidx>=1) dtend(:,k,qidx)=dtend(:,k,qidx)+rqvblten(:,k1)*dt_phs end do - if (qdiag3d) then - do k=1,levs - k1=levs+1-k - do i=1,im - dq3dt_PBL(i,k) = rqvblten(i,k1)*dt_phs - end do - end do - end if end if if (lprnt1) then diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index 9d70397e7..e9509d66c 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -660,38 +660,63 @@ type = logical intent = in optional = F -[dt3dt_PBL] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[du3dt_PBL] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dv3dt_PBL] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_PBL] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F [gen_tend] standard_name = flag_for_generic_planetary_boundary_layer_tendency long_name = true if GFS_PBL_generic should calculate tendencies @@ -706,13 +731,6 @@ dimensions = () type = logical intent = in -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 3101f79e3..4daa648d1 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -4,7 +4,7 @@ !>\ingroup gsd_mynn_edmf !> The following references best describe the code within -!! Olson et al. (2018, NOAA Technical Memorandum) +!! Olson et al. (2019, NOAA Technical Memorandum) !! Nakanishi and Niino (2009 ) \cite NAKANISHI_2009 MODULE mynnedmf_wrapper @@ -89,18 +89,19 @@ SUBROUTINE mynnedmf_wrapper_run( & & sub_thl,sub_sqv,det_thl,det_sqv,& & nupdraft,maxMF,ktop_plume, & & dudt, dvdt, dtdt, & - & dqdt_water_vapor, dqdt_liquid_cloud, & - & dqdt_ice_cloud, dqdt_ozone, & - & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & - & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, & + & dqdt_water_vapor, dqdt_liquid_cloud, & ! <=== ntqv, ntcw + & dqdt_ice_cloud, dqdt_ozone, & ! <=== ntiw, ntoz + & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & ! <=== ntlnc, ntinc + & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, & ! <=== ntwa, ntia & flag_for_pbl_generic_tend, & - & du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, & - & do3dt_PBL, dq3dt_PBL, dt3dt_PBL, & - & htrsw, htrlw, xmu, & + & dtend, dtidx, index_of_temperature, & + & index_of_x_wind, index_of_y_wind, ntke, & + & ntqv, ntcw, ntiw, ntoz, ntlnc, ntinc, ntwa, ntia, & + & index_of_process_pbl, htrsw, htrlw, xmu, & & grav_settling, bl_mynn_tkebudget, bl_mynn_tkeadvect, & & bl_mynn_cloudpdf, bl_mynn_mixlength, & & bl_mynn_edmf, bl_mynn_edmf_mom, bl_mynn_edmf_tke, & - & bl_mynn_edmf_part, bl_mynn_cloudmix, bl_mynn_mixqt,& + & bl_mynn_cloudmix, bl_mynn_mixqt, & & bl_mynn_output, & & icloud_bl, do_mynnsfclay, & & imp_physics, imp_physics_gfdl, & @@ -211,7 +212,6 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_edmf, & & bl_mynn_edmf_mom, & & bl_mynn_edmf_tke, & - & bl_mynn_edmf_part, & & bl_mynn_cloudmix, & & bl_mynn_mixqt, & & bl_mynn_tkebudget, & @@ -220,11 +220,19 @@ SUBROUTINE mynnedmf_wrapper_run( & & imp_physics, imp_physics_wsm6, & & imp_physics_thompson, imp_physics_gfdl +!TENDENCY DIAGNOSTICS + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_of_temperature, index_of_x_wind, & + index_of_y_wind, index_of_process_pbl + integer, intent(in) :: ntoz, ntqv, ntcw, ntiw, ntlnc, ntinc, ntwa, ntia, ntke + !MISC CONFIGURATION OPTIONS INTEGER, PARAMETER :: & & spp_pbl=0, & - & bl_mynn_mixscalars=1, & - & levflag=2 + & bl_mynn_mixscalars=1 + REAL, PARAMETER :: & + & closure=2.5 !2.5, 2.6 or 3.0 LOGICAL :: & & FLAG_QI, FLAG_QNI, FLAG_QC, FLAG_QNC, & & FLAG_QNWFA, FLAG_QNIFA @@ -274,11 +282,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ice_aer_num_conc real(kind=kind_phys), dimension(:,:), intent(out) :: & & Tsq, Qsq, Cov, exch_h, exch_m - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - & du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, & - & do3dt_PBL, dq3dt_PBL, dt3dt_PBL - real(kind=kind_phys), dimension(:), intent(in) :: xmu - real(kind=kind_phys), dimension(:,:), intent(in) :: htrsw, htrlw + real(kind=kind_phys), dimension(:), intent(in) :: xmu + real(kind=kind_phys), dimension(:,:), intent(in) :: htrsw, htrlw !LOCAL real(kind=kind_phys), dimension(im,levs) :: & & sqv,sqc,sqi,qnc,qni,ozone,qnwfa,qnifa, & @@ -288,6 +293,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & RQNWFABLTEN, RQNIFABLTEN, & & dqke,qWT,qSHEAR,qBUOY,qDISS, & & pattern_spp_pbl + real(kind=kind_phys), allocatable :: old_ozone(:,:) !MYNN-CHEM arrays real(kind=kind_phys), dimension(im,nchem) :: chem3d @@ -327,8 +333,9 @@ SUBROUTINE mynnedmf_wrapper_run( & real, dimension(im) :: & & WSTAR,DELTA,qcg,hfx,qfx,rmol,xland, & & uoce,voce,vdfg,znt,ts - + integer :: idtend real, dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 + real(kind=kind_phys), allocatable :: save_qke_adv(:,:) ! Initialize CCPP error handling variables errmsg = '' @@ -341,6 +348,14 @@ SUBROUTINE mynnedmf_wrapper_run( & write(0,*)"flag_restart=",flag_restart endif + if(.not. flag_for_pbl_generic_tend .and. ldiag3d) then + idtend = dtidx(ntke+100,index_of_process_pbl) + if(idtend>=1) then + allocate(save_qke_adv(im,levs)) + save_qke_adv=qke_adv + endif + endif + ! DH* TODO: Use flag_restart to distinguish which fields need ! to be initialized and which are read from restart files if (flag_init) then @@ -490,7 +505,10 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo endif - + if(ldiag3d .and. dtidx(100+ntoz,index_of_process_pbl)>1) then + allocate(old_ozone(im,levs)) + old_ozone = ozone + endif if (lprnt)write(0,*)"prepping MYNN-EDMF variables..." do k=1,levs @@ -547,11 +565,6 @@ SUBROUTINE mynnedmf_wrapper_run( & else rmol(i)=ABS(rb(i))*1./(dz(i,1)*0.5) endif - !if (rb(i) .ge. 0.)then - ! rmol(i)=rb(i)*8./(dz(i,1)*0.5) - !else - ! rmol(i)=MAX(rb(i)*5.,-10.)/(dz(i,1)*0.5) - !endif endif ts(i)=tsurf(i)/exner(i,1) !theta ! qsfc(i)=qss(i) @@ -604,7 +617,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"bl_mynn_tkebudget=",bl_mynn_tkebudget," bl_mynn_tkeadvect=",bl_mynn_tkeadvect print*,"bl_mynn_cloudpdf=",bl_mynn_cloudpdf," bl_mynn_mixlength=",bl_mynn_mixlength print*,"bl_mynn_edmf=",bl_mynn_edmf," bl_mynn_edmf_mom=",bl_mynn_edmf_mom - print*,"bl_mynn_edmf_tke=",bl_mynn_edmf_tke," bl_mynn_edmf_part=",bl_mynn_edmf_part + print*,"bl_mynn_edmf_tke=",bl_mynn_edmf_tke print*,"bl_mynn_cloudmix=",bl_mynn_cloudmix," bl_mynn_mixqt=",bl_mynn_mixqt print*,"icloud_bl=",icloud_bl print*,"T:",t3d(1,1),t3d(1,2),t3d(1,levs) @@ -673,7 +686,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & ,bl_mynn_mixlength=bl_mynn_mixlength & !input parameter & ,icloud_bl=icloud_bl & !input parameter & ,qc_bl=qc_bl,qi_bl=qi_bl,cldfra_bl=cldfra_bl & !output - & ,levflag=levflag,bl_mynn_edmf=bl_mynn_edmf & !input parameter + & ,closure=closure,bl_mynn_edmf=bl_mynn_edmf & !input parameter & ,bl_mynn_edmf_mom=bl_mynn_edmf_mom & !input parameter & ,bl_mynn_edmf_tke=bl_mynn_edmf_tke & !input parameter & ,bl_mynn_mixscalars=bl_mynn_mixscalars & !input parameter @@ -711,22 +724,17 @@ SUBROUTINE mynnedmf_wrapper_run( & dvdt(i,k) = dvdt(i,k) + RVBLTEN(i,k) enddo enddo - accum_duvt3dt: if(lssav) then - if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then - do k = 1, levs - do i = 1, im - du3dt_PBL(i,k) = du3dt_PBL(i,k) + RUBLTEN(i,k)*dtf - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + RVBLTEN(i,k)*dtf - enddo - enddo - endif - - if (lsidea .or. (ldiag3d .and. .not. flag_for_pbl_generic_tend)) then - do k = 1, levs - do i = 1, im - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + RTHBLTEN(i,k)*exner(i,k)*dtf - enddo - enddo + accum_duvt3dt: if(ldiag3d .or. lsidea) then + call dtend_helper(index_of_x_wind,RUBLTEN) + call dtend_helper(index_of_y_wind,RVBLTEN) + call dtend_helper(index_of_temperature,RTHBLTEN,exner) + if(ldiag3d) then + call dtend_helper(100+ntoz,dqdt_ozone) + ! idtend = dtidx(100+ntoz,index_of_process_pbl) + ! if(idtend>=1) then + ! dtend(:,:,idtend) = dtend(:,:,idtend) + (ozone-old_ozone) + ! deallocate(old_ozone) + ! endif endif endif accum_duvt3dt !Update T, U and V: @@ -749,6 +757,11 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then + call dtend_helper(100+ntqv,RQVBLTEN) + call dtend_helper(100+ntcw,RQCBLTEN) + call dtend_helper(100+ntiw,RQIBLTEN) + endif !Update moist species: !do k=1,levs ! do i=1,im @@ -773,6 +786,15 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) enddo enddo + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then + call dtend_helper(100+ntqv,RQVBLTEN) + call dtend_helper(100+ntcw,RQCBLTEN) + call dtend_helper(100+ntlnc,RQNCBLTEN) + call dtend_helper(100+ntiw,RQIBLTEN) + call dtend_helper(100+ntinc,RQNIBLTEN) + call dtend_helper(100+ntwa,RQNWFABLTEN) + call dtend_helper(100+ntia,RQNIFABLTEN) + endif !do k=1,levs ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt @@ -796,6 +818,12 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then + call dtend_helper(100+ntqv,RQVBLTEN) + call dtend_helper(100+ntcw,RQCBLTEN) + call dtend_helper(100+ntiw,RQIBLTEN) + call dtend_helper(100+ntinc,RQNIBLTEN) + endif !do k=1,levs ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt @@ -819,6 +847,11 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then + call dtend_helper(100+ntqv,RQVBLTEN) + call dtend_helper(100+ntcw,RQCBLTEN) + call dtend_helper(100+ntiw,RQIBLTEN) + endif !do k=1,levs ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt @@ -840,16 +873,13 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then + call dtend_helper(100+ntqv,RQVBLTEN) + call dtend_helper(100+ntcw,RQCBLTEN) + call dtend_helper(100+ntiw,RQIBLTEN) + endif endif - if(lssav .and. (ldiag3d .and. qdiag3d .and. .not. flag_for_pbl_generic_tend)) then - do k=1,levs - do i=1,im - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf - enddo - enddo - endif - if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" @@ -891,6 +921,33 @@ SUBROUTINE mynnedmf_wrapper_run( & print* endif + if(allocated(save_qke_adv)) then + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then + idtend = dtidx(100+ntke,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + qke_adv-save_qke_adv + endif + endif + deallocate(save_qke_adv) + endif + + CONTAINS + + SUBROUTINE dtend_helper(itracer,field,mult) + real(kind=kind_phys), intent(in) :: field(im,levs) + real(kind=kind_phys), intent(in), optional :: mult(im,levs) + integer, intent(in) :: itracer + integer :: idtend + + idtend=dtidx(itracer,index_of_process_pbl) + if(idtend>=1) then + if(present(mult)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + field*dtf*mult + else + dtend(:,:,idtend) = dtend(:,:,idtend) + field*dtf + endif + endif + END SUBROUTINE dtend_helper END SUBROUTINE mynnedmf_wrapper_run diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index de24fcbef..1b77d101e 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1019,68 +1019,126 @@ type = logical intent = in optional = F -[du3dt_PBL] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[du3dt_OGWD] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in x wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dv3dt_PBL] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dv3dt_OGWD] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in y wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[do3dt_PBL] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dq3dt_PBL] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntke] + standard_name = index_for_turbulent_kinetic_energy + long_name = tracer index for turbulent kinetic energy + units = index + dimensions = () + type = integer + intent = in optional = F -[dt3dt_PBL] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntwa] + standard_name = index_for_water_friendly_aerosols + long_name = tracer index for water friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntia] + standard_name = index_for_ice_friendly_aerosols + long_name = tracer index for ice friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [htrsw] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step @@ -1173,14 +1231,6 @@ type = integer intent = in optional = F -[bl_mynn_edmf_part] - standard_name = edmf_partition_flag - long_name = flag to partitioning of the MF and ED areas - units = flag - dimensions = () - type = integer - intent = in - optional = F [bl_mynn_cloudmix] standard_name = cloud_specie_mix_flag long_name = flag to activate mixing of cloud species diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index d691de909..36bb3d0e2 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -2,7 +2,7 @@ !! This file contains the entity of MYNN-EDMF PBL scheme. !WRF:MODEL_LAYER:PHYSICS ! -! translated from NN f77 to F90 and put into WRF by Mariusz Pagowski +! Translated from NN f77 to F90 and put into WRF by Mariusz Pagowski ! NOAA/GSD & CIRA/CSU, Feb 2008 ! changes to original code: ! 1. code is 1D (in z) @@ -13,7 +13,8 @@ ! 5. cosmetic changes to adhere to WRF standard (remove common blocks, ! intent etc) !------------------------------------------------------------------- -!Modifications implemented by Joseph Olson and Jaymes Kenyon NOAA/GSD/MDB - CU/CIRES +!Modifications implemented by Joseph Olson and Jaymes Kenyon (NOAA/GSL), +!Wayne Angevine (NOAA/CSL), Kay Suselj (NASA/JPL), Franciano Puhales (UFSM) ! ! Departures from original MYNN (Nakanish & Niino 2009) ! 1. Addition of BouLac mixing length in the free atmosphere. @@ -119,11 +120,30 @@ ! Misc small-impact bugfixes: ! 1) dz was incorrectly indexed in mym_condensation ! 2) configurations with icloud_bl = 0 were using uninitialized arrays +! v4.3 / CCPP +! This version includes many modifications that proved valuable in the global +! framework and removes some key lingering bugs in the mixing of chemical species. +! TKE Budget output fixed (Puhales, 2020-12) +! New option for stability function: (Puhales, 2020-12) +! bl_mynn_stfunc = 0 (original, Kansas-type function, Paulson, 1970 ) +! bl_mynn_stfunc = 1 (new (for test), same used for Jimenez et al (MWR) +! see the Technical Note for this implementation). +! Improved conservation of momentum and higher-order moments. +! Important bug fixes for mixing of chemical species. +! Addition of pressure-gradient effects on updraft momentum transport. +! Addition of bl_mynn_closure option = 2.5, 2.6, or 3.0 +! Addition of sig_order to regulate the use of higher-order moments +! for sigma when using bl_mynn_cloudpdf = 2 (Chab-Becht). This +! new option is set in the subroutine mym_condensation. +! Many miscellaneous tweaks. ! -! Many of these changes are now documented in Olson et al. (2019, -! NOAA Technical Memorandum) -! -! For more explanation of some configuration options, see "JOE's mods" below: +! Many of these changes are now documented in: +! Olson, J. B., J. S. Kenyon, W. M. Angevine, J. M. Brown, M. Pagowski, and K. Suselj, 2019: +! A description of the MYNN-EDMF scheme and coupling to other components in WRF-ARW. +! NOAA Tech. Memo. OAR GSD, 61, 37 pp., https://doi.org/10.25923/n9wm-be49. +! Puhales, Franciano S., Joseph B. Olson, Jimy Dudhia, Douglas Lima de Bem, Rafael Maroneze, +! Otavio C. Acevedo, Felipe D. Costa, and Vagner Anabor, 2020: Turbulent Kinetic Energy +! Budget for MYNN-EDMF PBL Scheme in WRF model. Universidade Federal de Santa Maria Technical Note. 9 pp. !------------------------------------------------------------------- MODULE module_bl_mynn @@ -250,11 +270,15 @@ MODULE module_bl_mynn !!for TKE in the upper PBL/cloud layer. REAL, PARAMETER :: scaleaware=1. - !>Temporary switch to deactivate the mixing of chemical species (already done when WRF_CHEM = 1) - INTEGER, PARAMETER :: bl_mynn_mixchem = 0 + !>Temporary switch to deactivate the mixing of chemical species (if WRF_CHEM = 1) + LOGICAL, PARAMETER :: mynn_chem_vertmx = .false. + LOGICAL, PARAMETER :: enh_vermix = .false. + !>Of the following the options, use one OR the other, not both. !>Adding top-down diffusion driven by cloud-top radiative cooling - INTEGER, PARAMETER :: bl_mynn_topdown = 1 + INTEGER, PARAMETER :: bl_mynn_topdown = 0 + !>Option to activate downdrafts, from Elynn Wu (0: deactive, 1: active) + INTEGER, PARAMETER :: bl_mynn_edmf_dd = 0 !>Option to activate heating due to dissipation of TKE (to activate, set to 1.0) REAL, PARAMETER :: dheat_opt = 1. @@ -262,6 +286,9 @@ MODULE module_bl_mynn !Option to activate environmental subsidence in mass-flux scheme LOGICAL, PARAMETER :: env_subs = .true. + !Option to switch flux-profile relationship for surface (from Puhales et al. 2020) + INTEGER, PARAMETER :: bl_mynn_stfunc = 1 + !option to print out more stuff for debugging purposes LOGICAL, PARAMETER :: debug_code = .false. @@ -462,7 +489,7 @@ SUBROUTINE mym_initialize ( & & dz, dx, zw, & & u, v, thl, qw, & ! & ust, rmo, pmz, phh, flt, flq, & - & zi, theta, sh, & + & zi, theta, thetav, sh, sm, & & ust, rmo, el, & & Qke, Tsq, Qsq, Cov, Psig_bl, cldfra_bl1D, & & bl_mynn_mixlength, & @@ -490,7 +517,7 @@ SUBROUTINE mym_initialize ( & INTEGER :: k,l,lmax REAL :: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1.,flt=0.,flq=0.,tmpq REAL :: zi - REAL, DIMENSION(kts:kte) :: theta + REAL, DIMENSION(kts:kte) :: theta, thetav REAL, DIMENSION(kts:kte) :: rstoch_col INTEGER ::spp_pbl @@ -503,10 +530,10 @@ SUBROUTINE mym_initialize ( & END DO ! !> - Call mym_level2() to calculate the stability functions at level 2. - CALL mym_level2 ( kts,kte,& - & dz, & - & u, v, thl, qw, & - & ql, vt, vq, & + CALL mym_level2 ( kts,kte, & + & dz, & + & u, v, thl, thetav, qw, & + & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! ! ** Preliminary setting ** @@ -661,10 +688,10 @@ END SUBROUTINE mym_initialize !!\param sh stability function for heat, at Level 2 !!\section gen_mym_level2 GSD MYNN-EDMF mym_level2 General Algorithm !! @ { - SUBROUTINE mym_level2 (kts,kte,& - & dz, & - & u, v, thl, qw, & - & ql, vt, vq, & + SUBROUTINE mym_level2 (kts,kte, & + & dz, & + & u, v, thl, thetav, qw, & + & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! !------------------------------------------------------------------- @@ -677,8 +704,8 @@ SUBROUTINE mym_level2 (kts,kte,& #endif REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,ql,vt,vq - + REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,ql,vt,vq,& + thetav REAL, DIMENSION(kts:kte), INTENT(out) :: & &dtl,dqw,dtv,gm,gh,sm,sh @@ -687,7 +714,7 @@ SUBROUTINE mym_level2 (kts,kte,& REAL :: rfc,f1,f2,rf1,rf2,smc,shc,& &ri1,ri2,ri3,ri4,duz,dtz,dqz,vtt,vqq,dtq,dzk,afk,abk,ri,rf - REAL :: a2den + REAL :: a2fac ! ev = 2.5e6 ! tv0 = 0.61*tref @@ -720,6 +747,8 @@ SUBROUTINE mym_level2 (kts,kte,& vtt = 1.0 +vt(k)*abk +vt(k-1)*afk ! Beta-theta in NN09, Eq. 39 vqq = tv0 +vq(k)*abk +vq(k-1)*afk ! Beta-q dtq = vtt*dtz +vqq*dqz + !Alternatively, use theta-v without the SGS clouds + !dtq = ( thetav(k)-thetav(k-1) )/( dzk ) ! dtl(k) = dtz dqw(k) = dqz @@ -734,21 +763,21 @@ SUBROUTINE mym_level2 (kts,kte,& ! ** Gradient Richardson number ** ri = -gh(k)/MAX( duz, 1.0e-10 ) - !a2den is needed for the Canuto/Kitamura mod + !a2fac is needed for the Canuto/Kitamura mod IF (CKmod .eq. 1) THEN - a2den = 1. + MAX(ri,0.0) + a2fac = 1./(1. + MAX(ri,0.0)) ELSE - a2den = 1. + 0.0 + a2fac = 1. ENDIF rfc = g1/( g1+g2 ) - f1 = b1*( g1-c1 ) +3.0*(a2/a2den)*( 1.0 -c2 )*( 1.0-c5 ) & + f1 = b1*( g1-c1 ) +3.0*a2*a2fac *( 1.0 -c2 )*( 1.0-c5 ) & & +2.0*a1*( 3.0-2.0*c2 ) f2 = b1*( g1+g2 ) -3.0*a1*( 1.0 -c2 ) rf1 = b1*( g1-c1 )/f1 rf2 = b1* g1 /f2 - smc = a1 /(a2/a2den)* f1/f2 - shc = 3.0*(a2/a2den)*( g1+g2 ) + smc = a1 /(a2*a2fac)* f1/f2 + shc = 3.0*(a2*a2fac)*( g1+g2 ) ri1 = 0.5/smc ri2 = rf1*smc @@ -756,7 +785,7 @@ SUBROUTINE mym_level2 (kts,kte,& ri4 = ri2**2 ! ** Flux Richardson number ** - rf = MIN( ri1*( ri+ri2-SQRT(ri**2-ri3*ri+ri4) ), rfc ) + rf = MIN( ri1*( ri + ri2-SQRT(ri**2 - ri3*ri + ri4) ), rfc ) ! sh (k) = shc*( rfc-rf )/( 1.0-rf ) sm (k) = smc*( rf1-rf )/( rf2-rf ) * sh(k) @@ -852,9 +881,10 @@ SUBROUTINE mym_length ( & INTEGER :: i,j,k - REAL :: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud,elb,els,els1,elf, & - & el_stab,el_unstab,el_mf,el_stab_mf,elb_mf,PBLH_PLUS_ENT, & - & Uonset,Ugrid,el_les + REAL :: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud,wstar,elb,els, & + & els1,elf,el_stab,el_unstab,el_mf,el_stab_mf,elb_mf, & + & PBLH_PLUS_ENT,Uonset,Ugrid,el_les + REAL, PARAMETER :: ctau = 1000. !constant for tau_cloud ! tv0 = 0.61*tref ! gtr = 9.81/tref @@ -902,7 +932,7 @@ SUBROUTINE mym_length ( & vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**(1.0/3.0) - ! ** Strictly, el(i,j,1) is not zero. ** + ! ** Strictly, el(i,k=1) is not zero. ** el(kts) = 0.0 zwk1 = zw(kts+1) @@ -943,30 +973,31 @@ SUBROUTINE mym_length ( & END DO - CASE (1) !OPERATIONAL FORM OF MIXING LENGTH + CASE (1, 2) !NONLOCAL (using BouLac) FORM OF MIXING LENGTH - cns = 2.3 + cns = 3.5 alp1 = 0.23 - alp2 = 0.65 - alp3 = 3.0 - alp4 = 20. + alp2 = 0.3 + alp3 = 1.5 + alp4 = 5. alp5 = 0.4 + alp6 = 50. ! Impose limits on the height integration for elt and the transition layer depth - zi2=MAX(zi,minzi) - h1=MAX(0.3*zi2,mindz) - h1=MIN(h1,maxdz) ! 1/2 transition layer depth + zi2=MAX(zi,200.) !minzi) + h1=MAX(0.3*zi2,200.) + h1=MIN(h1,500.) ! 1/2 transition layer depth h2=h1/2.0 ! 1/4 transition layer depth - qtke(kts)=MAX(qke(kts)/2.,0.01) !tke at full sigma levels - thetaw(kts)=theta(kts) !theta at full-sigma levels + qtke(kts)=MAX(0.5*qke(kts),0.01) !tke at full sigma levels + thetaw(kts)=theta(kts) !theta at full-sigma levels qkw(kts) = SQRT(MAX(qke(kts),1.0e-10)) DO k = kts+1,kte afk = dz(k)/( dz(k)+dz(k-1) ) abk = 1.0 -afk qkw(k) = SQRT(MAX(qke(k)*abk+qke(k-1)*afk,1.0e-3)) - qtke(k) = (qkw(k)**2.)/2. ! q -> TKE + qtke(k) = 0.5*(qkw(k)**2) ! q -> TKE thetaw(k)= theta(k)*abk + theta(k-1)*afk END DO @@ -985,9 +1016,9 @@ SUBROUTINE mym_length ( & zwk = zw(k) END DO - elt = alp1*elt/vsc + elt = MIN( MAX( alp1*elt/vsc, 10.), 400.) vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq - vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**(1.0/3.0) + vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird ! ** Strictly, el(i,j,1) is not zero. ** el(kts) = 0.0 @@ -1002,11 +1033,14 @@ SUBROUTINE mym_length ( & ! ** Length scale limited by the buoyancy effect ** IF ( dtv(k) .GT. 0.0 ) THEN bv = SQRT( gtr*dtv(k) ) - elb = alp2*qkw(k) / bv & ! formulation, - & *( 1.0 + alp3/alp2*& ! except keep - &SQRT( vsc/( bv*elt ) ) ) ! elb bounded by - elb = MIN(elb, zwk) ! zwk - elf = alp2 * qkw(k)/bv + !elb = alp2*qkw(k) / bv & ! formulation, + ! & *( 1.0 + alp3/alp2*& ! except keep + ! &SQRT( vsc/( bv*elt ) ) ) ! elb bounded by zwk + elb = MAX(alp2*qkw(k), & + & alp6*edmf_a1(k)*edmf_w1(k)) / bv & + & *( 1.0 + alp3*SQRT( vsc/(bv*elt) ) ) + elb = MIN(elb, zwk) + elf = 0.65 * qkw(k)/bv ELSE elb = 1.0e10 elf = elb @@ -1028,41 +1062,47 @@ SUBROUTINE mym_length ( & !add blending to use BouLac mixing length in free atmos; !defined relative to the PBLH (zi) + transition layer (h1) - el(k) = MIN(elb/( elb/elt+elb/els+1.0 ),elf) - el(k) = el(k)*(1.-wt) + alp5*elBLmin(k)*wt + !el(k) = MIN(elb/( elb/elt+elb/els+1.0 ),elf) + !try squared-blending + !el_unstab = SQRT( els**2/(1. + (els1**2/elt**2) )) + el(k) = SQRT( els**2/(1. + (els1**2/elt**2) +(els1**2/elb**2))) + el(k) = MIN (el(k), elf) + el(k) = el(k)*(1.-wt) + alp5*elBLavg(k)*wt ! include scale-awareness, except for original MYNN el(k) = el(k)*Psig_bl END DO - CASE (2) !Experimental mixing length formulation + CASE (3) !Experimental mixing length formulation - Uonset = 2.5 + dz(kts)*0.1 + Uonset = 3.5 + dz(kts)*0.1 Ugrid = sqrt(u1(kts)**2 + v1(kts)**2) - cns = 3.5 * (1.0 - MIN(MAX(Ugrid - Uonset, 0.0)/10.0, 1.0)) + cns = 3.5 !JOE-test * (1.0 - MIN(MAX(Ugrid - Uonset, 0.0)/10.0, 1.0)) alp1 = 0.23 - alp2 = 0.30 + 0.3*MIN(MAX((dx - 3000.)/10000., 0.0), 1.0) - alp3 = 2.0 - alp4 = 20. !10. + alp2 = 0.30 + alp3 = 1.5 + alp4 = 10.0 !was 20. alp5 = alp2 !like alp2, but for free atmosphere alp6 = 50.0 !used for MF mixing length ! Impose limits on the height integration for elt and the transition layer depth !zi2=MAX(zi,minzi) - zi2=MAX(zi, 100.) - h1=MAX(0.3*zi2,mindz) - h1=MIN(h1,maxdz) ! 1/2 transition layer depth + zi2=MAX(zi, 200.) + !h1=MAX(0.3*zi2,mindz) + !h1=MIN(h1,maxdz) ! 1/2 transition layer depth + h1=MAX(0.3*zi2,200.) + h1=MIN(h1,500.) h2=h1*0.5 ! 1/4 transition layer depth qtke(kts)=MAX(0.5*qke(kts),0.01) !tke at full sigma levels - qkw(kts) = SQRT(MAX(qke(kts),1.0e-10)) + qkw(kts) = SQRT(MAX(qke(kts),1.0e-4)) DO k = kts+1,kte afk = dz(k)/( dz(k)+dz(k-1) ) abk = 1.0 -afk qkw(k) = SQRT(MAX(qke(k)*abk+qke(k-1)*afk,1.0e-3)) - qtke(k) = 0.5*qkw(k) ! qkw -> TKE + qtke(k) = 0.5*qkw(k)**2 ! qkw -> TKE END DO elt = 1.0e-5 @@ -1074,14 +1114,14 @@ SUBROUTINE mym_length ( & zwk = zw(k) DO WHILE (zwk .LE. PBLH_PLUS_ENT) dzk = 0.5*( dz(k)+dz(k-1) ) - qdz = MAX( qkw(k)-qmin, 0.03 )*dzk !consider reducing 0.3 + qdz = MAX( qkw(k)-qmin, 0.03 )*dzk elt = elt +qdz*zwk vsc = vsc +qdz k = k+1 zwk = zw(k) END DO - elt = MAX(alp1*elt/vsc, 10.) + elt = MIN( MAX(alp1*elt/vsc, 10.), 400.) vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird @@ -1091,18 +1131,28 @@ SUBROUTINE mym_length ( & DO k = kts+1,kte zwk = zw(k) !full-sigma levels + dzk = 0.5*( dz(k)+dz(k-1) ) cldavg = 0.5*(cldfra_bl1D(k-1)+cldfra_bl1D(k)) ! ** Length scale limited by the buoyancy effect ** IF ( dtv(k) .GT. 0.0 ) THEN - bv = SQRT( gtr*dtv(k) ) + !impose min value on bv + bv = MAX( SQRT( gtr*dtv(k) ), 0.001) !elb_mf = alp2*qkw(k) / bv & - elb_mf = MAX(alp2*qkw(k), & -! &MAX(1.-0.5*cldavg,0.0)**0.5 * alp6*edmf_a1(k)*edmf_w1(k)) / bv & - & alp6*edmf_a1(k)*edmf_w1(k)) / bv & + elb_mf = MAX(alp2*qkw(k), & + & alp6*edmf_a1(k)*edmf_w1(k)) / bv & & *( 1.0 + alp3*SQRT( vsc/( bv*elt ) ) ) - elb = MIN(alp5*qkw(k)/bv, zwk) - elf = elb/(1. + (elb/600.)) !bound free-atmos mixing length to < 600 m. + elb = MIN(MAX(alp5*qkw(k), alp6*edmf_a1(k)*edmf_w1(k))/bv, zwk) + + !tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(vflx,1.0e-4))**onethird),30.),150.) + wstar = 1.25*(gtr*zi*MAX(vflx,1.0e-4))**onethird + tau_cloud = MIN(MAX(ctau * wstar/g, 30.), 150.) + !minimize influence of surface heat flux on tau far away from the PBLH. + wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 + tau_cloud = tau_cloud*(1.-wt) + 50.*wt + elf = MIN(MAX(tau_cloud*SQRT(MIN(qtke(k),40.)), & + & alp6*edmf_a1(k)*edmf_w1(k)/bv), zwk) + !IF (zwk > zi .AND. elf > 400.) THEN ! ! COMPUTE BouLac mixing length ! !CALL boulac_length0(k,kts,kte,zw,dz,qtke,thetaw,elBLmin0,elBLavg0) @@ -1121,15 +1171,22 @@ SUBROUTINE mym_length ( & ! velocity scale), except that elt is relpaced ! by zi, and zero is replaced by 1.0e-4 to ! prevent division by zero. - tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(flt,1.0e-4))**onethird),50.),150.) + !tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(vflx,1.0e-4))**onethird),50.),150.) + wstar = 1.25*(gtr*zi*MAX(vflx,1.0e-4))**onethird + tau_cloud = MIN(MAX(ctau * wstar/g, 50.), 200.) !minimize influence of surface heat flux on tau far away from the PBLH. wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 - tau_cloud = tau_cloud*(1.-wt) + 50.*wt + !tau_cloud = tau_cloud*(1.-wt) + 50.*wt + tau_cloud = tau_cloud*(1.-wt) + MAX(100.,dzk*0.25)*wt - elb = MIN(tau_cloud*SQRT(MIN(qtke(k),30.)), zwk) - elf = elb + elb = MIN(tau_cloud*SQRT(MIN(qtke(k),40.)), zwk) + !elf = elb + elf = elb !/(1. + (elb/800.)) !bound free-atmos mixing length to < 800 m. elb_mf = elb END IF + elf = elf/(1. + (elf/800.)) !bound free-atmos mixing length to < 800 m. +! elb_mf = elb_mf/(1. + (elb_mf/800.)) !bound buoyancy mixing length to < 800 m. + elb_mf = MAX(elb_mf, 0.01) !to avoid divide-by-zero below z_m = MAX(0.,zwk - 4.) @@ -1146,8 +1203,11 @@ SUBROUTINE mym_length ( & wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 ! "el_unstab" = blended els-elt - el_unstab = els/(1. + (els1/elt)) - el(k) = MIN(el_unstab, elb_mf) + !el_unstab = els/(1. + (els1/elt)) + !try squared-blending + !el(k) = SQRT( els**2/(1. + (els1**2/elt**2) )) + el(k) = SQRT( els**2/(1. + (els1**2/elt**2) +(els1**2/elb_mf**2))) + !el(k) = MIN(el_unstab, elb_mf) el(k) = el(k)*(1.-wt) + elf*wt ! include scale-awareness. For now, use simple asymptotic kz -> 12 m. @@ -1494,8 +1554,7 @@ END SUBROUTINE boulac_length ! SUBROUTINE mym_turbulence: ! ! Input variables: see subroutine mym_initialize -! levflag : <>3; Level 2.5 -! = 3; Level 3 +! closure : closure level (2.5, 2.6, or 3.0) ! ! # ql, vt, vq, qke, tsq, qsq and cov are changed to input variables. ! @@ -1542,14 +1601,14 @@ END SUBROUTINE boulac_length !! is set to True) SUBROUTINE mym_turbulence ( & & kts,kte, & - & levflag, & + & closure, & & dz, dx, zw, & - & u, v, thl, ql, qw, & + & u, v, thl, thetav, ql, qw, & & qke, tsq, qsq, cov, & & vt, vq, & & rmo, flt, flq, & & zi,theta, & - & sh, & + & sh, sm, & & El, & & Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D, & @@ -1568,11 +1627,12 @@ SUBROUTINE mym_turbulence ( & # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: levflag,bl_mynn_mixlength,bl_mynn_edmf + INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf + REAL, INTENT(IN) :: closure REAL, DIMENSION(kts:kte), INTENT(in) :: dz REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,Psig_shcu,dx - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,& + REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,thetav,qw,& &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1,edmf_qc1,& &TKEprodTD @@ -1596,10 +1656,10 @@ SUBROUTINE mym_turbulence ( & REAL :: zi, cldavg REAL, DIMENSION(kts:kte), INTENT(in) :: theta - REAL :: a2den, duz, ri, HLmod !JOE-Canuto/Kitamura mod -!JOE-stability criteria for cw - REAL:: auh,aum,adh,adm,aeh,aem,Req,Rsl,Rsl2 -!JOE-end + REAL :: a2fac, duz, ri !JOE-Canuto/Kitamura mod + + REAL:: auh,aum,adh,adm,aeh,aem,Req,Rsl,Rsl2,& + gmelq,sm20,sh20,sm25max,sh25max,sm25min,sh25min DOUBLE PRECISION q2sq, t2sq, r2sq, c2sq, elsq, gmel, ghel DOUBLE PRECISION q3sq, t3sq, r3sq, c3sq, dlsq, qdiv @@ -1608,7 +1668,8 @@ SUBROUTINE mym_turbulence ( & ! Stochastic INTEGER, INTENT(IN) :: spp_pbl REAL, DIMENSION(KTS:KTE) :: rstoch_col - REAL :: prlimit + REAL :: Prnum + REAL, PARAMETER :: Prlimit = 5.0 ! @@ -1624,11 +1685,11 @@ SUBROUTINE mym_turbulence ( & ! e5c = 6.0*a1*a1 ! - CALL mym_level2 (kts,kte,& - & dz, & - & u, v, thl, qw, & - & ql, vt, vq, & - & dtl, dqw, dtv, gm, gh, sm, sh ) + CALL mym_level2 (kts,kte, & + & dz, & + & u, v, thl, theta, qw, & + & ql, vt, vq, & + & dtl, dqw, dtv, gm, gh, sm, sh ) ! CALL mym_length ( & & kts,kte, & @@ -1648,20 +1709,30 @@ SUBROUTINE mym_turbulence ( & afk = dz(k)/( dz(k)+dz(k-1) ) abk = 1.0 -afk elsq = el (k)**2 - q2sq = b1*elsq*( sm(k)*gm(k)+sh(k)*gh(k) ) q3sq = qkw(k)**2 + q2sq = b1*elsq*( sm(k)*gm(k)+sh(k)*gh(k) ) + + sh20 = MAX(sh(k), 1e-5) + sm20 = MAX(sm(k), 1e-5) + sh(k)= MAX(sh(k), 1e-5) -!JOE-Canuto/Kitamura mod + !Canuto/Kitamura mod duz = ( u(k)-u(k-1) )**2 +( v(k)-v(k-1) )**2 duz = duz /dzk**2 ! ** Gradient Richardson number ** ri = -gh(k)/MAX( duz, 1.0e-10 ) IF (CKmod .eq. 1) THEN - a2den = 1. + MAX(ri,0.0) + a2fac = 1./(1. + MAX(ri,0.0)) ELSE - a2den = 1. + 0.0 + a2fac = 1. ENDIF -!JOE-end + !end Canuto/Kitamura mod + + !level 2.0 Prandtl number + !Prnum = MIN(sm20/sh20, 4.0) + !The form of Zilitinkevich et al. (2006) but modified + !following Esau and Grachev (2007, Wind Eng) + Prnum = MIN(0.76 + 4.0*MAX(ri,0.0), Prlimit) ! ! Modified: Dec/22/2005, from here, (dlsq -> elsq) gmel = gm (k)*elsq @@ -1671,7 +1742,7 @@ SUBROUTINE mym_turbulence ( & ! Level 2.0 debug prints IF ( debug_code ) THEN IF (sh(k)<0.0 .OR. sm(k)<0.0) THEN - print*,"MYNN; mym_turbulence2.0; sh=",sh(k)," k=",k + print*,"MYNN; mym_turbulence 2.0; sh=",sh(k)," k=",k print*," gm=",gm(k)," gh=",gh(k)," sm=",sm(k) print*," q2sq=",q2sq," q3sq=",q3sq," q3/q2=",q3sq/q2sq print*," qke=",qke(k)," el=",el(k)," ri=",ri @@ -1679,14 +1750,6 @@ SUBROUTINE mym_turbulence ( & ENDIF ENDIF -!JOE-Apply Helfand & Labraga stability check for all Ric -! when CKmod == 1. (currently not forced below) - IF (CKmod .eq. 1) THEN - HLmod = q2sq -1. - ELSE - HLmod = q3sq - ENDIF - ! ** Since qkw is set to more than 0.0, q3sq > 0.0. ** !JOE-test new stability criteria in level 2.5 (as well as level 3) - little/no impact @@ -1696,58 +1759,99 @@ SUBROUTINE mym_turbulence ( & !JOE-end IF ( q3sq .LT. q2sq ) THEN - !IF ( HLmod .LT. q2sq ) THEN !Apply Helfand & Labraga mod qdiv = SQRT( q3sq/q2sq ) !HL89: (1-alfa) - sm(k) = sm(k) * qdiv - sh(k) = sh(k) * qdiv ! + !Use level 2.5 stability functions + !e1 = q3sq - e1c*ghel*a2fac + !e2 = q3sq - e2c*ghel*a2fac + !e3 = e1 + e3c*ghel*a2fac**2 + !e4 = e1 - e4c*ghel*a2fac + !eden = e2*e4 + e3*e5c*gmel + !eden = MAX( eden, 1.0d-20 ) + !sm(k) = q3sq*a1*( e3-3.0*c1*e4 )/eden + !!JOE-Canuto/Kitamura mod + !!sh(k) = q3sq*a2*( e2+3.0*c1*e5c*gmel )/eden + !sh(k) = q3sq*(a2*a2fac)*( e2+3.0*c1*e5c*gmel )/eden + !sm(k) = Prnum*sh(k) + !sm(k) = sm(k) * qdiv + + !Use level 2.0 functions as in original MYNN + !sh(k) = sh(k) * qdiv + !sm(k) = Prnum*sh(k) + + !Recalculate terms for later use !JOE-Canuto/Kitamura mod !e1 = q3sq - e1c*ghel * qdiv**2 !e2 = q3sq - e2c*ghel * qdiv**2 !e3 = e1 + e3c*ghel * qdiv**2 !e4 = e1 - e4c*ghel * qdiv**2 - e1 = q3sq - e1c*ghel/a2den * qdiv**2 - e2 = q3sq - e2c*ghel/a2den * qdiv**2 - e3 = e1 + e3c*ghel/(a2den**2) * qdiv**2 - e4 = e1 - e4c*ghel/a2den * qdiv**2 + e1 = q3sq - e1c*ghel*a2fac * qdiv**2 + e2 = q3sq - e2c*ghel*a2fac * qdiv**2 + e3 = e1 + e3c*ghel*a2fac**2 * qdiv**2 + e4 = e1 - e4c*ghel*a2fac * qdiv**2 eden = e2*e4 + e3*e5c*gmel * qdiv**2 eden = MAX( eden, 1.0d-20 ) + !!JOE-Canuto/Kitamura mod + !!sh(k) = q3sq*a2*( e2+3.0*c1*e5c*gmel )/eden - retro 5 + sh(k) = q3sq*(a2*a2fac)*( e2+3.0*c1*e5c*gmel )/eden + sm(k) = Prnum*sh(k) ELSE !JOE-Canuto/Kitamura mod !e1 = q3sq - e1c*ghel !e2 = q3sq - e2c*ghel !e3 = e1 + e3c*ghel !e4 = e1 - e4c*ghel - e1 = q3sq - e1c*ghel/a2den - e2 = q3sq - e2c*ghel/a2den - e3 = e1 + e3c*ghel/(a2den**2) - e4 = e1 - e4c*ghel/a2den + e1 = q3sq - e1c*ghel*a2fac + e2 = q3sq - e2c*ghel*a2fac + e3 = e1 + e3c*ghel*a2fac**2 + e4 = e1 - e4c*ghel*a2fac eden = e2*e4 + e3*e5c*gmel eden = MAX( eden, 1.0d-20 ) qdiv = 1.0 - sm(k) = q3sq*a1*( e3-3.0*c1*e4 )/eden - !JOE-Canuto/Kitamura mod - !sh(k) = q3sq*a2*( e2+3.0*c1*e5c*gmel )/eden - sh(k) = q3sq*(a2/a2den)*( e2+3.0*c1*e5c*gmel )/eden + !Use level 2.5 stability functions + !sm(k) = q3sq*a1*( e3-3.0*c1*e4 )/eden + !!JOE-Canuto/Kitamura mod + !!sh(k) = q3sq*a2*( e2+3.0*c1*e5c*gmel )/eden + sh(k) = q3sq*(a2*a2fac)*( e2+3.0*c1*e5c*gmel )/eden + sm(k) = Prnum*sh(k) END IF !end Helfand & Labraga check + !Impose broad limits on Sh and Sm: + gmelq = MAX(gmel/q3sq, 1e-8) + sm25max = MIN(sm20*3.0, SQRT(.1936/gmelq)) + sh25max = MIN(sh20*3.0, 0.76*b2) + sm25min = MAX(sm20*0.1, 1e-6) + sh25min = MAX(sh20*0.1, 1e-6) + !JOE: Level 2.5 debug prints ! HL88 , lev2.5 criteria from eqs. 3.17, 3.19, & 3.20 IF ( debug_code ) THEN - IF (sh(k)<0.0 .OR. sm(k)<0.0 .OR. & - sh(k) > 0.76*b2 .or. (sm(k)**2*gm(k) .gt. .44**2)) THEN - print*,"MYNN; mym_turbulence2.5; sh=",sh(k)," k=",k - print*," gm=",gm(k)," gh=",gh(k)," sm=",sm(k) - print*," q2sq=",q2sq," q3sq=",q3sq," q3/q2=",q3sq/q2sq - print*," qke=",qke(k)," el=",el(k)," ri=",ri + IF ((sh(k)sh25max .OR. sm(k)>sm25max) ) THEN + print*,"In mym_turbulence 2.5: k=",k + print*," sm=",sm(k)," sh=",sh(k) + print*," ri=",ri," Pr=",sm(k)/MAX(sh(k),1e-8) + print*," gm=",gm(k)," gh=",gh(k) + print*," q2sq=",q2sq," q3sq=",q3sq, q3sq/q2sq + print*," qke=",qke(k)," el=",el(k) print*," PBLH=",zi," u=",u(k)," v=",v(k) + print*," SMnum=",q3sq*a1*( e3-3.0*c1*e4)," SMdenom=",eden + print*," SHnum=",q3sq*(a2*a2fac)*( e2+3.0*c1*e5c*gmel ),& + " SHdenom=",eden ENDIF ENDIF + !Enforce additional constraints for level 2.5 functions + IF ( sh(k) > sh25max ) sh(k) = sh25max + IF ( sh(k) < sh25min ) sh(k) = sh25min + !IF ( sm(k) > sm25max ) sm(k) = sm25max + !IF ( sm(k) < sm25min ) sm(k) = sm25min + sm(k) = Prnum*sh(k) + ! ** Level 3 : start ** - IF ( levflag .EQ. 3 ) THEN + IF ( closure .GE. 3.0 ) THEN t2sq = qdiv*b2*elsq*sh(k)*dtl(k)**2 r2sq = qdiv*b2*elsq*sh(k)*dqw(k)**2 c2sq = qdiv*b2*elsq*sh(k)*dtl(k)*dqw(k) @@ -1760,6 +1864,7 @@ SUBROUTINE mym_turbulence ( & ! vtt = 1.0 +vt(k)*abk +vt(k-1)*afk vqq = tv0 +vq(k)*abk +vq(k-1)*afk + t2sq = vtt*t2sq +vqq*c2sq r2sq = vtt*c2sq +vqq*r2sq c2sq = MAX( vtt*t2sq+vqq*r2sq, 0.0d0 ) @@ -1774,18 +1879,18 @@ SUBROUTINE mym_turbulence ( & IF ( q3sq/dlsq .LT. -gh(k) ) q3sq = -dlsq*gh(k) ! ! ** Limitation on c3sq (0.12 =< cw =< 0.76) ** - !JOE: use Janjic's (2001; p 13-17) methodology (eqs 4.11-414 and 5.7-5.10) + ! Use Janjic's (2001; p 13-17) methodology (eqs 4.11-414 and 5.7-5.10) ! to calculate an exact limit for c3sq: - auh = 27.*a1*((a2/a2den)**2)*b2*(g/tref)**2 - aum = 54.*(a1**2)*(a2/a2den)*b2*c1*(g/tref) - adh = 9.*a1*((a2/a2den)**2)*(12.*a1 + 3.*b2)*(g/tref)**2 - adm = 18.*(a1**2)*(a2/a2den)*(b2 - 3.*(a2/a2den))*(g/tref) + auh = 27.*a1*((a2*a2fac)**2)*b2*(g/tref)**2 + aum = 54.*(a1**2)*(a2*a2fac)*b2*c1*(g/tref) + adh = 9.*a1*((a2*a2fac)**2)*(12.*a1 + 3.*b2)*(g/tref)**2 + adm = 18.*(a1**2)*(a2*a2fac)*(b2 - 3.*(a2*a2fac))*(g/tref) - aeh = (9.*a1*((a2/a2den)**2)*b1 +9.*a1*((a2/a2den)**2)* & + aeh = (9.*a1*((a2*a2fac)**2)*b1 +9.*a1*((a2*a2fac)**2)* & (12.*a1 + 3.*b2))*(g/tref) - aem = 3.*a1*(a2/a2den)*b1*(3.*(a2/a2den) + 3.*b2*c1 + & + aem = 3.*a1*(a2*a2fac)*b1*(3.*(a2*a2fac) + 3.*b2*c1 + & (18.*a1*c1 - b2)) + & - (18.)*(a1**2)*(a2/a2den)*(b2 - 3.*(a2/a2den)) + (18.)*(a1**2)*(a2*a2fac)*(b2 - 3.*(a2*a2fac)) Req = -aeh/aem Rsl = (auh + aum*Req)/(3.*adh + 3.*adm*Req) @@ -1803,23 +1908,23 @@ SUBROUTINE mym_turbulence ( & !e2 = q3sq - e2c*ghel * qdiv**2 !e3 = q3sq + e3c*ghel * qdiv**2 !e4 = q3sq - e4c*ghel * qdiv**2 - e2 = q3sq - e2c*ghel/a2den * qdiv**2 - e3 = q3sq + e3c*ghel/(a2den**2) * qdiv**2 - e4 = q3sq - e4c*ghel/a2den * qdiv**2 + e2 = q3sq - e2c*ghel*a2fac * qdiv**2 + e3 = q3sq + e3c*ghel*a2fac**2 * qdiv**2 + e4 = q3sq - e4c*ghel*a2fac * qdiv**2 eden = e2*e4 + e3 *e5c*gmel * qdiv**2 !JOE-Canuto/Kitamura mod !wden = cc3*gtr**2 * dlsq**2/elsq * qdiv**2 & ! & *( e2*e4c - e3c*e5c*gmel * qdiv**2 ) wden = cc3*gtr**2 * dlsq**2/elsq * qdiv**2 & - & *( e2*e4c/a2den - e3c*e5c*gmel/(a2den**2) * qdiv**2 ) + & *( e2*e4c*a2fac - e3c*e5c*gmel*a2fac**2 * qdiv**2 ) IF ( wden .NE. 0.0 ) THEN !JOE: test dynamic limits - !clow = q3sq*( 0.12-cw25 )*eden/wden - !cupp = q3sq*( 0.76-cw25 )*eden/wden - clow = q3sq*( Rsl -cw25 )*eden/wden - cupp = q3sq*( Rsl2-cw25 )*eden/wden + clow = q3sq*( 0.12-cw25 )*eden/wden + cupp = q3sq*( 0.76-cw25 )*eden/wden + !clow = q3sq*( Rsl -cw25 )*eden/wden + !cupp = q3sq*( Rsl2-cw25 )*eden/wden ! IF ( wden .GT. 0.0 ) THEN c3sq = MIN( MAX( c3sq, c2sq+clow ), c2sq+cupp ) @@ -1834,7 +1939,7 @@ SUBROUTINE mym_turbulence ( & !JOE-Canuto/Kitamura mod !e6c = 3.0*a2*cc3*gtr * dlsq/elsq - e6c = 3.0*(a2/a2den)*cc3*gtr * dlsq/elsq + e6c = 3.0*(a2*a2fac)*cc3*gtr * dlsq/elsq !============================ ! ** for Gamma_theta ** @@ -1863,8 +1968,8 @@ SUBROUTINE mym_turbulence ( & !JOE-Canuto/Kitamura mod !smd = dlsq*enum*gtr/eden * qdiv**2 * (e3c+e4c)*a1/a2 - smd = dlsq*enum*gtr/eden * qdiv**2 * (e3c/(a2den**2) + & - & e4c/a2den)*a1/(a2/a2den) + smd = dlsq*enum*gtr/eden * qdiv**2 * (e3c*a2fac**2 + & + & e4c*a2fac)*a1/(a2*a2fac) gamv = e1 *enum*gtr/eden sm(k) = sm(k) +smd @@ -1899,9 +2004,9 @@ SUBROUTINE mym_turbulence ( & cldavg = 0.5*(cldfra_bl1D(k-1) + cldfra_bl1D(k)) IF (edmf_a1(k) > 0.001 .OR. cldavg > 0.02) THEN cldavg = 0.5*(cldfra_bl1D(k-1) + cldfra_bl1D(k)) - !sm(k) = MAX(sm(k), MAX(1.0 - 2.0*cldavg, 0.0)**0.33 * 0.03 * & + !sm(k) = MAX(sm(k), MAX(1.0 - 2.0*cldavg, 0.0)**0.33 * 0.03 * & ! & MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) - !sh(k) = MAX(sh(k), MAX(1.0 - 2.0*cldavg, 0.0)**0.33 * 0.03 * & + !sh(k) = MAX(sh(k), MAX(1.0 - 2.0*cldavg, 0.0)**0.33 * 0.03 * & ! & MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) ! for mass-flux columns @@ -1910,7 +2015,6 @@ SUBROUTINE mym_turbulence ( & ! for clouds sm(k) = MAX(sm(k), 0.03*MIN(cldavg,1.0) ) sh(k) = MAX(sh(k), 0.03*MIN(cldavg,1.0) ) - ENDIF ! elq = el(k)*qkw(k) @@ -1919,8 +2023,8 @@ SUBROUTINE mym_turbulence ( & ! Production of TKE (pdk), T-variance (pdt), ! q-variance (pdq), and covariance (pdc) pdk(k) = elq*( sm(k)*gm(k) & - & +sh(k)*gh(k)+gamv ) + & ! JAYMES TKE - & TKEprodTD(k) ! JOE-top-down + & +sh(k)*gh(k)+gamv ) + & + & TKEprodTD(k) pdt(k) = elh*( sh(k)*dtl(k)+gamt )*dtl(k) pdq(k) = elh*( sh(k)*dqw(k)+gamq )*dqw(k) pdc(k) = elh*( sh(k)*dtl(k)+gamt )& @@ -1942,41 +2046,34 @@ SUBROUTINE mym_turbulence ( & IF ( bl_mynn_tkebudget == 1) THEN !TKE BUDGET - dudz = ( u(k)-u(k-1) )/dzk - dvdz = ( v(k)-v(k-1) )/dzk - dTdz = ( thl(k)-thl(k-1) )/dzk - - upwp = -elq*sm(k)*dudz - vpwp = -elq*sm(k)*dvdz - Tpwp = -elq*sh(k)*dTdz - Tpwp = SIGN(MAX(ABS(Tpwp),1.E-6),Tpwp) - - IF ( k .EQ. kts+1 ) THEN - qWT1D(kts)=0. - q3sq_old =0. - qWTP_old =0. - !** Limitation on q, instead of L/q ** - dlsq1 = MAX(el(kts)**2,1.0) - IF ( q3sq_old/dlsq1 .LT. -gh(k) ) q3sq_old = -dlsq1*gh(k) - ENDIF +! dudz = ( u(k)-u(k-1) )/dzk +! dvdz = ( v(k)-v(k-1) )/dzk +! dTdz = ( thl(k)-thl(k-1) )/dzk + +! upwp = -elq*sm(k)*dudz +! vpwp = -elq*sm(k)*dvdz +! Tpwp = -elq*sh(k)*dTdz +! Tpwp = SIGN(MAX(ABS(Tpwp),1.E-6),Tpwp) - !!!Vertical Transport Term - qWTP_new = elq*Sqfac*sm(k)*(q3sq - q3sq_old)/dzk - qWT1D(k) = 0.5*(qWTP_new - qWTP_old)/dzk - qWTP_old = elq*Sqfac*sm(k)*(q3sq - q3sq_old)/dzk - q3sq_old = q3sq + +!! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB !!!Shear Term !!!qSHEAR1D(k)=-(upwp*dudz + vpwp*dvdz) - qSHEAR1D(k) = elq*sm(k)*gm(k) + qSHEAR1D(k) = elq*sm(k)*gm(k) !staggered !!!Buoyancy Term !!!qBUOY1D(k)=g*Tpwp/thl(k) !qBUOY1D(k)= elq*(sh(k)*gh(k) + gamv) - qBUOY1D(k) = elq*(sh(k)*(-dTdz*g/thl(k)) + gamv) + !qBUOY1D(k) = elq*(sh(k)*(-dTdz*g/thl(k)) + gamv) !! ORIGINAL CODE + + !! Buoyncy term takes the TKEprodTD(k) production now + qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered - !!!Dissipation Term - qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) + !!!Dissipation Term (now it evaluated on mym_predict) + !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE + + !! >> EOB ENDIF END DO @@ -1999,13 +2096,6 @@ SUBROUTINE mym_turbulence ( & END DO ! - IF ( bl_mynn_tkebudget == 1) THEN - !JOE-TKE BUDGET - qWT1D(kts)=0. - qSHEAR1D(kts)=qSHEAR1D(kts+1) - qBUOY1D(kts)=qBUOY1D(kts+1) - qDISS1D(kts)=qDISS1D(kts+1) - ENDIF if (spp_pbl==1) then DO k = kts,kte @@ -2069,15 +2159,15 @@ END SUBROUTINE mym_turbulence !>\ingroup gsd_mynn_edmf !! This subroutine predicts the turbulent quantities at the next step. SUBROUTINE mym_predict (kts,kte, & - & levflag, & + & closure, & & delt, & & dz, & & ust, flt, flq, pmz, phh, & - & el, dfq, & + & el, dfq, rho, & & pdk, pdt, pdq, pdc, & & qke, tsq, qsq, cov, & - & s_aw,s_awqke,bl_mynn_edmf_tke & - &) + & s_aw,s_awqke,bl_mynn_edmf_tke, & + & qWT1D, qDISS1D,bl_mynn_tkebudget) !! TKE budget (Puhales, 2020) !------------------------------------------------------------------- INTEGER, INTENT(IN) :: kts,kte @@ -2087,22 +2177,30 @@ SUBROUTINE mym_predict (kts,kte, & # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: levflag + REAL, INTENT(IN) :: closure INTEGER, INTENT(IN) :: bl_mynn_edmf_tke REAL, INTENT(IN) :: delt - REAL, DIMENSION(kts:kte), INTENT(IN) :: dz, dfq,el + REAL, DIMENSION(kts:kte), INTENT(IN) :: dz, dfq, el, rho REAL, DIMENSION(kts:kte), INTENT(INOUT) :: pdk, pdt, pdq, pdc REAL, INTENT(IN) :: flt, flq, ust, pmz, phh REAL, DIMENSION(kts:kte), INTENT(INOUT) :: qke,tsq, qsq, cov ! WA 8/3/15 REAL, DIMENSION(kts:kte+1), INTENT(INOUT) :: s_awqke,s_aw - + + !! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB + REAL, DIMENSION(kts:kte), INTENT(OUT) :: qWT1D, qDISS1D + INTEGER, INTENT(IN) :: bl_mynn_tkebudget + REAL, DIMENSION(kts:kte) :: tke_up,dzinv + !! >> EOB + INTEGER :: k REAL, DIMENSION(kts:kte) :: qkw, bp, rp, df3q REAL :: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff REAL, DIMENSION(kts:kte) :: dtz REAL, DIMENSION(kts:kte) :: a,b,c,d,x + REAL, DIMENSION(kts:kte) :: rhoinv + REAL, DIMENSION(kts:kte+1) :: rhoz,kqdz,kmdz ! REGULATE THE MOMENTUM MIXING FROM THE MASS-FLUX SCHEME (on or off) IF (bl_mynn_edmf_tke == 0) THEN @@ -2123,6 +2221,33 @@ SUBROUTINE mym_predict (kts,kte, & dtz(k)=delt/dz(k) END DO ! +!JOE-add conservation + stability criteria + !Prepare "constants" for diffusion equation. + !khdz = rho*Kh/dz = rho*dfh + rhoz(kts) =rho(kts) + rhoinv(kts)=1./rho(kts) + kqdz(kts) =rhoz(kts)*df3q(kts) + kmdz(kts) =rhoz(kts)*dfq(kts) + DO k=kts+1,kte + rhoz(k) =(rho(k)*dz(k-1) + rho(k-1)*dz(k))/(dz(k-1)+dz(k)) + rhoz(k) = MAX(rhoz(k),1E-4) + rhoinv(k)=1./MAX(rho(k),1E-4) + kqdz(k) = rhoz(k)*df3q(k) ! for TKE + kmdz(k) = rhoz(k)*dfq(k) ! for T'2, q'2, and T'q' + ENDDO + rhoz(kte+1)=rhoz(kte) + kqdz(kte+1)=rhoz(kte+1)*df3q(kte) + kmdz(kte+1)=rhoz(kte+1)*dfq(kte) + + !stability criteria for mf + DO k=kts+1,kte-1 + kqdz(k) = MAX(kqdz(k), 0.5*rho(k)* s_aw(k)) + kqdz(k) = MAX(kqdz(k), -0.5*rho(k)*(s_aw(k)-s_aw(k+1))) + kmdz(k) = MAX(kmdz(k), 0.5*rho(k)* s_aw(k)) + kmdz(k) = MAX(kmdz(k), -0.5*rho(k)*(s_aw(k)-s_aw(k+1))) + ENDDO +!JOE-end conservation mods + pdk1 = 2.0*ust**3*pmz/( vkz ) phm = 2.0/ust *phh/( vkz ) pdt1 = phm*flt**2 @@ -2159,11 +2284,17 @@ SUBROUTINE mym_predict (kts,kte, & ! c(k-kts+1)=-dtz(k)*df3q(k+1) ! d(k-kts+1)=rp(k)*delt + qke(k) ! WA 8/3/15 add EDMF contribution - a(k-kts+1)=-dtz(k)*df3q(k) + 0.5*dtz(k)*s_aw(k)*onoff - b(k-kts+1)=1. + dtz(k)*(df3q(k)+df3q(k+1)) & - + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff + bp(k)*delt - c(k-kts+1)=-dtz(k)*df3q(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(k-kts+1)=rp(k)*delt + qke(k) + dtz(k)*(s_awqke(k)-s_awqke(k+1))*onoff +! a(k)= - dtz(k)*df3q(k) + 0.5*dtz(k)*s_aw(k)*onoff +! b(k)=1. + dtz(k)*(df3q(k)+df3q(k+1)) & +! + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff + bp(k)*delt +! c(k)= - dtz(k)*df3q(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff +! d(k)=rp(k)*delt + qke(k) + dtz(k)*(s_awqke(k)-s_awqke(k+1))*onoff +!JOE 8/22/20 improve conservation + a(k)= - dtz(k)*kqdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*onoff + b(k)=1. + dtz(k)*(kqdz(k)+kqdz(k+1))*rhoinv(k) & + & + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff + bp(k)*delt + c(k)= - dtz(k)*kqdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff + d(k)=rp(k)*delt + qke(k) + dtz(k)*(s_awqke(k)-s_awqke(k+1))*onoff ENDDO !! DO k=kts+1,kte-1 @@ -2184,46 +2315,52 @@ SUBROUTINE mym_predict (kts,kte, & DO k=kts,kte ! qke(k)=max(d(k-kts+1), 1.e-4) qke(k)=max(x(k), 1.e-4) + qke(k)=min(qke(k), 150.) ENDDO + +!! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB + IF (bl_mynn_tkebudget == 1) THEN + !! TKE Vertical transport << EOBvt + tke_up=0.5*qke + dzinv=1./dz + k=kts + qWT1D(k)=dzinv(k)*((kqdz(k+1)*(tke_up(k+1)-tke_up(k))-kqdz(k)*tke_up(k))+& + 0.5*(s_aw(k+1)*tke_up(k+1)+(s_aw(k+1)-s_aw(k))*tke_up(k)+(s_awqke(k)-s_awqke(k+1)))*onoff) !unstaggered + DO k=kts+1,kte-1 + qWT1D(k)=dzinv(k)*((kqdz(k+1)*(tke_up(k+1)-tke_up(k))-kqdz(k)*(tke_up(k)-tke_up(k-1)))+& + 0.5*(s_aw(k+1)*tke_up(k+1)+(s_aw(k+1)-s_aw(k))*tke_up(k)-s_aw(k)*tke_up(k-1)+(s_awqke(k)-s_awqke(k+1)))*onoff) !unstaggered + ENDDO + k=kte + qWT1D(k)=dzinv(k)*(-kqdz(k)*(tke_up(k)-tke_up(k-1))+0.5*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggered + !! >> EOBvt + qDISS1D=bp*tke_up !! TKE dissipation rate !unstaggered + END IF +!! >> EOB + + IF ( closure > 2.5 ) THEN - IF ( levflag .EQ. 3 ) THEN -! -! Modified: Dec/22/2005, from here -! ** dfq for the scalar variance is 1.0*dfm. ** -! CALL coefvu ( dfq, 1.0 ) make change here -! Modified: Dec/22/2005, up to here -! -! ** Prediction of the temperature variance ** -!! DO k = kts+1,kte-1 + ! ** Prediction of the moisture variance ** DO k = kts,kte-1 b2l = b2*0.5*( el(k+1)+el(k) ) bp(k) = 2.*qkw(k) / b2l - rp(k) = pdt(k+1) + pdt(k) + rp(k) = pdq(k+1) +pdq(k) END DO - -!zero gradient for tsq at bottom and top - -!! a(1)=0. -!! b(1)=1. -!! c(1)=-1. -!! d(1)=0. -! Since dfq(kts)=0.0, a(1)=0.0 and b(1)=1.+dtz(k)*dfq(k+1)+bp(k)*delt. + !zero gradient for qsq at bottom and top + !a(1)=0. + !b(1)=1. + !c(1)=-1. + !d(1)=0. + + ! Since dfq(kts)=0.0, a(1)=0.0 and b(1)=1.+dtz(k)*dfq(k+1)+bp(k)*delt. DO k=kts,kte-1 - a(k-kts+1)=-dtz(k)*dfq(k) - b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1))+bp(k)*delt - c(k-kts+1)=-dtz(k)*dfq(k+1) - d(k-kts+1)=rp(k)*delt + tsq(k) + a(k)= - dtz(k)*kmdz(k)*rhoinv(k) + b(k)=1. + dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + bp(k)*delt + c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) + d(k)=rp(k)*delt + qsq(k) ENDDO -!! DO k=kts+1,kte-1 -!! a(k-kts+1)=-dtz(k)*dfq(k) -!! b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1)) -!! c(k-kts+1)=-dtz(k)*dfq(k+1) -!! d(k-kts+1)=rp(k)*delt + tsq(k) - tsq(k)*bp(k)*delt -!! ENDDO - a(kte)=-1. !0. b(kte)=1. c(kte)=0. @@ -2233,19 +2370,36 @@ SUBROUTINE mym_predict (kts,kte, & CALL tridiag2(kte,a,b,c,d,x) DO k=kts,kte -! tsq(k)=d(k-kts+1) - tsq(k)=x(k) + !qsq(k)=d(k-kts+1) + qsq(k)=MAX(x(k),1e-12) ENDDO - -! ** Prediction of the moisture variance ** + ELSE + !level 2.5 - use level 2 diagnostic + DO k = kts,kte-1 + IF ( qkw(k) .LE. 0.0 ) THEN + b2l = 0.0 + ELSE + b2l = b2*0.25*( el(k+1)+el(k) )/qkw(k) + END IF + qsq(k) = b2l*( pdq(k+1)+pdq(k) ) + END DO + qsq(kte)=qsq(kte-1) + END IF +!!!!!!!!!!!!!!!!!!!!!!end level 2.6 + + IF ( closure .GE. 3.0 ) THEN +! +! ** dfq for the scalar variance is 1.0*dfm. ** +! +! ** Prediction of the temperature variance ** !! DO k = kts+1,kte-1 DO k = kts,kte-1 b2l = b2*0.5*( el(k+1)+el(k) ) bp(k) = 2.*qkw(k) / b2l - rp(k) = pdq(k+1) +pdq(k) + rp(k) = pdt(k+1) + pdt(k) END DO -!zero gradient for qsq at bottom and top +!zero gradient for tsq at bottom and top !! a(1)=0. !! b(1)=1. @@ -2254,17 +2408,22 @@ SUBROUTINE mym_predict (kts,kte, & ! Since dfq(kts)=0.0, a(1)=0.0 and b(1)=1.+dtz(k)*dfq(k+1)+bp(k)*delt. DO k=kts,kte-1 - a(k-kts+1)=-dtz(k)*dfq(k) - b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1))+bp(k)*delt - c(k-kts+1)=-dtz(k)*dfq(k+1) - d(k-kts+1)=rp(k)*delt + qsq(k) + !a(k-kts+1)=-dtz(k)*dfq(k) + !b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1))+bp(k)*delt + !c(k-kts+1)=-dtz(k)*dfq(k+1) + !d(k-kts+1)=rp(k)*delt + tsq(k) +!JOE 8/22/20 improve conservation + a(k)= - dtz(k)*kmdz(k)*rhoinv(k) + b(k)=1. + dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + bp(k)*delt + c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) + d(k)=rp(k)*delt + tsq(k) ENDDO !! DO k=kts+1,kte-1 !! a(k-kts+1)=-dtz(k)*dfq(k) !! b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1)) !! c(k-kts+1)=-dtz(k)*dfq(k+1) -!! d(k-kts+1)=rp(k)*delt + qsq(k) -qsq(k)*bp(k)*delt +!! d(k-kts+1)=rp(k)*delt + tsq(k) - tsq(k)*bp(k)*delt !! ENDDO a(kte)=-1. !0. @@ -2276,10 +2435,10 @@ SUBROUTINE mym_predict (kts,kte, & CALL tridiag2(kte,a,b,c,d,x) DO k=kts,kte -! qsq(k)=d(k-kts+1) - qsq(k)=x(k) +! tsq(k)=d(k-kts+1) + tsq(k)=x(k) ENDDO - + ! ** Prediction of the temperature-moisture covariance ** !! DO k = kts+1,kte-1 DO k = kts,kte-1 @@ -2297,10 +2456,15 @@ SUBROUTINE mym_predict (kts,kte, & ! Since dfq(kts)=0.0, a(1)=0.0 and b(1)=1.+dtz(k)*dfq(k+1)+bp(k)*delt. DO k=kts,kte-1 - a(k-kts+1)=-dtz(k)*dfq(k) - b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1))+bp(k)*delt - c(k-kts+1)=-dtz(k)*dfq(k+1) - d(k-kts+1)=rp(k)*delt + cov(k) + !a(k-kts+1)=-dtz(k)*dfq(k) + !b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1))+bp(k)*delt + !c(k-kts+1)=-dtz(k)*dfq(k+1) + !d(k-kts+1)=rp(k)*delt + cov(k) +!JOE 8/22/20 improve conservation + a(k)= - dtz(k)*kmdz(k)*rhoinv(k) + b(k)=1. + dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + bp(k)*delt + c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) + d(k)=rp(k)*delt + cov(k) ENDDO !! DO k=kts+1,kte-1 @@ -2324,7 +2488,8 @@ SUBROUTINE mym_predict (kts,kte, & ENDDO ELSE -!! DO k = kts+1,kte-1 + + !Not level 3 - default to level 2 diagnostic DO k = kts,kte-1 IF ( qkw(k) .LE. 0.0 ) THEN b2l = 0.0 @@ -2333,16 +2498,10 @@ SUBROUTINE mym_predict (kts,kte, & END IF ! tsq(k) = b2l*( pdt(k+1)+pdt(k) ) - qsq(k) = b2l*( pdq(k+1)+pdq(k) ) cov(k) = b2l*( pdc(k+1)+pdc(k) ) END DO -!! tsq(kts)=tsq(kts+1) -!! qsq(kts)=qsq(kts+1) -!! cov(kts)=cov(kts+1) - tsq(kte)=tsq(kte-1) - qsq(kte)=qsq(kte-1) cov(kte)=cov(kte-1) END IF @@ -2422,7 +2581,7 @@ SUBROUTINE mym_condensation (kts,kte, & cldfra_bl1D DOUBLE PRECISION :: t3sq, r3sq, c3sq - REAL :: qsl,esat,qsat,tlk,qsat_tl,dqsl,cld0,q1k,eq1,qll,& + REAL :: qsl,esat,qsat,tlk,qsat_tl,dqsl,cld0,q1k,qlk,eq1,qll,& &q2p,pt,rac,qt,t,xl,rsl,cpm,cdhdz,Fng,qww,alpha,beta,bb,& &ls_min,ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water,& &low_weight @@ -2430,13 +2589,14 @@ SUBROUTINE mym_condensation (kts,kte, & REAL :: erf - !JOE: NEW VARIABLES FOR ALTERNATE SIGMA + !VARIABLES FOR ALTERNATIVE SIGMA REAL::dth,dtl,dqw,dzk,els REAL, DIMENSION(kts:kte), INTENT(IN) :: Sh,el - !JOE: variables for BL clouds - REAL::zagl,damp,PBLH2,ql_limit + !variables for SGS BL clouds + REAL :: zagl,damp,PBLH2 REAL :: lfac + INTEGER, PARAMETER :: sig_order = 1 !sigma form, 1: use state variables, 2: higher-order variables !JAYMES: variables for tropopause-height estimation REAL :: theta1, theta2, ht1, ht2 @@ -2511,6 +2671,7 @@ SUBROUTINE mym_condensation (kts,kte, & !CLOUD FRACTION. rr2 = 1/SQRT(2) = 0.707 cldfra_bl1D(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + q1k = q1(k) eq1 = rrp*EXP( -0.5*q1k*q1k ) qll = MAX( cldfra_bl1D(k)*q1k + eq1, 0.0 ) !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) @@ -2523,7 +2684,7 @@ SUBROUTINE mym_condensation (kts,kte, & if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 - !Now estimate the buiyancy flux functions + !Now estimate the buoyancy flux functions q2p = xlvcp/exner(k) pt = thl(k) +q2p*ql(k) ! potential temp @@ -2583,7 +2744,7 @@ SUBROUTINE mym_condensation (kts,kte, & if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 - !Now estimate the buiyancy flux functions + !Now estimate the buoyancy flux functions q2p = xlvcp/exner(k) pt = thl(k) +q2p*ql(k) ! potential temp @@ -2600,84 +2761,147 @@ SUBROUTINE mym_condensation (kts,kte, & END DO CASE (2, -2) - !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS - !JAYMES- this added 27 Apr 2015 - PBLH2=MAX(10.,PBLH1) - zagl = 0. - DO k = kts,kte-1 - t = th(k)*exner(k) - !SATURATED VAPOR PRESSURE - esat = esat_blend(t) - !SATURATED SPECIFIC HUMIDITY - !qsl=ep_2*esat/(p(k)-ep_3*esat) - qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) - !dqw/dT: Clausius-Clapeyron - dqsl = qsl*ep_2*ev/( rd*t**2 ) - !RH (0 to 1.0) - RH(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsl)),0.001) - - alp(k) = 1.0/( 1.0+dqsl*xlvcp ) - bet(k) = dqsl*exner(k) - xl = xl_blend(t) ! obtain latent heat - tlk = thl(k)*(p(k)/p1000mb)**rcp ! recover liquid temp (tl) from thl - qsat_tl = qsat_blend(tlk,p(k)) ! get saturation water vapor mixing ratio - ! at tl and p - rsl = xl*qsat_tl / (r_v*tlk**2) ! slope of C-C curve at t = tl - ! CB02, Eqn. 4 - cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 - a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - !SPP - qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) - !qmq(k) = a(k) * (qw(k) - qsat_tl) ! saturation deficit/excess; + if (sig_order == 1) then + !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS + !using the first-order version of sigma (their eq. 5). + !JAYMES- this added 27 Apr 2015 + PBLH2=MAX(10.,PBLH1) + zagl = 0. + DO k = kts,kte-1 + t = th(k)*exner(k) + !SATURATED VAPOR PRESSURE + esat = esat_blend(t) + !SATURATED SPECIFIC HUMIDITY + !qsl=ep_2*esat/(p(k)-ep_3*esat) + qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) + !dqw/dT: Clausius-Clapeyron + dqsl = qsl*ep_2*ev/( rd*t**2 ) + !RH (0 to 1.0) + RH(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsl)),0.001) + + alp(k) = 1.0/( 1.0+dqsl*xlvcp ) + bet(k) = dqsl*exner(k) + + xl = xl_blend(t) ! obtain latent heat + tlk = thl(k)*(p(k)/p1000mb)**rcp ! recover liquid temp (tl) from thl + qsat_tl = qsat_blend(tlk,p(k)) ! get saturation water vapor mixing ratio + ! at tl and p + rsl = xl*qsat_tl / (r_v*tlk**2) ! slope of C-C curve at t = tl + ! CB02, Eqn. 4 + cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 + a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" + !SPP + qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) + !qmq(k) = a(k) * (qw(k) - qsat_tl) ! saturation deficit/excess; ! the numerator of Q1 - qmq(k) = a(k) * (qw_pert - qsat_tl) - b(k) = a(k)*rsl ! CB02 variable "b" - dtl = 0.5*(thl(k+1)*(p(k+1)/p1000mb)**rcp + tlk) & + qmq(k) = a(k) * (qw_pert - qsat_tl) + b(k) = a(k)*rsl ! CB02 variable "b" + + dtl = 0.5*(thl(k+1)*(p(k+1)/p1000mb)**rcp + tlk) & & - 0.5*(tlk + thl(MAX(k-1,kts))*(p(MAX(k-1,kts))/p1000mb)**rcp) - dqw = 0.5*(qw(k+1) + qw(k)) - 0.5*(qw(k) + qw(MAX(k-1,kts))) + dqw = 0.5*(qw(k+1) + qw(k)) - 0.5*(qw(k) + qw(MAX(k-1,kts))) - if (k .eq. kts) then - dzk = 0.5*dz(k) - else - dzk = dz(k) - end if + if (k .eq. kts) then + dzk = 0.5*dz(k) + else + dzk = dz(k) + end if - cdhdz = dtl/dzk + (g/cpm)*(1.+qw(k)) ! expression below Eq. 9 + cdhdz = dtl/dzk + (g/cpm)*(1.+qw(k)) ! expression below Eq. 9 ! in CB02 - zagl = zagl + dz(k) - !Use analog to surface layer length scale to make the cloud mixing length scale - !become less than z in stable conditions. - els = zagl !save for more testing: /(1.0 + 1.0*MIN( 0.5*dz(1)*MAX(rmo,0.0), 1. )) - - !ls_min = 300. + MIN(3.*MAX(HFX1,0.),300.) - ls_min = 300. + MIN(2.*MAX(HFX1,0.),150.) - ls_min = MIN(MAX(els,25.),ls_min) ! Let this be the minimum possible length scale: - if (zagl > PBLH1+2000.) ls_min = MAX(ls_min + 0.5*(PBLH1+2000.-zagl),300.) - ! 25 m < ls_min(=zagl) < 300 m - lfac=MIN(4.25+dx/4000.,6.) ! A dx-dependent multiplier for the master length scale: - ! lfac(750 m) = 4.4 - ! lfac(3 km) = 5.0 - ! lfac(13 km) = 6.0 - ls = MAX(MIN(lfac*el(k),600.),ls_min) ! Bounded: ls_min < ls < 600 m - ! Note: CB02 use 900 m as a constant free-atmosphere length scale. - - ! Above 300 m AGL, ls_min remains 300 m. For dx = 3 km, the - ! MYNN master length scale (el) must exceed 60 m before ls - ! becomes responsive to el, otherwise ls = ls_min = 300 m. - - sgm(k) = MAX(1.e-10, 0.225*ls*SQRT(MAX(0., & ! Eq. 9 in CB02: - & (a(k)*dqw/dzk)**2 & ! < 1st term in brackets, - & -2*a(k)*b(k)*cdhdz*dqw/dzk & ! < 2nd term, - & +b(k)**2 * cdhdz**2))) ! < 3rd term - ! CB02 use a multiplier of 0.2, but 0.225 is chosen - ! based on tests - - q1(k) = qmq(k) / sgm(k) ! Q1, the normalized saturation - cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 - - END DO - + zagl = zagl + dz(k) + !Use analog to surface layer length scale to make the cloud mixing length scale + !become less than z in stable conditions. + els = zagl !save for more testing: /(1.0 + 1.0*MIN( 0.5*dz(1)*MAX(rmo,0.0), 1. )) + + !ls_min = 300. + MIN(3.*MAX(HFX1,0.),300.) + ls_min = 300. + MIN(2.*MAX(HFX1,0.),150.) + ls_min = MIN(MAX(els,25.),ls_min) ! Let this be the minimum possible length scale: + if (zagl > PBLH1+2000.) ls_min = MAX(ls_min + 0.5*(PBLH1+2000.-zagl),300.) + ! 25 m < ls_min(=zagl) < 300 m + lfac=MIN(4.25+dx/4000.,6.) ! A dx-dependent multiplier for the master length scale: + ! lfac(750 m) = 4.4 + ! lfac(3 km) = 5.0 + ! lfac(13 km) = 6.0 + ls = MAX(MIN(lfac*el(k),600.),ls_min) ! Bounded: ls_min < ls < 600 m + ! Note: CB02 use 900 m as a constant free-atmosphere length scale. + + ! Above 300 m AGL, ls_min remains 300 m. For dx = 3 km, the + ! MYNN master length scale (el) must exceed 60 m before ls + ! becomes responsive to el, otherwise ls = ls_min = 300 m. + + sgm(k) = MAX(1.e-10, 0.225*ls*SQRT(MAX(0., & ! Eq. 9 in CB02: + & (a(k)*dqw/dzk)**2 & ! < 1st term in brackets, + & -2*a(k)*b(k)*cdhdz*dqw/dzk & ! < 2nd term, + & +b(k)**2 * cdhdz**2))) ! < 3rd term + ! CB02 use a multiplier of 0.2, but 0.225 is chosen + ! based on tests + + q1(k) = qmq(k) / sgm(k) ! Q1, the normalized saturation + cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 + END DO + + else + + !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS + !but with use of higher-order moments to estimate sigma + PBLH2=MAX(10.,PBLH1) + zagl = 0. + DO k = kts,kte-1 + t = th(k)*exner(k) + !SATURATED VAPOR PRESSURE + esat = esat_blend(t) + !SATURATED SPECIFIC HUMIDITY + !qsl=ep_2*esat/(p(k)-ep_3*esat) + qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) + !dqw/dT: Clausius-Clapeyron + dqsl = qsl*ep_2*ev/( rd*t**2 ) + !RH (0 to 1.0) + RH(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsl)),0.001) + + alp(k) = 1.0/( 1.0+dqsl*xlvcp ) + bet(k) = dqsl*exner(k) + + xl = xl_blend(t) ! obtain latent heat + tlk = thl(k)*(p(k)/p1000mb)**rcp ! recover liquid temp (tl) from thl + qsat_tl = qsat_blend(tlk,p(k)) ! get saturation water vapor mixing ratio + ! at tl and p + rsl = xl*qsat_tl / (r_v*tlk**2) ! slope of C-C curve at t = tl + ! CB02, Eqn. 4 + cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 + a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" + b(k) = a(k)*rsl ! CB02 variable "b" + + !SPP + qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) + + !This form of qmq (the numerator of Q1) no longer uses the a(k) factor + qmq(k) = qw_pert - qsat_tl ! saturation deficit/excess; + + !Use the form of Eq. (6) in Chaboureau and Bechtold (2002) + !except neglect all but the first term for sig_r + r3sq = MAX( qsq(k), 0.0 ) + !Calculate sigma using higher-order moments: + sgm(k) = SQRT( r3sq ) + !Set limits on sigma relative to saturation water vapor + sgm(k) = MIN( sgm(k), qsat_tl*0.666 ) !500 ) + sgm(k) = MAX( sgm(k), qsat_tl*0.050 ) !Note: 0.02 results in SWDOWN similar + !to the first-order version of sigma + q1(k) = qmq(k) / sgm(k) ! Q1, the normalized saturation + + !Original C-B cloud fraction, allows cloud fractions out to q1 = -3.5 + cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 + !This form only allows cloud fractions out to q1 = -1.8 + !cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.41*ATAN(1.55*q1(k)))) + !This form only allows cloud fractions out to q1 = -1 + !cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.50*ATAN(1.55*q1(k)))) + + END DO + + endif !end sig_order option + + ! Specify hydrometeors ! JAYMES- this option added 8 May 2015 ! The cloud water formulations are taken from CB02, Eq. 8. ! "fng" represents the non-Gaussian contribution to the liquid @@ -2691,7 +2915,7 @@ SUBROUTINE mym_condensation (kts,kte, & zagl = zagl + dz(k) !CLOUD WATER AND ICE - IF (q1k < 0.) THEN !unstaurated + IF (q1k < 0.) THEN !unsaturated ql_water = sgm(k)*EXP(1.2*q1k-1) ql_ice = sgm(k)*EXP(1.2*q1k-1.) !Reduce ice mixing ratios in the upper troposphere @@ -2700,24 +2924,28 @@ SUBROUTINE mym_condensation (kts,kte, & ! + (1.-low_weight) * sgm(k)*EXP(1.1*q1k-2.8)!upper-lev ELSE IF (q1k > 2.) THEN !supersaturated ql_water = sgm(k)*q1k - ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*q1k + ql_ice = sgm(k)*q1k + !ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*q1k ELSE !slightly saturated (0 > q1 < 2) ql_water = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) + ql_ice = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) + !ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) ENDIF !In saturated grid cells, use average of current estimate and prev time step IF ( qc(k) > 1.e-7 ) ql_water = 0.5 * ( ql_water + qc(k) ) IF ( qi(k) > 1.e-9 ) ql_ice = 0.5 * ( ql_ice + qi(k) ) - IF (cldfra_bl1D(K) < 0.005) THEN + IF (cldfra_bl1D(k) < 0.01) THEN ql_ice = 0.0 ql_water = 0.0 + cldfra_bl1D(k) = 0.0 ENDIF - !PHASE PARTITIONING: Make some inferences about the relative amounts of subgrid cloud water vs. ice - !based on collocated explicit clouds. Otherise, use a simple temperature-dependent partitioning. - IF ( qc(k) + qi(k) > 0.0 ) THEN ! explicit condensate exists, so attempt to retain its phase partitioning + !PHASE PARTITIONING: Make some inferences about the relative amounts of + !subgrid cloud water vs. ice based on collocated explicit clouds. Otherise, + !use a simple temperature-dependent partitioning. + IF ( qc(k) + qi(k) > 0.0 ) THEN ! explicit condensate exists, retain its phase partitioning IF ( qi(k) == 0.0 ) THEN ! explicit contains no ice; assume subgrid liquid liq_frac = 1.0 ELSE IF ( qc(k) == 0.0 ) THEN ! explicit contains no liquid; assume subgrid ice @@ -2744,8 +2972,12 @@ SUBROUTINE mym_condensation (kts,kte, & qc_bl1D(k) = 0. qi_bl1D(k) = 0. endif - - !Buoyancy-flux-related calculations follow... + ENDDO + + !Buoyancy-flux-related calculations follow... + DO k = kts,kte-1 + t = th(k)*exner(k) + ! "Fng" represents the non-Gaussian transport factor ! (non-dimensional) from Bechtold et al. 1995 ! (hereafter BCMT95), section 3(c). Their suggested @@ -2757,17 +2989,16 @@ SUBROUTINE mym_condensation (kts,kte, & !ELSE ! Fng = 1.-1.5*q1k !ENDIF - ! For purposes of the buoyancy flux in stratus, we will use Fng = 1 - !Fng = 1. - Q1(k)=MAX(Q1(k),-5.0) - IF (Q1(k) .GE. 1.0) THEN + !limiting to avoid mixing away stratus, was -5 + q1k=MAX(Q1(k),-1.0) + IF (q1k .GE. 1.0) THEN Fng = 1.0 - ELSEIF (Q1(k) .GE. -1.7 .AND. Q1(k) .LT. 1.0) THEN - Fng = EXP(-0.4*(Q1(k)-1.0)) - ELSEIF (Q1(k) .GE. -2.5 .AND. Q1(k) .LT. -1.7) THEN - Fng = 3.0 + EXP(-3.8*(Q1(k)+1.7)) + ELSEIF (q1k .GE. -1.7 .AND. q1k .LT. 1.0) THEN + Fng = EXP(-0.4*(q1k-1.0)) + ELSEIF (q1k .GE. -2.5 .AND. q1k .LT. -1.7) THEN + Fng = 3.0 + EXP(-3.8*(q1k+1.7)) ELSE - Fng = MIN(23.9 + EXP(-1.6*(Q1(k)+2.5)), 60.) + Fng = MIN(23.9 + EXP(-1.6*(q1k+2.5)), 60.) ENDIF Fng = MIN(Fng, 20.) @@ -2796,8 +3027,7 @@ SUBROUTINE mym_condensation (kts,kte, & !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.5 ) / 0.51 )**3.3 cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 cldfra_bl1D(K) = MIN( 1., cld_factor*cldfra_bl1D(K) ) - - END DO + ENDDO END SELECT !end cloudPDF option @@ -2816,7 +3046,6 @@ SUBROUTINE mym_condensation (kts,kte, & qc_bl1D(kte)=0. qi_bl1D(kte)=0. cldfra_bl1D(kte)=0. - RETURN #ifdef HARDCODE_VERTICAL @@ -2831,10 +3060,10 @@ END SUBROUTINE mym_condensation !! This subroutine solves for tendencies of U, V, \f$\theta\f$, qv, !! qc, and qi SUBROUTINE mynn_tendencies(kts,kte, & - &levflag,grav_settling, & + &closure,grav_settling, & &delt,dz,rho, & &u,v,th,tk,qv,qc,qi,qnc,qni, & - &p,exner, & + &psfc,p,exner, & &thl,sqv,sqc,sqi,sqw, & &qnwfa,qnifa,ozone, & &ust,flt,flq,flqv,flqc,wspd,qcg, & @@ -2849,6 +3078,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & &s_awu,s_awv, & &s_awqnc,s_awqni, & &s_awqnwfa,s_awqnifa, & + &sd_aw,sd_awthl,sd_awqt,sd_awqv, & + &sd_awqc,sd_awu,sd_awv, & &sub_thl,sub_sqv, & &sub_u,sub_v, & &det_thl,det_sqv,det_sqc, & @@ -2870,7 +3101,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(in) :: grav_settling,levflag + INTEGER, INTENT(in) :: grav_settling + REAL, INTENT(in) :: closure INTEGER, INTENT(in) :: bl_mynn_cloudmix,bl_mynn_mixqt,& bl_mynn_edmf,bl_mynn_edmf_mom, & bl_mynn_mixscalars @@ -2887,7 +3119,9 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! mass-flux plumes REAL, DIMENSION(kts:kte+1), INTENT(in) :: s_aw,s_awthl,s_awqt,& - &s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv,s_awqnwfa,s_awqnifa + &s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & + &s_awqnwfa,s_awqnifa, & + &sd_aw,sd_awthl,sd_awqt,sd_awqv,sd_awqc,sd_awu,sd_awv ! tendencies from mass-flux environmental subsidence and detrainment REAL, DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & &sub_u,sub_v,det_thl,det_sqv,det_sqc,det_u,det_v @@ -2897,14 +3131,14 @@ SUBROUTINE mynn_tendencies(kts,kte, & &qnwfa,qnifa,ozone,dfm,dfh REAL, DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv,dqc,dqi,& &dqni,dqnc,dqnwfa,dqnifa,dozone - REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,wspd,uoce,voce,qcg + REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,wspd,uoce,voce,qcg,psfc ! REAL, INTENT(IN) :: delt,ust,flt,flq,qcg,& ! &gradu_top,gradv_top,gradth_top,gradqv_top !local vars - REAL, DIMENSION(kts:kte) :: dtz,vt,vq,dfhc,dfmc !Kh for clouds (Pr < 2) + REAL, DIMENSION(kts:kte) :: dtz,dfhc,dfmc !Kh for clouds (Pr < 2) REAL, DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqw2,qni2,qnc2, & !AFTER MIXING qnwfa2,qnifa2,ozone2 REAL, DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv @@ -2913,12 +3147,13 @@ SUBROUTINE mynn_tendencies(kts,kte, & & khdz, kmdz REAL :: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw REAL :: grav_settling2,vdfg1 !Katata-fogdes - REAL :: t,esat,qsl,onoff,kh,km,dzk + REAL :: t,esat,qsl,onoff,kh,km,dzk,rhosfc + REAL :: ustdrag,ustdiff INTEGER :: k,kk !Activate nonlocal mixing from the mass-flux scheme for - !scalars (0.0 = no; 1.0 = yes) - REAL, PARAMETER :: nonloc = 0.0 + !number concentrations and aerosols (0.0 = no; 1.0 = yes) + REAL, PARAMETER :: nonloc = 1.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -2933,6 +3168,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & !Prepare "constants" for diffusion equation. !khdz = rho*Kh/dz = rho*dfh + rhosfc = psfc/(Rd*(Tk(kts)+0.608*qv(kts))) dtz(kts) =delt/dz(kts) rhoz(kts) =rho(kts) rhoinv(kts)=1./rho(kts) @@ -2959,46 +3195,43 @@ SUBROUTINE mynn_tendencies(kts,kte, & kmdz(k) = MAX(kmdz(k), -0.5*rho(k)*(s_aw(k)-s_aw(k+1))) ENDDO + ustdrag = MIN(ust*ust,0.99)/wspd ! limit at ~ 20 m/s + ustdiff = MIN(ust*ust,0.01)/wspd ! limit at ~ 2 m/s + !!============================================ !! u !!============================================ k=kts +!original approach ! a(1)=0. ! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff ! c(1)=-dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff ! d(1)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & ! sub_u(k)*delt + det_u(k)*delt -! -! DO k=kts+1,kte-1 -! a(k)= - dtz(k)*dfm(k) + 0.5*dtz(k)*s_aw(k)*onoff -! b(k)=1. + dtz(k)*(dfm(k)+dfm(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff -! c(k)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(k)=u(k) + dtz(k)*(s_awu(k)-s_awu(k+1))*onoff + & -! sub_u(k)*delt + det_u(k)*delt -! ENDDO !rho-weighted: +! a(k)= -dtz(k)*kmdz(k)*rhoinv(k) +! b(k)=1.+dtz(k)*(kmdz(k+1)+ust**2/wspd)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff +! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff +! d(k)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & +! & sub_u(k)*delt + det_u(k)*delt + +!rho-weighted with drag term moved out of b-array a(k)= -dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(kmdz(k+1)+ust**2/wspd)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & - & sub_u(k)*delt + det_u(k)*delt - -!!JOE - tend test -!! a(k)=0. -!! b(k)=1.+dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff -!! c(k) =-dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff -!! d(k)=u(k)*(1.-ust**2/wspd*dtz(k)) + & -!! dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + b(k)=1.+dtz(k)*(kmdz(k+1))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*sd_aw(k+1)*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*sd_aw(k+1)*onoff + d(k)=u(k)*(1.-ust**2/wspd*dtz(k)*rhosfc/rho(k)) + dtz(k)*uoce*ust**2/wspd - & + !d(k)=u(k)*(1.-ust**2/wspd*dtz(k)) + dtz(k)*uoce*ust**2/wspd - & + & dtz(k)*s_awu(k+1)*onoff - dtz(k)*sd_awu(k+1)*onoff + sub_u(k)*delt + det_u(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*onoff + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*onoff + 0.5*dtz(k)*sd_aw(k)*onoff b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*(s_awu(k)-s_awu(k+1))*onoff + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff + 0.5*dtz(k)*(sd_aw(k)-sd_aw(k+1))*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*sd_aw(k+1)*onoff + d(k)=u(k) + dtz(k)*(s_awu(k)-s_awu(k+1))*onoff + dtz(k)*(sd_awu(k)-sd_awu(k+1))*onoff + & & sub_u(k)*delt + det_u(k)*delt ENDDO @@ -3034,41 +3267,34 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts +!original approach ! a(1)=0. ! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff ! c(1)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -!! d(1)=v(k) ! d(1)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & ! sub_v(k)*delt + det_v(k)*delt -! -! DO k=kts+1,kte-1 -! a(k)= - dtz(k)*dfm(k) + 0.5*dtz(k)*s_aw(k)*onoff -! b(k)=1. + dtz(k)*(dfm(k)+dfm(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff -! c(k)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(k)=v(k) + dtz(k)*(s_awv(k)-s_awv(k+1))*onoff + & -! sub_v(k)*delt + det_v(k)*delt -! ENDDO !rho-weighted: +! a(k)= -dtz(k)*kmdz(k)*rhoinv(k) +! b(k)=1.+dtz(k)*(kmdz(k+1)+ust**2/wspd)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff +! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff +! d(k)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & +! & sub_v(k)*delt + det_v(k)*delt + +!rho-weighted with drag term moved out of b-array a(k)= -dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(kmdz(k+1)+ust**2/wspd)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & - & sub_v(k)*delt + det_v(k)*delt - -!!JOE - tend test -!! a(k)=0. -!! b(k)=1.+dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff -!! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff -!! d(k)=v(k)*(1.-ust**2/wspd*dtz(k)) + & -!! dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + b(k)=1.+dtz(k)*(kmdz(k+1))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*sd_aw(k+1)*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*sd_aw(k+1)*onoff + d(k)=v(k)*(1.-ust**2/wspd*dtz(k)*rhosfc/rho(k)) + dtz(k)*voce*ust**2/wspd - & + !d(k)=v(k)*(1.-ust**2/wspd*dtz(k)) + dtz(k)*voce*ust**2/wspd - & + & dtz(k)*s_awv(k+1)*onoff - dtz(k)*sd_awv(k+1)*onoff + sub_v(k)*delt + det_v(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*onoff + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*onoff + 0.5*dtz(k)*sd_aw(k)*onoff b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*(s_awv(k)-s_awv(k+1))*onoff + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff + 0.5*dtz(k)*(sd_aw(k)-sd_aw(k+1))*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*sd_aw(k+1)*onoff + d(k)=v(k) + dtz(k)*(s_awv(k)-s_awv(k+1))*onoff + dtz(k)*(sd_awv(k)-sd_awv(k+1))*onoff + & & sub_v(k)*delt + det_v(k)*delt ENDDO @@ -3120,21 +3346,22 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! & sub_thl(k)*delt + det_thl(k)*delt ! ENDDO -!rho-weighted: +!rho-weighted: a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt - dtz(k)*s_awthl(k+1) + & + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt - dtz(k)*s_awthl(k+1) -dtz(k)*sd_awthl(k+1) + & & diss_heat(k)*delt*dheat_opt + sub_thl(k)*delt + det_thl(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + 0.5*dtz(k)*sd_aw(k) b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - d(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) + & - & diss_heat(k)*delt*dheat_opt + & - & sub_thl(k)*delt + det_thl(k)*delt + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + 0.5*dtz(k)*(sd_aw(k)-sd_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + d(k)=thl(k) + tcd(k)*delt + & + & dtz(k)*(s_awthl(k)-s_awthl(k+1)) + dtz(k)*(sd_awthl(k)-sd_awthl(k+1)) + & + & diss_heat(k)*delt*dheat_opt + & + & sub_thl(k)*delt + det_thl(k)*delt ENDDO !! no flux at the top @@ -3190,16 +3417,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & !rho-weighted: a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) - dtz(k)*sd_awqt(k+1) DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + 0.5*dtz(k)*sd_aw(k) b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqw(k) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + 0.5*dtz(k)*(sd_aw(k)-sd_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + d(k)=sqw(k) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) + dtz(k)*(sd_awqt(k)-sd_awqt(k+1)) ENDDO !! no flux at the top @@ -3255,17 +3482,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & !rho-weighted: a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt - dtz(k)*s_awqc(k+1) + & + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt - dtz(k)*s_awqc(k+1) - dtz(k)*sd_awqc(k+1) + & & det_sqc(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + 0.5*dtz(k)*sd_aw(k) b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + 0.5*dtz(k)*(sd_aw(k)-sd_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + d(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + dtz(k)*(sd_awqc(k)-sd_awqc(k+1)) + & & det_sqc(k)*delt ENDDO @@ -3312,17 +3539,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & !rho-weighted: a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) + & + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) - dtz(k)*sd_awqv(k+1) + & & sub_sqv(k)*delt + det_sqv(k)*delt DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + 0.5*dtz(k)*sd_aw(k) b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + 0.5*dtz(k)*(sd_aw(k)-sd_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) - 0.5*dtz(k)*sd_aw(k+1) + d(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + dtz(k)*(sd_awqv(k)-sd_awqv(k+1)) + & & sub_sqv(k)*delt + det_sqv(k)*delt ENDDO @@ -3656,8 +3883,11 @@ SUBROUTINE mynn_tendencies(kts,kte, & !===================== DO k=kts,kte !Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt !mixing ratio - Dqv(k)=(sqv2(k) - sqv(k))/delt !spec humidity - !IF(-Dqv(k) > qv(k)) Dqv(k)=-qv(k) + Dqv(k)=(sqv2(k) - sqv(k))/delt !spec humidity + IF(Dqv(k)*delt + sqv(k) < 0.) THEN + !print*,' neg qv:',qsl,sqv(k),sqv2(k),sqc(k),sqi(k),tk(k) + Dqv(k)=-sqv(k)*0.99/delt + ENDIF ENDDO IF (bl_mynn_cloudmix > 0) THEN @@ -3738,6 +3968,15 @@ SUBROUTINE mynn_tendencies(kts,kte, & ENDDO ENDIF + !===================== + ! OZONE TENDENCY CHECK + !===================== + DO k=kts,kte + IF(Dozone(k)*delt + ozone(k) < 0.) THEN + Dozone(k)=-ozone(k)*0.99/delt + ENDIF + ENDDO + !=================== ! THETA TENDENCY !=================== @@ -3793,48 +4032,58 @@ END SUBROUTINE mynn_tendencies ! ================================================================== #if (WRF_CHEM == 1) -!>\ingroup gsd_mynn_edmf - SUBROUTINE mynn_mix_chem(kts,kte, & - levflag,grav_settling, & - delt,dz, & + SUBROUTINE mynn_mix_chem(kts,kte,i,j, & + grav_settling, & + delt,dz,pblh, & nchem, kdvel, ndvel, num_vert_mix, & chem1, vd1, & qnc,qni, & p,exner, & - thl,sqv,sqc,sqi,sqw, & + thl,sqv,sqc,sqi,sqw,rho, & ust,flt,flq,flqv,flqc,wspd,qcg, & - uoce,voce, & - tsq,qsq,cov, & tcd,qcd, & dfm,dfh,dfq, & s_aw, & s_awchem, & - bl_mynn_cloudmix) + bl_mynn_cloudmix, & + emis_ant_no, & + frp_mean, & + enh_vermix ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte - INTEGER, INTENT(in) :: grav_settling,levflag + INTEGER, INTENT(in) :: kts,kte,i,j + INTEGER, INTENT(in) :: grav_settling INTEGER, INTENT(in) :: bl_mynn_cloudmix REAL, DIMENSION(kts:kte), INTENT(IN) :: qni,qnc,& - &p,exner,dfm,dfh,dfq,dz,tsq,qsq,cov,tcd,qcd - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: thl,sqw,sqv,sqc,sqi - REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,wspd,uoce,voce,qcg + &p,exner,dfm,dfh,dfq,dz,tcd,qcd + REAL, DIMENSION(kts:kte), INTENT(INOUT) :: thl,sqw,sqv,sqc,sqi,rho + REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,qcg INTEGER, INTENT(IN ) :: nchem, kdvel, ndvel, num_vert_mix REAL, DIMENSION( kts:kte+1), INTENT(IN) :: s_aw REAL, DIMENSION( kts:kte, nchem ), INTENT(INOUT) :: chem1 REAL, DIMENSION( kts:kte+1,nchem), INTENT(IN) :: s_awchem - REAL, DIMENSION( ndvel ), INTENT(INOUT) :: vd1 - + REAL, DIMENSION( ndvel ), INTENT(IN) :: vd1 + REAL, INTENT(IN) :: emis_ant_no,frp_mean,pblh + LOGICAL, INTENT(IN) :: enh_vermix !local vars - REAL, DIMENSION(kts:kte) :: dtz,vt,vq - REAL, DIMENSION(1:kte-kts+1) :: a,b,c,d + REAL, DIMENSION(kts:kte) :: dtz + REAL, DIMENSION(1:kte-kts+1) :: a,b,c,d,x REAL :: rhs,gfluxm,gfluxp,dztop - REAL :: t,esl,qsl + REAL :: t,esl,qsl,dzk + REAL :: hght + REAL :: khdz_old, khdz_back INTEGER :: k,kk INTEGER :: ic ! Chemical array loop index - REAL, DIMENSION( kts:kte, nchem ) :: chem_new + + INTEGER, SAVE :: icall + + REAL, DIMENSION(kts:kte) :: rhoinv + REAL, DIMENSION(kts:kte+1) :: rhoz,khdz + REAL, PARAMETER :: no_threshold = 0.1 + REAL, PARAMETER :: frp_threshold = 0.0 + REAL, PARAMETER :: pblh_threshold = 250.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -3842,6 +4091,53 @@ SUBROUTINE mynn_mix_chem(kts,kte, & dtz(k)=delt/dz(k) ENDDO + !Prepare "constants" for diffusion equation. + !khdz = rho*Kh/dz = rho*dfh + rhoz(kts) =rho(kts) + rhoinv(kts)=1./rho(kts) + khdz(kts) =rhoz(kts)*dfh(kts) +! JLS + khdz_old = khdz(kts) + khdz_back = pblh * 0.15 / dz(kts) + IF ( enh_vermix ) THEN + IF ( pblh < pblh_threshold ) THEN + IF ( emis_ant_no > no_threshold ) THEN + khdz(k) = MAX(khdz(k),khdz_back) + ENDIF + IF ( frp_mean > frp_threshold ) THEN + khdz(k) = MAX(khdz(k),khdz_back) + ENDIF + ENDIF + ENDIF + DO k=kts+1,kte + rhoz(k) =(rho(k)*dz(k-1) + rho(k-1)*dz(k))/(dz(k-1)+dz(k)) + rhoz(k) = MAX(rhoz(k),1E-4) + rhoinv(k)=1./MAX(rho(k),1E-4) + dzk = 0.5 *( dz(k)+dz(k-1) ) + khdz(k) = rhoz(k)*dfh(k) + ENDDO + khdz(kte+1)=rhoz(kte+1)*dfh(kte) + + !stability criteria for mf + DO k=kts+1,kte-1 + khdz(k) = MAX(khdz(k), 0.5*rho(k)* s_aw(k)) + khdz(k) = MAX(khdz(k), -0.5*rho(k)*(s_aw(k)-s_aw(k+1))) + + khdz_old = khdz(k) + khdz_back = pblh * 0.15 / dz(k) + IF ( enh_vermix ) THEN + !Modify based on anthropogenic emissions of NO and FRP + IF ( pblh < pblh_threshold ) THEN + IF ( emis_ant_no > no_threshold ) THEN + khdz(k) = MAX(khdz(k),khdz_back) + ENDIF + IF ( frp_mean > frp_threshold ) THEN + khdz(k) = MAX(khdz(k),khdz_back) + ENDIF + ENDIF + ENDIF + ENDDO + !============================================ ! Patterned after mixing of water vapor in mynn_tendencies. !============================================ @@ -3849,17 +4145,33 @@ SUBROUTINE mynn_mix_chem(kts,kte, & DO ic = 1,nchem k=kts - a(1)=0. - b(1)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(1)=-dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - d(1)=chem1(k,ic) + dtz(k) * -vd1(ic)*chem1(1,ic) - dtz(k)*s_awchem(k+1,ic) + !a(1)=0. + !b(1)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) + !c(1)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) + !d(1)=chem1(k,ic) + dtz(k) * -vd1(ic)*chem1(1,ic) - dtz(k)*s_awchem(k+1,ic) + + !DO k=kts+1,kte-1 + ! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) + ! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + ! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) + ! ! d(kk)=chem1(k,ic) + qcd(k)*delt + ! d(k)=chem1(k,ic) + rhs*delt + dtz(k)*(s_awchem(k,ic)-s_awchem(k+1,ic)) + !ENDDO + +!rho-weighted: + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=chem1(k,ic) & !dtz(k)*flt !neglecting surface sources + & + dtz(k) * -vd1(ic)*chem1(1,ic) & + & - dtz(k)*s_awchem(k+1,ic) DO k=kts+1,kte-1 - a(k)=-dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) - b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) - c(k)=-dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - ! d(kk)=chem1(k,ic) + qcd(k)*delt - d(k)=chem1(k,ic) + rhs*delt + dtz(k)*(s_awchem(k,ic)-s_awchem(k+1,ic)) + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1) + d(k)=chem1(k,ic) + dtz(k)*(s_awchem(k,ic)-s_awchem(k+1,ic)) ENDDO ! prescribed value at top @@ -3868,10 +4180,12 @@ SUBROUTINE mynn_mix_chem(kts,kte, & c(kte)=0. d(kte)=chem1(kte,ic) - CALL tridiag(kte,a,b,c,d) + !CALL tridiag(kte,a,b,c,d) + CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte - chem_new(k,ic)=d(k-kts+1) + !chem_new(k,ic)=d(k) + chem1(k,ic)=x(k) ENDDO ENDDO @@ -4043,6 +4357,9 @@ SUBROUTINE mynn_bl_driver( & #if (WRF_CHEM == 1) chem3d, vd3d, nchem, & ! WA 7/29/15 For WRF-Chem kdvel, ndvel, num_vert_mix, & + FRP_MEAN,EMIS_ANT_NO, & ! JLS/RAR to adjust exchange coeffs + mynn_chem_vertmx, & ! JLS/RAR + enh_vermix, & ! JLS/RAR #endif &Tsq,Qsq,Cov, & &RUBLTEN,RVBLTEN,RTHBLTEN, & @@ -4058,11 +4375,12 @@ SUBROUTINE mynn_bl_driver( & &bl_mynn_cloudpdf,Sh3D, & &bl_mynn_mixlength, & &icloud_bl,qc_bl,qi_bl,cldfra_bl,& - &levflag,bl_mynn_edmf, & + &bl_mynn_edmf, & &bl_mynn_edmf_mom,bl_mynn_edmf_tke, & &bl_mynn_mixscalars, & &bl_mynn_output, & &bl_mynn_cloudmix,bl_mynn_mixqt, & + &closure, & &edmf_a,edmf_w,edmf_qt, & &edmf_thl,edmf_ent,edmf_qc, & &sub_thl3D,sub_sqv3D, & @@ -4080,8 +4398,7 @@ SUBROUTINE mynn_bl_driver( & INTEGER, INTENT(in) :: initflag !INPUT NAMELIST OPTIONS: - LOGICAL, INTENT(in) :: restart,cycling - INTEGER, INTENT(in) :: levflag + LOGICAL, INTENT(IN) :: restart,cycling INTEGER, INTENT(in) :: grav_settling INTEGER, INTENT(in) :: bl_mynn_tkebudget INTEGER, INTENT(in) :: bl_mynn_cloudpdf @@ -4095,10 +4412,14 @@ SUBROUTINE mynn_bl_driver( & INTEGER, INTENT(in) :: bl_mynn_cloudmix INTEGER, INTENT(in) :: bl_mynn_mixqt INTEGER, INTENT(in) :: icloud_bl + REAL, INTENT(in) :: closure LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& FLAG_QNWFA,FLAG_QNIFA - +#if (WRF_CHEM == 1) + LOGICAL, INTENT(IN) :: mynn_chem_vertmx,enh_vermix +#endif + INTEGER,INTENT(in) :: & & IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & @@ -4111,8 +4432,9 @@ SUBROUTINE mynn_bl_driver( & ! initflag > 0 for TRUE ! else for FALSE -! levflag : <>3; Level 2.5 -! = 3; Level 3 +! closure : <= 2.5; Level 2.5 +! 2.5< and <3; Level 2.6 +! = 3; Level 3 ! grav_settling = 1 when gravitational settling accounted for ! grav_settling = 0 when gravitational settling NOT accounted for @@ -4121,31 +4443,30 @@ SUBROUTINE mynn_bl_driver( & ! REAL, INTENT(in) :: dx !END WRF !FV3 - REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(in) :: dx + REAL, DIMENSION(IMS:IME), INTENT(in) :: dx !END FV3 - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(in) :: dz,& + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(in) :: dz,& &u,v,w,th,sqv3D,p,exner,rho,T3D - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), OPTIONAL, INTENT(in)::& + REAL, DIMENSION(IMS:IME,KMS:KME), OPTIONAL, INTENT(in)::& &sqc3D,sqi3D,qni,qnc,qnwfa,qnifa REAL, DIMENSION(IMS:IME,KMS:KME), OPTIONAL, INTENT(in):: ozone - REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(in) :: xland,ust,& - &ch,rmol,ts,qsfc,qcg,ps,hfx,qfx,wspd,uoce,voce,vdfg,znt + REAL, DIMENSION(IMS:IME), INTENT(in) :: xland,ust,& + &ch,ts,qsfc,qcg,ps,hfx,qfx,wspd,uoce,voce,vdfg,znt - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & &Qke,Tsq,Qsq,Cov, & !&tke_pbl, & !JOE-added for coupling (TKE_PBL = QKE/2) - &qke_adv !ACF for QKE advection + &qke_adv !ACF for QKE advection - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,& &RQIBLTEN,RQNIBLTEN,RQNCBLTEN, & &RQNWFABLTEN,RQNIFABLTEN REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: DOZONE - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(in) :: & - &RTHRATEN + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(in) :: RTHRATEN - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(out) :: & + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(out) :: & &exch_h,exch_m !These 10 arrays are only allocated when bl_mynn_output > 0 @@ -4153,30 +4474,32 @@ SUBROUTINE mynn_bl_driver( & & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D - REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(inout) :: & - &Pblh,wstar,delta !JOE-added for GRIMS + !REAL, DIMENSION(:,:), OPTIONAL :: & + REAL, DIMENSION(IMS:IME,KMS:KME) :: & + & edmf_a_dd,edmf_w_dd,edmf_qt_dd,edmf_thl_dd,edmf_ent_dd,edmf_qc_dd - REAL, DIMENSION(IMS:IME,JMS:JME) :: & - &Psig_bl,Psig_shcu + REAL, DIMENSION(IMS:IME), INTENT(inout) :: Pblh,wstar,delta,rmol - INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: & + REAL, DIMENSION(IMS:IME) :: Psig_bl,Psig_shcu + + INTEGER,DIMENSION(IMS:IME),INTENT(INOUT) :: & &KPBL,nupdraft,ktop_plume - REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: & + REAL, DIMENSION(IMS:IME), INTENT(OUT) :: & &maxmf - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & &el_pbl - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(out) :: & + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(out) :: & &qWT,qSHEAR,qBUOY,qDISS,dqke ! 3D budget arrays are not allocated when bl_mynn_tkebudget == 0. ! 1D (local) budget arrays are used for passing between subroutines. REAL, DIMENSION(KTS:KTE) :: qWT1,qSHEAR1,qBUOY1,qDISS1,dqke1,diss_heat - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: Sh3D + REAL, DIMENSION(IMS:IME,KMS:KME) :: Sh3D - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & + REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout), optional :: & &qc_bl,qi_bl,cldfra_bl REAL, DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D,cldfra_bl1D,& qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old @@ -4184,8 +4507,10 @@ SUBROUTINE mynn_bl_driver( & ! WA 7/29/15 Mix chemical arrays #if (WRF_CHEM == 1) INTEGER, INTENT(IN ) :: nchem, kdvel, ndvel, num_vert_mix - REAL, DIMENSION( ims:ime, kms:kme, jms:jme, nchem ), INTENT(INOUT), OPTIONAL :: chem3d - REAL, DIMENSION( ims:ime, kdvel, jms:jme, ndvel ), INTENT(IN), OPTIONAL :: vd3d + REAL, DIMENSION( ims:ime, kms:kme, nchem ), INTENT(INOUT), OPTIONAL :: chem3d + REAL, DIMENSION( ims:ime, kdvel, ndvel ), INTENT(IN), OPTIONAL :: vd3d + REAL, DIMENSION(ims:ime), INTENT(IN), OPTIONAL ::FRP_MEAN,EMIS_ANT_NO + REAL, DIMENSION( kts:kte, nchem ) :: chem1 REAL, DIMENSION( kts:kte+1, nchem ) :: s_awchem1 REAL, DIMENSION( ndvel ) :: vd1 @@ -4198,8 +4523,7 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(KTS:KTE) :: thl,thvl,tl,qv1,qc1,qi1,sqw,& &El, Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & &Vt, Vq, sgm, thlsg - - REAL, DIMENSION(KTS:KTE) :: thetav,sh,u1,v1,w1,p1,ex1,dz1,th1,tk1,rho1,& + REAL, DIMENSION(KTS:KTE) :: thetav,sh,sm,u1,v1,w1,p1,ex1,dz1,th1,tk1,rho1,& & qke1,tsq1,qsq1,cov1,sqv,sqi,sqc,du1,dv1,dth1,dqv1,dqc1,dqi1,ozone1, & & k_m1,k_h1,qni1,dqni1,qnc1,dqnc1,qnwfa1,qnifa1,dqnwfa1,dqnifa1,dozone1 @@ -4207,41 +4531,31 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(KTS:KTE) :: dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf REAL, DIMENSION(KTS:KTE) :: edmf_a1,edmf_w1,edmf_qt1,edmf_thl1,& edmf_ent1,edmf_qc1 + REAL, DIMENSION(KTS:KTE) :: edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1,edmf_thl_dd1,& + edmf_ent_dd1,edmf_qc_dd1 REAL, DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & det_thl,det_sqv,det_sqc,det_u,det_v REAL,DIMENSION(KTS:KTE+1) :: s_aw1,s_awthl1,s_awqt1,& s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1,& s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1 + REAL,DIMENSION(KTS:KTE+1) :: sd_aw1,sd_awthl1,sd_awqt1,& + sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 REAL, DIMENSION(KTS:KTE+1) :: zw - REAL :: cpm,sqcg,flt,flq,flqv,flqc,pmz,phh,exnerg,zet,& - & afk,abk,ts_decay, qc_bl2, qi_bl2, & + REAL :: cpm,sqcg,flt,fltv,flq,flqv,flqc,pmz,phh,exnerg,zet,phi_m,& + & afk,abk,ts_decay, qc_bl2, qi_bl2, & & th_sfc,ztop_plume,sqc9,sqi9 -!JOE-add GRIMS parameters & variables - real,parameter :: d1 = 0.02, d2 = 0.05, d3 = 0.001 - real,parameter :: h1 = 0.33333335, h2 = 0.6666667 - REAL :: govrth, sflux, bfx0, wstar3, wm2, wm3, delb -!JOE-end GRIMS !JOE-top-down diffusion - REAL, DIMENSION(ITS:ITE,JTS:JTE) :: maxKHtopdown - REAL,DIMENSION(KTS:KTE) :: KHtopdown,zfac,wscalek2,& - zfacent,TKEprodTD - REAL :: bfxpbl,dthvx,tmp1,temps,templ,zl1,wstar3_2 - real :: ent_eff,radsum,radflux,we,rcldb,rvls,& - minrad,zminrad - real, parameter :: pfac =2.0, zfmin = 0.01, phifac=8.0 - integer :: kk,kminrad - logical :: cloudflg + REAL, DIMENSION(ITS:ITE) :: maxKHtopdown + REAL,DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD !JOE-end top down -!for WRF INTEGER, SAVE :: levflag - LOGICAL :: INITIALIZE_QKE ! Stochastic fields - INTEGER, INTENT(IN) ::spp_pbl - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN),OPTIONAL ::pattern_spp_pbl + INTEGER, INTENT(IN) ::spp_pbl + REAL, DIMENSION( ims:ime, kms:kme), INTENT(IN),OPTIONAL ::pattern_spp_pbl REAL, DIMENSION(KTS:KTE) :: rstoch_col @@ -4263,9 +4577,6 @@ SUBROUTINE mynn_bl_driver( & ITF=ITE KTF=KTE -!WRF -! levflag=mynn_level - IF (bl_mynn_edmf > 0) THEN ! setup random seed !call init_random_seed @@ -4282,11 +4593,22 @@ SUBROUTINE mynn_bl_driver( & det_thl3D(its:ite,kts:kte)=0. det_sqv3D(its:ite,kts:kte)=0. ENDIF - ktop_plume(its:ite,jts:jte)=0 !int - nupdraft(its:ite,jts:jte)=0 !int - maxmf(its:ite,jts:jte)=0. + ktop_plume(its:ite)=0 !int + nupdraft(its:ite)=0 !int + maxmf(its:ite)=0. + ENDIF + maxKHtopdown(its:ite)=0. + + IF (bl_mynn_edmf_dd > 0) THEN + IF (bl_mynn_output > 0) THEN + edmf_a_dd(its:ite,kts:kte)=0. + edmf_w_dd(its:ite,kts:kte)=0. + edmf_qt_dd(its:ite,kts:kte)=0. + edmf_thl_dd(its:ite,kts:kte)=0. + edmf_ent_dd(its:ite,kts:kte)=0. + edmf_qc_dd(its:ite,kts:kte)=0. + ENDIF ENDIF - maxKHtopdown(its:ite,jts:jte)=0. ! DH* CHECK HOW MUCH OF THIS INIT IF-BLOCK IS ACTUALLY NEEDED FOR RESTARTS !> - Within the MYNN-EDMF, there is a dependecy check for the first time step, @@ -4297,7 +4619,7 @@ SUBROUTINE mynn_bl_driver( & !Test to see if we want to initialize qke IF ( (restart .or. cycling)) THEN - IF (MAXVAL(QKE(its:ite,kts,jts:jte)) < 0.0002) THEN + IF (MAXVAL(QKE(its:ite,kts)) < 0.0002) THEN INITIALIZE_QKE = .TRUE. !print*,"QKE is too small, must initialize" ELSE @@ -4310,14 +4632,14 @@ SUBROUTINE mynn_bl_driver( & ENDIF if (.not.restart .or. .not.cycling) THEN - Sh3D(its:ite,kts:kte,jts:jte)=0. - el_pbl(its:ite,kts:kte,jts:jte)=0. - tsq(its:ite,kts:kte,jts:jte)=0. - qsq(its:ite,kts:kte,jts:jte)=0. - cov(its:ite,kts:kte,jts:jte)=0. - cldfra_bl(its:ite,kts:kte,jts:jte)=0. - qc_bl(its:ite,kts:kte,jts:jte)=0. - qke(its:ite,kts:kte,jts:jte)=0. + Sh3D(its:ite,kts:kte)=0. + el_pbl(its:ite,kts:kte)=0. + tsq(its:ite,kts:kte)=0. + qsq(its:ite,kts:kte)=0. + cov(its:ite,kts:kte)=0. + cldfra_bl(its:ite,kts:kte)=0. + qc_bl(its:ite,kts:kte)=0. + qke(its:ite,kts:kte)=0. else qc_bl1D(kts:kte)=0.0 qi_bl1D(kts:kte)=0.0 @@ -4335,59 +4657,57 @@ SUBROUTINE mynn_bl_driver( & edmf_a1(kts:kte)=0.0 edmf_w1(kts:kte)=0.0 edmf_qc1(kts:kte)=0.0 + edmf_a_dd1(kts:kte)=0.0 + edmf_w_dd1(kts:kte)=0.0 + edmf_qc_dd1(kts:kte)=0.0 sgm(kts:kte)=0.0 vt(kts:kte)=0.0 vq(kts:kte)=0.0 - DO j=JTS,JTF - DO k=KTS,KTE - DO i=ITS,ITF - exch_m(i,k,j)=0. - exch_h(i,k,j)=0. - ENDDO - ENDDO + DO k=KTS,KTE + DO i=ITS,ITF + exch_m(i,k)=0. + exch_h(i,k)=0. + ENDDO ENDDO IF ( bl_mynn_tkebudget == 1) THEN - DO j=JTS,JTF - DO k=KTS,KTE - DO i=ITS,ITF - qWT(i,k,j)=0. - qSHEAR(i,k,j)=0. - qBUOY(i,k,j)=0. - qDISS(i,k,j)=0. - dqke(i,k,j)=0. - ENDDO - ENDDO - ENDDO + DO k=KTS,KTE + DO i=ITS,ITF + qWT(i,k)=0. + qSHEAR(i,k)=0. + qBUOY(i,k)=0. + qDISS(i,k)=0. + dqke(i,k)=0. + ENDDO + ENDDO ENDIF - DO j=JTS,JTF - DO i=ITS,ITF - DO k=KTS,KTE !KTF - dz1(k)=dz(i,k,j) - u1(k) = u(i,k,j) - v1(k) = v(i,k,j) - w1(k) = w(i,k,j) - th1(k)=th(i,k,j) - tk1(k)=T3D(i,k,j) - rho1(k)=rho(i,k,j) - sqc(k)=sqc3D(i,k,j) !/(1.+qv(i,k,j)) - sqv(k)=sqv3D(i,k,j) !/(1.+qv(i,k,j)) - thetav(k)=th(i,k,j)*(1.+0.61*sqv(k)) + DO i=ITS,ITF + DO k=KTS,KTE !KTF + dz1(k)=dz(i,k) + u1(k) = u(i,k) + v1(k) = v(i,k) + w1(k) = w(i,k) + th1(k)=th(i,k) + tk1(k)=T3D(i,k) + rho1(k)=rho(i,k) + sqc(k)=sqc3D(i,k) !/(1.+qv(i,k)) + sqv(k)=sqv3D(i,k) !/(1.+qv(i,k)) + thetav(k)=th(i,k)*(1.+0.608*sqv(k)) IF (icloud_bl > 0) THEN - CLDFRA_BL1D(k)=CLDFRA_BL(i,k,j) - QC_BL1D(k)=QC_BL(i,k,j) - QI_BL1D(k)=QI_BL(i,k,j) + CLDFRA_BL1D(k)=CLDFRA_BL(i,k) + QC_BL1D(k)=QC_BL(i,k) + QI_BL1D(k)=QI_BL(i,k) ENDIF IF (PRESENT(sqi3D) .AND. FLAG_QI ) THEN - sqi(k)=sqi3D(i,k,j) !/(1.+qv(i,k,j)) + sqi(k)=sqi3D(i,k) !/(1.+qv(i,k)) sqw(k)=sqv(k)+sqc(k)+sqi(k) - thl(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc(k) & - & - xlscp/exner(i,k,j)*sqi(k) + thl(k)=th(i,k)- xlvcp/exner(i,k)*sqc(k) & + & - xlscp/exner(i,k)*sqi(k) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. - !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & + !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN @@ -4397,15 +4717,15 @@ SUBROUTINE mynn_bl_driver( & sqc9=sqc(k) sqi9=sqi(k) ENDIF - thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & - & - xlscp/exner(i,k,j)*sqi9 + thlsg(k)=th(i,k)- xlvcp/exner(i,k)*sqc9 & + & - xlscp/exner(i,k)*sqi9 ELSE sqi(k)=0.0 sqw(k)=sqv(k)+sqc(k) - thl(k)=th(i,k,j)-xlvcp/exner(i,k,j)*sqc(k) + thl(k)=th(i,k)-xlvcp/exner(i,k)*sqc(k) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. - !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) + !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) @@ -4414,51 +4734,51 @@ SUBROUTINE mynn_bl_driver( & sqc9=sqc(k) sqi9=0.0 ENDIF - thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & - & - xlscp/exner(i,k,j)*sqi9 + thlsg(k)=th(i,k)- xlvcp/exner(i,k)*sqc9 & + & - xlscp/exner(i,k)*sqi9 ENDIF thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) IF (k==kts) THEN zw(k)=0. ELSE - zw(k)=zw(k-1)+dz(i,k-1,j) + zw(k)=zw(k-1)+dz(i,k-1) ENDIF IF (INITIALIZE_QKE) THEN !Initialize tke for initial PBLH calc only - using !simple PBLH form of Koracin and Berkowicz (1988, BLM) !to linearly taper off tke towards top of PBL. - qke1(k)=5.*ust(i,j) * MAX((ust(i,j)*700. - zw(k))/(MAX(ust(i,j),0.01)*700.), 0.01) + qke1(k)=5.*ust(i) * MAX((ust(i)*700. - zw(k))/(MAX(ust(i),0.01)*700.), 0.01) ELSE - qke1(k)=qke(i,k,j) + qke1(k)=qke(i,k) ENDIF - el(k)=el_pbl(i,k,j) - sh(k)=Sh3D(i,k,j) - tsq1(k)=tsq(i,k,j) - qsq1(k)=qsq(i,k,j) - cov1(k)=cov(i,k,j) + el(k)=el_pbl(i,k) + sh(k)=Sh3D(i,k) + tsq1(k)=tsq(i,k) + qsq1(k)=qsq(i,k) + cov1(k)=cov(i,k) if (spp_pbl==1) then - rstoch_col(k)=pattern_spp_pbl(i,k,j) + rstoch_col(k)=pattern_spp_pbl(i,k) else rstoch_col(k)=0.0 endif ENDDO - zw(kte+1)=zw(kte)+dz(i,kte,j) + zw(kte+1)=zw(kte)+dz(i,kte) !> - Call get_pblh() to calculate hybrid (\f$\theta_{vli}-TKE\f$) PBL height. -! CALL GET_PBLH(KTS,KTE,PBLH(i,j),thetav,& - CALL GET_PBLH(KTS,KTE,PBLH(i,j),thvl,& - & Qke1,zw,dz1,xland(i,j),KPBL(i,j)) +! CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& + CALL GET_PBLH(KTS,KTE,PBLH(i),thvl, & + & Qke1,zw,dz1,xland(i),KPBL(i)) !> - Call scale_aware() to calculate similarity functions for scale-adaptive control !! (\f$P_{\sigma-PBL}\f$ and \f$P_{\sigma-shcu}\f$). IF (scaleaware > 0.) THEN - CALL SCALE_AWARE(dx(i,j),PBLH(i,j),Psig_bl(i,j),Psig_shcu(i,j)) + CALL SCALE_AWARE(dx(i),PBLH(i),Psig_bl(i),Psig_shcu(i)) ELSE - Psig_bl(i,j)=1.0 - Psig_shcu(i,j)=1.0 + Psig_bl(i)=1.0 + Psig_shcu(i)=1.0 ENDIF ! DH* CHECK IF WE CAN DO WITHOUT CALLING THIS ROUTINE FOR RESTARTS @@ -4466,48 +4786,49 @@ SUBROUTINE mynn_bl_driver( & !! \f$q^{'2}\f$, and \f$\theta^{'}q^{'}\f$. These variables are calculated after !! obtaining prerequisite variables by calling the following subroutines from !! within mym_initialize(): mym_level2() and mym_length(). - CALL mym_initialize ( & - &kts,kte, & - &dz1, dx(i,j), zw, & - &u1, v1, thl, sqv, & - &PBLH(i,j), th1, sh, & - &ust(i,j), rmol(i,j), & - &el, Qke1, Tsq1, Qsq1, Cov1, & - &Psig_bl(i,j), cldfra_bl1D, & - &bl_mynn_mixlength, & + CALL mym_initialize ( & + &kts,kte, & + &dz1, dx(i), zw, & + &u1, v1, thl, sqv, & + &PBLH(i), th1, thetav, sh, sm, & + &ust(i), rmol(i), & + &el, Qke1, Tsq1, Qsq1, Cov1, & + &Psig_bl(i), cldfra_bl1D, & + &bl_mynn_mixlength, & &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf,& - &INITIALIZE_QKE, & + &INITIALIZE_QKE, & &spp_pbl,rstoch_col ) IF (.not.restart) THEN !UPDATE 3D VARIABLES DO k=KTS,KTE !KTF - el_pbl(i,k,j)=el(k) - sh3d(i,k,j)=sh(k) - qke(i,k,j)=qke1(k) - tsq(i,k,j)=tsq1(k) - qsq(i,k,j)=qsq1(k) - cov(i,k,j)=cov1(k) - !ACF,JOE- initialize qke_adv array if using advection - IF (bl_mynn_tkeadvect) THEN - qke_adv(i,k,j)=qke1(k) - ENDIF + el_pbl(i,k)=el(k) + sh3d(i,k)=sh(k) + qke(i,k)=qke1(k) + tsq(i,k)=tsq1(k) + qsq(i,k)=qsq1(k) + cov(i,k)=cov1(k) ENDDO + !initialize qke_adv array if using advection + IF (bl_mynn_tkeadvect) THEN + DO k=KTS,KTE + qke_adv(i,k)=qke1(k) + ENDDO + ENDIF ENDIF !*** Begin debugging ! k=kdebug ! IF(I==IMD .AND. J==JMD)THEN ! PRINT*,"MYNN DRIVER INIT: k=",1," sh=",sh(k) -! PRINT*," sqw=",sqw(k)," thl=",thl(k)," k_m=",exch_m(i,k,j) -! PRINT*," xland=",xland(i,j)," rmol=",rmol(i,j)," ust=",ust(i,j) -! PRINT*," qke=",qke(i,k,j)," el=",el_pbl(i,k,j)," tsq=",Tsq(i,k,j) -! PRINT*," PBLH=",PBLH(i,j)," u=",u(i,k,j)," v=",v(i,k,j) +! PRINT*," sqw=",sqw(k)," thl=",thl(k)," k_m=",exch_m(i,k) +! PRINT*," xland=",xland(i)," rmol=",rmol(i)," ust=",ust(i) +! PRINT*," qke=",qke(i,k)," el=",el_pbl(i,k)," tsq=",Tsq(i,k) +! PRINT*," PBLH=",PBLH(i)," u=",u(i,k)," v=",v(i,k) ! ENDIF !*** End debugging - ENDDO - ENDDO + ENDDO !end i-loop ENDIF ! end initflag @@ -4518,32 +4839,38 @@ SUBROUTINE mynn_bl_driver( & qke=qke_adv ENDIF - DO j=JTS,JTF - DO i=ITS,ITF - DO k=KTS,KTE !KTF + DO i=ITS,ITF + DO k=KTS,KTE !KTF !JOE-TKE BUDGET IF ( bl_mynn_tkebudget == 1) THEN - dqke(i,k,j)=qke(i,k,j) + dqke(i,k)=qke(i,k) END IF IF (icloud_bl > 0) THEN - CLDFRA_BL1D(k)=CLDFRA_BL(i,k,j) - QC_BL1D(k)=QC_BL(i,k,j) - QI_BL1D(k)=QI_BL(i,k,j) - cldfra_bl1D_old(k)=cldfra_bl(i,k,j) - qc_bl1D_old(k)=qc_bl(i,k,j) - qi_bl1D_old(k)=qi_bl(i,k,j) + CLDFRA_BL1D(k)=CLDFRA_BL(i,k) + QC_BL1D(k)=QC_BL(i,k) + QI_BL1D(k)=QI_BL(i,k) + cldfra_bl1D_old(k)=cldfra_bl(i,k) + qc_bl1D_old(k)=qc_bl(i,k) + qi_bl1D_old(k)=qi_bl(i,k) + else + CLDFRA_BL1D(k)=0.0 + QC_BL1D(k)=0.0 + QI_BL1D(k)=0.0 + cldfra_bl1D_old(k)=0.0 + qc_bl1D_old(k)=0.0 + qi_bl1D_old(k)=0.0 ENDIF - dz1(k)= dz(i,k,j) - u1(k) = u(i,k,j) - v1(k) = v(i,k,j) - w1(k) = w(i,k,j) - th1(k)= th(i,k,j) - tk1(k)=T3D(i,k,j) - rho1(k)=rho(i,k,j) - qv1(k)= sqv3D(i,k,j)/(1.-sqv3D(i,k,j)) - qc1(k)= sqc3D(i,k,j)/(1.-sqv3D(i,k,j)) - sqv(k)= sqv3D(i,k,j) !/(1.+qv(i,k,j)) - sqc(k)= sqc3D(i,k,j) !/(1.+qv(i,k,j)) + dz1(k)= dz(i,k) + u1(k) = u(i,k) + v1(k) = v(i,k) + w1(k) = w(i,k) + th1(k)= th(i,k) + tk1(k)=T3D(i,k) + rho1(k)=rho(i,k) + qv1(k)= sqv3D(i,k)/(1.-sqv3D(i,k)) + qc1(k)= sqc3D(i,k)/(1.-sqv3D(i,k)) + sqv(k)= sqv3D(i,k) !/(1.+qv(i,k)) + sqc(k)= sqc3D(i,k) !/(1.+qv(i,k)) dqc1(k)=0.0 dqi1(k)=0.0 dqni1(k)=0.0 @@ -4552,14 +4879,14 @@ SUBROUTINE mynn_bl_driver( & dqnifa1(k)=0.0 dozone1(k)=0.0 IF(PRESENT(sqi3D) .AND. FLAG_QI)THEN - qi1(k)= sqi3D(i,k,j)/(1.-sqv3D(i,k,j)) - sqi(k)= sqi3D(i,k,j) !/(1.+qv(i,k,j)) + qi1(k)= sqi3D(i,k)/(1.-sqv3D(i,k)) + sqi(k)= sqi3D(i,k) !/(1.+qv(i,k)) sqw(k)= sqv(k)+sqc(k)+sqi(k) - thl(k)= th(i,k,j) - xlvcp/exner(i,k,j)*sqc(k) & - & - xlscp/exner(i,k,j)*sqi(k) + thl(k)= th(i,k) - xlvcp/exner(i,k)*sqc(k) & + & - xlscp/exner(i,k)*sqi(k) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. - !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & + !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN @@ -4569,16 +4896,16 @@ SUBROUTINE mynn_bl_driver( & sqc9=sqc(k) sqi9=sqi(k) ENDIF - thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & - & - xlscp/exner(i,k,j)*sqi9 + thlsg(k)=th(i,k)- xlvcp/exner(i,k)*sqc9 & + & - xlscp/exner(i,k)*sqi9 ELSE qi1(k)=0.0 sqi(k)=0.0 sqw(k)= sqv(k)+sqc(k) - thl(k)= th(i,k,j)-xlvcp/exner(i,k,j)*sqc(k) + thl(k)= th(i,k)-xlvcp/exner(i,k)*sqc(k) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. - !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) + !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) @@ -4587,29 +4914,29 @@ SUBROUTINE mynn_bl_driver( & sqc9=sqc(k) sqi9=0.0 ENDIF - thlsg(k)=th(i,k,j)- xlvcp/exner(i,k,j)*sqc9 & - & - xlscp/exner(i,k,j)*sqi9 + thlsg(k)=th(i,k)- xlvcp/exner(i,k)*sqc9 & + & - xlscp/exner(i,k)*sqi9 ENDIF - thetav(k)=th(i,k,j)*(1.+0.608*sqv(k)) - thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) + thetav(k)=th(i,k)*(1.+0.608*sqv(k)) + thvl(k) =thlsg(k) *(1.+0.608*sqv(k)) IF (PRESENT(qni) .AND. FLAG_QNI ) THEN - qni1(k)=qni(i,k,j) + qni1(k)=qni(i,k) ELSE qni1(k)=0.0 ENDIF IF (PRESENT(qnc) .AND. FLAG_QNC ) THEN - qnc1(k)=qnc(i,k,j) + qnc1(k)=qnc(i,k) ELSE qnc1(k)=0.0 ENDIF IF (PRESENT(qnwfa) .AND. FLAG_QNWFA ) THEN - qnwfa1(k)=qnwfa(i,k,j) + qnwfa1(k)=qnwfa(i,k) ELSE qnwfa1(k)=0.0 ENDIF IF (PRESENT(qnifa) .AND. FLAG_QNIFA ) THEN - qnifa1(k)=qnifa(i,k,j) + qnifa1(k)=qnifa(i,k) ELSE qnifa1(k)=0.0 ENDIF @@ -4618,16 +4945,16 @@ SUBROUTINE mynn_bl_driver( & ELSE ozone1(k)=0.0 ENDIF - p1(k) = p(i,k,j) - ex1(k)= exner(i,k,j) - el(k) = el_pbl(i,k,j) - qke1(k)=qke(i,k,j) - sh(k) = sh3d(i,k,j) - tsq1(k)=tsq(i,k,j) - qsq1(k)=qsq(i,k,j) - cov1(k)=cov(i,k,j) + p1(k) = p(i,k) + ex1(k)= exner(i,k) + el(k) = el_pbl(i,k) + qke1(k)=qke(i,k) + sh(k) = sh3d(i,k) + tsq1(k)=tsq(i,k) + qsq1(k)=qsq(i,k) + cov1(k)=cov(i,k) if (spp_pbl==1) then - rstoch_col(k)=pattern_spp_pbl(i,k,j) + rstoch_col(k)=pattern_spp_pbl(i,k) else rstoch_col(k)=0.0 endif @@ -4649,6 +4976,18 @@ SUBROUTINE mynn_bl_driver( & s_awqni1(k)=0. s_awqnwfa1(k)=0. s_awqnifa1(k)=0. + ![EWDD] + edmf_a_dd1(k)=0.0 + edmf_w_dd1(k)=0.0 + edmf_qc_dd1(k)=0.0 + sd_aw1(k)=0. + sd_awthl1(k)=0. + sd_awqt1(k)=0. + sd_awqv1(k)=0. + sd_awqc1(k)=0. + sd_awu1(k)=0. + sd_awv1(k)=0. + sd_awqke1(k)=0. sub_thl(k)=0. sub_sqv(k)=0. sub_u(k)=0. @@ -4660,16 +4999,16 @@ SUBROUTINE mynn_bl_driver( & det_v(k)=0. #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN IF (PRESENT(chem3d) .AND. PRESENT(vd3d)) THEN ! WA 7/29/15 Set up chemical arrays DO ic = 1,nchem - chem1(k,ic) = chem3d(i,k,j,ic) + chem1(k,ic) = chem3d(i,k,ic) s_awchem1(k,ic)=0. ENDDO DO ic = 1,ndvel IF (k == KTS) THEN - vd1(ic) = vd3d(i,1,j,ic) + vd1(ic) = vd3d(i,1,ic) ENDIF ENDDO ELSE @@ -4689,11 +5028,11 @@ SUBROUTINE mynn_bl_driver( & IF (k==kts) THEN zw(k)=0. ELSE - zw(k)=zw(k-1)+dz(i,k-1,j) + zw(k)=zw(k-1)+dz(i,k-1) ENDIF ENDDO ! end k - zw(kte+1)=zw(kte)+dz(i,kte,j) + zw(kte+1)=zw(kte)+dz(i,kte) !EDMF s_aw1(kte+1)=0. s_awthl1(kte+1)=0. @@ -4707,6 +5046,14 @@ SUBROUTINE mynn_bl_driver( & s_awqni1(kte+1)=0. s_awqnwfa1(kte+1)=0. s_awqnifa1(kte+1)=0. + sd_aw1(kte+1)=0. + sd_awthl1(kte+1)=0. + sd_awqt1(kte+1)=0. + sd_awqv1(kte+1)=0. + sd_awqc1(kte+1)=0. + sd_awu1(kte+1)=0. + sd_awv1(kte+1)=0. + sd_awqke1(kte+1)=0. #if (WRF_CHEM == 1) DO ic = 1,nchem s_awchem1(kte+1,ic)=0. @@ -4715,181 +5062,100 @@ SUBROUTINE mynn_bl_driver( & !> - Call get_pblh() to calculate the hybrid \f$\theta_{vli}-TKE\f$ !! PBL height diagnostic. -! CALL GET_PBLH(KTS,KTE,PBLH(i,j),thetav,& - CALL GET_PBLH(KTS,KTE,PBLH(i,j),thvl,& - & Qke1,zw,dz1,xland(i,j),KPBL(i,j)) +! CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& + CALL GET_PBLH(KTS,KTE,PBLH(i),thvl,& + & Qke1,zw,dz1,xland(i),KPBL(i)) !> - Call scale_aware() to calculate the similarity functions, !! \f$P_{\sigma-PBL}\f$ and \f$P_{\sigma-shcu}\f$, to control !! the scale-adaptive behaviour for the local and nonlocal !! components, respectively. IF (scaleaware > 0.) THEN - CALL SCALE_AWARE(dx(i,j),PBLH(i,j),Psig_bl(i,j),Psig_shcu(i,j)) + CALL SCALE_AWARE(dx(i),PBLH(i),Psig_bl(i),Psig_shcu(i)) ELSE - Psig_bl(i,j)=1.0 - Psig_shcu(i,j)=1.0 + Psig_bl(i)=1.0 + Psig_shcu(i)=1.0 ENDIF - sqcg= 0.0 !JOE, it was: qcg(i,j)/(1.+qcg(i,j)) + sqcg= 0.0 !JOE, it was: qcg(i)/(1.+qcg(i)) cpm=cp*(1.+0.84*qv1(kts)) - exnerg=(ps(i,j)/p1000mb)**rcp + exnerg=(ps(i)/p1000mb)**rcp !----------------------------------------------------- !ORIGINAL CODE - !flt = hfx(i,j)/( rho(i,kts,j)*cpm ) & - ! +xlvcp*ch(i,j)*(sqc(kts)/exner(i,kts,j) -sqcg/exnerg) - !flq = qfx(i,j)/ rho(i,kts,j) & - ! -ch(i,j)*(sqc(kts) -sqcg ) + !flt = hfx(i)/( rho(i,kts)*cpm ) & + ! +xlvcp*ch(i)*(sqc(kts)/exner(i,kts) -sqcg/exnerg) + !flq = qfx(i)/ rho(i,kts) & + ! -ch(i)*(sqc(kts) -sqcg ) !----------------------------------------------------- ! Katata-added - The deposition velocity of cloud (fog) ! water is used instead of CH. - flt = hfx(i,j)/( rho(i,kts,j)*cpm ) & - & +xlvcp*vdfg(i,j)*(sqc(kts)/exner(i,kts,j)- sqcg/exnerg) - flq = qfx(i,j)/ rho(i,kts,j) & - & -vdfg(i,j)*(sqc(kts) - sqcg ) -!JOE-test- should this be after the call to mym_condensation?-using old vt & vq -!same as original form -! flt = flt + xlvcp*ch(i,j)*(sqc(kts)/exner(i,kts,j) -sqcg/exnerg) - flqv = qfx(i,j)/rho(i,kts,j) - flqc = -vdfg(i,j)*(sqc(kts) - sqcg ) - th_sfc = ts(i,j)/ex1(kts) - - zet = 0.5*dz(i,kts,j)*rmol(i,j) - if ( zet >= 0.0 ) then - pmz = 1.0 + (cphm_st-1.0) * zet - phh = 1.0 + cphh_st * zet + !flt = hfx(i)/( rho(i,kts)*cpm ) & + ! & +xlvcp*vdfg(i)*(sqc(kts)/exner(i,kts)- sqcg/exnerg) + !flq = qfx(i)/ rho(i,kts) & + ! & -vdfg(i)*(sqc(kts) - sqcg ) + !----------------------------------------------------- + flqv = qfx(i)/rho1(kts) + flqc = -vdfg(i)*(sqc(kts) - sqcg ) + th_sfc = ts(i)/ex1(kts) + + ! TURBULENT FLUX FOR TKE BOUNDARY CONDITIONS + flq =flqv+flqc !! LATENT + flt =hfx(i)/(rho1(kts)*cpm )-xlvcp*flqc/exner(i,kts) !! Temperature flux + fltv=flt + flqv*ep_1*th_sfc !! Virtual temperature flux + + ! Update 1/L using updated sfc heat flux and friction velocity + rmol(i) = -vk*gtr*fltv/max(ust(i)**3,1.0e-6) + zet = 0.5*dz(i,kts)*rmol(i) + zet = MAX(zet, -20.) + zet = MIN(zet, 20.) + if (bl_mynn_stfunc == 0) then + !Original Kansas-type stability functions + if ( zet >= 0.0 ) then + pmz = 1.0 + (cphm_st-1.0) * zet + phh = 1.0 + cphh_st * zet + else + pmz = 1.0/ (1.0-cphm_unst*zet)**0.25 - zet + phh = 1.0/SQRT(1.0-cphh_unst*zet) + end if else - pmz = 1.0/ (1.0-cphm_unst*zet)**0.25 - zet - phh = 1.0/SQRT(1.0-cphh_unst*zet) + !Updated stability functions (Puhales, 2020) + phi_m = phim(zet) + pmz = phi_m - zet + phh = phih(zet) end if - !-- Estimate wstar & delta for GRIMS shallow-cu------- - govrth = g/th1(kts) - sflux = hfx(i,j)/rho(i,kts,j)/cpm + & - qfx(i,j)/rho(i,kts,j)*ep_1*th1(kts) - bfx0 = max(sflux,0.) - wstar3 = (govrth*bfx0*pblh(i,j)) - wstar(i,j) = wstar3**h1 - wm3 = wstar3 + 5.*ust(i,j)**3. - wm2 = wm3**h2 - delb = govrth*d3*pblh(i,j) - delta(i,j) = min(d1*pblh(i,j) + d2*wm2/delb, 100.) - !-- End GRIMS----------------------------------------- - !> - Call mym_condensation() to calculate the nonconvective component !! of the subgrid cloud fraction and mixing ratio as well as the functions -!! used to calculate the buoyancy flux. Different cloud PDFs can be +!! used to calculate the buoyancy flux. Different cloud PDFs can be !! selected by use of the namelist parameter \p bl_mynn_cloudpdf. CALL mym_condensation ( kts,kte, & - &dx(i,j),dz1,zw,thl,sqw,sqv,sqc,sqi,& + &dx(i),dz1,zw,thl,sqw,sqv,sqc,sqi,& &p1,ex1,tsq1,qsq1,cov1, & &Sh,el,bl_mynn_cloudpdf, & &qc_bl1D,qi_bl1D,cldfra_bl1D, & - &PBLH(i,j),HFX(i,j), & - &Vt, Vq, th1, sgm, rmol(i,j), & + &PBLH(i),HFX(i), & + &Vt, Vq, th1, sgm, rmol(i), & &spp_pbl, rstoch_col ) - !ADD TKE source driven by cloud top cooling -!> - Calculate the buoyancy production of TKE from cloud-top cooling when +!> - Add TKE source driven by cloud top cooling +!! Calculate the buoyancy production of TKE from cloud-top cooling when !! \p bl_mynn_topdown =1. IF (bl_mynn_topdown.eq.1)then - cloudflg=.false. - minrad=100. - kminrad=kpbl(i,j) - zminrad=PBLH(i,j) - KHtopdown(kts:kte)=0.0 - TKEprodTD(kts:kte)=0.0 - maxKHtopdown(i,j)=0.0 - !CHECK FOR STRATOCUMULUS-TOPPED BOUNDARY LAYERS - DO kk = MAX(1,kpbl(i,j)-2),kpbl(i,j)+3 - if(sqc(kk).gt. 1.e-6 .OR. sqi(kk).gt. 1.e-6 .OR. & - cldfra_bl1D(kk).gt.0.5) then - cloudflg=.true. - endif - if(rthraten(i,kk,j) < minrad)then - minrad=rthraten(i,kk,j) - kminrad=kk - zminrad=zw(kk) + 0.5*dz1(kk) - endif - ENDDO - IF (MAX(kminrad,kpbl(i,j)) < 2)cloudflg = .false. - IF (cloudflg) THEN - zl1 = dz1(kts) - k = MAX(kpbl(i,j)-1, kminrad-1) - !Best estimate of height of TKE source (top of downdrafts): - !zminrad = 0.5*pblh(i,j) + 0.5*zminrad - - templ=thl(k)*ex1(k) - !rvls is ws at full level - rvls=100.*6.112*EXP(17.67*(templ-273.16)/(templ-29.65))*(ep_2/p1(k+1)) - temps=templ + (sqw(k)-rvls)/(cp/xlv + ep_2*xlv*rvls/(rd*templ**2)) - rvls=100.*6.112*EXP(17.67*(temps-273.15)/(temps-29.65))*(ep_2/p1(k+1)) - rcldb=max(sqw(k)-rvls,0.) - - !entrainment efficiency - dthvx = (thl(k+2) + th1(k+2)*ep_1*sqw(k+2)) & - - (thl(k) + th1(k) *ep_1*sqw(k)) - dthvx = max(dthvx,0.1) - tmp1 = xlvcp * rcldb/(ex1(k)*dthvx) - !Originally from Nichols and Turton (1986), where a2 = 60, but lowered - !here to 8, as in Grenier and Bretherton (2001). - ent_eff = 0.2 + 0.2*8.*tmp1 - - radsum=0. - DO kk = MAX(1,kpbl(i,j)-3),kpbl(i,j)+3 - radflux=rthraten(i,kk,j)*ex1(kk) !converts theta/s to temp/s - radflux=radflux*cp/g*(p1(kk)-p1(kk+1)) ! converts temp/s to W/m^2 - if (radflux < 0.0 ) radsum=abs(radflux)+radsum - ENDDO - - !More strict limits over land to reduce stable-layer mixouts - if ((xland(i,j)-1.5).GE.0)THEN ! WATER - radsum=MIN(radsum,90.0) - bfx0 = max(radsum/rho1(k)/cp,0.) - else ! LAND - radsum=MIN(0.25*radsum,30.0)!practically turn off over land - bfx0 = max(radsum/rho1(k)/cp - max(sflux,0.0),0.) - endif - - !entrainment from PBL top thermals - wm3 = g/thetav(k)*bfx0*MIN(pblh(i,j),1500.) ! this is wstar3(i) - wm2 = wm2 + wm3**h2 - bfxpbl = - ent_eff * bfx0 - dthvx = max(thetav(k+1)-thetav(k),0.1) - we = max(bfxpbl/dthvx,-sqrt(wm3**h2)) - - DO kk = kts,kpbl(i,j)+3 - !Analytic vertical profile - zfac(kk) = min(max((1.-(zw(kk+1)-zl1)/(zminrad-zl1)),zfmin),1.) - zfacent(kk) = 10.*MAX((zminrad-zw(kk+1))/zminrad,0.0)*(1.-zfac(kk))**3 - - !Calculate an eddy diffusivity profile (not used at the moment) - wscalek2(kk) = (phifac*karman*wm3*(zfac(kk)))**h1 - !Modify shape of KH to be similar to Lock et al (2000): use pfac = 3.0 - KHtopdown(kk) = wscalek2(kk)*karman*(zminrad-zw(kk+1))*(1.-zfac(kk))**3 !pfac - KHtopdown(kk) = MAX(KHtopdown(kk),0.0) - !Do not include xkzm at kpbl-1 since it changes entrainment - !if (kk.eq.kpbl(i,j)-1 .and. cloudflg .and. we.lt.0.0) then - ! KHtopdown(kk) = 0.0 - !endif - - !Calculate TKE production = 2(g/TH)(w'TH'), where w'TH' = A(TH/g)wstar^3/PBLH, - !A = ent_eff, and wstar is associated with the radiative cooling at top of PBL. - !An analytic profile controls the magnitude of this TKE prod in the vertical. - TKEprodTD(kk)=2.*ent_eff*wm3/MAX(pblh(i,j),100.)*zfacent(kk) - TKEprodTD(kk)= MAX(TKEprodTD(kk),0.0) - ENDDO - ENDIF !end cloud check - maxKHtopdown(i,j)=MAXVAL(KHtopdown(:)) + CALL topdown_cloudrad(kts,kte,dz1,zw, & + &xland(i),kpbl(i),PBLH(i), & + &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & + &cldfra_bl1D,rthraten, & + &maxKHtopdown(i),KHtopdown,TKEprodTD ) ELSE - maxKHtopdown(i,j)=0.0 + maxKHtopdown(i) = 0.0 KHtopdown(kts:kte) = 0.0 - TKEprodTD(kts:kte)=0.0 - ENDIF !end top-down check + TKEprodTD(kts:kte) = 0.0 + ENDIF IF (bl_mynn_edmf > 0) THEN - !PRINT*,"Calling DMP Mass-Flux: i= ",i," j=",j + !PRINT*,"Calling DMP Mass-Flux: i= ",i," j=" CALL DMP_mf( & &kts,kte,delt,zw,dz1,p1, & &bl_mynn_edmf_mom, & @@ -4899,11 +5165,11 @@ SUBROUTINE mynn_bl_driver( & &sqw,sqv,sqc,qke1, & &qnc1,qni1,qnwfa1,qnifa1, & &ex1,Vt,Vq,sgm, & - &ust(i,j),flt,flq,flqv,flqc, & - &PBLH(i,j),KPBL(i,j),DX(i,j), & - &xland(i,j),th_sfc, & + &ust(i),flt,flq,flqv,flqc, & + &PBLH(i),KPBL(i),DX(i), & + &xland(i),th_sfc, & ! now outputs - tendencies - ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & + ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & ! outputs - updraft properties & edmf_a1,edmf_w1,edmf_qt1, & & edmf_thl1,edmf_ent1,edmf_qc1, & @@ -4919,37 +5185,52 @@ SUBROUTINE mynn_bl_driver( & & det_u,det_v, & #if (WRF_CHEM == 1) & nchem,chem1,s_awchem1, & + & mynn_chem_vertmx, & #endif & qc_bl1D,cldfra_bl1D, & & qc_bl1D_old,cldfra_bl1D_old, & & FLAG_QC,FLAG_QI, & & FLAG_QNC,FLAG_QNI, & & FLAG_QNWFA,FLAG_QNIFA, & - & Psig_shcu(i,j), & - & nupdraft(i,j),ktop_plume(i,j), & - & maxmf(i,j),ztop_plume, & - & spp_pbl,rstoch_col & - ) + & Psig_shcu(i), & + & nupdraft(i),ktop_plume(i), & + & maxmf(i),ztop_plume, & + & spp_pbl,rstoch_col ) + ENDIF + IF (bl_mynn_edmf_dd == 1) THEN + CALL DDMF_JPL(kts,kte,delt,zw,dz1,p1, & + &u1,v1,th1,thl,thetav,tk1, & + sqw,sqv,sqc,rho1,ex1, & + &ust(i),flt,flq, & + &PBLH(i),KPBL(i), & + &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1, & + &edmf_thl_dd1,edmf_ent_dd1, & + &edmf_qc_dd1, & + &sd_aw1,sd_awthl1,sd_awqt1, & + &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1, & + &sd_awqke1, & + &qc_bl1d,cldfra_bl1d, & + &rthraten(i,:) ) ENDIF !> - Call mym_turbulence() to collect the necessary variable !! to carry out successive claculations. CALL mym_turbulence ( & - &kts,kte,levflag, & - &dz1, DX(i,j), zw, & - &u1, v1, thl, sqc, sqw, & + &kts,kte,closure, & + &dz1, DX(i), zw, & + &u1, v1, thl, thetav, sqc, sqw, & &qke1, tsq1, qsq1, cov1, & &vt, vq, & - &rmol(i,j), flt, flq, & - &PBLH(i,j),th1, & - &Sh,el, & + &rmol(i), flt, flq, & + &PBLH(i),th1, & + &Sh,Sm,el, & &Dfm,Dfh,Dfq, & &Tcd,Qcd,Pdk, & &Pdt,Pdq,Pdc, & &qWT1,qSHEAR1,qBUOY1,qDISS1, & &bl_mynn_tkebudget, & - &Psig_bl(i,j),Psig_shcu(i,j), & + &Psig_bl(i),Psig_shcu(i), & &cldfra_bl1D,bl_mynn_mixlength, & &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & &TKEprodTD, & @@ -4958,43 +5239,47 @@ SUBROUTINE mynn_bl_driver( & !> - Call mym_predict() to solve TKE and !! \f$\theta^{'2}, q^{'2}, and \theta^{'}q^{'}\f$ !! for the following time step. - CALL mym_predict (kts,kte,levflag, & + CALL mym_predict (kts,kte,closure, & &delt, dz1, & - &ust(i,j), flt, flq, pmz, phh, & - &el, dfq, pdk, pdt, pdq, pdc, & + &ust(i), flt, flq, pmz, phh, & + &el, dfq, rho1, pdk, pdt, pdq, pdc,& &Qke1, Tsq1, Qsq1, Cov1, & - &s_aw1, s_awqke1, bl_mynn_edmf_tke) + &s_aw1, s_awqke1, bl_mynn_edmf_tke,& + &qWT1, qDISS1,bl_mynn_tkebudget) !! TKE budget (Puhales, 2020) DO k=kts,kte-1 - ! Set max dissipative heating rate close to 0.1 K per hour (=0.000027...) - diss_heat(k) = MIN(MAX(twothirds*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.00003) + ! Set max dissipative heating rate to 7.2 K per hour + diss_heat(k) = MIN(MAX(0.75*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.002) ENDDO diss_heat(kte) = 0. !> - Call mynn_tendencies() to solve for tendencies of !! \f$U, V, \theta, q_{v}, q_{c}, and q_{i}\f$. CALL mynn_tendencies(kts,kte, & - &levflag,grav_settling, & + &closure,grav_settling, & &delt, dz1, rho1, & &u1, v1, th1, tk1, qv1, & &qc1, qi1, qnc1, qni1, & - &p1, ex1, thl, sqv, sqc, sqi, sqw,& + &ps(i), p1, ex1, thl, & + &sqv, sqc, sqi, sqw, & &qnwfa1, qnifa1, ozone1, & - &ust(i,j),flt,flq,flqv,flqc, & - &wspd(i,j),qcg(i,j), & - &uoce(i,j),voce(i,j), & + &ust(i),flt,flq,flqv,flqc, & + &wspd(i),qcg(i), & + &uoce(i),voce(i), & &tsq1, qsq1, cov1, & &tcd, qcd, & &dfm, dfh, dfq, & &Du1, Dv1, Dth1, Dqv1, & &Dqc1, Dqi1, Dqnc1, Dqni1, & &Dqnwfa1, Dqnifa1, Dozone1, & - &vdfg(i,j), diss_heat, & + &vdfg(i), diss_heat, & ! mass flux components &s_aw1,s_awthl1,s_awqt1, & &s_awqv1,s_awqc1,s_awu1,s_awv1, & &s_awqnc1,s_awqni1, & &s_awqnwfa1,s_awqnifa1, & + &sd_aw1,sd_awthl1,sd_awqt1, & + &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,& &sub_thl,sub_sqv, & &sub_u,sub_v, & &det_thl,det_sqv,det_sqc, & @@ -5006,60 +5291,67 @@ SUBROUTINE mynn_bl_driver( & &bl_mynn_mixqt, & &bl_mynn_edmf, & &bl_mynn_edmf_mom, & - &bl_mynn_mixscalars ) + &bl_mynn_mixscalars ) #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN - CALL mynn_mix_chem(kts,kte, & - levflag,grav_settling, & - delt, dz1, & - nchem, kdvel, ndvel, num_vert_mix, & - chem1, vd1, & - qnc1,qni1, & - p1, ex1, thl, sqv, sqc, sqi, sqw,& - ust(i,j),flt,flq,flqv,flqc, & - wspd(i,j),qcg(i,j), & - uoce(i,j),voce(i,j), & - tsq1, qsq1, cov1, & - tcd, qcd, & - &dfm, dfh, dfq, & + IF ( mynn_chem_vertmx ) THEN + CALL mynn_mix_chem(kts,kte,i, & + grav_settling, & + delt, dz1, pblh(i), & + nchem, kdvel, ndvel, num_vert_mix,& + chem1, vd1, & + qnc1,qni1, & + p1, ex1, thl, sqv, sqc, sqi, sqw, & + rho1, ust(i),flt,flq,flqv,flqc, & + wspd(i),qcg(i), & + tcd, qcd, & + &dfm, dfh, dfq, & ! mass flux components - & s_aw1, & - & s_awchem1, & - &bl_mynn_cloudmix) + & s_aw1, & + & s_awchem1, & + &bl_mynn_cloudmix, & + EMIS_ANT_NO(i), & + FRP_MEAN(i), & + enh_vermix) + IF (PRESENT(chem3d) ) THEN + DO ic = 1,nchem + DO k = kts,kte + chem3d(i,k,ic) = chem1(k,ic) + ENDDO + ENDDO + ENDIF ENDIF #endif -!> - Call retrieve_exchange_coeffs() to retrieve K_m1 -!! and K_h1. + CALL retrieve_exchange_coeffs(kts,kte,& &dfm, dfh, dz1, K_m1, K_h1) !UPDATE 3D ARRAYS DO k=KTS,KTE !KTF - exch_m(i,k,j)=K_m1(k) - exch_h(i,k,j)=K_h1(k) - RUBLTEN(i,k,j)=du1(k) - RVBLTEN(i,k,j)=dv1(k) - RTHBLTEN(i,k,j)=dth1(k) - RQVBLTEN(i,k,j)=dqv1(k) + exch_m(i,k)=K_m1(k) + exch_h(i,k)=K_h1(k) + RUBLTEN(i,k)=du1(k) + RVBLTEN(i,k)=dv1(k) + RTHBLTEN(i,k)=dth1(k) + RQVBLTEN(i,k)=dqv1(k) IF(bl_mynn_cloudmix > 0)THEN - IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k,j)=dqc1(k) - IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k,j)=dqi1(k) + IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k)=dqc1(k) + IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k)=dqi1(k) ELSE - IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k,j)=0. - IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k,j)=0. + IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k)=0. + IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k)=0. ENDIF IF(bl_mynn_cloudmix > 0 .AND. bl_mynn_mixscalars > 0)THEN - IF (PRESENT(qnc) .AND. FLAG_QNC) RQNCBLTEN(i,k,j)=dqnc1(k) - IF (PRESENT(qni) .AND. FLAG_QNI) RQNIBLTEN(i,k,j)=dqni1(k) - IF (PRESENT(qnwfa) .AND. FLAG_QNWFA) RQNWFABLTEN(i,k,j)=dqnwfa1(k) - IF (PRESENT(qnifa) .AND. FLAG_QNIFA) RQNIFABLTEN(i,k,j)=dqnifa1(k) + IF (PRESENT(qnc) .AND. FLAG_QNC) RQNCBLTEN(i,k)=dqnc1(k) + IF (PRESENT(qni) .AND. FLAG_QNI) RQNIBLTEN(i,k)=dqni1(k) + IF (PRESENT(qnwfa) .AND. FLAG_QNWFA) RQNWFABLTEN(i,k)=dqnwfa1(k) + IF (PRESENT(qnifa) .AND. FLAG_QNIFA) RQNIFABLTEN(i,k)=dqnifa1(k) ELSE - IF (PRESENT(qnc) .AND. FLAG_QNC) RQNCBLTEN(i,k,j)=0. - IF (PRESENT(qni) .AND. FLAG_QNI) RQNIBLTEN(i,k,j)=0. - IF (PRESENT(qnwfa) .AND. FLAG_QNWFA) RQNWFABLTEN(i,k,j)=0. - IF (PRESENT(qnifa) .AND. FLAG_QNIFA) RQNIFABLTEN(i,k,j)=0. + IF (PRESENT(qnc) .AND. FLAG_QNC) RQNCBLTEN(i,k)=0. + IF (PRESENT(qni) .AND. FLAG_QNI) RQNIBLTEN(i,k)=0. + IF (PRESENT(qnwfa) .AND. FLAG_QNWFA) RQNWFABLTEN(i,k)=0. + IF (PRESENT(qnifa) .AND. FLAG_QNIFA) RQNIFABLTEN(i,k)=0. ENDIF DOZONE(i,k)=DOZONE1(k) @@ -5069,45 +5361,58 @@ SUBROUTINE mynn_bl_driver( & !DECAY TIMESCALE FOR CALM CONDITION IS THE EDDY TURNOVER !TIMESCALE, BUT FOR WINDY CONDITIONS, IT IS THE ADVECTIVE !TIMESCALE. USE THE MINIMUM OF THE TWO. - ts_decay = MIN( 1800., 3.*dx(i,j)/MAX(SQRT(u1(k)**2 + v1(k)**2),1.0) ) - cldfra_bl(i,k,j)= MAX(cldfra_bl1D(k),cldfra_bl1D_old(k)-(0.25*delt/ts_decay)) + ts_decay = MIN( 1800., 3.*dx(i)/MAX(SQRT(u1(k)**2 + v1(k)**2),1.0) ) + cldfra_bl(i,k)= MAX(cldfra_bl1D(k),cldfra_bl1D_old(k)-(0.25*delt/ts_decay)) ! qc_bl2 and qi_bl2 are decay rates qc_bl2 = MAX(qc_bl1D(k),qc_bl1D_old(k)) qc_bl2 = MAX(qc_bl2,1.0E-5) qi_bl2 = MAX(qi_bl1D(k),qi_bl1D_old(k)) qi_bl2 = MAX(qi_bl2,1.0E-6) - qc_bl(i,k,j) = MAX(qc_bl1D(k),qc_bl1D_old(k)-(MIN(qc_bl2,1.0E-4) * delt/ts_decay)) - qi_bl(i,k,j) = MAX(qi_bl1D(k),qi_bl1D_old(k)-(MIN(qi_bl2,1.0E-5) * delt/ts_decay)) - IF (cldfra_bl(i,k,j) < 0.005 .OR. & - (qc_bl(i,k,j) + qi_bl(i,k,j)) < 1E-9) THEN - CLDFRA_BL(i,k,j)= 0. - QC_BL(i,k,j) = 0. - QI_BL(i,k,j) = 0. + qc_bl(i,k) = MAX(qc_bl1D(k),qc_bl1D_old(k)-(MIN(qc_bl2,1.0E-4) * delt/ts_decay)) + qi_bl(i,k) = MAX(qi_bl1D(k),qi_bl1D_old(k)-(MIN(qi_bl2,1.0E-5) * delt/ts_decay)) + IF (cldfra_bl(i,k) < 0.005 .OR. & + (qc_bl(i,k) + qi_bl(i,k)) < 1E-9) THEN + CLDFRA_BL(i,k)= 0. + QC_BL(i,k) = 0. + QI_BL(i,k) = 0. ENDIF ELSE - qc_bl(i,k,j)=qc_bl1D(k) - qi_bl(i,k,j)=qi_bl1D(k) - cldfra_bl(i,k,j)=cldfra_bl1D(k) + qc_bl(i,k)=qc_bl1D(k) + qi_bl(i,k)=qi_bl1D(k) + cldfra_bl(i,k)=cldfra_bl1D(k) ENDIF ENDIF - el_pbl(i,k,j)=el(k) - qke(i,k,j)=qke1(k) - tsq(i,k,j)=tsq1(k) - qsq(i,k,j)=qsq1(k) - cov(i,k,j)=cov1(k) - sh3d(i,k,j)=sh(k) + el_pbl(i,k)=el(k) + qke(i,k)=qke1(k) + tsq(i,k)=tsq1(k) + qsq(i,k)=qsq1(k) + cov(i,k)=cov1(k) + sh3d(i,k)=sh(k) ENDDO !end-k IF ( bl_mynn_tkebudget == 1) THEN - DO k = kts,kte - dqke(i,k,j) = (qke1(k)-dqke(i,k,j))*0.5 !qke->tke - qWT(i,k,j) = qWT1(k)*delt - qSHEAR(i,k,j)= qSHEAR1(k)*delt - qBUOY(i,k,j) = qBUOY1(k)*delt - qDISS(i,k,j) = qDISS1(k)*delt + !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) + !! Lower boundary condtions (using similarity relationships such as the prognostic equation for Qke) + k=kts + qSHEAR1(k)=4.*(ust(i)**3*phi_m/(vk*dz(i,k)))-qSHEAR1(k+1) !! staggered + qBUOY1(k)=4.*(-ust(i)**3*zet/(vk*dz(i,k)))-qBUOY1(k+1) !! staggered + !! unstaggering SHEAR and BUOY and trasfering all TKE budget to 3D array + DO k = kts,kte-1 + qSHEAR(i,k)=0.5*(qSHEAR1(k)+qSHEAR1(k+1)) !!! unstaggering in z + qBUOY(i,k)=0.5*(qBUOY1(k)+qBUOY1(k+1)) !!! unstaggering in z + qWT(i,k)=qWT1(k) + qDISS(i,k)=qDISS1(k) + dqke(i,k)=(qke1(k)-dqke(i,k))*0.5/delt ENDDO + !! Upper boundary conditions + k=kte + qSHEAR(i,k)=0. + qBUOY(i,k)=0. + qWT(i,k)=0. + qDISS(i,k)=0. + dqke(i,k)=0. ENDIF !update updraft properties @@ -5124,42 +5429,51 @@ SUBROUTINE mynn_bl_driver( & det_thl3D(i,k)=det_thl(k) det_sqv3D(i,k)=det_sqv(k) ENDDO + if (bl_mynn_edmf_dd > 0) THEN + !update downdraft properties + edmf_a_dd(i,k)=edmf_a_dd1(k) + edmf_w_dd(i,k)=edmf_w_dd1(k) + edmf_qt_dd(i,k)=edmf_qt_dd1(k) + edmf_thl_dd(i,k)=edmf_thl_dd1(k) + edmf_ent_dd(i,k)=edmf_ent_dd1(k) + edmf_qc_dd(i,k)=edmf_qc_dd1(k) + ENDIF ENDIF !*** Begin debug prints IF ( debug_code ) THEN DO k = kts,kte IF ( sh(k) < 0. .OR. sh(k)> 200.)print*,& - "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," sh=",sh(k) - IF ( qke(i,k,j) < -1. .OR. qke(i,k,j)> 200.)print*,& - "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," qke=",qke(i,k,j) - IF ( el_pbl(i,k,j) < 0. .OR. el_pbl(i,k,j)> 2000.)print*,& - "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," el_pbl=",el_pbl(i,k,j) + "SUSPICIOUS VALUES AT: i,k=",i,k," sh=",sh(k) + IF ( qke(i,k) < -1. .OR. qke(i,k)> 200.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," qke=",qke(i,k) + IF ( el_pbl(i,k) < 0. .OR. el_pbl(i,k)> 2000.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," el_pbl=",el_pbl(i,k) IF ( ABS(vt(k)) > 0.8 )print*,& - "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," vt=",vt(k) + "SUSPICIOUS VALUES AT: i,k=",i,k," vt=",vt(k) IF ( ABS(vq(k)) > 6000.)print*,& - "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," vq=",vq(k) - IF ( exch_m(i,k,j) < 0. .OR. exch_m(i,k,j)> 2000.)print*,& - "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," exxch_m=",exch_m(i,k,j) - IF ( vdfg(i,j) < 0. .OR. vdfg(i,j)>5. )print*,& - "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," vdfg=",vdfg(i,j) - IF ( ABS(QFX(i,j))>.001)print*,& - "SUSPICIOUS VALUES AT: i,j=",i,j," QFX=",QFX(i,j) - IF ( ABS(HFX(i,j))>1000.)print*,& - "SUSPICIOUS VALUES AT: i,j=",i,j," HFX=",HFX(i,j) + "SUSPICIOUS VALUES AT: i,k=",i,k," vq=",vq(k) + IF ( exch_m(i,k) < 0. .OR. exch_m(i,k)> 2000.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," exxch_m=",exch_m(i,k) + IF ( vdfg(i) < 0. .OR. vdfg(i)>5. )print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," vdfg=",vdfg(i) + IF ( ABS(QFX(i))>.001)print*,& + "SUSPICIOUS VALUES AT: i=",i," QFX=",QFX(i) + IF ( ABS(HFX(i))>1000.)print*,& + "SUSPICIOUS VALUES AT: i=",i," HFX=",HFX(i) IF (icloud_bl > 0) then - IF( cldfra_bl(i,k,j) < 0.0 .OR. cldfra_bl(i,k,j)> 1.)THEN - PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k,j)," qc_bl=",QC_BL(i,k,j) + IF( cldfra_bl(i,k) < 0.0 .OR. cldfra_bl(i,k)> 1.)THEN + PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k)," qc_bl=",QC_BL(i,k) ENDIF ENDIF !IF (I==IMD .AND. J==JMD) THEN ! PRINT*,"MYNN DRIVER END: k=",k," sh=",sh(k) - ! PRINT*," sqw=",sqw(k)," thl=",thl(k)," exch_m=",exch_m(i,k,j) - ! PRINT*," xland=",xland(i,j)," rmol=",rmol(i,j)," ust=",ust(i,j) - ! PRINT*," qke=",qke(i,k,j)," el=",el_pbl(i,k,j)," tsq=",tsq(i,k,j) - ! PRINT*," PBLH=",PBLH(i,j)," u=",u(i,k,j)," v=",v(i,k,j) - ! PRINT*," vq=",vq(k)," vt=",vt(k)," vdfg=",vdfg(i,j) + ! PRINT*," sqw=",sqw(k)," thl=",thl(k)," exch_m=",exch_m(i,k) + ! PRINT*," xland=",xland(i)," rmol=",rmol(i)," ust=",ust(i) + ! PRINT*," qke=",qke(i,k)," el=",el_pbl(i,k)," tsq=",tsq(i,k) + ! PRINT*," PBLH=",PBLH(i)," u=",u(i,k)," v=",v(i,k) + ! PRINT*," vq=",vq(k)," vt=",vt(k)," vdfg=",vdfg(i) !ENDIF ENDDO !end-k ENDIF @@ -5167,15 +5481,14 @@ SUBROUTINE mynn_bl_driver( & !JOE-add tke_pbl for coupling w/shallow-cu schemes (TKE_PBL = QKE/2.) ! TKE_PBL is defined on interfaces, while QKE is at middle of layer. - !tke_pbl(i,kts,j) = 0.5*MAX(qke(i,kts,j),1.0e-10) + !tke_pbl(i,kts) = 0.5*MAX(qke(i,kts),1.0e-10) !DO k = kts+1,kte ! afk = dz1(k)/( dz1(k)+dz1(k-1) ) ! abk = 1.0 -afk - ! tke_pbl(i,k,j) = 0.5*MAX(qke(i,k,j)*abk+qke(i,k-1,j)*afk,1.0e-3) + ! tke_pbl(i,k) = 0.5*MAX(qke(i,k)*abk+qke(i,k-1)*afk,1.0e-3) !ENDDO - ENDDO - ENDDO + ENDDO !end i-loop !ACF copy qke into qke_adv if using advection IF (bl_mynn_tkeadvect) THEN @@ -5213,14 +5526,11 @@ SUBROUTINE mynn_bl_init_driver( & & ITS,ITE,JTS,JTE,KTS,KTE - REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: & - &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & + REAL,DIMENSION(IMS:IME,KMS:KME),INTENT(INOUT) :: & + &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & &RQCBLTEN,RQIBLTEN,& !RQNIBLTEN,RQNCBLTEN & &QKE,EXCH_H -! REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: & -! &qc_bl,cldfra_bl - INTEGER :: I,J,K,ITF,JTF,KTF JTF=MIN0(JTE,JDE-1) @@ -5228,22 +5538,20 @@ SUBROUTINE mynn_bl_init_driver( & ITF=MIN0(ITE,IDE-1) IF(.NOT.RESTART)THEN - DO J=JTS,JTF - DO K=KTS,KTF - DO I=ITS,ITF - RUBLTEN(i,k,j)=0. - RVBLTEN(i,k,j)=0. - RTHBLTEN(i,k,j)=0. - RQVBLTEN(i,k,j)=0. - if( p_qc >= param_first_scalar ) RQCBLTEN(i,k,j)=0. - if( p_qi >= param_first_scalar ) RQIBLTEN(i,k,j)=0. - !if( p_qnc >= param_first_scalar ) RQNCBLTEN(i,k,j)=0. - !if( p_qni >= param_first_scalar ) RQNIBLTEN(i,k,j)=0. - !QKE(i,k,j)=0. - EXCH_H(i,k,j)=0. -! if(icloud_bl > 0) qc_bl(i,k,j)=0. -! if(icloud_bl > 0) cldfra_bl(i,k,j)=0. - ENDDO + DO K=KTS,KTF + DO I=ITS,ITF + RUBLTEN(i,k)=0. + RVBLTEN(i,k)=0. + RTHBLTEN(i,k)=0. + RQVBLTEN(i,k)=0. + if( p_qc >= param_first_scalar ) RQCBLTEN(i,k)=0. + if( p_qi >= param_first_scalar ) RQIBLTEN(i,k)=0. + !if( p_qnc >= param_first_scalar ) RQNCBLTEN(i,k)=0. + !if( p_qni >= param_first_scalar ) RQNIBLTEN(i,k)=0. + !QKE(i,k)=0. + EXCH_H(i,k)=0. +! if(icloud_bl > 0) qc_bl(i,k)=0. +! if(icloud_bl > 0) cldfra_bl(i,k)=0. ENDDO ENDDO ENDIF @@ -5375,7 +5683,7 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) & MIN((TKEeps-qtke)/MAX(qtkem1-qtke, 1E-6), 1.0) !IN CASE OF NEAR ZERO TKE, SET PBLH = LOWEST LEVEL. PBLH_TKE = MAX(PBLH_TKE,zw1D(kts+1)) - !print *,"PBLH_TKE:",i,j,PBLH_TKE, Qke1D(k)/2., zw1D(kts+1) + !print *,"PBLH_TKE:",i,PBLH_TKE, Qke1D(k)/2., zw1D(kts+1) ENDIF !k = k+1 IF (k .EQ. kte-1) PBLH_TKE = zw1D(kts+1) !EXIT SAFEGUARD @@ -5441,7 +5749,7 @@ SUBROUTINE DMP_mf( & & scalar_opt, & & u,v,w,th,thl,thv,tk, & & qt,qv,qc,qke, & - qnc,qni,qnwfa,qnifa, & + & qnc,qni,qnwfa,qnifa, & & exner,vt,vq,sgm, & & ust,flt,flq,flqv,flqc, & & pblh,kpbl,DX,landsea,ts, & @@ -5461,6 +5769,7 @@ SUBROUTINE DMP_mf( & & det_u,det_v, & #if (WRF_CHEM == 1) & nchem,chem,s_awchem, & + & mynn_chem_vertmx, & #endif ! in/outputs - subgrid scale clouds & qc_bl1d,cldfra_bl1d, & @@ -5489,7 +5798,7 @@ SUBROUTINE DMP_mf( & REAL,DIMENSION(KTS:KTE), INTENT(IN) :: U,V,W,TH,THL,TK,QT,QV,QC,& exner,dz,THV,P,qke,qnc,qni,qnwfa,qnifa - REAL,DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW !height at full-sigma + REAL,DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW !height at full-sigma REAL, INTENT(IN) :: DT,UST,FLT,FLQ,FLQV,FLQC,PBLH,& DX,Psig_shcu,landsea,ts LOGICAL, OPTIONAL :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA @@ -5567,6 +5876,7 @@ SUBROUTINE DMP_mf( & REAL,DIMENSION(KTS:KTE+1,1:NUP, nchem) :: UPCHEM INTEGER :: ic REAL,DIMENSION(KTS:KTE+1, nchem) :: edmf_chem + LOGICAL, INTENT(IN) :: mynn_chem_vertmx #endif !JOE: add declaration of ERF @@ -5604,8 +5914,8 @@ SUBROUTINE DMP_mf( & envm_u,envm_v !environmental variables defined at middle of layer REAL,DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface REAL :: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & - detrateUV,oow,exc_fac,aratio,detturb,qc_grid - REAL, PARAMETER :: Cdet = 1./45. + detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs + REAL, PARAMETER :: Cdet = 1./45. REAL, PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of @@ -5613,6 +5923,10 @@ SUBROUTINE DMP_mf( & !is compensated by "gentle" environmental subsidence. REAL, PARAMETER :: Csub=0.25 + !Factor for the pressure gradient effects on momentum transport + REAL, PARAMETER :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere + REAL :: Uk,Ukm1,Vk,Vkm1,dxsa + ! check the inputs ! print *,'dt',dt ! print *,'dz',dz @@ -5641,7 +5955,7 @@ SUBROUTINE DMP_mf( & UPQNWFA=0. UPQNIFA=0. #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN UPCHEM(KTS:KTE+1,1:NUP,1:nchem)=0.0 ENDIF #endif @@ -5654,7 +5968,7 @@ SUBROUTINE DMP_mf( & edmf_ent=0. edmf_qc =0. #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN edmf_chem(kts:kte+1,1:nchem) = 0.0 ENDIF #endif @@ -5672,7 +5986,7 @@ SUBROUTINE DMP_mf( & s_awqnwfa=0. s_awqnifa=0. #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN s_awchem(kts:kte+1,1:nchem) = 0.0 ENDIF #endif @@ -5704,7 +6018,9 @@ SUBROUTINE DMP_mf( & IF(ZW(k)<=50.)k50=k !Search for cloud base - IF(qc(k)>1E-5 .AND. cloud_base == 9000.0)THEN + qc_sgs = MAX(qc(k), qc_bl1d(k)*cldfra_bl1d(k)) + !IF(qc(k) >1E-5 .AND. cloud_base == 9000.0)THEN + IF(qc_sgs> 1E-5 .AND. cloud_base == 9000.0)THEN cloud_base = 0.5*(ZW(k)+ZW(k+1)) ENDIF @@ -5875,7 +6191,7 @@ SUBROUTINE DMP_mf( & ENDDO #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN DO I=1,NUP !NUP2 IF(I > NUP2) exit do ic = 1,nchem @@ -5894,6 +6210,9 @@ SUBROUTINE DMP_mf( & envm_v(k)=V(k) ENDDO + !dxsa is scale-adaptive factor governing the pressure-gradient term of the momentum transport + dxsa = 1. - MIN(MAX((12000.0-dx)/(12000.0-3000.0), 0.), 1.) + !QCn = 0. ! do integration updraft DO I=1,NUP !NUP2 @@ -5921,12 +6240,18 @@ SUBROUTINE DMP_mf( & ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) + ! Define environment U & V at the model interface levels + Uk =(U(k)*DZ(k+1)+U(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + Ukm1=(U(k-1)*DZ(k)+U(k)*DZ(k-1))/(DZ(k-1)+DZ(k)) + Vk =(V(k)*DZ(k+1)+V(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + Vkm1=(V(k-1)*DZ(k)+V(k)*DZ(k-1))/(DZ(k-1)+DZ(k)) + ! Linear entrainment: EntExp= ENT(K,I)*(ZW(k+1)-ZW(k)) QTn =UPQT(k-1,I) *(1.-EntExp) + QT(k)*EntExp THLn=UPTHL(k-1,I)*(1.-EntExp) + THL(k)*EntExp - Un =UPU(k-1,I) *(1.-EntExp) + U(k)*EntExp - Vn =UPV(k-1,I) *(1.-EntExp) + V(k)*EntExp + Un =UPU(k-1,I) *(1.-EntExp) + U(k)*EntExp + dxsa*pgfac*(Uk - Ukm1) + Vn =UPV(k-1,I) *(1.-EntExp) + V(k)*EntExp + dxsa*pgfac*(Vk - Vkm1) QKEn=UPQKE(k-1,I)*(1.-EntExp) + QKE(k)*EntExp QNCn=UPQNC(k-1,I)*(1.-EntExp) + QNC(k)*EntExp QNIn=UPQNI(k-1,I)*(1.-EntExp) + QNI(k)*EntExp @@ -5948,7 +6273,7 @@ SUBROUTINE DMP_mf( & !QKEn=QKE(k)*(1-EntExp)+UPQKE(K-1,I)*EntExp #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN do ic = 1,nchem ! Exponential Entrainment: !chemn(ic) = chem(k,ic)*(1-EntExp)+UPCHEM(K-1,I,ic)*EntExp @@ -5998,6 +6323,46 @@ SUBROUTINE DMP_mf( & Wn = UPW(K-1,I) - MIN(1.25*(ZW(k)-ZW(k-1))/200., 2.0) ENDIF Wn = MIN(MAX(Wn,0.0), 3.0) +! WA ACP mod 5/7/20 for accelerating plumes above cloud base, add entrainment +! and recalculate updraft variables + IF (QCn > 0.0 .AND. Wn > UPW(K-1,I)) THEN + ENT(K,I) = ENT(K,I) * 2.0 + EntExp= ENT(K,I)*(ZW(k+1)-ZW(k)) + QTn =UPQT(k-1,I) *(1.-EntExp) + QT(k)*EntExp + THLn=UPTHL(k-1,I)*(1.-EntExp) + THL(k)*EntExp + Un =UPU(k-1,I) *(1.-EntExp) + U(k)*EntExp + Vn =UPV(k-1,I) *(1.-EntExp) + V(k)*EntExp + QKEn=UPQKE(k-1,I)*(1.-EntExp) + QKE(k)*EntExp + QNCn=UPQNC(k-1,I)*(1.-EntExp) + QNC(k)*EntExp + QNIn=UPQNI(k-1,I)*(1.-EntExp) + QNI(k)*EntExp + QNWFAn=UPQNWFA(k-1,I)*(1.-EntExp) + QNWFA(k)*EntExp + QNIFAn=UPQNIFA(k-1,I)*(1.-EntExp) + QNIFA(k)*EntExp + ! Define pressure at model interface + Pk =(P(k)*DZ(k+1)+P(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + ! Compute new plume properties thvn and qcn + call condensation_edmf(QTn,THLn,Pk,ZW(k+1),THVn,QCn) + ! Define environment THV at the model interface levels + THVk =(THV(k)*DZ(k+1)+THV(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + THVkm1=(THV(k-1)*DZ(k)+THV(k)*DZ(k-1))/(DZ(k-1)+DZ(k)) + B=g*(THVn/THVk - 1.0) + IF(B>0.)THEN + BCOEFF = 0.15 + ELSE + BCOEFF = 0.2 !0.33 + ENDIF + + IF (UPW(K-1,I) < 0.2 ) THEN + Wn = UPW(K-1,I) + (-2. * ENT(K,I) * UPW(K-1,I) + BCOEFF*B / MAX(UPW(K-1,I),0.2)) * MIN(ZW(k)-ZW(k-1), 250.) + ELSE + Wn = UPW(K-1,I) + (-2. * ENT(K,I) * UPW(K-1,I) + BCOEFF*B / UPW(K-1,I)) * MIN(ZW(k)-ZW(k-1), 250.) + ENDIF + IF (UPW(K-1,I) < 0.2 ) THEN + Wn = UPW(K-1,I) + (-2. * ENT(K,I) * UPW(K-1,I) + BCOEFF*B / MAX(UPW(K-1,I),0.2)) * MIN(ZW(k)-ZW(k-1), 250.) + ELSE + Wn = UPW(K-1,I) + (-2. * ENT(K,I) * UPW(K-1,I) + BCOEFF*B / UPW(K-1,I)) * MIN(ZW(k)-ZW(k-1), 250.) + ENDIF + ENDIF +! END WA TEST !Check to make sure that the plume made it up at least one level. !if it failed, then set nup2=0 and exit the mass-flux portion. IF (k==kts+1 .AND. Wn == 0.) THEN @@ -6081,7 +6446,7 @@ SUBROUTINE DMP_mf( & UPQNIFA(K,I)=QNIFAn UPA(K,I)=UPA(K-1,I) #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN do ic = 1,nchem UPCHEM(k,I,ic) = chemn(ic) enddo @@ -6146,7 +6511,7 @@ SUBROUTINE DMP_mf( & s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) ENDDO #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN DO k=KTS,KTE IF(k > KTOP) exit DO i=1,NUP !NUP2 @@ -6205,7 +6570,7 @@ SUBROUTINE DMP_mf( & s_awqke= s_awqke*adjustment ENDIF #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN s_awchem = s_awchem*adjustment ENDIF #endif @@ -6226,7 +6591,7 @@ SUBROUTINE DMP_mf( & edmf_ent(K)=edmf_ent(K)+UPA(K,i)*ENT(K,i) edmf_qc(K) =edmf_qc(K) +UPA(K,i)*UPQC(K,i) #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN do ic = 1,nchem edmf_chem(k,ic) = edmf_chem(k,ic) + UPA(K,I)*UPCHEM(k,i,ic) enddo @@ -6243,7 +6608,7 @@ SUBROUTINE DMP_mf( & edmf_ent(k)=edmf_ent(k)/edmf_a(k) edmf_qc(k)=edmf_qc(k)/edmf_a(k) #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN + IF ( mynn_chem_vertmx ) THEN do ic = 1,nchem edmf_chem(k,ic) = edmf_chem(k,ic)/edmf_a(k) enddo @@ -6308,6 +6673,7 @@ SUBROUTINE DMP_mf( & det_sqv(k)=Cdet*(envm_sqv(k)-qv(k))*envi_a(k)*Psig_w det_sqc(k)=Cdet*(envm_sqc(k)-qc(k))*envi_a(k)*Psig_w ENDDO + IF (momentum_opt > 0) THEN sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)*(u(kts+1)-u(kts))/dzi(kts) sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)*(v(kts+1)-v(kts))/dzi(kts) @@ -6397,11 +6763,11 @@ SUBROUTINE DMP_mf( & sigq = 9.E-3 * 0.5*(edmf_a(k)+edmf_a(k-1)) * & & 0.5*(edmf_w(k)+edmf_w(k-1)) * f ! convective component of sigma (CB2005) - !sigq = MAX(sigq, 1.0E-4) sigq = SQRT(sigq**2 + sgm(k)**2) ! combined conv + stratus components + sigq = MAX(sigq, 1.0E-6) qmq = a * (qt(k) - qsat_tl) ! saturation deficit/excess; - ! the numerator of Q1 + ! the numerator of Q1 mf_cf = min(max(0.5 + 0.36 * atan(1.55*(qmq/sigq)),0.01),0.6) IF ( debug_code ) THEN print*,"In MYNN, StEM edmf" @@ -6442,7 +6808,7 @@ SUBROUTINE DMP_mf( & qc_bl1d(k) = (QCp*Ac_mf + QCs*Ac_strat)/cldfra_bl1d(k) ENDIF ELSE - Ac_mf = mf_cf + Ac_mf = mf_cf ENDIF !Now recalculate the terms for the buoyancy flux for mass-flux clouds: @@ -6451,7 +6817,7 @@ SUBROUTINE DMP_mf( & !following RAP and HRRR testing. !Fng = 2.05 ! the non-Gaussian transport factor (assumed constant) !Use Bechtold and Siebesma (1998) piecewise estimation of Fng: - Q1 = qmq/MAX(sigq,1E-10) + Q1 = qmq/MAX(sigq,1E-6) Q1=MAX(Q1,-5.0) IF (Q1 .GE. 1.0) THEN Fng = 1.0 @@ -6466,7 +6832,6 @@ SUBROUTINE DMP_mf( & vt(k) = qww - MIN(0.40,Ac_mf)*beta*bb*Fng - 1. vq(k) = alpha + MIN(0.40,Ac_mf)*beta*a*Fng - tv0 ENDIF - ENDDO ENDIF !end nup2 > 0 @@ -6589,17 +6954,417 @@ subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) end subroutine condensation_edmf !=============================================================== -!>\ingroup gsd_mynn_edmf -!! This subroutine calculates the similarity functions, -!!\f$P_{\sigma-PBL}\f$ and \f$P_{\sigma-shcu}\f$, to control the -!! scale-adaptive behavior for the local and nonlocal components, -!! respectively. -!! -!! NOTES ON SCALE-AWARE FORMULATION: -!!JOE: add scale-aware factor (Psig) here, taken from Honnert et al. (2011, -!! JAS) and/or from Hyeyum Hailey Shin and Song-You Hong (2013, JAS) + +subroutine condensation_edmf_r(QT,THL,P,zagl,THV,QC) +! +! zero or one condensation for edmf: calculates THL and QC +! similar to condensation_edmf but with different inputs +! +real,intent(in) :: QT,THV,P,zagl +real,intent(out) :: THL, QC + +integer :: niter,i +real :: diff,exn,t,th,qs,qcold + +! number of iterations + niter=50 +! minimum difference + diff=2.e-5 + + EXN=(P/p1000mb)**rcp + ! assume first that th = thv + T = THV*EXN + !QS = qsat_blend(T,P) + !QC = QS - QT + + QC=0. + + do i=1,NITER + QCOLD = QC + T = EXN*THV/(1.+QT*(rvovrd-1.)-rvovrd*QC) + QS=qsat_blend(T,P) + QC= MAX((QT-QS),0.) + if (abs(QC-QCOLD)0) then +! Wn2=DOWNW(K+1,I)**2*EntW - Wa*B/Beta_dm * (1. - EntW) +! else +! Wn2=DOWNW(K+1,I)**2 - 2.*Wa*B*deltaZ +! end if + + mindownw = MIN(DOWNW(K+1,I),-0.2) + Wn = DOWNW(K+1,I) + (-2.*ENT(K,I)*DOWNW(K+1,I) - & + BCOEFF*B/mindownw)*MIN(deltaZ, 250.) + + !Do not allow a parcel to accelerate more than 1.25 m/s over 200 m. + !Add max increase of 2.0 m/s for coarse vertical resolution. + IF(Wn < DOWNW(K+1,I) - MIN(1.25*deltaZ/200., 2.0))THEN + Wn = DOWNW(K+1,I) - MIN(1.25*deltaZ/200., 2.0) + ENDIF + !Add symmetrical max decrease in w + IF(Wn > DOWNW(K+1,I) + MIN(1.25*deltaZ/200., 2.0))THEN + Wn = DOWNW(K+1,I) + MIN(1.25*deltaZ/200., 2.0) + ENDIF + Wn = MAX(MIN(Wn,0.0), -3.0) + + print *, " k =", k, " z =", ZW(k) + print *, " entw =",ENT(K,I), " Bouy =", B + print *, " downthv =", THVn, " thvk =", thvk + print *, " downthl =", THLn, " thl =", thl(k) + print *, " downqt =", QTn , " qt =", qt(k) + print *, " downw+1 =",DOWNW(K+1,I), " Wn2 =", Wn + + IF (Wn .lt. 0.) THEN !terminate when velocity is too small + DOWNW(K,I) = Wn !-sqrt(Wn2) + DOWNTHV(K,I)= THVn + DOWNTHL(K,I)= THLn + DOWNQT(K,I) = QTn + DOWNQC(K,I) = QCn + DOWNU(K,I) = Un + DOWNV(K,I) = Vn + DOWNA(K,I) = DOWNA(K+1,I) + ELSE + !plumes must go at least 2 levels + if (DD_initK(I) - K .lt. 2) then + DOWNW(:,I) = 0.0 + DOWNTHV(:,I)= 0.0 + DOWNTHL(:,I)= 0.0 + DOWNQT(:,I) = 0.0 + DOWNQC(:,I) = 0.0 + DOWNU(:,I) = 0.0 + DOWNV(:,I) = 0.0 + endif + exit + ENDIF + ENDDO + ENDDO + endif ! end cloud flag + + DOWNW(1,:) = 0. !make sure downdraft does not go to the surface + DOWNA(1,:) = 0. + + ! Combine both moist and dry plume, write as one averaged plume + ! Even though downdraft starts at different height, average all up to qlTop + DO k=qlTop,KTS,-1 + DO I=1,NDOWN + IF (I > NDOWN) exit + edmf_a_dd(K) =edmf_a_dd(K) +DOWNA(K-1,I) + edmf_w_dd(K) =edmf_w_dd(K) +DOWNA(K-1,I)*DOWNW(K-1,I) + edmf_qt_dd(K) =edmf_qt_dd(K) +DOWNA(K-1,I)*DOWNQT(K-1,I) + edmf_thl_dd(K)=edmf_thl_dd(K)+DOWNA(K-1,I)*DOWNTHL(K-1,I) + edmf_ent_dd(K)=edmf_ent_dd(K)+DOWNA(K-1,I)*ENT(K-1,I) + edmf_qc_dd(K) =edmf_qc_dd(K) +DOWNA(K-1,I)*DOWNQC(K-1,I) + ENDDO + + IF (edmf_a_dd(k) >0.) THEN + edmf_w_dd(k) =edmf_w_dd(k) /edmf_a_dd(k) + edmf_qt_dd(k) =edmf_qt_dd(k) /edmf_a_dd(k) + edmf_thl_dd(k)=edmf_thl_dd(k)/edmf_a_dd(k) + edmf_ent_dd(k)=edmf_ent_dd(k)/edmf_a_dd(k) + edmf_qc_dd(k) =edmf_qc_dd(k) /edmf_a_dd(k) + ENDIF + ENDDO + + ! + ! computing variables needed for solver + ! + + DO k=KTS,qlTop + DO I=1,NDOWN + sd_aw(k) =sd_aw(k) +DOWNA(k,i)*DOWNW(k,i) + sd_awthl(k)=sd_awthl(k)+DOWNA(k,i)*DOWNW(k,i)*DOWNTHL(k,i) + sd_awqt(k) =sd_awqt(k) +DOWNA(k,i)*DOWNW(k,i)*DOWNQT(k,i) + sd_awqc(k) =sd_awqc(k) +DOWNA(k,i)*DOWNW(k,i)*DOWNQC(k,i) + sd_awu(k) =sd_awu(k) +DOWNA(k,i)*DOWNW(k,i)*DOWNU(k,i) + sd_awv(k) =sd_awv(k) +DOWNA(k,i)*DOWNW(k,i)*DOWNV(k,i) + ENDDO + sd_awqv(k) = sd_awqt(k) - sd_awqc(k) + ENDDO + +END SUBROUTINE DDMF_JPL +!=============================================================== + + SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) + !--------------------------------------------------------------- + ! NOTES ON SCALE-AWARE FORMULATION + ! + !JOE: add scale-aware factor (Psig) here, taken from Honnert et al. (2011, + ! JAS) and/or from Hyeyum Hailey Shin and Song-You Hong (2013, JAS) + ! ! Psig_bl tapers local mixing ! Psig_shcu tapers nonlocal mixing @@ -6766,6 +7531,220 @@ FUNCTION xl_blend(t) END FUNCTION xl_blend ! =================================================================== + + FUNCTION phim(zet) + ! New stability function parameters for momentum (Puhales, 2020, WRF 4.2.1) + ! The forms in unstable conditions (z/L < 0) use Grachev et al. (2000), which are a blend of + ! the classical (Kansas) forms (i.e., Paulson 1970, Dyer and Hicks 1970), valid for weakly + ! unstable conditions (-1 < z/L < 0). The stability functions for stable conditions use an + ! updated form taken from Cheng and Brutsaert (2005), which extends the validity into very + ! stable conditions [z/L ~ O(10)]. + IMPLICIT NONE + + REAL, INTENT(IN):: zet + REAL :: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi + REAL, PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + REAL, PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + REAL, PARAMETER :: am_unst=10., ah_unst=34. + REAL :: phi_m,phim + + if ( zet >= 0.0 ) then + dummy_0=1+zet**bm_st + dummy_1=zet+dummy_0**(rbm_st) + dummy_11=1+dummy_0**(rbm_st-1)*zet**(bm_st-1) + dummy_2=(-am_st/dummy_1)*dummy_11 + phi_m = 1-zet*dummy_2 + else + dummy_0 = (1.0-cphm_unst*zet)**0.25 + phi_m = 1./dummy_0 + dummy_psi = 2.*log(0.5*(1.+dummy_0))+log(0.5*(1.+dummy_0**2))-2.*atan(dummy_0)+1.570796 + + dummy_0=(1.-am_unst*zet) ! parentesis arg + dummy_1=dummy_0**0.333333 ! y + dummy_11=-0.33333*am_unst*dummy_0**-0.6666667 ! dy/dzet + dummy_2 = 0.33333*(dummy_1**2.+dummy_1+1.) ! f + dummy_22 = 0.3333*dummy_11*(2.*dummy_1+1.) ! df/dzet + dummy_3 = 0.57735*(2.*dummy_1+1.) ! g + dummy_33 = 1.1547*dummy_11 ! dg/dzet + dummy_4 = 1.5*log(dummy_2)-1.73205*atan(dummy_3)+1.813799364 !psic + dummy_44 = (1.5/dummy_2)*dummy_22-1.73205*dummy_33/(1.+dummy_3**2)! dpsic/dzet + + dummy_0 = zet**2 + dummy_1 = 1./(1.+dummy_0) ! denon + dummy_11 = 2.*zet ! denon/dzet + dummy_2 = ((1-phi_m)/zet+dummy_11*dummy_4+dummy_0*dummy_44)*dummy_1 + dummy_22 = -dummy_11*(dummy_psi+dummy_0*dummy_4)*dummy_1**2 + + phi_m = 1.-zet*(dummy_2+dummy_22) + end if + + !phim = phi_m - zet + phim = phi_m + + END FUNCTION phim +! =================================================================== + + FUNCTION phih(zet) + ! New stability function parameters for heat (Puhales, 2020, WRF 4.2.1) + ! The forms in unstable conditions (z/L < 0) use Grachev et al. (2000), which are a blend of + ! the classical (Kansas) forms (i.e., Paulson 1970, Dyer and Hicks 1970), valid for weakly + ! unstable conditions (-1 < z/L < 0). The stability functions for stable conditions use an + ! updated form taken from Cheng and Brutsaert (2005), which extends the validity into very + ! stable conditions [z/L ~ O(10)]. + IMPLICIT NONE + + REAL, INTENT(IN):: zet + REAL :: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi + REAL, PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + REAL, PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + REAL, PARAMETER :: am_unst=10., ah_unst=34. + REAL :: phh,phih + + if ( zet >= 0.0 ) then + dummy_0=1+zet**bh_st + dummy_1=zet+dummy_0**(rbh_st) + dummy_11=1+dummy_0**(rbh_st-1)*zet**(bh_st-1) + dummy_2=(-ah_st/dummy_1)*dummy_11 + phih = 1-zet*dummy_2 + else + dummy_0 = (1.0-cphh_unst*zet)**0.5 + phh = 1./dummy_0 + dummy_psi = 2.*log(0.5*(1.+dummy_0)) + + dummy_0=(1.-ah_unst*zet) ! parentesis arg + dummy_1=dummy_0**0.333333 ! y + dummy_11=-0.33333*ah_unst*dummy_0**-0.6666667 ! dy/dzet + dummy_2 = 0.33333*(dummy_1**2.+dummy_1+1.) ! f + dummy_22 = 0.3333*dummy_11*(2.*dummy_1+1.) ! df/dzet + dummy_3 = 0.57735*(2.*dummy_1+1.) ! g + dummy_33 = 1.1547*dummy_11 ! dg/dzet + dummy_4 = 1.5*log(dummy_2)-1.73205*atan(dummy_3)+1.813799364 !psic + dummy_44 = (1.5/dummy_2)*dummy_22-1.73205*dummy_33/(1.+dummy_3**2)! dpsic/dzet + + dummy_0 = zet**2 + dummy_1 = 1./(1.+dummy_0) ! denon + dummy_11 = 2.*zet ! ddenon/dzet + dummy_2 = ((1-phh)/zet+dummy_11*dummy_4+dummy_0*dummy_44)*dummy_1 + dummy_22 = -dummy_11*(dummy_psi+dummy_0*dummy_4)*dummy_1**2 + + phih = 1.-zet*(dummy_2+dummy_22) + end if + +END FUNCTION phih +! ================================================================== + SUBROUTINE topdown_cloudrad(kts,kte,dz1,zw,xland,kpbl,PBLH, & + &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & + &cldfra_bl1D,rthraten, & + &maxKHtopdown,KHtopdown,TKEprodTD ) + + !input + integer, intent(in) :: kte,kts + real, dimension(kts:kte), intent(in) :: dz1,sqc,sqi,sqw,& + thl,th1,ex1,p1,rho1,thetav,cldfra_bl1D,rthraten + real, dimension(kts:kte+1), intent(in) :: zw + real, intent(in) :: pblh,xland + integer,intent(in) :: kpbl + !output + real, intent(out) :: maxKHtopdown + real, dimension(kts:kte), intent(out) :: KHtopdown,TKEprodTD + !local + real, dimension(kts:kte) :: zfac,wscalek2,zfacent + real :: bfx0,sflux,wm2,wm3,h1,h2,bfxpbl,dthvx,tmp1 + real :: temps,templ,zl1,wstar3_2 + real :: ent_eff,radsum,radflux,we,rcldb,rvls,minrad,zminrad + real, parameter :: pfac =2.0, zfmin = 0.01, phifac=8.0 + integer :: k,kk,kminrad + logical :: cloudflg + + cloudflg=.false. + minrad=100. + kminrad=kpbl + zminrad=PBLH + KHtopdown(kts:kte)=0.0 + TKEprodTD(kts:kte)=0.0 + maxKHtopdown=0.0 + + !CHECK FOR STRATOCUMULUS-TOPPED BOUNDARY LAYERS + DO kk = MAX(1,kpbl-2),kpbl+3 + if (sqc(kk).gt. 1.e-6 .OR. sqi(kk).gt. 1.e-6 .OR. & + cldfra_bl1D(kk).gt.0.5) then + cloudflg=.true. + endif + if (rthraten(kk) < minrad)then + minrad=rthraten(kk) + kminrad=kk + zminrad=zw(kk) + 0.5*dz1(kk) + endif + ENDDO + + IF (MAX(kminrad,kpbl) < 2)cloudflg = .false. + IF (cloudflg) THEN + zl1 = dz1(kts) + k = MAX(kpbl-1, kminrad-1) + !Best estimate of height of TKE source (top of downdrafts): + !zminrad = 0.5*pblh(i) + 0.5*zminrad + + templ=thl(k)*ex1(k) + !rvls is ws at full level + rvls=100.*6.112*EXP(17.67*(templ-273.16)/(templ-29.65))*(ep_2/p1(k+1)) + temps=templ + (sqw(k)-rvls)/(cp/xlv + ep_2*xlv*rvls/(rd*templ**2)) + rvls=100.*6.112*EXP(17.67*(temps-273.15)/(temps-29.65))*(ep_2/p1(k+1)) + rcldb=max(sqw(k)-rvls,0.) + + !entrainment efficiency + dthvx = (thl(k+2) + th1(k+2)*ep_1*sqw(k+2)) & + - (thl(k) + th1(k) *ep_1*sqw(k)) + dthvx = max(dthvx,0.1) + tmp1 = xlvcp * rcldb/(ex1(k)*dthvx) + !Originally from Nichols and Turton (1986), where a2 = 60, but lowered + !here to 8, as in Grenier and Bretherton (2001). + ent_eff = 0.2 + 0.2*8.*tmp1 + + radsum=0. + DO kk = MAX(1,kpbl-3),kpbl+3 + radflux=rthraten(kk)*ex1(kk) !converts theta/s to temp/s + radflux=radflux*cp/g*(p1(kk)-p1(kk+1)) ! converts temp/s to W/m^2 + if (radflux < 0.0 ) radsum=abs(radflux)+radsum + ENDDO + + !More strict limits over land to reduce stable-layer mixouts + if ((xland-1.5).GE.0)THEN ! WATER + radsum=MIN(radsum,90.0) + bfx0 = max(radsum/rho1(k)/cp,0.) + else ! LAND + radsum=MIN(0.25*radsum,30.0)!practically turn off over land + bfx0 = max(radsum/rho1(k)/cp - max(sflux,0.0),0.) + endif + + !entrainment from PBL top thermals + wm3 = g/thetav(k)*bfx0*MIN(pblh,1500.) ! this is wstar3(i) + wm2 = wm2 + wm3**h2 + bfxpbl = - ent_eff * bfx0 + dthvx = max(thetav(k+1)-thetav(k),0.1) + we = max(bfxpbl/dthvx,-sqrt(wm3**h2)) + + DO kk = kts,kpbl+3 + !Analytic vertical profile + zfac(kk) = min(max((1.-(zw(kk+1)-zl1)/(zminrad-zl1)),zfmin),1.) + zfacent(kk) = 10.*MAX((zminrad-zw(kk+1))/zminrad,0.0)*(1.-zfac(kk))**3 + + !Calculate an eddy diffusivity profile (not used at the moment) + wscalek2(kk) = (phifac*karman*wm3*(zfac(kk)))**h1 + !Modify shape of Kh to be similar to Lock et al (2000): use pfac = 3.0 + KHtopdown(kk) = wscalek2(kk)*karman*(zminrad-zw(kk+1))*(1.-zfac(kk))**3 !pfac + KHtopdown(kk) = MAX(KHtopdown(kk),0.0) + + !Calculate TKE production = 2(g/TH)(w'TH'), where w'TH' = A(TH/g)wstar^3/PBLH, + !A = ent_eff, and wstar is associated with the radiative cooling at top of PBL. + !An analytic profile controls the magnitude of this TKE prod in the vertical. + TKEprodTD(kk)=2.*ent_eff*wm3/MAX(pblh,100.)*zfacent(kk) + TKEprodTD(kk)= MAX(TKEprodTD(kk),0.0) + ENDDO + ENDIF !end cloud check + maxKHtopdown=MAXVAL(KHtopdown(:)) + + END SUBROUTINE topdown_cloudrad +! ================================================================== ! =================================================================== ! =================================================================== diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 326a96953..19e055da4 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -75,8 +75,9 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt,dku, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & & xkzminv,moninq_fac,hurr_pbl,islimsk,var_ric, & - & coef_ric_l,coef_ric_s,lssav,ldiag3d,qdiag3d,ntoz, & - & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL,do3dt_PBL, & + & coef_ric_l,coef_ric_s,ldiag3d,ntqv,rtg_ozone_index,ntoz, & + & dtend,dtidx,index_of_process_pbl,index_of_x_wind, & + & index_of_y_wind,index_of_temperature, & & flag_for_pbl_generic_tend,errmsg,errflg) ! use machine , only : kind_phys @@ -91,7 +92,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ! arguments ! - logical, intent(in) :: lprnt, hurr_pbl, lssav, ldiag3d, qdiag3d + logical, intent(in) :: lprnt, hurr_pbl, ldiag3d logical, intent(in) :: flag_for_pbl_generic_tend integer, intent(in) :: ipr, islimsk(:) integer, intent(in) :: im, km, ntrac, ntcw, kinver(:), ntoz @@ -103,9 +104,11 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & coef_ric_l, coef_ric_s real(kind=kind_phys), intent(inout) :: dv(:,:), du(:,:), & & tau(:,:), rtg(:,:,:) - ! Only allocated if ldiag3d or qdiag3d are true - real(kind=kind_phys), intent(inout), dimension(:,:) :: & - & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL,do3dt_PBL + ! dtend is only allocated if ldiag3d or qdiag3d are true + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_of_x_wind, index_of_y_wind, & + & index_of_process_pbl, index_of_temperature, ntqv, rtg_ozone_index real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & & t1(:,:), q1(:,:,:), & @@ -206,6 +209,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, & cldtime real :: ttend_fac + + integer :: idtend1, idtend2 !! for hurricane application real(kind=kind_phys) wspm(im,km-1) @@ -281,6 +286,10 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & rdt = 1. / dt2 km1 = km - 1 kmpbl = km / 2 + + idtend1 = 0 + idtend2 = 0 + !> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) do k=1,km do i=1,im @@ -1297,15 +1306,28 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & rtg(i,k,1) = rtg(i,k,1)+qtend dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend - if(lssav .and. ldiag3d .and. .not. & - & flag_for_pbl_generic_tend) then - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*delt - if(qdiag3d) then - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*delt - endif - endif enddo enddo + if(.not.flag_for_pbl_generic_tend) then + idtend1=dtidx(index_of_temperature,index_of_process_pbl) + idtend2=dtidx(ntqv+100,index_of_process_pbl) + if(idtend1>=1) then + do k = 1,km + do i = 1,im + ttend = (a1(i,k)-t1(i,k)) * rdt + dtend(i,k,idtend1) = dtend(i,k,idtend1) + ttend*delt + enddo + enddo + endif + if(idtend2>=1) then + do k = 1,km + do i = 1,im + qtend = (a2(i,k)-q1(i,k,1))*rdt + dtend(i,k,idtend2) = dtend(i,k,idtend2) + qtend*delt + enddo + enddo + endif + endif if(ntrac >= 2) then do kk = 2, ntrac is = (kk-1) * km @@ -1316,16 +1338,19 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo enddo - if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & - & .not. flag_for_pbl_generic_tend) then - kk = ntoz - is = (kk-1) * km - do k = 1, km - do i = 1, im - qtend = (a2(i,k+is)-q1(i,k,kk)) - do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend - enddo - enddo + if(.not.flag_for_pbl_generic_tend .and. ldiag3d .and. & + & rtg_ozone_index>0) then + idtend1 = dtidx(100+ntoz,index_of_process_pbl) + if(idtend1>=1) then + kk = rtg_ozone_index + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (a2(i,k+is)-q1(i,k,kk)) + dtend(i,k,idtend1) = dtend(i,k,idtend1)+qtend + enddo + enddo + endif endif endif ! @@ -1435,11 +1460,6 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & dv(i,k) = dv(i,k) + vtend dusfc(i) = dusfc(i) + conw*del(i,k)*utend dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend - if(lssav .and. ldiag3d .and. .not. & - & flag_for_pbl_generic_tend) then - du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*delt - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*delt - endif ! ! for dissipative heating for ecmwf model ! @@ -1452,6 +1472,27 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! enddo enddo + if(.not.flag_for_pbl_generic_tend) then + idtend1 = dtidx(index_of_x_wind,index_of_process_pbl) + if(idtend1>=1) then + do k = 1,km + do i = 1,im + utend = (a1(i,k)-u1(i,k))*rdt + dtend(i,k,idtend1) = dtend(i,k,idtend1) + utend*delt + enddo + enddo + endif + + idtend2 = dtidx(index_of_y_wind,index_of_process_pbl) + if(idtend2>=1) then + do k = 1,km + do i = 1,im + vtend = (a2(i,k)-v1(i,k))*rdt + dtend(i,k,idtend2) = dtend(i,k,idtend2) + vtend*delt + enddo + enddo + endif + endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 24096cbe6..ac1d5006c 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -555,16 +555,6 @@ dimensions = () type = real kind = kind_phys - intent = in - optional = F -[lssav] - standard_name = flag_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in - optional = F [ldiag3d] standard_name = flag_diagnostics_3D long_name = flag for 3d diagnostic fields @@ -573,12 +563,20 @@ type = logical intent = in optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index dimensions = () - type = logical + type = integer + intent = in + optional = F +[rtg_ozone_index] + standard_name = vertically_diffused_tracer_index_of_ozone + long_name = number of tracers + units = count + dimensions = () + type = integer intent = in optional = F [ntoz] @@ -589,50 +587,55 @@ type = integer intent = in optional = F -[du3dt_PBL] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout optional = F -[dv3dt_PBL] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dt3dt_PBL] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dq3dt_PBL] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[do3dt_PBL] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [flag_for_pbl_generic_tend] standard_name = flag_for_generic_planetary_boundary_layer_tendency diff --git a/physics/moninshoc.f b/physics/moninshoc.f index 199c85aa2..4e9e60b46 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -48,10 +48,10 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & prsi,del,prsl,prslk,phii,phil,delt, & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, - & grav,rd,cp,hvap,fv,ntoz,dt3dt_PBL, - & du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL, - & gen_tend,ldiag3d,qdiag3d, - & errmsg,errflg) + & grav,rd,cp,hvap,fv,ntoz,dtend,dtidx, + & index_of_temperature,index_of_x_wind, + & index_of_y_wind,index_of_process_pbl, + & gen_tend,ldiag3d,ntqv,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -78,10 +78,12 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & tau real(kind=kind_phys), dimension(:,:,:), intent(inout) :: rtg - real(kind=kind_phys), dimension(:,:), intent(inout) :: - & du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + integer, dimension(:,:), intent(in) :: dtidx + integer, intent(in) :: index_of_temperature, index_of_x_wind, + & index_of_y_wind, index_of_process_pbl, ntqv logical, intent(in) :: ldiag3d, - & qdiag3d, gen_tend + & gen_tend integer, dimension(:), intent(out) :: kpbl real(kind=kind_phys), dimension(:), intent(out) :: dusfc, @@ -126,6 +128,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, &, prmin=0.25_kp, prmax=4.0_kp, vk=0.4_kp, & cfac=6.5_kp real(kind=kind_phys) :: gravi, cont, conq, gocp, go2 + integer :: idtend gravi = one / grav cont = cp * gravi @@ -468,19 +471,13 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo if(ldiag3d .and. .not. gen_tend) then - do k = 1,km - do i = 1,im - ttend = (a1(i,k)-t1(i,k)) - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend - enddo - enddo - if(qdiag3d) then - do k = 1,km - do i = 1,im - qtend = (a2(i,k)-q1(i,k,1)) - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend - enddo - enddo + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (a1-t1) + endif + idtend = dtidx(ntqv+100,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + a2-q1(:,:,1) endif endif do i = 1,im @@ -500,15 +497,18 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo endif enddo - if(ldiag3d .and. ntoz>0 .and. qdiag3d .and. .not. gen_tend) then - kk = ntoz - is = (kk-1) * km - do k = 1, km - do i = 1, im - qtend = (a2(i,k+is)-q1(i,k,kk)) - do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend + if(ldiag3d .and. ntoz>0 .and. .not. gen_tend) then + idtend=dtidx(100+ntoz,index_of_process_pbl) + if(idtend>=1) then + kk = ntoz + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (a2(i,k+is)-q1(i,k,kk)) + dtend(i,k,idtend) = dtend(i,k,idtend) + qtend + enddo enddo - enddo + endif endif endif ! @@ -556,14 +556,14 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo if (ldiag3d .and. .not. gen_tend) then - do k = 1,km - do i = 1,im - utend = (a1(i,k)-u1(i,k)) - vtend = (a2(i,k)-v1(i,k)) - du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend - enddo - enddo + idtend = dtidx(index_of_x_wind,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + a1-u1 + endif + idtend = dtidx(index_of_y_wind,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + a1-v1 + endif endif ! if (ntke > 0) then ! solve tridiagonal problem for momentum and tke diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 51f2c4536..aeb337a95 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -505,46 +505,54 @@ type = integer intent = in optional = F -[dt3dt_PBL] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[du3dt_PBL] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys - intent = inout -[dv3dt_PBL] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_PBL] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[do3dt_PBL] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout + intent = in + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [gen_tend] standard_name = flag_for_generic_planetary_boundary_layer_tendency @@ -560,13 +568,14 @@ dimensions = () type = logical intent = in -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index dimensions = () - type = logical + type = integer intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/ozphys.f b/physics/ozphys.f index c1f464cb4..f0229717a 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -46,8 +46,10 @@ end subroutine ozphys_finalize !> @{ subroutine ozphys_run ( & & im, levs, ko3, dt, oz, tin, po3, & - & prsl, prdout, oz_coeff, delp, ldiag3d, qdiag3d, & - & ozp1, ozp2, ozp3, ozp4, con_g, me, errmsg, errflg) + & prsl, prdout, oz_coeff, delp, ldiag3d, & + & ntoz, dtend, dtidx, index_of_process_prod_loss, & + & index_of_process_ozmix, index_of_process_temp, & + & index_of_process_overhead_ozone, con_g, me, errmsg, errflg) ! ! this code assumes that both prsl and po3 are from bottom to top ! as are all other variables @@ -57,23 +59,23 @@ subroutine ozphys_run ( & ! ! Interface variables integer, intent(in) :: im, levs, ko3, oz_coeff, me - real(kind=kind_phys), intent(inout) :: & - & oz(:,:) - ! These arrays may not be allocated and need assumed array sizes - real(kind=kind_phys), intent(inout) :: & - & ozp1(:,:), ozp2(:,:), ozp3(:,:), ozp4(:,:) + real(kind=kind_phys), intent(inout) :: oz(:,:) + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), ntoz, & + & index_of_process_prod_loss, index_of_process_ozmix, & + & index_of_process_temp, index_of_process_overhead_ozone real(kind=kind_phys), intent(in) :: & & dt, po3(:), prdout(:,:,:), & & prsl(:,:), tin(:,:), delp(:,:), & & con_g real :: gravi - logical, intent(in) :: ldiag3d, qdiag3d + logical, intent(in) :: ldiag3d character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! ! Local variables - integer k,kmax,kmin,l,i,j + integer k,kmax,kmin,l,i,j, idtend(4) logical flg(im) real(kind=kind_phys) pmax, pmin, tem, temp real(kind=kind_phys) wk1(im), wk2(im), wk3(im), prod(im,oz_coeff), @@ -86,6 +88,17 @@ subroutine ozphys_run ( & ! save input oz in ozi ozi = oz gravi=1.0/con_g + + + if(ldiag3d) then + idtend(1) = dtidx(100+ntoz,index_of_process_prod_loss) ! was ozp1 + idtend(2) = dtidx(100+ntoz,index_of_process_ozmix) ! was ozp2 + idtend(3) = dtidx(100+ntoz,index_of_process_temp) ! was ozp3 + idtend(4) = dtidx(100+ntoz,index_of_process_overhead_ozone) ! was ozp4 + else + idtend=0 + endif + ! !> - Calculate vertical integrated column ozone values. if (oz_coeff > 2) then @@ -152,11 +165,13 @@ subroutine ozphys_run ( & oz(i,l) = (ozib(i) + prod(i,1)*dt) / (1.0 + prod(i,2)*dt) enddo ! - if (ldiag3d .and. qdiag3d) then ! ozone change diagnostics - do i=1,im - ozp1(i,l) = ozp1(i,l) + prod(i,1)*dt - ozp2(i,l) = ozp2(i,l) + (oz(i,l) - ozib(i)) - enddo + if(idtend(1)>=1) then + dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 + & prod(:,1)*dt + endif + if(idtend(2)>=1) then + dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 + & (oz(:,l) - ozib(:)) endif endif !> - Calculate the 4 terms of prognostic ozone change during time \a dt: @@ -173,16 +188,23 @@ subroutine ozphys_run ( & ! &,' ozib=',ozib(i),' l=',l,' tin=',tin(i,l),'colo3=',colo3(i,l+1) oz(i,l) = (ozib(i) + tem*dt) / (1.0 + prod(i,2)*dt) enddo - if(ldiag3d .and. qdiag3d) then - do i=1,im - ozp1(i,l) = ozp1(i,l) + prod(i,1)*dt - ozp2(i,l) = ozp2(i,l) + (oz(i,l) - ozib(i)) - ozp3(i,l) = ozp3(i,l) + prod(i,3)*tin(i,l)*dt - ozp4(i,l) = ozp4(i,l) + prod(i,4)*colo3(i,l+1)*dt - enddo + if(idtend(1)>=1) then + dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 + & prod(:,1)*dt + endif + if(idtend(2)>=1) then + dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 + & (oz(:,l)-ozib(:)) + endif + if(idtend(3)>=1) then + dtend(:,l,idtend(3)) = dtend(:,l,idtend(3)) + ! was ozp3 + & prod(:,3)*tin(:,l)*dt + endif + if(idtend(4)>=1) then + dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 + & prod(:,4)*colo3(:,l+1)*dt endif endif - enddo ! vertical loop ! return diff --git a/physics/ozphys.meta b/physics/ozphys.meta index 2edfc04e8..274c50210 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -140,49 +140,63 @@ type = logical intent = in optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ozp1] - standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate - long_name = cumulative change in ozone concentration due to production and loss rate - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout optional = F -[ozp2] - standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio - long_name = cumulative change in ozone concentration due to ozone mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[ozp3] - standard_name = cumulative_change_in_ozone_concentration_due_to_temperature - long_name = cumulative change in ozone concentration due to temperature - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in optional = F -[ozp4] - standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column - long_name = cumulative change in ozone concentration due to overhead ozone column - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_prod_loss] + standard_name = index_of_production_and_loss_process_in_cumulative_change_index + long_name = index of production and loss effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_ozmix] + standard_name = index_of_ozone_mixing_ratio_process_in_cumulative_change_index + long_name = index of ozone mixing ratio effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_temp] + standard_name = index_of_temperature_process_in_cumulative_change_index + long_name = index of temperature effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_overhead_ozone] + standard_name = index_of_overhead_process_in_cumulative_change_index + long_name = index of overhead ozone effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [con_g] standard_name = gravitational_acceleration diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index af8be0702..9711b45b4 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -49,11 +49,10 @@ end subroutine ozphys_2015_finalize !! climatological T and O3 are in location 5 and 6 of prdout array !!\author June 2015 - Shrinivas Moorthi subroutine ozphys_2015_run ( & - & im, levs, ko3, dt, oz, tin, po3, & - & prsl, prdout, pl_coeff, delp, & - & ldiag3d, qdiag3d, & - & ozp1,ozp2,ozp3,ozp4,con_g, & - & me, errmsg, errflg) + & im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_coeff, & + & delp, ldiag3d, dtend, dtidx, ntoz, index_of_process_prod_loss& + & , index_of_process_ozmix, index_of_process_temp, & + & index_of_process_overhead_ozone, con_g, me, errmsg, errflg) ! ! use machine , only : kind_phys @@ -62,22 +61,21 @@ subroutine ozphys_2015_run ( & real(kind=kind_phys),intent(in) :: con_g real :: gravi integer, intent(in) :: im, levs, ko3, pl_coeff,me - logical, intent(in) :: ldiag3d, qdiag3d real(kind=kind_phys), intent(in) :: po3(:), & & prsl(:,:), tin(:,:), & & delp(:,:), & & prdout(:,:,:), dt - ! These arrays may not be allocated and need assumed array sizes - real(kind=kind_phys), intent(inout) :: & - & ozp1(:,:), ozp2(:,:), ozp3(:,:),ozp4(:,:) - real(kind=kind_phys), intent(inout) :: oz(:,:) - + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), ntoz, & + & index_of_process_prod_loss, index_of_process_ozmix, & + & index_of_process_temp, index_of_process_overhead_ozone + real(kind=kind_phys), intent(inout) :: oz(im,levs) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer k,kmax,kmin,l,i,j - logical flg(im) + integer k,kmax,kmin,l,i,j, idtend(4) + logical ldiag3d, flg(im), qdiag3d real(kind=kind_phys) pmax, pmin, tem, temp real(kind=kind_phys) wk1(im), wk2(im), wk3(im),prod(im,pl_coeff), & & ozib(im), colo3(im,levs+1), coloz(im,levs+1),& @@ -87,6 +85,15 @@ subroutine ozphys_2015_run ( & errmsg = '' errflg = 0 + if(ldiag3d) then + idtend(1) = dtidx(100+ntoz,index_of_process_prod_loss) ! was ozp1 + idtend(2) = dtidx(100+ntoz,index_of_process_ozmix) ! was ozp2 + idtend(3) = dtidx(100+ntoz,index_of_process_temp) ! was ozp3 + idtend(4) = dtidx(100+ntoz,index_of_process_overhead_ozone) ! was ozp4 + else + idtend=0 + endif + !ccpp: save input oz in ozi ozi = oz gravi=1.0/con_g @@ -160,14 +167,21 @@ subroutine ozphys_2015_run ( & !ccpp ozo(i,l) = (ozib(i) + tem*dt) / (1.0 - prod(i,2)*dt) oz(i,l) = (ozib(i) + tem*dt) / (1.0 - prod(i,2)*dt) enddo - if (ldiag3d .and. qdiag3d) then ! ozone change diagnostics - do i=1,im - ozp1(i,l) = ozp1(i,l) + (prod(i,1)-prod(i,2)*prod(i,6))*dt - ozp2(i,l) = ozp2(i,l) + (oz(i,l) - ozib(i)) - ozp3(i,l) = ozp3(i,l) + prod(i,3)*(tin(i,l)-prod(i,5))*dt - ozp4(i,l) = ozp4(i,l) + prod(i,4) - & * (colo3(i,l)-coloz(i,l))*dt - enddo + if(idtend(1)>=1) then + dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 + & (prod(:,1)-prod(:,2)*prod(:,6))*dt + endif + if(idtend(2)>=1) then + dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 + & (oz(:,l) - ozib(:)) + endif + if(idtend(3)>=1) then + dtend(:,l,idtend(3)) = dtend(:,l,idtend(3)) + ! was ozp3 + & prod(:,3)*(tin(:,l)-prod(:,5))*dt + endif + if(idtend(4)>=1) then + dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 + & prod(:,4) * (colo3(:,l)-coloz(:,l))*dt endif enddo ! vertical loop ! diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 11f1dfa0c..639917b85 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -140,49 +140,62 @@ type = logical intent = in optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ozp1] - standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate - long_name = cumulative change in ozone concentration due to production and loss rate - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[ozp2] - standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio - long_name = cumulative change in ozone concentration due to ozone mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[ozp3] - standard_name = cumulative_change_in_ozone_concentration_due_to_temperature - long_name = cumulative change in ozone concentration due to temperature - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in optional = F -[ozp4] - standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column - long_name = cumulative change in ozone concentration due to overhead ozone column - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_prod_loss] + standard_name = index_of_production_and_loss_process_in_cumulative_change_index + long_name = index of production and loss effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_ozmix] + standard_name = index_of_ozone_mixing_ratio_process_in_cumulative_change_index + long_name = index of ozone mixing ratio effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_temp] + standard_name = index_of_temperature_process_in_cumulative_change_index + long_name = index of temperature effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_overhead_ozone] + standard_name = index_of_overhead_process_in_cumulative_change_index + long_name = index of overhead ozone effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [con_g] standard_name = gravitational_acceleration diff --git a/physics/phys_tend.F90 b/physics/phys_tend.F90 index 333c22e2a..b444f2d97 100644 --- a/physics/phys_tend.F90 +++ b/physics/phys_tend.F90 @@ -19,81 +19,82 @@ end subroutine phys_tend_finalize !> \section arg_table_phys_tend_run Argument Table !! \htmlinclude phys_tend_run.html !! - subroutine phys_tend_run(ldiag3d, qdiag3d, & - du3dt_pbl, du3dt_orogwd, du3dt_deepcnv, du3dt_congwd, & - du3dt_rdamp, du3dt_shalcnv, du3dt_phys, & - dv3dt_pbl, dv3dt_orogwd, dv3dt_deepcnv, dv3dt_congwd, & - dv3dt_rdamp, dv3dt_shalcnv, dv3dt_phys, & - dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_deepcnv, & - dt3dt_shalcnv, dt3dt_mp, dt3dt_orogwd, dt3dt_rdamp, & - dt3dt_congwd, dt3dt_phys, & - dq3dt_pbl, dq3dt_deepcnv, dq3dt_shalcnv, dq3dt_mp, & - dq3dt_o3pbl, dq3dt_o3prodloss, dq3dt_o3mix, & - dq3dt_o3tmp, dq3dt_o3column, dq3dt_phys, dq3dt_o3phys, & - errmsg, errflg) + subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & + index_of_process_physics, index_of_process_photochem, & + nprocess, nprocess_summed, is_photochem, ntoz, errmsg, errflg) ! Interface variables - logical, intent(in) :: ldiag3d, qdiag3d - real(kind=kind_phys), intent(in ) :: du3dt_pbl(:,:) - real(kind=kind_phys), intent(in ) :: du3dt_orogwd(:,:) - real(kind=kind_phys), intent(in ) :: du3dt_deepcnv(:,:) - real(kind=kind_phys), intent(in ) :: du3dt_congwd(:,:) - real(kind=kind_phys), intent(in ) :: du3dt_rdamp(:,:) - real(kind=kind_phys), intent(in ) :: du3dt_shalcnv(:,:) - real(kind=kind_phys), intent( out) :: du3dt_phys(:,:) - real(kind=kind_phys), intent(in ) :: dv3dt_pbl(:,:) - real(kind=kind_phys), intent(in ) :: dv3dt_orogwd(:,:) - real(kind=kind_phys), intent(in ) :: dv3dt_deepcnv(:,:) - real(kind=kind_phys), intent(in ) :: dv3dt_congwd(:,:) - real(kind=kind_phys), intent(in ) :: dv3dt_rdamp(:,:) - real(kind=kind_phys), intent(in ) :: dv3dt_shalcnv(:,:) - real(kind=kind_phys), intent( out) :: dv3dt_phys(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_lw(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_sw(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_pbl(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_deepcnv(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_shalcnv(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_mp(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_orogwd(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_rdamp(:,:) - real(kind=kind_phys), intent(in ) :: dt3dt_congwd(:,:) - real(kind=kind_phys), intent( out) :: dt3dt_phys(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_pbl(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_deepcnv(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_shalcnv(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_mp(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_o3pbl(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_o3prodloss(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_o3mix(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_o3tmp(:,:) - real(kind=kind_phys), intent(in ) :: dq3dt_o3column(:,:) - real(kind=kind_phys), intent( out) :: dq3dt_phys(:,:) - real(kind=kind_phys), intent( out) :: dq3dt_o3phys(:,:) + logical, intent(in) :: ldiag3d, is_photochem(:) + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), index_of_process_physics, ntoz, & + ntracp100, nprocess, nprocess_summed, index_of_process_photochem character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + integer :: ichem, iphys, itrac + logical :: all_true(nprocess) + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (.not.ldiag3d .and. .not.qdiag3d) return - - du3dt_phys = du3dt_pbl + du3dt_orogwd + du3dt_deepcnv + & - du3dt_congwd + du3dt_rdamp + du3dt_shalcnv - - dv3dt_phys = dv3dt_pbl + dv3dt_orogwd + dv3dt_deepcnv + & - dv3dt_congwd + dv3dt_rdamp + dv3dt_shalcnv - - dt3dt_phys = dt3dt_lw + dt3dt_sw + dt3dt_pbl + & - dt3dt_deepcnv + dt3dt_shalcnv + dt3dt_mp + & - dt3dt_orogwd + dt3dt_rdamp + dt3dt_congwd - - dq3dt_phys = dq3dt_pbl + dq3dt_deepcnv + & - dq3dt_shalcnv + dq3dt_mp - - dq3dt_o3phys = dq3dt_o3pbl + dq3dt_o3prodloss & - + dq3dt_o3mix + dq3dt_o3tmp + dq3dt_o3column - + if(.not.ldiag3d) then + return + endif + + all_true = .true. + + ! Total photochemical tendencies + itrac=ntoz+100 + ichem = dtidx(itrac,index_of_process_photochem) + if(ichem>=1) then + call sum_it(ichem,itrac,is_photochem) + endif + + + do itrac=2,ntracp100 + ! Total physics tendencies + iphys = dtidx(itrac,index_of_process_physics) + if(iphys>=1) then + call sum_it(iphys,itrac,all_true) + endif + enddo + + contains + + subroutine sum_it(isum,itrac,sum_me) + implicit none + integer, intent(in) :: isum ! third index of dtend of summary process + integer, intent(in) :: itrac ! tracer or state variable being summed + logical, intent(in) :: sum_me(nprocess) ! false = skip this process + logical :: first + integer :: idtend, iprocess + + first=.true. + do iprocess=1,nprocess + if(iprocess>nprocess_summed) then + exit ! Don't sum up the sums. + else if(.not.sum_me(iprocess)) then + cycle ! We were asked to skip this one. + endif + idtend = dtidx(itrac,iprocess) + if(idtend>=1) then + ! This tendency was calculated for this tracer, so + ! accumulate it into the total tendency. + if(first) then + dtend(:,:,isum) = dtend(:,:,idtend) + first=.false. + else + dtend(:,:,isum) = dtend(:,:,isum) + dtend(:,:,idtend) + endif + endif + enddo + if(first) then + ! No tendencies were calculated, so sum is 0: + dtend(:,:,isum) = 0 + endif + end subroutine sum_it + end subroutine phys_tend_run end module phys_tend diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index 3af255148..d9331c4f1 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -15,329 +15,79 @@ type = logical intent = in optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F -[du3dt_pbl] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[du3dt_orogwd] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in x wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[du3dt_deepcnv] - standard_name = cumulative_change_in_x_wind_due_to_deep_convection - long_name = cumulative change in x wind due to deep convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[du3dt_congwd] - standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in x wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[du3dt_rdamp] - standard_name = cumulative_change_in_x_wind_due_to_rayleigh_damping - long_name = cumulative change in x wind due to Rayleigh damping - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[du3dt_shalcnv] - standard_name = cumulative_change_in_x_wind_due_to_shallow_convection - long_name = cumulative change in x wind due to shallow convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[du3dt_phys] - standard_name = cumulative_change_in_x_wind_due_to_physics - long_name = cumulative change in x wind due to physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys - intent = out + intent = inout optional = F -[dv3dt_pbl] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dv3dt_orogwd] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in y wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dv3dt_deepcnv] - standard_name = cumulative_change_in_y_wind_due_to_deep_convection - long_name = cumulative change in y wind due to deep convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dv3dt_congwd] - standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in y wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dv3dt_rdamp] - standard_name = cumulative_change_in_y_wind_due_to_rayleigh_damping - long_name = cumulative change in y wind due to Rayleigh damping - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dv3dt_shalcnv] - standard_name = cumulative_change_in_y_wind_due_to_shallow_convection - long_name = cumulative change in y wind due to shallow convection - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dv3dt_phys] - standard_name = cumulative_change_in_y_wind_due_to_physics - long_name = cumulative change in y wind due to physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dt3dt_lw] - standard_name = cumulative_change_in_temperature_due_to_longwave_radiation - long_name = cumulative change in temperature due to longwave radiation - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_sw] - standard_name = cumulative_change_in_temperature_due_to_shortwave_radiation - long_name = cumulative change in temperature due to shortwave radiation - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_pbl] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_deepcnv] - standard_name = cumulative_change_in_temperature_due_to_deep_convection - long_name = cumulative change in temperature due to deep convection - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_shalcnv] - standard_name = cumulative_change_in_temperature_due_to_shallow_convection - long_name = cumulative change in temperature due to shallow convection - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_mp] - standard_name = cumulative_change_in_temperature_due_to_microphysics - long_name = cumulative change in temperature due to microphysics - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_orogwd] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_rdamp] - standard_name = cumulative_change_in_temperature_due_to_rayleigh_damping - long_name = cumulative change in temperature due to Rayleigh damping - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_congwd] - standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag - long_name = cumulative change in temperature due to convective gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dt3dt_phys] - standard_name = cumulative_change_in_temperature_due_to_physics - long_name = cumulative change in temperature due to physics - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dq3dt_pbl] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dq3dt_deepcnv] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection - long_name = cumulative change in water vapor specific humidity due to deep convection - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer intent = in optional = F -[dq3dt_shalcnv] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shallow_convection - long_name = cumulative change in water vapor specific humidity due to shallow convection - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys +[ntracp100] + standard_name = number_of_tracers_plus_one_hundred + long_name = number of tracers plus one hundred + units = count + dimensions = () + type = integer intent = in optional = F -[dq3dt_mp] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_microphysics - long_name = cumulative change in water vapor specific humidity due to microphysics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys +[index_of_process_physics] + standard_name = index_of_all_physics_process_in_cumulative_change_index + long_name = index of all physics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer intent = in optional = F -[dq3dt_o3pbl] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys +[index_of_process_photochem] + standard_name = index_of_photochemistry_process_in_cumulative_change_index + long_name = index of photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer intent = in optional = F -[dq3dt_o3prodloss] - standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate - long_name = cumulative change in ozone concentration due to production and loss rate - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys +[nprocess] + standard_name = number_of_cumulative_change_processes + long_name = number of processes that cause changes in state variables + units = count + dimensions = () + type = integer intent = in optional = F -[dq3dt_o3mix] - standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio - long_name = cumulative change in ozone concentration due to ozone mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys +[nprocess_summed] + standard_name = number_of_physics_causes_of_tracer_changes + long_name = number of causes in dtidx per tracer summed for total physics tendency + units = count + dimensions = () + type = integer intent = in optional = F -[dq3dt_o3tmp] - standard_name = cumulative_change_in_ozone_concentration_due_to_temperature - long_name = cumulative change in ozone concentration due to temperature - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys +[is_photochem] + standard_name = flags_for_photochemistry_processes_to_sum + long_name = flags for photochemistry processes to sum as the total photochemistry process cumulative change + units = flag + dimensions = (number_of_cumulative_change_processes) + type = logical intent = in optional = F -[dq3dt_o3column] - standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column - long_name = cumulative change in ozone concentration due to overhead ozone column - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer intent = in optional = F -[dq3dt_phys] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_physics - long_name = cumulative change in water vapor specific humidity due to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dq3dt_o3phys] - standard_name = cumulative_change_in_ozone_concentration_due_to_physics - long_name = cumulative change in ozone concentration due to physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index 61eaa2d92..70ed997a2 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -22,10 +22,10 @@ end subroutine rayleigh_damp_init !>\section gen_ray_damp_run GFS rayleigh_damp_runGeneral Algorithm !> @{ subroutine rayleigh_damp_run ( & - & lsidea,IM,KM,A,B,C,U1,V1,DT,CP, & - & LEVR,pgr,PRSL,PRSLRD0,ral_ts, & - & ldiag3d,du3dt,dv3dt,dt3dt, & - & errmsg,errflg) + & lsidea,IM,KM,A,B,C,U1,V1,DT,CP,LEVR,pgr,PRSL,PRSLRD0,ral_ts, & + & ldiag3d,dtend,dtidx,index_of_process_rayleigh_damping, & + & index_of_temperature,index_of_x_wind,index_of_y_wind, & + & errmsg,errflg) ! ! ******************************************************************** ! -----> I M P L E M E N T A T I O N V E R S I O N <---------- @@ -72,9 +72,10 @@ subroutine rayleigh_damp_run ( & real(kind=kind_phys),intent(in) :: pgr(:), PRSL(:,:) real(kind=kind_phys),intent(in) :: U1(:,:), V1(:,:) real(kind=kind_phys),intent(inout) :: A(:,:), B(:,:), C(:,:) - real(kind=kind_phys),intent(inout) :: du3dt(:,:) - real(kind=kind_phys),intent(inout) :: dv3dt(:,:) - real(kind=kind_phys),intent(inout) :: dt3dt(:,:) + real(kind=kind_phys),optional, intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), & + & index_of_process_rayleigh_damping, index_of_temperature, & + & index_of_x_wind, index_of_y_wind character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -83,7 +84,18 @@ subroutine rayleigh_damp_run ( & real(kind=kind_phys) DTAUX, DTAUY, wrk1, rtrd1, rfactrd, wrk2 &, ENG0, ENG1, tem1, tem2, dti, hfbcpdt, rtrd real(kind=kind_phys) tx1(im), deltaA, deltaB, deltaC - integer i, k + integer i, k, uidx,vidx,tidx + + if(ldiag3d) then + uidx=dtidx(index_of_x_wind,index_of_process_rayleigh_damping) + vidx=dtidx(index_of_y_wind,index_of_process_rayleigh_damping) + tidx=dtidx(index_of_temperature, & + & index_of_process_rayleigh_damping) + else + uidx=0 + vidx=0 + tidx=0 + endif ! ! Initialize CCPP error handling variables errmsg = '' @@ -121,10 +133,14 @@ subroutine rayleigh_damp_run ( & A(I,K) = A(I,K) + deltaA B(I,K) = B(I,K) + deltaB C(I,K) = C(I,K) + deltaC - IF(ldiag3d) THEN - dv3dt(I,K) = dv3dt(I,K) + deltaA - du3dt(I,K) = du3dt(I,K) + deltaB - dt3dt(I,K) = dt3dt(I,K) + deltaC + IF(vidx>=1) THEN + dtend(i,k,vidx) = dtend(i,k,vidx) + deltaA + ENDIF + IF(uidx>=1) THEN + dtend(i,k,uidx) = dtend(i,k,uidx) + deltaB + ENDIF + IF(tidx>=1) THEN + dtend(i,k,tidx) = dtend(i,k,tidx) + deltaC ENDIF ENDDO ENDDO diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index e53cfa75d..059f8e08b 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -146,32 +146,55 @@ type = logical intent = in optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_rayleigh_damping - long_name = cumulative change in zonal wind due to Rayleigh damping - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_rayleigh_damping - long_name = cumulative change in meridional wind due to Rayleigh damping - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_rayleigh_damping - long_name = cumulative change in temperature due to Rayleigh damping - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_rayleigh_damping] + standard_name = index_of_rayleigh_damping_process_in_cumulative_change_index + long_name = index of rayleigh damping process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 610d79bfe..feb4ef870 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -70,8 +70,9 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & prsi,del,prsl,prslk,phii,phil,delt, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & & kinver,xkzm_m,xkzm_h,xkzm_s, & - & dt3dt_PBL,du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL, & - & gen_tend,ldiag3d,qdiag3d,errmsg,errflg) + & index_of_temperature,index_of_x_wind,index_of_y_wind, & + & index_of_process_pbl,ntqv,ntoz,dtend,dtidx, & + & gen_tend,ldiag3d,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -83,9 +84,10 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & integer, intent(in) :: kinver(:) integer, intent(out) :: kpbl(:) ! - logical, intent(in) :: gen_tend, ldiag3d, qdiag3d - real(kind=kind_phys), intent(inout), dimension(:,:) :: & - & dt3dt_PBL,du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL + logical, intent(in) :: gen_tend, ldiag3d + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend + integer, intent(in) :: index_of_temperature,index_of_x_wind, & + & index_of_y_wind, ntqv, ntoz, dtidx(:,:), index_of_process_pbl ! real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 @@ -215,6 +217,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & real(kind=kind_phys) qlcr, zstblmax ! real(kind=kind_phys) h1 + integer :: idtend !! parameter(wfac=7.0,cfac=4.5) parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) @@ -1409,19 +1412,13 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if (ldiag3d .and. .not. gen_tend) then - do k = 1,km - do i = 1,im - ttend = (f1(i,k)-t1(i,k))*rdt - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*delt - enddo - enddo - if (qdiag3d) then - do k = 1,km - do i = 1,im - qtend = (f2(i,k)-q1(i,k,1))*rdt - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*delt - enddo - enddo + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f1-t1) + endif + idtend = dtidx(100+ntqv,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) +delt*rdt*(f2-q1(:,:,1)) endif endif ! @@ -1525,14 +1522,14 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if (ldiag3d .and. .not. gen_tend) then - do k = 1,km - do i = 1,im - utend = (f1(i,k)-u1(i,k))*rdt - vtend = (f2(i,k)-v1(i,k))*rdt - du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*delt - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*delt - enddo - enddo + idtend=dtidx(index_of_x_wind,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f1-u1) + endif + idtend=dtidx(index_of_y_wind,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f2-v1) + endif endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index baea94ad5..40bc129bc 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -559,50 +559,70 @@ kind = kind_phys intent = in optional = F -[dt3dt_PBL] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys - intent = inout + intent = in optional = F -[du3dt_PBL] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dv3dt_PBL] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[dq3dt_PBL] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[do3dt_PBL] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in optional = F [gen_tend] standard_name = flag_for_generic_planetary_boundary_layer_tendency @@ -620,14 +640,6 @@ type = logical intent = in optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 4bbfe61cc..a165df5c7 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -75,7 +75,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & prsi,del,prsl,prslk,phii,phil,delt, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl,dkt,dku, & & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & - & ntoz,du3dt,dv3dt,dt3dt,dq3dt,do3dt,gen_tend,ldiag3d,qdiag3d, & + & ntoz,ntqv,dtend,dtidx,index_of_temperature,index_of_x_wind, & + & index_of_y_wind,index_of_process_pbl,gen_tend,ldiag3d, & & errmsg,errflg) ! use machine , only : kind_phys @@ -84,11 +85,11 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & implicit none ! !---------------------------------------------------------------------- - integer, intent(in) :: im, km, ntrac, ntcw, ntiw, ntke, ntoz + integer, intent(in) :: im, km, ntrac, ntcw, ntiw, ntke, ntoz,ntqv integer, intent(in) :: kinver(:) integer, intent(in) :: islimsk(:) integer, intent(out) :: kpbl(:) - logical, intent(in) :: gen_tend,ldiag3d,qdiag3d + logical, intent(in) :: gen_tend,ldiag3d ! real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 @@ -111,10 +112,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & prsi(:,:), del(:,:), & & prsl(:,:), prslk(:,:), & & phii(:,:), phil(:,:) - real(kind=kind_phys), intent(inout), dimension(:,:) :: & - & du3dt(:,:), dv3dt(:,:), & - & dt3dt(:,:), dq3dt(:,:), & - & do3dt(:,:) + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend + integer, intent(in) :: dtidx(:,:), index_of_temperature, & + & index_of_x_wind, index_of_y_wind, index_of_process_pbl real(kind=kind_phys), intent(out) :: & & dusfc(:), dvsfc(:), & & dtsfc(:), dqsfc(:), & @@ -132,7 +132,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & !*** !*** local variables !*** - integer i,is,k,kk,n,ndt,km1,kmpbl,kmscu,ntrac1 + integer i,is,k,kk,n,ndt,km1,kmpbl,kmscu,ntrac1,idtend integer lcld(im),kcld(im),krad(im),mrad(im) integer kx1(im), kpblx(im) ! @@ -1310,6 +1310,13 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & rtg(i,k,ntke) = rtg(i,k,ntke)+qtend enddo enddo + if(ldiag3d) then + idtend = dtidx(ntke+100,index_of_process_pbl) + if(idtend>0) then + dtend(1:im,1:km,idtend) = dtend(1:im,1:km,idtend) + & + & (f1(1:im,1:km)-q1(1:im,1:km,ntke))*rdt + endif + endif c !> ## Compute tridiagonal matrix elements for heat and moisture c @@ -1437,17 +1444,22 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if(ldiag3d .and. .not. gen_tend) then - do k = 1,km - do i = 1,im - ttend = (f1(i,k)-t1(i,k))*rdt - dt3dt(i,k) = dt3dt(i,k)+ttend*delt + idtend=dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + do k = 1,km + do i = 1,im + ttend = (f1(i,k)-t1(i,k))*rdt + dtend(i,k,idtend) = dtend(i,k,idtend)+ttend*delt + enddo enddo - enddo - if(qdiag3d) then + endif + ! Send tendencies just for QV; other tracers are below. + idtend=dtidx(100+ntqv,index_of_process_pbl) + if(idtend>=1) then do k = 1,km do i = 1,im qtend = (f2(i,k)-q1(i,k,1))*rdt - dq3dt(i,k) = dq3dt(i,k)+qtend*delt + dtend(i,k,idtend) = dtend(i,k,idtend)+qtend*delt enddo enddo endif @@ -1463,14 +1475,21 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo enddo - if(ldiag3d .and. .not. gen_tend .and. qdiag3d .and. ntoz>0) then - kk=ntoz - is = (kk-1) * km - do k = 1, km - do i = 1, im - qtend = (f2(i,k+is)-q1(i,k,kk))*rdt - do3dt(i,k) = do3dt(i,k)+qtend*delt - enddo + if(ldiag3d .and. .not. gen_tend) then + ! Send tendencies for all tracers that were selected. + do kk = 2, ntrac1 + is = (kk-1) * km + idtend = dtidx(kk+100,index_of_process_pbl) + if(idtend>=1) then + if(kk/=ntke) then + do k = 1, km + do i = 1, im + qtend = (f2(i,k+is)-q1(i,k,kk))*rdt + dtend(i,k,idtend) = dtend(i,k,idtend)+qtend*delt + enddo + enddo + endif + endif enddo endif endif @@ -1487,12 +1506,15 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if(ldiag3d .and. .not. gen_tend) then - do k = 1,km1 - do i = 1,im - ttend = diss(i,k) / cp - dt3dt(i,k) = dt3dt(i,k)+dspfac * ttend*delt + idtend=dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + do k = 1,km1 + do i = 1,im + ttend = diss(i,k) / cp + dtend(i,k,idtend) = dtend(i,k,idtend)+dspfac*ttend*delt + enddo enddo - enddo + endif endif endif c @@ -1572,14 +1594,25 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if(ldiag3d .and. .not. gen_tend) then - do k = 1,km - do i = 1,im - utend = (f1(i,k)-u1(i,k))*rdt - vtend = (f2(i,k)-v1(i,k))*rdt - du3dt(i,k) = du3dt(i,k) + utend*delt - dv3dt(i,k) = dv3dt(i,k) + vtend*delt + idtend=dtidx(index_of_x_wind,index_of_process_pbl) + if(idtend>=1) then + do k = 1,km + do i = 1,im + utend = (f1(i,k)-u1(i,k))*rdt + dtend(i,k,idtend) = dtend(i,k,idtend) + utend*delt + enddo enddo - enddo + endif + + idtend=dtidx(index_of_y_wind,index_of_process_pbl) + if(idtend>=1) then + do k = 1,km + do i = 1,im + vtend = (f2(i,k)-v1(i,k))*rdt + dtend(i,k,idtend) = dtend(i,k,idtend) + vtend*delt + enddo + enddo + endif endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index fd2dbe887..e0a5dba26 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -627,50 +627,62 @@ type = integer intent = in optional = F -[du3dt] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in optional = F -[dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys - intent = inout + intent = in optional = F -[dt3dt] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[dq3dt] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[do3dt] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [gen_tend] standard_name = flag_for_generic_planetary_boundary_layer_tendency @@ -688,14 +700,6 @@ type = logical intent = in optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index 5a3e52db3..7c476e0b8 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -49,9 +49,10 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dusfc,dvsfc,dtsfc,dqsfc, & dt,kpbl1d, & u10,v10, & - dx,lssav,ldiag3d,qdiag3d, & - flag_for_pbl_generic_tend,ntoz,du3dt_PBL,dv3dt_PBL, & - dt3dt_PBL,dq3dt_PBL,do3dt_PBL,errmsg,errflg ) + dx,lssav,ldiag3d, & + flag_for_pbl_generic_tend,ntoz,ntqv,dtend,dtidx, & + index_of_process_pbl,index_of_temperature,index_of_x_wind, & + index_of_y_wind,errmsg,errflg ) use machine , only : kind_phys ! @@ -123,8 +124,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ! 1D in integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw,ntoz real(kind=kind_phys), intent(in ) :: g,cp,rd,rv,ep1,ep2,xlv,dt - logical, intent(in ) :: lssav, ldiag3d, qdiag3d, & - flag_for_pbl_generic_tend + logical, intent(in ) :: lssav, ldiag3d, flag_for_pbl_generic_tend ! 3D in real(kind=kind_phys), dimension(:,:) , & intent(in ) :: phil, & @@ -146,8 +146,6 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ttnp real(kind=kind_phys), dimension(:,:,:) , & intent(inout) :: qtnp - real(kind=kind_phys), dimension(:,:) , & - intent(inout) :: du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL ! 2D in integer, dimension(:) , & intent(in ) :: landmask @@ -176,6 +174,13 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dtsfc, & dqsfc + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), index_of_process_pbl, ntqv, & + index_of_x_wind, index_of_y_wind, index_of_temperature + + ! Index within dtend third dimension for tendency of interest: + integer :: idtend + ! error messages character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -978,12 +983,10 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then - do k = kte,kts,-1 - do i = its,ite - ttend = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*dtstep - enddo - enddo + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-thx+300.)*rdt*pi2d + endif endif ! ! compute tridiagonal matrix elements for moisture, clouds, and gases @@ -1109,13 +1112,11 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & tvflux_e(i,k) = tflux_e(i,k) + qflux_e(i,k)*ep1*thx(i,k) enddo enddo - if(lssav .and. ldiag3d .and. qdiag3d .and. .not. flag_for_pbl_generic_tend) then - do k = kte,kts,-1 - do i = its,ite - qtend = (f3(i,k,1)-qx(i,k,1))*rdt - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*dtstep - enddo - enddo + if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then + idtend = dtidx(ntqv+100,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f3(:,:,1)-qx(:,:,1)) + endif endif ! print*,"qtnp:",maxval(qtnp(:,:,1)),minval(qtnp(:,:,1)) ! @@ -1146,15 +1147,12 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo endif enddo - if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & + if(lssav .and. ldiag3d .and. ntoz>0 .and. & & .not. flag_for_pbl_generic_tend) then - ic = ntoz - do k = kte,kts,-1 - do i = its,ite - qtend = f3(i,k,ic)-qx(i,k,ic) - do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend - enddo - enddo + idtend=dtidx(ntoz+100,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + qtend*(f3(:,:,ntoz)-qx(:,:,ntoz)) + endif endif endif ! @@ -1248,14 +1246,14 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then - do k = kte,kts,-1 - do i = its,ite - utend = (f1(i,k)-ux(i,k))*rdt - vtend = (f2(i,k)-vx(i,k))*rdt - du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*dtstep - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*dtstep - enddo - enddo + idtend=dtidx(index_of_x_wind,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f1-ux) + endif + idtend=dtidx(index_of_y_wind,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f2-vx) + endif endif ! do i = its,ite diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 6b12b64f5..eed8fee71 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -457,13 +457,6 @@ dimensions = () type = logical intent = in -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in [flag_for_pbl_generic_tend] standard_name = flag_for_generic_planetary_boundary_layer_tendency long_name = true if GFS_PBL_generic should calculate tendencies @@ -479,46 +472,63 @@ type = integer intent = in optional = F -[du3dt_PBL] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dv3dt_PBL] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dt3dt_PBL] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_PBL] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[do3dt_PBL] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 44652ffac..104fc8e3f 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -319,7 +319,8 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, dudt_gw, dvdt_gw, dtdt_gw, kdis_gw, & tau_ogw, tau_ngw, tau_oss, & zogw, zlwb, zobl, zngw, dusfcg, dvsfcg, dudt, dvdt, dtdt, rdxzb, & - ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw, & + dtend, dtidx, index_of_x_wind, index_of_y_wind, index_of_temperature, & + index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, & lprnt, ipr, errmsg, errflg) ! !######################################################################## @@ -428,15 +429,10 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt -! -! These arrays are only allocated if ldiag=.true. -! -! Version of COORDE updated by CCPP-dev for time-aver -! - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw - - + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), & + index_of_x_wind, index_of_y_wind, index_of_temperature, & + index_of_process_orographic_gwd, index_of_process_nonorographic_gwd real(kind=kind_phys), intent(out), dimension(:) :: rdxzb ! for stoch phys. mtb-level @@ -467,7 +463,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! ugwp_v1 local variables - integer :: y4, month, day, ddd_ugwp, curdate, curday + integer :: y4, month, day, ddd_ugwp, curdate, curday, idtend ! ugwp_v1 temporary (local) diagnostic variables from cires_ugwp_solv2_v1 ! diagnostics for wind and temp rms to compare with space-borne data and metrics @@ -551,16 +547,18 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & ol4ss,theta,sigma,gamma,elvmax, & - dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & - dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & - dusfcg, dvsfcg, & - du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & - du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & + dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & + dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & + dusfcg, dvsfcg, & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & slmsk,br1,hpbl, con_g,con_cp,con_rd,con_rv, & con_fv, con_pi, lonr, & cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & - errmsg,errflg) + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, errmsg, errflg) ! ! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol ! @@ -629,15 +627,20 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! ! for old-fashioned GFS-style diag-cs like dt3dt(:.:, 1:14) collections ! - if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then - do k=1,levs - do i=1,im - ldu3dt_ogw(i,k) = ldu3dt_ogw(i,k) + Pdudt(i,k)*dtp - ldv3dt_ogw(i,k) = ldv3dt_ogw(i,k) + Pdvdt(i,k)*dtp - ldt3dt_ogw(i,k) = ldt3dt_ogw(i,k) + Pdtdt(i,k)*dtp - enddo - enddo + if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then + idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp + endif + idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp + endif + idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif + endif ENDIF ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -691,18 +694,20 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd end if ! do_ugwp_v1 -! -! GFS-style diag dt3dt(:.:, 1:14) time-averaged -! - if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then - do k=1,levs - do i=1,im - ldu3dt_ngw(i,k) = ldu3dt_ngw(i,k) + dudt_ngw(i,k)*dtp - ldv3dt_ngw(i,k) = ldv3dt_ngw(i,k) + dvdt_ngw(i,k)*dtp - ldt3dt_ngw(i,k) = ldt3dt_ngw(i,k) + dtdt_ngw(i,k)*dtp - enddo - enddo + if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then + idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dudt_ngw(i,k)*dtp endif + idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dvdt_ngw(i,k)*dtp + endif + idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtdt_ngw(i,k)*dtp + endif + endif ! ! get total sso-OGW + NGW diff --git a/physics/ugwpv1_gsldrag.meta b/physics/ugwpv1_gsldrag.meta index 2eac9a321..5cfae9dd1 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/ugwpv1_gsldrag.meta @@ -1149,59 +1149,62 @@ kind = kind_phys intent = out optional = F -[ldu3dt_ogw] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in x wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[ldv3dt_ogw] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in y wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[ldt3dt_ogw] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldu3dt_ngw] - standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in x wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldv3dt_ngw] - standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in y wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldt3dt_ngw] - standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag - long_name = cumulative change in temperature due to convective gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_nonorographic_gwd] + standard_name = index_of_nonorographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of nonorographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F [lprnt] standard_name = flag_print diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 7599874ce..da79ecde8 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -214,7 +214,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & - ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & + dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & + index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, & ldiag3d, lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & gwd_opt, errmsg, errflg) @@ -267,9 +268,10 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms real(kind=kind_phys), intent(out), dimension(:,:) :: dtaux2d_ls, dtauy2d_ls - ! These arrays are only allocated if ldiag=.true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), index_of_temperature, index_of_x_wind, & + index_of_y_wind, index_of_process_nonorographic_gwd, & + index_of_process_orographic_gwd logical, intent(in) :: ldiag3d, lssav ! These arrays only allocated if ldiag_ugwp = .true. @@ -305,7 +307,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), parameter :: tamp_mpa=30.e-3 - integer :: nmtvr_temp + integer :: nmtvr_temp, idtend real(kind=kind_phys), dimension(:,:), allocatable :: tke real(kind=kind_phys), dimension(:), allocatable :: turb_fac, tem @@ -337,9 +339,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fvirt,con_pi,lonr, & - cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + cdmbgwd,me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & - errmsg,errflg) + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, errmsg, errflg) ! ! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ls,dvsfc_ls ! @@ -390,13 +394,20 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then - do k=1,levs - do i=1,im - ldu3dt_ogw(i,k) = ldu3dt_ogw(i,k) + Pdudt(i,k)*dtp - ldv3dt_ogw(i,k) = ldv3dt_ogw(i,k) + Pdvdt(i,k)*dtp - ldt3dt_ogw(i,k) = ldt3dt_ogw(i,k) + Pdtdt(i,k)*dtp - enddo - enddo + idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp + endif + + idtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp + endif + + idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp + endif endif end if @@ -483,13 +494,20 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, endif ! cdmbgwd(3) > 0.0 if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then - do k=1,levs - do i=1,im - ldu3dt_cgw(i,k) = ldu3dt_cgw(i,k) + (gw_dudt(i,k) - Pdudt(i,k))*dtp - ldv3dt_cgw(i,k) = ldv3dt_cgw(i,k) + (gw_dvdt(i,k) - Pdvdt(i,k))*dtp - ldt3dt_cgw(i,k) = ldt3dt_cgw(i,k) + (gw_dtdt(i,k) - Pdtdt(i,k))*dtp - enddo - enddo + idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp + endif + + idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp + endif + + idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp + endif endif end if ! do_ugwp_v0.or.do_ugwp_v0_nst_only diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index f675d1131..a20911645 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1193,66 +1193,69 @@ type = integer intent = in optional = F -[ldu3dt_ogw] - standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in x wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in optional = F -[ldv3dt_ogw] - standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag - long_name = cumulative change in y wind due to orographic gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F -[ldt3dt_ogw] - standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag - long_name = cumulative change in temperature due to orographic gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in optional = F -[ldu3dt_cgw] - standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in x wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldv3dt_cgw] - standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag - long_name = cumulative change in y wind due to convective gravity wave drag - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldt3dt_cgw] - standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag - long_name = cumulative change in temperature due to convective gravity wave drag - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in optional = F -[ldiag3d] - standard_name = flag_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index dimensions = () - type = logical + type = integer + intent = in + optional = F +[index_of_process_nonorographic_gwd] + standard_name = index_of_nonorographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of nonorographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer intent = in optional = F [lssav] diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index d59ceb386..bed2f2a66 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -49,8 +49,9 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & g,rd,cp,rv,ep1,ep2,xlv, & dusfc,dvsfc,dtsfc,dqsfc, & dt,kpbl1d,u10,v10,lssav,ldiag3d,qdiag3d, & - flag_for_pbl_generic_tend,ntoz,du3dt_PBL,dv3dt_PBL, & - dt3dt_PBL,dq3dt_PBL,do3dt_PBL,errmsg,errflg ) + flag_for_pbl_generic_tend,ntoz,ntqv,dtend,dtidx, & + index_of_temperature,index_of_x_wind,index_of_y_wind, & + index_of_process_pbl,errmsg,errflg ) use machine , only : kind_phys ! @@ -103,8 +104,9 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & intent(inout) :: utnp,vtnp,ttnp real(kind=kind_phys), dimension( :,:,: ) , & intent(inout) :: qtnp - real(kind=kind_phys), dimension(:,:) , & - intent(inout) :: du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), ntqv, index_of_temperature, & + index_of_x_wind, index_of_y_wind, index_of_process_pbl ! !--------------------------------------------------------------------------------- ! output variables @@ -210,6 +212,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dsdzu,dsdzv,wm3,dthx,dqx,wspd10,ross,tem1,dsig,tvcon,conpr, & prfac,prfac2,phim8z,radsum,tmp1,templ,rvls,temps,ent_eff, & rcldb,bruptmp,radflux + integer :: idtend ! !------------------------------------------------------------------------------- ! @@ -869,12 +872,10 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then - do k = km,1,-1 - do i = 1,im - ttend = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) - dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*dtstep - enddo - enddo + idtend = dtidx(index_of_temperature,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-thx+300.)*rdt*pi2d + endif endif ! ! compute tridiagonal matrix elements for moisture, clouds, and gases @@ -985,12 +986,10 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo enddo if(lssav .and. ldiag3d .and. qdiag3d .and. .not. flag_for_pbl_generic_tend) then - do k = km,1,-1 - do i = 1,im - qtend = (f3(i,k,1)-qx(i,k,1))*rdt - dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*dtstep - enddo - enddo + idtend = dtidx(ntqv+100,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f3(:,:,1)-qx(:,:,1))*rdt + endif endif ! if(ndiff.ge.2) then @@ -1004,13 +1003,10 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & & .not. flag_for_pbl_generic_tend) then - ic = ntoz - do k = km,1,-1 - do i = 1,im - qtend = f3(i,k,ic)-qx(i,k,ic) - do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend - enddo - enddo + idtend = dtidx(100+ntoz,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + f3(:,:,ntoz)-qx(:,:,ntoz) + endif endif endif ! @@ -1094,14 +1090,15 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then - do k = km,1,-1 - do i = 1,im - utend = (f1(i,k)-ux(i,k))*rdt - vtend = (f2(i,k)-vx(i,k))*rdt - du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*dtstep - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*dtstep - enddo - enddo + idtend = dtidx(index_of_x_wind,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-ux)*rdt + endif + + idtend = dtidx(index_of_y_wind,index_of_process_pbl) + if(idtend>=1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f2-vx)*rdt + endif endif ! !---- end of vertical diffusion diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index 1ee952d45..ba3516f7d 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -497,46 +497,63 @@ type = integer intent = in optional = F -[du3dt_PBL] - standard_name = cumulative_change_in_x_wind_due_to_PBL - long_name = cumulative change in x wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dv3dt_PBL] - standard_name = cumulative_change_in_y_wind_due_to_PBL - long_name = cumulative change in y wind due to PBL - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dt3dt_PBL] - standard_name = cumulative_change_in_temperature_due_to_PBL - long_name = cumulative change in temperature due to PBL - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_PBL] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL - long_name = cumulative change in water vapor specific humidity due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[do3dt_PBL] - standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL - long_name = cumulative change in ozone mixing ratio due to PBL - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys - intent = inout + intent = in + optional = F +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in + optional = F +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP