From c332b82c0ddea144132a04a617579e4a10bccdc1 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Mon, 4 Jan 2021 23:56:59 +0000 Subject: [PATCH 01/34] remove all d*3dt variables and switch to dtend (these changes are totally untested) --- physics/GFS_DCNV_generic.F90 | 50 ++-- physics/GFS_DCNV_generic.meta | 65 ++++- physics/GFS_GWD_generic.F90 | 63 +++-- physics/GFS_GWD_generic.meta | 128 ++++++---- physics/GFS_MP_generic.F90 | 80 ++++--- physics/GFS_MP_generic.meta | 126 +++++----- physics/GFS_PBL_generic.F90 | 58 +++-- physics/GFS_PBL_generic.meta | 99 ++++++++ physics/GFS_SCNV_generic.F90 | 46 ++-- physics/GFS_SCNV_generic.meta | 79 ++++--- physics/GFS_debug.F90 | 28 +-- physics/GFS_suite_interstitial.F90 | 69 ++++-- physics/GFS_suite_interstitial.meta | 101 ++++---- physics/cires_ugwp.F90 | 53 +++-- physics/cires_ugwp.meta | 94 ++++---- physics/cu_gf_driver.F90 | 88 +++++-- physics/cu_gf_driver.meta | 125 +++++----- physics/gwdc.f | 21 +- physics/gwdc.meta | 50 +++- physics/h2ophys.f | 3 +- physics/h2ophys.meta | 8 - physics/module_MYJPBL_wrapper.F90 | 38 +-- physics/module_MYJPBL_wrapper.meta | 83 ++++--- physics/module_MYNNPBL_wrapper.F90 | 42 ++-- physics/module_MYNNPBL_wrapper.meta | 102 ++++---- physics/moninedmf.f | 71 ++++-- physics/moninedmf.meta | 98 ++++---- physics/ozphys.f | 64 +++-- physics/ozphys.meta | 88 ++++--- physics/ozphys_2015.f | 51 ++-- physics/ozphys_2015.meta | 88 ++++--- physics/phys_tend.F90 | 107 ++++----- physics/phys_tend.meta | 352 +++------------------------- physics/rayleigh_damp.f | 40 +++- physics/rayleigh_damp.meta | 65 +++-- physics/shinhongvdif.F90 | 71 +++--- physics/shinhongvdif.meta | 91 ++++--- physics/unified_ugwp.F90 | 55 +++-- physics/unified_ugwp.meta | 103 ++++---- physics/ysuvdif.F90 | 58 +++-- 40 files changed, 1683 insertions(+), 1418 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index bfe97bc70..fbadc38f5 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -91,10 +91,11 @@ 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, & + subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, 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, & + rainc, cldwrk, upd_mf, dwn_mf, det_mf, dtend, dtidx, index_for_cause_dcnv, & + index_for_temperature, index_for_x_wind, index_for_y_wind, ntqv, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, errmsg, errflg) @@ -103,7 +104,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs implicit none integer, intent(in) :: im, levs - logical, intent(in) :: lssav, ldiag3d, qdiag3d, ras, cscnv + logical, intent(in) :: lssav, ldiag3d, ras, cscnv logical, intent(in) :: flag_for_dcnv_generic_tend real(kind=kind_phys), intent(in) :: frain, dtf @@ -115,10 +116,14 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d real(kind=kind_phys), dimension(im), 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 + ! dtend, upd_mf, dwn_mf, det_mf only allocated if ldiag3d == .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: upd_mf, dwn_mf, det_mf real(kind=kind_phys), dimension(im,levs), intent(inout) :: cnvw, cnvc + + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + integer, intent(in) :: dtidx(:,:), index_for_cause_dcnv, index_for_temperature, & + index_for_x_wind, index_for_y_wind, ntqv + ! 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 @@ -128,7 +133,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k + integer :: i, k, idtend ! Initialize CCPP error handling variables errmsg = '' @@ -164,23 +169,24 @@ 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_for_temperature,index_for_cause_dcnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0-save_t)*frain + endif -! 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 - 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 - enddo + idtend=dtidx(index_for_x_wind,index_for_cause_dcnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0-save_u)*frain + endif + + idtend=dtidx(index_for_y_wind,index_for_cause_dcnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0-save_v)*frain + endif + + idtend=dtidx(100+ntqv,index_for_cause_dcnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0_water_vapor-save_qv)*frain endif endif ! if (ldiag3d) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index ff7933f07..95b79976b 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -196,14 +196,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 [ras] standard_name = flag_for_ras_deep_convection long_name = flag for ras convection scheme @@ -355,6 +347,63 @@ kind = kind_phys intent = in optional = F +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + type = real + kind = kind_phys + intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[index_for_cause_dcnv] + standard_name = index_for_cause_dcnv + long_name = tracer changes caused by deep convection scheme + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + 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 [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 2ab0fb37a..33c61384b 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -20,7 +20,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_for_temperature, index_for_x_wind, & + & index_for_y_wind, index_for_cause_orographic_gwd, & + & dudt, dvdt, dtdt, dtf, & & flag_for_gwd_generic_tend, errmsg, errflg) use machine, only : kind_phys @@ -36,14 +38,16 @@ subroutine GFS_GWD_generic_pre_run( & logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend real(kind=kind_phys), intent(in) :: dtdt(im,levs), dudt(im,levs), dvdt(im,levs) - ! 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_for_temperature, & + & index_for_x_wind, index_for_y_wind, index_for_cause_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 = '' @@ -117,15 +121,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_for_temperature, index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) - dtdt*dtf + endif + + idtend = dtidx(index_for_x_wind, index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) - dudt*dtf + endif + + idtend = dtidx(index_for_y_wind, index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) - dvdt*dtf endif endif @@ -154,7 +163,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_for_temperature, index_for_x_wind, & + & index_for_y_wind, index_for_cause_orographic_gwd, errmsg, errflg use machine, only : kind_phys implicit none @@ -166,11 +176,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_for_temperature, & + & index_for_x_wind, index_for_y_wind, index_for_cause_orographic_gwd character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + integer :: idtend + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -180,9 +196,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_for_temperature, index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtdt*dtf + endif + + idtend = dtidx(index_for_x_wind, index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dudt*dtf + endif + + idtend = dtidx(index_for_y_wind, index_for_cause_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 dc7ed7a70..2de649338 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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in 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 +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + 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_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_orographic_gwd] + standard_name = index_for_cause_orographic_gwd + long_name = tracer changes caused by orographic gravity wave drag + 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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in 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 +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + 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_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_orographic_gwd] + standard_name = index_for_cause_orographic_gwd + long_name = tracer changes caused by orographic gravity wave drag + 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 435a80509..50e8407bf 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -12,7 +12,7 @@ end subroutine GFS_MP_generic_pre_init !> \section arg_table_GFS_MP_generic_pre_run Argument Table !! \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) + subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, errmsg, errflg) ! use machine, only: kind_phys @@ -22,7 +22,7 @@ subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, real(kind=kind_phys), dimension(im, levs), intent(in) :: gt0 real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 - real(kind=kind_phys), dimension(im, levs), intent(inout) :: save_t, save_qv + real(kind=kind_phys), dimension(im, levs), intent(inout) :: save_t real(kind=kind_phys), dimension(im, levs, ntrac), intent(inout) :: save_q character(len=*), intent(out) :: errmsg @@ -41,16 +41,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 save 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) @@ -85,12 +84,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, & do_sppt, ca_global, dtdtr, dtdtc, 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, ncause, index_for_temperature, index_for_cause_mp,ldiag3d, qdiag3d, lssav, & + errmsg, errflg) ! use machine, only: kind_phys @@ -99,15 +100,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_for_temperature,index_for_cause_mp,ncause real(kind=kind_phys), intent(in) :: dtf, frain, con_g real(kind=kind_phys), dimension(im), intent(in) :: rain1, xlat, xlon, tsfc real(kind=kind_phys), dimension(im), intent(inout) :: ice, snow, graupel, rainc real(kind=kind_phys), dimension(im), intent(in) :: rain0, ice0, snow0, graupel0 real(kind=kind_phys), dimension(im,nrcm), intent(in) :: rann - real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, prsl, save_t, save_qv, del + real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, prsl, save_t, del real(kind=kind_phys), dimension(im,levs+1), intent(in) :: prsi, phii - real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: gq0 + real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: gq0, save_q real(kind=kind_phys), dimension(im), intent(in ) :: sr real(kind=kind_phys), dimension(im), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, & @@ -115,8 +117,8 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, & snow_cpl, pwat - 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 ! only if ldiag3d + integer, dimension(ntrac,ncause), intent(in) :: dtidx ! Stochastic physics / surface perturbations logical, intent(in) :: do_sppt, ca_global @@ -151,7 +153,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 @@ -322,7 +324,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) @@ -340,21 +342,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_for_temperature,index_for_cause_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_for_cause_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 981f5478d..3added996 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 = out - 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 @@ -903,6 +852,71 @@ kind = kind_phys intent = in optional = F +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + type = real + kind = kind_phys + intent = inout + optional = F +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_causes) + type = integer + intent = in + optional = F +[ncause] + standard_name = number_of_possible_causes_of_tracer_changes + long_name = number of possible causes of tracer changes + units = count + dimensions = () + type = integer + intent = in + optional = F +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_mp] + standard_name = index_for_cause_mp + long_name = tracer changes caused by microphysics scheme + 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 357309b2a..d65b019b5 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -311,12 +311,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, flag_cice, dusfc_cice, dvsfc_cice, & + dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dtend, dtidx, index_for_temperature, index_for_x_wind, index_for_y_wind, & + index_for_cause_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, flag_cice, 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 +331,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 logical, dimension(:), intent(in) :: flag_cice @@ -359,9 +359,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_for_temperature, index_for_x_wind, index_for_y_wind, index_for_cause_pbl logical, dimension(:),intent(in) :: wet, dry, icy real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci @@ -609,27 +611,31 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then if (lsidea) then - dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf + idtend = dtidx(index_for_temperature, index_for_cause_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_for_temperature, index_for_cause_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_for_x_wind, index_for_cause_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_for_y_wind, index_for_cause_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_for_cause_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_for_cause_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 endif diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 5e83b8ad4..e4bae0939 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -676,6 +676,56 @@ type = integer intent = in optional = F +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + type = real + kind = kind_phys + intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + units = index + dimensions = () + type = integer + intent = in + optional = F + [ltaerosol] standard_name = flag_for_aerosol_physics long_name = flag for aerosol physics @@ -816,6 +866,55 @@ kind = kind_phys intent = in optional = F +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + type = real + kind = kind_phys + intent = inout + optional = F +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + 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 diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index ae8fac5f9..8dd73a07a 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -71,25 +71,28 @@ end subroutine GFS_SCNV_generic_post_finalize !! \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, & + frain, gu0, gv0, gt0, gq0_water_vapor, save_u, save_v, save_t, save_qv, dqdti, clw, & shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, & rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & - flag_for_scnv_generic_tend, & + dtend, dtidx, index_for_temperature, index_for_x_wind, index_for_y_wind, & + index_for_cause_scnv, ntqv, flag_for_scnv_generic_tend, & imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, nn + integer, intent(in) :: im, levs, nn, ntqv logical, intent(in) :: lssav, ldiag3d, qdiag3d, cplchm, flag_for_scnv_generic_tend real(kind=kind_phys), intent(in) :: frain real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(in) :: save_u, save_v, save_t, save_qv - ! 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), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_for_temperature, index_for_x_wind, index_for_y_wind, index_for_cause_scnv real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw ! Post code for SAS/SAMF @@ -108,7 +111,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k + integer :: i, k, idtend real(kind=kind_phys) :: tem ! Initialize CCPP error handling variables @@ -138,19 +141,24 @@ 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 - enddo + idtend = dtidx(index_for_temperature, index_for_cause_scnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0(i,k) - save_t(i,k)) * frain + endif + + idtend = dtidx(index_for_x_wind, index_for_cause_scnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0(i,k) - save_u(i,k)) * frain + endif + + idtend = dtidx(index_for_y_wind, index_for_cause_scnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0(i,k) - save_v(i,k)) * frain + endif + + idtend = dtidx(100+ntqv, index_for_cause_scnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0_water_vapor(i,k) - save_qv(i,k)) * frain endif endif endif diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index a3122da71..94b006016 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -293,41 +293,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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in 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 +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + 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_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + 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_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_scnv] + standard_name = index_for_cause_scnv + long_name = tracer changes caused by shallow convection scheme + 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 diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 4680f8de7..14ee241dd 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -387,7 +387,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, icause, itracer integer :: mpirank, mpisize, mpicomm integer :: omprank, ompsize @@ -631,22 +631,16 @@ 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 + do itracer=2,Model%ntracp100 + do icause=1,Model%ncause + idtend = Model%dtidx(itracer,icause) + 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(icause), Diag%dtend(1,1,idtend)) + endif + enddo + enddo 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) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 551f0e600..d32106874 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -162,7 +162,8 @@ end subroutine GFS_suite_interstitial_2_finalize subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, 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_for_cause_longwave, index_for_cause_shortwave, & + index_for_cause_pbl, index_for_cause_dcnv, index_for_cause_scnv, index_for_cause_mp, index_for_temperature, & ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_GP_jacobian, skt, sktp1r, fluxlwUP, fluxlwUP_jac, errmsg, errflg) implicit none @@ -196,8 +197,12 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl fluxlwUP, & ! Upwelling LW flux (W/m2) fluxlwUP_jac ! Jacobian of upwelling LW flux (W/m2/K) - ! 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_for_cause_longwave, index_for_cause_shortwave, & + index_for_cause_pbl, index_for_cause_dcnv, index_for_cause_scnv, & + index_for_cause_mp, index_for_temperature logical, intent(in ), dimension(im) :: dry, icy, wet real(kind=kind_phys), intent(in ), dimension(im) :: frland @@ -208,7 +213,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! 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, dT @@ -302,23 +307,47 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl 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_for_temperature,index_for_cause_lw) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,1)*dtf + endif + + idtend = dtidx(index_for_temperature,index_for_cause_sw) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,2)*dtf + endif + + idtend = dtidx(index_for_temperature,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,3)*dtf + endif + + idtend = dtidx(index_for_temperature,index_for_cause_dcnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,4)*dtf + endif + + idtend = dtidx(index_for_temperature,index_for_cause_scnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,5)*dtf + endif + + idtend = dtidx(index_for_temperature,index_for_cause_mp) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,6)*dtf + endif else - do k=1,levs - do i=1,im - dt3dt_lw(i,k) = dt3dt_lw(i,k) + htrlw(i,k)*dtf - dt3dt_sw(i,k) = dt3dt_sw(i,k) + htrsw(i,k)*dtf*xmu(i) - enddo - enddo + idtend = dtidx(index_for_temperature,index_for_cause_lw) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + htrlw(:,:)*dtf + endif + + idtend = dtidx(index_for_temperature,index_for_cause_sw) + if(idtend>1) then + do k=1,levs + dtend(:,k,idtend) = dtend(:,k,idtend) + htrlw(:,k)*dtf*xmu(:) + enddo + endif endif endif endif ! end if_lssav_block diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index b27884f9a..e21e83a26 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -664,59 +664,70 @@ 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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + 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 = inout +[index_for_cause_longwave] + standard_name = index_for_cause_longwave + long_name = tracer changes caused by long wave radiation + 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 +[index_for_cause_shortwave] + standard_name = index_for_cause_shortwave + long_name = tracer changes caused by short wave radiation + 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_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + 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_for_cause_dcnv] + standard_name = index_for_cause_dcnv + long_name = tracer changes caused by deep convection scheme + 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_for_cause_scnv] + standard_name = index_for_cause_scnv + long_name = tracer changes caused by shallow convection scheme + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_mp] + standard_name = index_for_cause_mp + long_name = tracer changes caused by microphysics scheme + units = index + dimensions = () + type = integer + intent = in optional = F [ctei_rml] standard_name = grid_sensitive_critical_cloud_top_entrainment_instability_criteria diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 21b331041..d33466592 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -156,7 +156,9 @@ 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, & +! FIXME: delete ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & + dtend, dtidx, index_for_x_wind, index_for_y_wind, index_for_temperature, & + index_for_cause_orographic_gwd, index_for_cause_convective_gwd, & ldiag3d, lssav, flag_for_gwd_generic_tend, errmsg, errflg) implicit none @@ -182,9 +184,12 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr real(kind=kind_phys), intent(out), dimension(im, levs):: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis real(kind=kind_phys), intent(out), dimension(im, levs):: 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(in) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), & + index_for_x_wind, index_for_y_wind, index_for_temperature, & + index_for_cause_orographic_gwd, index_for_cause_convective_gwd + logical, intent(in) :: ldiag3d, lssav ! These arrays only allocated if ldiag_ugwp = .true. @@ -206,7 +211,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 @@ -280,13 +285,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_for_x_wind,index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt(i,k)*dtp + endif + idtend = dtidx(index_for_y_wind,index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt(i,k)*dtp + endif + idtend = dtidx(index_for_temperature,index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt(i,k)*dtp + endif endif @@ -387,13 +397,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_for_x_wind,index_for_cause_convective_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dudt(i,k) - Pdudt(i,k))*dtp + endif + idtend = dtidx(index_for_y_wind,index_for_cause_convective_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dvdt(i,k) - Pdvdt(i,k))*dtp + endif + idtend = dtidx(index_for_temperature,index_for_cause_convective_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dtdt(i,k) - Pdtdt(i,k))*dtp + endif endif end subroutine cires_ugwp_run diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index d7d7da286..14bfa9a0b 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -866,59 +866,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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + 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) - type = real - kind = kind_phys - intent = inout +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + 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_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + 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_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + 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_for_cause_orographic_gwd] + standard_name = index_for_cause_orographic_gwd + long_name = tracer changes caused by orographic gravity wave drag + 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_for_cause_convective_gwd] + standard_name = index_for_cause_convective_gwd + long_name = tracer changes caused by convective gravity wave drag + units = index + dimensions = () + type = integer + intent = in optional = F [ldiag3d] standard_name = flag_diagnostics_3D diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index dcf0d183b..3f9cb131a 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -69,9 +69,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & hbot,htop,kcnv,xland,hfx2,qfx2,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) +! fixme: delete ! du3dt_SCNV,dv3dt_SCNV,dt3dt_SCNV,dq3dt_SCNV, & + ! du3dt_DCNV,dv3dt_DCNV,dt3dt_DCNV,dq3dt_DCNV, & + dtend,dtidx,ntqv,index_for_temperature,index_for_x_wind, & + index_for_y_wind,index_for_cause_scnv,index_for_cause_dcnv, & + ldiag3d,qci_conv,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -94,8 +96,14 @@ 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 ) :: ldiag3d + + ! dtend is only allocated if ldiag=.true. + real(kind=kind_phys), optional, intent(in) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), & + index_for_x_wind, index_for_y_wind, index_for_temperature, & + index_for_cause_scnv, index_for_cause_dcnv, ntqv + real(kind=kind_phys), dimension( im , km ), intent(in ) :: forcet,forceqv_spechum,w,phil real(kind=kind_phys), dimension( im , km ), intent(inout ) :: t,us,vs real(kind=kind_phys), dimension( im , km ), intent(inout ) :: qci_conv @@ -168,7 +176,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & 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 :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep,uidx,vidx,tidx,qidx integer :: itf,jtf,ktf,iss,jss,nbegin,nend integer :: high_resolution real(kind=kind_phys) :: clwtot,clwtot1,excess,tcrit,tscl_kf,dp,dq,sub_spread,subcenter @@ -861,32 +869,64 @@ 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_for_x_wind,index_for_cause_scnv) + vidx=dtidx(index_for_v_wind,index_for_cause_scnv) + tidx=dtidx(index_for_temperature,index_for_cause_scnv) + qidx=dtidx(100+ntqv,index_for_cause_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(i)*outts(i,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 - 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 + uidx=dtidx(index_for_x_wind,index_for_cause_dcnv) + vidx=dtidx(index_for_v_wind,index_for_cause_dcnv) + tidx=dtidx(index_for_temperature,index_for_cause_dcnv) + qidx=dtidx(100+ntqv,index_for_cause_dcnv) + if(uidx>1) then + do k=kts,ktf + dtend(:,k,uidx) = dtend(:,k,uidx) + (cuten(i)*outu(i,k)+cutenm(i)*outum(i,k)) * dt + enddo + endif + if(vidx>1) then + do k=kts,ktf + dtend(:,k,vidx) = dtend(:,k,vidx) + (cuten(i)*outv(i,k)+cutenm(i)*outvm(i,k)) * dt + enddo + endif + if(tidx>1) then + do k=kts,ktf + dtend(:,k,tidx) = dtend(:,k,tidx) + (cuten(i)*outt(i,k)+cutenm(i)*outtm(i,k)) * dt + enddo + endif + 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) - dq3dt_DCNV(i,k) = dq3dt_DCNV(i,k) + tem - endif + dtend(i,k,qidx) = dtend(i,k,qidx) + tem + enddo enddo - enddo + endif endif endif end subroutine cu_gf_driver_run diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index f27b2cc91..32ae324a8 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -367,77 +367,70 @@ 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) - 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) +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + 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 +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + 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 +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + 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_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + 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_for_cause_scnv] + standard_name = index_for_cause_scnv + long_name = tracer changes caused by shallow convection scheme + 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_for_cause_dcnv] + standard_name = index_for_cause_dcnv + long_name = tracer changes caused by deep convection scheme + units = index + dimensions = () + type = integer + intent = in optional = F [ldiag3d] standard_name = flag_diagnostics_3D @@ -447,14 +440,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 [qci_conv] standard_name = convective_cloud_condesate_after_rainout long_name = convective cloud condesate after rainout diff --git a/physics/gwdc.f b/physics/gwdc.f index fc81373ce..608f6d39e 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -1460,7 +1460,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_for_x_wind, index_for_y_wind, & + & index_for_cause_convective_gwd, gu0, gv0, gt0, & & errmsg, errflg) use machine, only : kind_phys @@ -1472,14 +1473,16 @@ 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(:,:), index_for_cause_convective_gwd + integer, intent(in) :: index_for_x_wind, index_for_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 @@ -1494,8 +1497,14 @@ subroutine gwdc_post_run( & endif ! end if_lssav if (ldiag3d) then - du3dt(:,:) = du3dt(:,:) + gwdcu(:,:) * dtf - dv3dt(:,:) = dv3dt(:,:) + gwdcv(:,:) * dtf + idtend = dtidx(index_for_x_wind,index_for_cause_convective_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + gwdcu(:,:) * dtf + endif + idtend = dtidx(index_for_y_wind,index_for_cause_convective_gwd) + 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..217bb09aa 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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in 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 +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_convective_gwd] + standard_name = index_for_cause_convective_gwd + long_name = tracer changes caused by convective gravity wave drag + 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 8222638ae..d2d84738b 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -23,7 +23,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 @@ -41,7 +41,6 @@ subroutine h2ophys_run(im, levs, kh2o, dt, h2o, ph2o, prsl, & real(kind=kind_phys), intent(in) :: ph2o(kh2o) real(kind=kind_phys), intent(in) :: prsl(im,levs) real(kind=kind_phys), intent(in) :: h2opltc(im,kh2o,h2o_coeff) - 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 62db330f4..3275b89d2 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -84,14 +84,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 5924de96f..e7230e90e 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -40,9 +40,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_for_temperature, index_for_x_wind, & + & index_for_y_wind, index_for_cause_pbl, & + & ntqv, errmsg, errflg ) ! @@ -77,6 +78,11 @@ 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_for_temperature, index_for_x_wind, & + & index_for_y_wind, index_for_cause_pbl, ntqv + !MYJ-1D integer,intent(in) :: im, levs integer,intent(in) :: kdt, me @@ -113,8 +119,6 @@ SUBROUTINE myjpbl_wrapper_run( & dudt, dvdt, dtdt real(kind=kind_phys),dimension(im,levs-1),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(im,levs,ntrac),intent(inout) :: & @@ -158,6 +162,7 @@ SUBROUTINE myjpbl_wrapper_run( & ! 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 = '' @@ -581,21 +586,18 @@ SUBROUTINE myjpbl_wrapper_run( & end do end do if (ldiag3d .and. .not. gen_tend) then + uidx = dtidx(index_for_x_wind,index_for_cause_pbl) + vidx = dtidx(index_for_y_wind,index_for_cause_pbl) + tidx = dtidx(index_for_temperature,index_for_cause_pbl) + qidx = dtidx(ntqv+100,index_for_cause_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 - 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 + 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 if end if diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index 758dfb77b..e25d17893 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -630,38 +630,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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + 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 diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 6011c203e..268c7e787 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -83,9 +83,9 @@ SUBROUTINE mynnedmf_wrapper_run( & & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, & & flag_for_pbl_generic_tend, & - & du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, & - & do3dt_PBL, dq3dt_PBL, dt3dt_PBL, & - & htrsw, htrlw, xmu, & + & ntqv, dtend, dtidx, index_for_temperature, & + & index_for_x_wind, index_for_y_wind, & + & index_for_cause_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, & @@ -209,6 +209,12 @@ 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_for_temperature, index_for_x_wind, ntqv, & + index_for_y_wind, index_for_cause_pbl + !MISC CONFIGURATION OPTIONS INTEGER, PARAMETER :: & & spp_pbl=0, & @@ -263,9 +269,6 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ice_aer_num_conc real(kind=kind_phys), dimension(im,levs), 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(im), intent(in) :: xmu real(kind=kind_phys), dimension(im, levs), intent(in) :: htrsw, htrlw !LOCAL @@ -317,7 +320,7 @@ 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 ! Initialize CCPP error handling variables @@ -703,20 +706,16 @@ SUBROUTINE mynnedmf_wrapper_run( & 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 + idtend=dtidx(index_for_x_wind,index_for_cause_pbl) + if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RUBLTEN(i,k)*dtf + + idtend=dtidx(index_for_y_wind,index_for_cause_pbl) + if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RVBLTEN(i,k)*dtf 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 + idtend=dtidx(index_for_temperature,index_for_cause_pbl) + if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RTHBLTEN(i,k)*exner(i,k)*dtf endif endif accum_duvt3dt !Update T, U and V: @@ -833,11 +832,8 @@ SUBROUTINE mynnedmf_wrapper_run( & 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 + idtend=dtidx(100+ntqv,index_for_cause_pbl) + if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + dqdt_water_vapor*dtf endif if (lprnt) then diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 9b9d4cb52..5b21ae8c1 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1011,68 +1011,62 @@ 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 = 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 +[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_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) +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + 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_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + 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_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + 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_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + 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 +[index_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + units = index + dimensions = () + type = integer + intent = in optional = F [htrsw] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step diff --git a/physics/moninedmf.f b/physics/moninedmf.f index d5cb2ded3..0ab7b5e37 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -65,8 +65,9 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & 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,ntoz, & + & dtend,dtidx,index_for_cause_pbl,index_for_x_wind, & + & index_for_y_wind,index_for_temperature, & & flag_for_pbl_generic_tend,errmsg,errflg) ! use machine , only : kind_phys @@ -81,10 +82,10 @@ 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(im) - integer, intent(in) :: im, km, ntrac, ntcw, kinver(im), ntoz + integer, intent(in) :: im, km, ntrac, ntcw, kinver(im) integer, intent(out) :: kpbl(im) ! @@ -93,9 +94,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(im,km), du(im,km), & & tau(im,km), rtg(im,km,ntrac) - ! 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_for_x_wind, index_for_y_wind, & + index_for_cause_pbl, index_for_temperature, ntqv, ntoz real(kind=kind_phys), intent(in) :: & & u1(im,km), v1(im,km), & & t1(im,km), q1(im,km,ntrac), & @@ -194,6 +197,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) @@ -269,6 +274,10 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & rdt = 1. / dt2 km1 = km - 1 kmpbl = km / 2 + + idtend1 = 1 + idtend2 = 1 + !> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) do k=1,km do i=1,im @@ -1273,6 +1282,10 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! recover tendencies of heat and moisture ! !> After returning with the solution, the tendencies for temperature and moisture are recovered. + if(flag_for_pbl_generic_tend) then + idtend1=dtidx(index_for_temperature,index_for_cause_pbl) + idtend2=dtidx(ntqv+100,index_for_cause_pbl) + endif do k = 1,km do i = 1,im ttend = (a1(i,k)-t1(i,k)) * rdt @@ -1281,12 +1294,11 @@ 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 + if(idtend1>1) then + dtend(i,k,idtend1) = dtend(i,k,idtend1) + ttend*delt + endif + if(idtend2>1) then + dtend(i,k,idtend2) = dtend(i,k,idtend2) + qtend*delt endif enddo enddo @@ -1300,16 +1312,18 @@ 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 + if(flag_for_pbl_generic_tend) then + idtend1 = dtidx(100+ntoz,index_for_cause_pbl) + if(idtend1>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,idtend1) = dtend(i,k,idtend1)+qtend + enddo enddo - enddo + endif endif endif ! @@ -1410,6 +1424,10 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! recover tendencies of momentum ! !> Finally, the tendencies are recovered from the tridiagonal solutions. + if(flag_for_pbl_generic_tend) then + idtend1 = dtidx(index_for_x_wind,index_for_cause_pbl) + idtend2 = dtidx(index_for_y_wind,index_for_cause_pbl) + endif do k = 1,km do i = 1,im utend = (a1(i,k)-u1(i,k))*rdt @@ -1418,10 +1436,11 @@ 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 + if(idtend1>1) then + dtend(i,k,idtend1) = dtend(i,k,idtend1) + utend*delt + endif + if(idtend2>1) then + dtend(i,k,idtend2) = dtend(i,k,idtend2) + vtend*delt endif ! ! for dissipative heating for ecmwf model diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index b14dbd2fc..f72e8f2e4 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -538,14 +538,6 @@ dimensions = () type = real kind = kind_phys -[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 @@ -554,12 +546,12 @@ 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 [ntoz] @@ -570,51 +562,57 @@ 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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + 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_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + 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 +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + 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_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + 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_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in 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 diff --git a/physics/ozphys.f b/physics/ozphys.f index 3d3c1d004..113f6bc42 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, index_for_cause_prod_loss, & + & index_for_cause_ozmix, index_for_cause_temp, & + & index_for_cause_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 @@ -59,21 +61,23 @@ subroutine ozphys_run ( & integer, intent(in) :: im, levs, ko3, oz_coeff, me real(kind=kind_phys), intent(inout) :: & & oz(im,levs) - ! These arrays may not be allocated and need assumed array sizes - real(kind=kind_phys), intent(inout) :: & - & ozp1(:,:), ozp2(:,:), ozp3(:,:), ozp4(:,:) + ! The dtend array may not be allocated and needs an assumed array size + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), ntoz, & + & index_for_cause_prod_loss, index_for_cause_ozmix, & + & index_for_cause_temp, index_for_cause_overhead_ozone real(kind=kind_phys), intent(in) :: & & dt, po3(ko3), prdout(im,ko3,oz_coeff), & & prsl(im,levs), tin(im,levs), delp(im,levs), & & 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 +90,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_for_cause_overhead_ozone) ! was ozp1 + idtend(2) = dtidx(100+ntoz,index_for_cause_ozmix) ! was ozp2 + idtend(3) = dtidx(100+ntoz,index_for_cause_temp) ! was ozp3 + idtend(4) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp4 + else + idtend=1 + endif + ! !> - Calculate vertical integrated column ozone values. if (oz_coeff > 2) then @@ -152,11 +167,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 +190,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)) = idtend(:,l,idtend(1)) + ! was ozp1 + & prod(:,1)*dt + endif + if(idtend(2)>1) then + dtend(:,l,idtend(2)) = idtend(:,l,idtend(2)) + ! was ozp2 + & (oz(:,l)-ozib(:)) + endif + if(idtend(3)>1) then + dtend(:,l,idtend(3)) = idtend(:,l,idtend(3)) + ! was ozp3 + & prod(:,3)*tin(:,l)*dt + endif + if(idtend(4)>1) then + dtend(:,l,idtend(4)) = idtend(:,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..c832f9457 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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in 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 +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + 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 +[index_for_cause_prod_loss] + standard_name = index_for_cause_prod_loss + long_name = tracer changes caused by ozone production and loss + 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_for_cause_ozmix] + standard_name = index_for_cause_ozmix + long_name = tracer changes caused by ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_temp] + standard_name = index_for_cause_temp + long_name = tracer changes caused by temperature + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_overhead_ozone] + standard_name = index_for_cause_overhead_ozone + long_name = tracer changes caused by overhead ozone column + 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 cc60ed2b4..5bec3c9cd 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_for_cause_prod_loss,& + & index_for_cause_ozmix, index_for_cause_temp, & + & index_for_cause_overhead_ozone, con_g, me, errmsg, errflg) ! ! use machine , only : kind_phys @@ -66,16 +65,18 @@ subroutine ozphys_2015_run ( & & prsl(im,levs), tin(im,levs), & & delp(im,levs), & & prdout(im,ko3,pl_coeff), dt - ! These arrays may not be allocated and need assumed array sizes - real(kind=kind_phys), intent(inout) :: & - & ozp1(:,:), ozp2(:,:), ozp3(:,:),ozp4(:,:) + ! dtend may not be allocated and needs an assumed array size + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), ntoz, & + & index_for_cause_prod_loss, index_for_cause_ozmix, & + & index_for_cause_temp, index_for_cause_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 + 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), & @@ -86,6 +87,15 @@ subroutine ozphys_2015_run ( & errmsg = '' errflg = 0 + if(ldiag3d) then + idtend(1) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp1 + idtend(2) = dtidx(100+ntoz,index_for_cause_ozmix) ! was ozp2 + idtend(3) = dtidx(100+ntoz,index_for_cause_temp) ! was ozp3 + idtend(4) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp4 + else + idtend=1 + endif + !ccpp: save input oz in ozi ozi = oz gravi=1.0/con_g @@ -159,14 +169,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(i,1)-prod(i,2)*prod(i,6))*dt + endif + if(idtend(2)>1) then + dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 + & (oz(i,l) - ozib(i)) + endif + if(idtend(3)>1) then + dtend(:,l,idtend(3)) = dtend(:,l,idtend(3)) + ! was ozp3 + & prod(i,3)*(tin(i,l)-prod(i,5))*dt + endif + if(idtend(4)>1) then + dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 + & prod(i,4) * (colo3(i,l)-coloz(i,l))*dt endif enddo ! vertical loop ! diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 11f1dfa0c..931d16532 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in 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 +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + 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 +[index_for_cause_prod_loss] + standard_name = index_for_cause_prod_loss + long_name = tracer changes caused by ozone production and loss + 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_for_cause_ozmix] + standard_name = index_for_cause_ozmix + long_name = tracer changes caused by ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_temp] + standard_name = index_for_cause_temp + long_name = tracer changes caused by temperature + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_overhead_ozone] + standard_name = index_for_cause_overhead_ozone + long_name = tracer changes caused by overhead ozone column + 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..98d76e104 100644 --- a/physics/phys_tend.F90 +++ b/physics/phys_tend.F90 @@ -19,80 +19,57 @@ 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_for_cause_physics, index_for_cause_non_physics, & + ncause, 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 + real(kind=kind_phys), optional, intent(inout) :: dtend + integer, intent(in) :: dtidx(:,:), index_for_cause_physics, index_for_cause_non_physics, ntracp100 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + integer :: itrac, iphys, icause, idtend + logical :: first + ! 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 + + do itrac=2,ntracp100 + first=.true. + iphys = dtidx(itrac,index_for_cause_physics) + if(iphys<2) then + cycle ! No physics tendency requested for this tracer + endif + do icause=1,ncause + if(icause==index_for_cause_physics .or. & + icuase==index_for_cause_non_physics) then + cycle ! Don't sum up the sums. + endif + idtend = dtidx(itrac,icause) + if(idtend>1) then + ! This tendency was calculated for this tracer, so + ! accumulate it into the total physics tendency. + if(first) then + dtend(:,:,iphys) = dtend(:,:,idtend) + first=.false. + else + dtend(:,:,iphys) = dtend(:,:,iphys) + dtend(:,:,idtend) + endif + endif + enddo + if(first) then + ! No physics tendencies were calculated for this tracer, + ! so total physics tendency is 0. + dtend(:,:,iphys) = 0 + endif + enddo end subroutine phys_tend_run diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index 3af255148..31acfab86 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -15,329 +15,55 @@ 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) - type = real - kind = kind_phys - intent = out - 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 - 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 - 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 - 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 +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + type = real + kind = kind_phys + intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + 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 +[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_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 +[index_for_cause_physics] + standard_name = index_for_cause_physics + long_name = tracer changes caused by physics schemes + units = index + 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 +[index_for_cause_non_physics] + standard_name = index_for_cause_non_physics + long_name = tracer changes caused by everything except physics schemes + units = index + dimensions = () + type = integer 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 +[ncause] + standard_name = number_of_possible_causes_of_tracer_changes + long_name = number of possible causes of tracer changes + units = count + 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 8d05f8b0b..730915c6d 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_for_cause_rayleigh_damping, & + & index_for_temperature,index_for_x_wind,index_for_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(im), PRSL(IM,KM) real(kind=kind_phys),intent(in) :: U1(IM,KM), V1(IM,KM) real(kind=kind_phys),intent(inout) :: A(IM,KM), B(IM,KM), C(IM,KM) - 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_for_cause_rayleigh_damping, index_for_temperature, & + & index_for_x_wind, index_for_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_for_x_wind,index_for_cause_rayleigh_damping) + vidx=dtidx(index_for_y_wind,index_for_cause_rayleigh_damping) + tidx=dtidx(index_for_temperature, & + & index_for_cause_rayleigh_damping) + else + uidx=1 + vidx=1 + tidx=1 + 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..45205323e 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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys + active = (flag_diagnostics_3D) intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in 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 +[index_for_cause_rayleigh_damping] + standard_name = index_for_cause_rayleigh_damping + long_name = tracer changes caused by Rayleigh damping + units = index + dimensions = () + 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_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index 4032f1828..a50a5747a 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -34,9 +34,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_for_cause_pbl,index_for_temperature,index_for_x_wind, & + index_for_y_wind,errmsg,errflg ) use machine , only : kind_phys ! @@ -108,7 +109,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, & + logical, intent(in ) :: lssav, ldiag3d, & flag_for_pbl_generic_tend ! 3D in real(kind=kind_phys), dimension(im, km) , & @@ -131,8 +132,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ttnp real(kind=kind_phys), dimension(im, km, ntrac ) , & intent(inout) :: qtnp - real(kind=kind_phys), dimension(im,km) , & - intent(inout) :: du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL + ! 2D in integer, dimension(im) , & intent(in ) :: landmask @@ -161,6 +161,14 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dtsfc, & dqsfc + ! 3D diagnostic tendencies; dtend is only allocated if ldiag3d=.true. + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), index_for_cause_pbl, ntqv, & + index_for_x_wind, index_for_y_wind, index_for_temperature + + ! Index within dtend third dimension for tendency of interest: + integer :: idtend + ! error messages character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -963,12 +971,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_for_temperature,index_for_cause_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 @@ -1094,13 +1100,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_for_cause_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)) ! @@ -1131,15 +1135,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_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + qtend*(f3(:,:,ntoz)-qx(:,:,ntoz)) + endif endif endif ! @@ -1233,14 +1234,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_for_x_wind,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f1-ux) + endif + idtend=dtidx(index_for_y_wind,index_for_cause_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 8c850ff37..9046c5982 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -449,46 +449,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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[index_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + 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/unified_ugwp.F90 b/physics/unified_ugwp.F90 index fda887f3e..34faf7e42 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -232,7 +232,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, dudt_mtb,dudt_ogw, 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_for_temperature, index_for_x_wind, index_for_y_indw, & + index_for_cause_orographic_gwd, index_for_cause_convective_gwd, & ldiag3d, lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & do_ugwp_v1_orog_only, gwd_opt, errmsg, errflg) @@ -279,9 +280,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), intent(out), dimension(im, levs):: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis real(kind=kind_phys), intent(out), dimension(im, levs):: 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 + ! The dtend array is are only allocated if ldiag=.true. + real(kind=kind_phys), intent(inout), optional :: dtend + integer, intent(in) :: dtidx, index_for_temperature, index_for_x_wind, & + index_for_y_wind, index_for_cause_convective_gwd, & + index_for_cause_orographic_gwd logical, intent(in) :: ldiag3d, lssav ! These arrays only allocated if ldiag_ugwp = .true. @@ -333,7 +336,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ! ugwp_v1 local variables integer :: y4, month, day, ddd_ugwp, curdate, curday - integer :: hour + integer :: hour, idtend real(kind=kind_phys) :: hcurdate, hcurday, fhour, fhrday integer :: kdtrest integer :: curday_ugwp @@ -445,13 +448,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_for_cause_x_wind,index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp + endif + + idtend = dtidx(index_for_cause_y_wind,index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp + endif + + idtend = dtidx(index_for_cause_temperature,index_for_cause_orographic_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp + endif endif end if @@ -564,13 +574,20 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, #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_for_cause_x_wind,index_for_cause_convective_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp + endif + + idtend = dtidx(index_for_cause_y_wind,index_for_cause_convective_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp + endif + + idtend = dtidx(index_for_cause_temperature,index_for_cause_convective_gwd) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp + endif endif end if ! do_ugwp_v0 diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 675a68edd..0f260726d 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1199,66 +1199,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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) type = real kind = kind_phys intent = inout + optional = T +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + 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_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + 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_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + 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_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + 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_for_cause_orographic_gwd] + standard_name = index_for_cause_orographic_gwd + long_name = tracer changes caused by orographic gravity wave drag + 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_for_cause_convective_gwd] + standard_name = index_for_cause_convective_gwd + long_name = tracer changes caused by convective gravity wave drag + units = index dimensions = () - type = logical + type = integer intent = in optional = F [lssav] diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index 75c0b31d3..4ccc37a41 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -34,8 +34,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_for_temperature,index_for_x_wind,index_for_y_wind, & + index_for_cause_pbl,errmsg,errflg ) use machine , only : kind_phys ! @@ -88,8 +89,9 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & intent(inout) :: utnp,vtnp,ttnp real(kind=kind_phys), dimension( im,km,ntrac ) , & intent(inout) :: qtnp - real(kind=kind_phys), dimension(im,km) , & - 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_for_temperature, & + index_for_x_wind, index_for_y_wind, index_for_cause_pbl ! !--------------------------------------------------------------------------------- ! output variables @@ -854,12 +856,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_for_temperature,index_for_cause_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 @@ -970,12 +970,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_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f3(:,:,1)-qx(:,:,1))*rdt + endif endif ! if(ndiff.ge.2) then @@ -989,13 +987,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_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + f3(:,:,ntoz)-qx(:,:,ntoz) + endif endif endif ! @@ -1079,14 +1074,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_for_x_wind,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-ux)*rdt + endif + + idtend = dtidx(index_for_y_wind,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f2-vx)*rdt + endif endif ! !---- end of vertical diffusion From aac67fbcd7db2976736c335b369029a5c2d7818e Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Tue, 12 Jan 2021 16:08:33 +0000 Subject: [PATCH 02/34] Changes to make the first test case run to completion in debug mode. --- physics/GFS_DCNV_generic.meta | 38 +-------- physics/GFS_GWD_generic.F90 | 2 +- physics/GFS_GWD_generic.meta | 4 +- physics/GFS_MP_generic.F90 | 2 +- physics/GFS_PBL_generic.F90 | 9 ++- physics/GFS_PBL_generic.meta | 121 ---------------------------- physics/GFS_SCNV_generic.F90 | 8 +- physics/GFS_SCNV_generic.meta | 2 +- physics/GFS_suite_interstitial.F90 | 8 +- physics/GFS_suite_interstitial.meta | 10 ++- physics/cires_ugwp.F90 | 2 +- physics/cires_ugwp.meta | 2 +- physics/cu_gf_driver.meta | 2 +- physics/gwdc.meta | 2 +- physics/module_MYJPBL_wrapper.meta | 2 +- physics/module_MYNNPBL_wrapper.meta | 2 +- physics/moninedmf.f | 2 +- physics/moninedmf.meta | 3 +- physics/moninshoc.f | 73 ++++++++--------- physics/moninshoc.meta | 95 ++++++++++++---------- physics/ozphys.f | 10 +-- physics/ozphys.meta | 2 +- physics/ozphys_2015.meta | 2 +- physics/phys_tend.meta | 2 +- physics/rayleigh_damp.meta | 2 +- physics/satmedmfvdif.F | 47 +++++------ physics/satmedmfvdif.meta | 91 ++++++++++----------- physics/shinhongvdif.meta | 2 +- physics/unified_ugwp.meta | 2 +- 29 files changed, 201 insertions(+), 348 deletions(-) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 95b79976b..7da6d659f 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -355,7 +355,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair @@ -455,42 +455,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 diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 33c61384b..40fdd6198 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -164,7 +164,7 @@ end subroutine GFS_GWD_generic_post_init !! @{ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, dvdt, dtdt, & & dugwd, dvgwd, flag_for_gwd_generic_tend, dtend, dtidx, index_for_temperature, index_for_x_wind, & - & index_for_y_wind, index_for_cause_orographic_gwd, errmsg, errflg + & index_for_y_wind, index_for_cause_orographic_gwd, errmsg, errflg) use machine, only : kind_phys implicit none diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 2de649338..27297ff36 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -190,7 +190,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair @@ -372,7 +372,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 50e8407bf..38e6d3feb 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -118,7 +118,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, snow_cpl, pwat real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend ! only if ldiag3d - integer, dimension(ntrac,ncause), intent(in) :: dtidx + integer, dimension(:,:), intent(in) :: dtidx ! Stochastic physics / surface perturbations logical, intent(in) :: do_sppt, ca_global diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index d65b019b5..82efda4e3 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -315,7 +315,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, shinhong, do_ysu, dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dtend, dtidx, index_for_temperature, index_for_x_wind, index_for_y_wind, & index_for_cause_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, + dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, & rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, flag_cice, 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) @@ -382,7 +382,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 @@ -623,11 +624,11 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, endif idtend = dtidx(index_for_x_wind, index_for_cause_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) + 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_for_y_wind, index_for_cause_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) + 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_for_cause_pbl) if(idtend>1) then diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index e4bae0939..d65508f37 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -676,56 +676,6 @@ type = integer intent = in optional = F -[dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields - units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) - type = real - kind = kind_phys - intent = inout - optional = T -[dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) - type = integer - intent = in - optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field - units = index - dimensions = () - type = integer - intent = in - optional = F -[index_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field - units = index - dimensions = () - type = integer - intent = in - optional = F -[index_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field - units = index - dimensions = () - type = integer - intent = in - optional = F -[index_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme - units = index - dimensions = () - type = integer - intent = in - optional = F - [ltaerosol] standard_name = flag_for_aerosol_physics long_name = flag for aerosol physics @@ -774,14 +724,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 @@ -1140,69 +1082,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 8dd73a07a..b60ade9bc 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -143,22 +143,22 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl if (ldiag3d) then idtend = dtidx(index_for_temperature, index_for_cause_scnv) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0(i,k) - save_t(i,k)) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (gt0 - save_t) * frain endif idtend = dtidx(index_for_x_wind, index_for_cause_scnv) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0(i,k) - save_u(i,k)) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (gu0 - save_u) * frain endif idtend = dtidx(index_for_y_wind, index_for_cause_scnv) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0(i,k) - save_v(i,k)) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0 - save_v) * frain endif idtend = dtidx(100+ntqv, index_for_cause_scnv) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0_water_vapor(i,k) - save_qv(i,k)) * frain + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0_water_vapor - save_qv) * frain endif endif endif diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 94b006016..5fec5247b 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -301,7 +301,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index d32106874..2d5efd6ad 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -307,12 +307,12 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (ldiag3d) then if (lsidea) then - idtend = dtidx(index_for_temperature,index_for_cause_lw) + idtend = dtidx(index_for_temperature,index_for_cause_longwave) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,1)*dtf endif - idtend = dtidx(index_for_temperature,index_for_cause_sw) + idtend = dtidx(index_for_temperature,index_for_cause_shortwave) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,2)*dtf endif @@ -337,12 +337,12 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,6)*dtf endif else - idtend = dtidx(index_for_temperature,index_for_cause_lw) + idtend = dtidx(index_for_temperature,index_for_cause_longwave) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + htrlw(:,:)*dtf endif - idtend = dtidx(index_for_temperature,index_for_cause_sw) + idtend = dtidx(index_for_temperature,index_for_cause_shortwave) if(idtend>1) then do k=1,levs dtend(:,k,idtend) = dtend(:,k,idtend) + htrlw(:,k)*dtf*xmu(:) diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index e21e83a26..d30283b96 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -672,7 +672,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair @@ -729,6 +729,14 @@ type = integer intent = in optional = F +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F [ctei_rml] standard_name = grid_sensitive_critical_cloud_top_entrainment_instability_criteria long_name = grid sensitive critical cloud top entrainment instability criteria diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index d33466592..0dbbaf4da 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -185,7 +185,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr real(kind=kind_phys), intent(out), dimension(im, levs):: dudt_mtb, dudt_ogw, dudt_tms ! dtend is only allocated if ldiag=.true. - real(kind=kind_phys), optional, intent(in) :: dtend(:,:,:) + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & index_for_x_wind, index_for_y_wind, index_for_temperature, & index_for_cause_orographic_gwd, index_for_cause_convective_gwd diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 14bfa9a0b..f230e2189 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -875,7 +875,7 @@ kind = kind_phys active = (flag_diagnostics_3D) intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 32ae324a8..32ed8c38c 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -375,7 +375,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 217bb09aa..e9b4eaa4f 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -599,7 +599,7 @@ kind = kind_phys active = (flag_diagnostics_3D) intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index e25d17893..bc998c136 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -638,7 +638,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 5b21ae8c1..8b3c742a4 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1027,7 +1027,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 0ab7b5e37..8622eb3c1 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -98,7 +98,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_for_x_wind, index_for_y_wind, & - index_for_cause_pbl, index_for_temperature, ntqv, ntoz + & index_for_cause_pbl, index_for_temperature, ntqv, ntoz real(kind=kind_phys), intent(in) :: & & u1(im,km), v1(im,km), & & t1(im,km), q1(im,km,ntrac), & diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index f72e8f2e4..fd2247d20 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -571,7 +571,7 @@ kind = kind_phys active = (flag_diagnostics_3D) intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair @@ -612,7 +612,6 @@ type = integer intent = in 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 diff --git a/physics/moninshoc.f b/physics/moninshoc.f index eb9a5d963..b0d3f51a7 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -31,10 +31,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_for_temperature,index_for_x_wind, + & index_for_y_wind,index_for_cause_pbl, + & gen_tend,ldiag3d,ntqv,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -62,10 +62,13 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & tau real(kind=kind_phys), dimension(im,km,ntrac), intent(inout) :: rtg - real(kind=kind_phys), dimension(:,:), intent(inout) :: - & du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL + real(kind=kind_phys), intent(inout) :: + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + integer, dimension(:,:,:), intent(in) :: dtidx + integer, intent(in) :: index_for_temperature, index_for_x_wind, + & index_for_y_wind, index_for_cause_pbl, ntqv logical, intent(in) :: ldiag3d, - & qdiag3d, gen_tend + & gen_tend integer, dimension(im), intent(out) :: kpbl real(kind=kind_phys), dimension(im), intent(out) :: dusfc, @@ -110,6 +113,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 @@ -449,19 +453,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_for_temperature,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (a1-t1) + endif + idtend = dtidx(ntqv+100,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + a2-q1(:,:,1) endif endif do i = 1,im @@ -481,15 +479,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_for_cause_pbl) + if(idtend>0) 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 ! @@ -537,14 +538,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_for_x_wind,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + a1-u1 + endif + idtend = dtidx(index_for_y_wind,index_for_cause_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 f550c5b59..2cc53ebd5 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -475,46 +475,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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) 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 = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + units = index + dimensions = () + type = integer + intent = in optional = F [gen_tend] standard_name = flag_for_generic_planetary_boundary_layer_tendency @@ -530,13 +538,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 113f6bc42..708358efe 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -47,7 +47,7 @@ end subroutine ozphys_finalize subroutine ozphys_run ( & & im, levs, ko3, dt, oz, tin, po3, & & prsl, prdout, oz_coeff, delp, ldiag3d, & - & ntoz, index_for_cause_prod_loss, & + & ntoz, dtend, dtidx, index_for_cause_prod_loss, & & index_for_cause_ozmix, index_for_cause_temp, & & index_for_cause_overhead_ozone, con_g, me, errmsg, errflg) ! @@ -191,19 +191,19 @@ subroutine ozphys_run ( & oz(i,l) = (ozib(i) + tem*dt) / (1.0 + prod(i,2)*dt) enddo if(idtend(1)>1) then - dtend(:,l,idtend(1)) = idtend(:,l,idtend(1)) + ! was ozp1 + dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 & prod(:,1)*dt endif if(idtend(2)>1) then - dtend(:,l,idtend(2)) = idtend(:,l,idtend(2)) + ! was ozp2 + dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 & (oz(:,l)-ozib(:)) endif if(idtend(3)>1) then - dtend(:,l,idtend(3)) = idtend(:,l,idtend(3)) + ! was ozp3 + 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)) = idtend(:,l,idtend(4)) + ! was ozp4 + dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 & prod(:,4)*colo3(:,l+1)*dt endif endif diff --git a/physics/ozphys.meta b/physics/ozphys.meta index c832f9457..aee1a8622 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -149,7 +149,7 @@ kind = kind_phys active = (flag_diagnostics_3D) intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 931d16532..8dc9ee994 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -149,7 +149,7 @@ kind = kind_phys active = (flag_diagnostics_3D) intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index 31acfab86..bf3ff536c 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -23,7 +23,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 45205323e..8300b7e07 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -155,7 +155,7 @@ kind = kind_phys active = (flag_diagnostics_3D) intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index ec6add8a5..812984b68 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -61,8 +61,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_for_temperature,index_for_x_wind,index_for_y_wind, & + & index_for_cause_pbl,ntqv,ntoz,dtidx, & + & gen_tend,ldiag3d,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -75,8 +76,9 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & integer, intent(out) :: kpbl(im) ! logical, intent(in) :: gen_tend, ldiag3d, qdiag3d - real(kind=kind_phys), intent(inout), dimension(:,:) :: & - & dt3dt_PBL,du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend & + integer, intent(in) :: index_for_temperature,index_for_x_wind, & + & index_for_y_wind, ntqv, ntoz, dtidx(:,:), index_for_cause_pbl ! real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 @@ -206,6 +208,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) @@ -1400,19 +1403,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_for_temperature,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f1-t1) + endif + idtend = dtidx(100+ntqv,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f2-q1(:,:,1)) endif endif ! @@ -1516,14 +1513,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_for_x_wind,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f1-u1) + endif + idtend=dtidx(index_for_y_wind,index_for_cause_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 d860e3310..88a6f7fe9 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -549,50 +549,53 @@ 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 = inout +[index_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + units = index + dimensions = () + 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 +[index_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + 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_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + 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_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + 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 +[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 @@ -610,14 +613,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.meta b/physics/shinhongvdif.meta index 9046c5982..34a18d52d 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -465,7 +465,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 0f260726d..c39d99ca3 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1215,7 +1215,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [dtidx] standard_name = dtend_outer_index long_name = index in outer dimension of dtend of a tracer-cause pair From 3e8d727ce7195029742b06bbc8c9b2c4b219c214 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 14 Jan 2021 17:36:11 +0000 Subject: [PATCH 03/34] Changes needed to get identical output in debug mode for these tests, with diagnostics turned on: fv3_ccpp_control_prod fv3_ccpp_gfs_v15p2_prod fv3_ccpp_gfs_v16beta_prod fv3_ccpp_gsd_prod --- physics/GFS_suite_interstitial.F90 | 4 +- physics/cires_ugwp.F90 | 12 ++-- physics/cu_gf_driver.F90 | 10 +--- physics/moninedmf.f | 6 +- physics/moninshoc.f | 3 +- physics/ozphys.f | 2 +- physics/phys_tend.F90 | 7 ++- physics/satmedmfvdif.F | 8 +-- physics/satmedmfvdif.meta | 17 ++++++ physics/satmedmfvdifq.F | 82 ++++++++++++------------- physics/satmedmfvdifq.meta | 96 ++++++++++++++++-------------- 11 files changed, 131 insertions(+), 116 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 2d5efd6ad..c38902595 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -345,7 +345,9 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl idtend = dtidx(index_for_temperature,index_for_cause_shortwave) if(idtend>1) then do k=1,levs - dtend(:,k,idtend) = dtend(:,k,idtend) + htrlw(:,k)*dtf*xmu(:) + do i=1,im + dtend(i,k,idtend) = dtend(i,k,idtend) + htrsw(i,k)*dtf*xmu(i) + enddo enddo endif endif diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 0dbbaf4da..df1e99579 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -287,15 +287,15 @@ 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 idtend = dtidx(index_for_x_wind,index_for_cause_orographic_gwd) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt(i,k)*dtp + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp endif idtend = dtidx(index_for_y_wind,index_for_cause_orographic_gwd) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt(i,k)*dtp + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp endif idtend = dtidx(index_for_temperature,index_for_cause_orographic_gwd) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt(i,k)*dtp + dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif endif @@ -399,15 +399,15 @@ 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 idtend = dtidx(index_for_x_wind,index_for_cause_convective_gwd) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dudt(i,k) - Pdudt(i,k))*dtp + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dudt - Pdudt)*dtp endif idtend = dtidx(index_for_y_wind,index_for_cause_convective_gwd) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dvdt(i,k) - Pdvdt(i,k))*dtp + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dvdt - Pdvdt)*dtp endif idtend = dtidx(index_for_temperature,index_for_cause_convective_gwd) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dtdt(i,k) - Pdtdt(i,k))*dtp + dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dtdt - Pdtdt)*dtp endif endif diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 3f9cb131a..4bfe0cbcd 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -99,7 +99,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & logical, intent(in ) :: ldiag3d ! dtend is only allocated if ldiag=.true. - real(kind=kind_phys), optional, intent(in) :: dtend(:,:,:) + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & index_for_x_wind, index_for_y_wind, index_for_temperature, & index_for_cause_scnv, index_for_cause_dcnv, ntqv @@ -113,10 +113,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & real(kind=kind_phys), dimension( im , km ), intent(out ) :: cnvw_moist,cnvc real(kind=kind_phys), dimension( im , km ), 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 - integer, dimension (im), intent(inout) :: hbot,htop,kcnv integer, dimension (im), intent(in) :: xland real(kind=kind_phys), dimension (im), intent(in) :: pbl @@ -870,7 +866,7 @@ 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 uidx=dtidx(index_for_x_wind,index_for_cause_scnv) - vidx=dtidx(index_for_v_wind,index_for_cause_scnv) + vidx=dtidx(index_for_y_wind,index_for_cause_scnv) tidx=dtidx(index_for_temperature,index_for_cause_scnv) qidx=dtidx(100+ntqv,index_for_cause_scnv) if(uidx>1) then @@ -900,7 +896,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & endif if((ideep.eq.1. .or. imid_gf.eq.1) .and. .not.flag_for_dcnv_generic_tend) then uidx=dtidx(index_for_x_wind,index_for_cause_dcnv) - vidx=dtidx(index_for_v_wind,index_for_cause_dcnv) + vidx=dtidx(index_for_y_wind,index_for_cause_dcnv) tidx=dtidx(index_for_temperature,index_for_cause_dcnv) qidx=dtidx(100+ntqv,index_for_cause_dcnv) if(uidx>1) then diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 8622eb3c1..bd52544ba 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -1282,7 +1282,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! recover tendencies of heat and moisture ! !> After returning with the solution, the tendencies for temperature and moisture are recovered. - if(flag_for_pbl_generic_tend) then + if(.not.flag_for_pbl_generic_tend) then idtend1=dtidx(index_for_temperature,index_for_cause_pbl) idtend2=dtidx(ntqv+100,index_for_cause_pbl) endif @@ -1312,7 +1312,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo enddo - if(flag_for_pbl_generic_tend) then + if(.not.flag_for_pbl_generic_tend) then idtend1 = dtidx(100+ntoz,index_for_cause_pbl) if(idtend1>1) then kk = ntoz @@ -1424,7 +1424,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! recover tendencies of momentum ! !> Finally, the tendencies are recovered from the tridiagonal solutions. - if(flag_for_pbl_generic_tend) then + if(.not.flag_for_pbl_generic_tend) then idtend1 = dtidx(index_for_x_wind,index_for_cause_pbl) idtend2 = dtidx(index_for_y_wind,index_for_cause_pbl) endif diff --git a/physics/moninshoc.f b/physics/moninshoc.f index b0d3f51a7..c92dc460f 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -62,9 +62,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & tau real(kind=kind_phys), dimension(im,km,ntrac), intent(inout) :: rtg - real(kind=kind_phys), intent(inout) :: real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend - integer, dimension(:,:,:), intent(in) :: dtidx + integer, dimension(:,:), intent(in) :: dtidx integer, intent(in) :: index_for_temperature, index_for_x_wind, & index_for_y_wind, index_for_cause_pbl, ntqv logical, intent(in) :: ldiag3d, diff --git a/physics/ozphys.f b/physics/ozphys.f index 708358efe..551b89da0 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -93,7 +93,7 @@ subroutine ozphys_run ( & if(ldiag3d) then - idtend(1) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp1 + idtend(1) = dtidx(100+ntoz,index_for_cause_prod_loss) ! was ozp1 idtend(2) = dtidx(100+ntoz,index_for_cause_ozmix) ! was ozp2 idtend(3) = dtidx(100+ntoz,index_for_cause_temp) ! was ozp3 idtend(4) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp4 diff --git a/physics/phys_tend.F90 b/physics/phys_tend.F90 index 98d76e104..e05b52416 100644 --- a/physics/phys_tend.F90 +++ b/physics/phys_tend.F90 @@ -25,8 +25,9 @@ subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & ! Interface variables logical, intent(in) :: ldiag3d - real(kind=kind_phys), optional, intent(inout) :: dtend - integer, intent(in) :: dtidx(:,:), index_for_cause_physics, index_for_cause_non_physics, ntracp100 + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:), index_for_cause_physics, & + index_for_cause_non_physics, ntracp100, ncause character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -49,7 +50,7 @@ subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & endif do icause=1,ncause if(icause==index_for_cause_physics .or. & - icuase==index_for_cause_non_physics) then + icause==index_for_cause_non_physics) then cycle ! Don't sum up the sums. endif idtend = dtidx(itrac,icause) diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 812984b68..c7acf9553 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -62,7 +62,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & & kinver,xkzm_m,xkzm_h,xkzm_s, & & index_for_temperature,index_for_x_wind,index_for_y_wind, & - & index_for_cause_pbl,ntqv,ntoz,dtidx, & + & index_for_cause_pbl,ntqv,ntoz,dtend,dtidx, & & gen_tend,ldiag3d,errmsg,errflg) ! use machine , only : kind_phys @@ -75,8 +75,8 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & integer, intent(in) :: kinver(im) integer, intent(out) :: kpbl(im) ! - logical, intent(in) :: gen_tend, ldiag3d, qdiag3d - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend & + logical, intent(in) :: gen_tend, ldiag3d + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend integer, intent(in) :: index_for_temperature,index_for_x_wind, & & index_for_y_wind, ntqv, ntoz, dtidx(:,:), index_for_cause_pbl ! @@ -1409,7 +1409,7 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & endif idtend = dtidx(100+ntqv,index_for_cause_pbl) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f2-q1(:,:,1)) + dtend(:,:,idtend) = dtend(:,:,idtend) +delt*rdt*(f2-q1(:,:,1)) endif endif ! diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 88a6f7fe9..52ea8c4ff 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -549,6 +549,23 @@ kind = kind_phys intent = in optional = F +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + type = real + kind = kind_phys + intent = in + optional = F +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F [index_for_temperature] standard_name = index_for_temperature long_name = index in dtidx first dimension of temperature field diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 63a67c810..ae4f04c8e 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -65,7 +65,8 @@ subroutine satmedmfvdifq_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,dspfac,bl_upfr,bl_dnfr, & - & ntoz,du3dt,dv3dt,dt3dt,dq3dt,do3dt,gen_tend,ldiag3d,qdiag3d, & + & ntoz,ntqv,dtend,dtidx,index_for_temperature,index_for_x_wind,& + & index_for_y_wind,index_for_cause_pbl,gen_tend,ldiag3d, & & errmsg,errflg) ! use machine , only : kind_phys @@ -74,11 +75,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(im) integer, intent(in) :: islimsk(im) integer, intent(out) :: kpbl(im) - 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 @@ -101,10 +102,10 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & prsi(im,km+1), del(im,km), & & prsl(im,km), prslk(im,km), & & phii(im,km+1), phil(im,km) - 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_for_temperature, index_f & + & or_x_wind, index_for_y_wind, index_for_cause & + & _pbl real(kind=kind_phys), intent(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -120,7 +121,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) ! @@ -1422,19 +1423,13 @@ 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 - enddo - enddo - if(qdiag3d) 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 - enddo - enddo + idtend=dtidx(index_for_temperature,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f1-t1) + endif + idtend=dtidx(100+ntqv,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) +delt*rdt*(f2-q1(:,:,1)) endif endif ! @@ -1448,15 +1443,18 @@ 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 + if(ldiag3d .and. .not. gen_tend .and. ntoz>0) then + idtend=dtidx(ntoz+100,index_for_cause_pbl) + if(idtend>1) 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 + dtend(i,k,idtend) = dtend(i,k,idtend)+qtend*delt + enddo enddo - enddo + endif endif endif ! @@ -1472,12 +1470,10 @@ 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 - enddo - enddo + idtend=dtidx(ntqv+100,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + delt*dspfac*diss/cp + endif endif endif c @@ -1556,14 +1552,14 @@ 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 - enddo - enddo + idtend=dtidx(index_for_x_wind,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend)=dtend(:,:,idtend)+delt*rdt*(f1-u1) + endif + idtend=dtidx(index_for_y_wind,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend)=dtend(:,:,idtend)+delt*rdt*(f2-v1) + endif endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index a57ce3839..ee98d6494 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -601,50 +601,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 = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) 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 = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + 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_for_temperature] + standard_name = index_for_temperature + long_name = index in dtidx first dimension of temperature field + 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_for_x_wind] + standard_name = index_for_x_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_y_wind] + standard_name = index_for_y_wind + long_name = index in dtidx first dimension of x wind field + units = index + dimensions = () + type = integer + intent = in + optional = F +[index_for_cause_pbl] + standard_name = index_for_cause_pbl + long_name = tracer changes caused by PBL scheme + units = index + dimensions = () + type = integer + intent = in optional = F [gen_tend] standard_name = flag_for_generic_planetary_boundary_layer_tendency @@ -662,14 +674,6 @@ type = logical intent = inout optional = F -[qdiag3d] - standard_name = flag_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 5c3a521913b37f3c2ff9fd0565dba879816eabe4 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Fri, 15 Jan 2021 17:37:45 +0000 Subject: [PATCH 04/34] Changes needed for new 3d diagnostic tendency arrays in some schemes. --- physics/cu_gf_driver.F90 | 8 +++---- physics/module_MYNNPBL_wrapper.F90 | 6 ++--- physics/ozphys_2015.f | 10 ++++---- physics/satmedmfvdifq.F | 38 +++++++++++++++++++++++++----- 4 files changed, 44 insertions(+), 18 deletions(-) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 4bfe0cbcd..1b323c553 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -881,7 +881,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & endif if(tidx>1) then do k=kts,ktf - dtend(:,k,tidx) = dtend(:,k,tidx) + cutens(i)*outts(i,k) * dt + dtend(:,k,tidx) = dtend(:,k,tidx) + cutens(:)*outts(:,k) * dt enddo endif if(qidx>1) then @@ -901,17 +901,17 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & qidx=dtidx(100+ntqv,index_for_cause_dcnv) if(uidx>1) then do k=kts,ktf - dtend(:,k,uidx) = dtend(:,k,uidx) + (cuten(i)*outu(i,k)+cutenm(i)*outum(i,k)) * dt + 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(i)*outv(i,k)+cutenm(i)*outvm(i,k)) * dt + 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(i)*outt(i,k)+cutenm(i)*outtm(i,k)) * dt + dtend(:,k,tidx) = dtend(:,k,tidx) + (cuten*outt(:,k)+cutenm*outtm(:,k)) * dt enddo endif if(qidx>1) then diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 268c7e787..538274249 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -707,15 +707,15 @@ SUBROUTINE mynnedmf_wrapper_run( & accum_duvt3dt: if(lssav) then if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend=dtidx(index_for_x_wind,index_for_cause_pbl) - if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RUBLTEN(i,k)*dtf + if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RUBLTEN*dtf idtend=dtidx(index_for_y_wind,index_for_cause_pbl) - if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RVBLTEN(i,k)*dtf + if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RVBLTEN*dtf endif if (lsidea .or. (ldiag3d .and. .not. flag_for_pbl_generic_tend)) then idtend=dtidx(index_for_temperature,index_for_cause_pbl) - if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RTHBLTEN(i,k)*exner(i,k)*dtf + if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RTHBLTEN*exner*dtf endif endif accum_duvt3dt !Update T, U and V: diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index 5bec3c9cd..f4561c769 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -88,7 +88,7 @@ subroutine ozphys_2015_run ( & errflg = 0 if(ldiag3d) then - idtend(1) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp1 + idtend(1) = dtidx(100+ntoz,index_for_cause_prod_loss) ! was ozp1 idtend(2) = dtidx(100+ntoz,index_for_cause_ozmix) ! was ozp2 idtend(3) = dtidx(100+ntoz,index_for_cause_temp) ! was ozp3 idtend(4) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp4 @@ -171,19 +171,19 @@ subroutine ozphys_2015_run ( & enddo if(idtend(1)>1) then dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 - & (prod(i,1)-prod(i,2)*prod(i,6))*dt + & (prod(:,1)-prod(:,2)*prod(:,6))*dt endif if(idtend(2)>1) then dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 - & (oz(i,l) - ozib(i)) + & (oz(:,l) - ozib(:)) endif if(idtend(3)>1) then dtend(:,l,idtend(3)) = dtend(:,l,idtend(3)) + ! was ozp3 - & prod(i,3)*(tin(i,l)-prod(i,5))*dt + & prod(:,3)*(tin(:,l)-prod(:,5))*dt endif if(idtend(4)>1) then dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 - & prod(i,4) * (colo3(i,l)-coloz(i,l))*dt + & prod(:,4) * (colo3(:,l)-coloz(:,l))*dt endif enddo ! vertical loop ! diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index ae4f04c8e..8092a0df4 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -1425,11 +1425,21 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & if(ldiag3d .and. .not. gen_tend) then idtend=dtidx(index_for_temperature,index_for_cause_pbl) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f1-t1) + 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 endif idtend=dtidx(100+ntqv,index_for_cause_pbl) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) +delt*rdt*(f2-q1(:,:,1)) + do k = 1,km + do i = 1,im + qtend = (f2(i,k)-q1(i,k,1))*rdt + dtend(i,k,idtend) = dtend(i,k,idtend)+qtend*delt + enddo + enddo endif endif ! @@ -1470,9 +1480,14 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if(ldiag3d .and. .not. gen_tend) then - idtend=dtidx(ntqv+100,index_for_cause_pbl) + idtend=dtidx(index_for_temperature,index_for_cause_pbl) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + delt*dspfac*diss/cp + 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 endif endif endif @@ -1554,11 +1569,22 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & if(ldiag3d .and. .not. gen_tend) then idtend=dtidx(index_for_x_wind,index_for_cause_pbl) if(idtend>1) then - dtend(:,:,idtend)=dtend(:,:,idtend)+delt*rdt*(f1-u1) + 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 endif + idtend=dtidx(index_for_y_wind,index_for_cause_pbl) if(idtend>1) then - dtend(:,:,idtend)=dtend(:,:,idtend)+delt*rdt*(f2-v1) + 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 ! From 127d7e4eececd8c5a795f048b8a26ec2b1138fcb Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 22 Jan 2021 17:33:31 +0000 Subject: [PATCH 05/34] Five suites output nearly all of the tendencies for convection, PBL, microphysics, total physics, and total non-physics, along with all other variables that previously worked. The TKE is being stubborn and the fv3_control does not want to report total physics tendency for liq_wat tracer. --- physics/GFS_DCNV_generic.F90 | 62 +++++++++++------- physics/GFS_DCNV_generic.meta | 94 +++++++++++++++++++-------- physics/GFS_SCNV_generic.F90 | 60 ++++++++++------- physics/GFS_SCNV_generic.meta | 74 ++++++++++++++++----- physics/cu_gf_driver.F90 | 72 +++++++++++++++++++-- physics/cu_gf_driver.meta | 16 +++++ physics/module_MYNNPBL_wrapper.F90 | 99 +++++++++++++++++++++-------- physics/module_MYNNPBL_wrapper.meta | 80 ++++++++++++++++++++--- physics/moninedmf.f | 11 ++-- physics/satmedmfvdifq.F | 11 ++-- 10 files changed, 443 insertions(+), 136 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index fbadc38f5..7b9ff1a9a 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -15,32 +15,32 @@ 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, & + dtidx, index_for_cause_dcnv, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs + integer, intent(in) :: im, levs, nsamftrac, ntqv, index_for_cause_dcnv, dtidx(:,:) logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0 - real(kind=kind_phys), dimension(im,levs), intent(inout) :: gq0_water_vapor + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: gq0 real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_u real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_v real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t - real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv + 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 real(kind=kind_phys), parameter :: zero = 0.0d0 - integer :: i, k + integer :: i, k, n ! Initialize CCPP error handling variables errmsg = '' @@ -63,11 +63,19 @@ 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) + if(nsamftrac>0) then + do n=1,nsamftrac + if(n==ntqv .or. dtidx(n+100,index_for_cause_dcnv)) then + save_q(:,:,n) = gq0(:,:,n) + endif enddo - enddo + else + do k=1,levs + do i=1,im + save_q(i,k,ntqv) = gq0(i,k,ntqv) + enddo + enddo + endif endif if (cplchm) then @@ -92,10 +100,10 @@ end subroutine GFS_DCNV_generic_post_finalize !! \htmlinclude GFS_DCNV_generic_post_run.html !! subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, 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, & + 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_for_cause_dcnv, & - index_for_temperature, index_for_x_wind, index_for_y_wind, ntqv, & + index_for_temperature, index_for_x_wind, index_for_y_wind, ntqv, gq0, save_q, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, errmsg, errflg) @@ -103,14 +111,15 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & implicit none - integer, intent(in) :: im, levs + integer, intent(in) :: im, levs, nsamftrac logical, intent(in) :: lssav, ldiag3d, ras, cscnv logical, intent(in) :: flag_for_dcnv_generic_tend real(kind=kind_phys), intent(in) :: frain, dtf real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d - real(kind=kind_phys), dimension(im,levs), intent(in) :: save_u, save_v, save_t, save_qv - real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0, gq0_water_vapor + real(kind=kind_phys), dimension(im,levs), intent(in) :: save_u, save_v, save_t + real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0 + real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q real(kind=kind_phys), dimension(im,levs), intent(in) :: ud_mf, dd_mf, dt_mf real(kind=kind_phys), intent(in) :: con_g integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d @@ -133,7 +142,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k, idtend + integer :: i, k, n, idtend ! Initialize CCPP error handling variables errmsg = '' @@ -184,9 +193,18 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0-save_v)*frain endif - idtend=dtidx(100+ntqv,index_for_cause_dcnv) - if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0_water_vapor-save_qv)*frain + if(nsamftrac>0) then + do n=1,nsamftrac + idtend=dtidx(100+n,index_for_cause_dcnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain + endif + enddo + else + idtend=dtidx(100+ntqv,index_for_cause_dcnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv)-save_q(:,:,ntqv))*frain + endif endif endif ! if (ldiag3d) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 7da6d659f..e49c8ff73 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,22 @@ kind = kind_phys intent = inout optional = F +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[index_for_cause_dcnv] + standard_name = index_for_cause_dcnv + long_name = tracer changes caused by deep convection scheme + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -275,15 +307,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 @@ -311,15 +334,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 @@ -404,6 +418,24 @@ 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 @@ -437,6 +469,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 diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index b60ade9bc..22897c1c4 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -14,22 +14,24 @@ 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_for_cause_scnv, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs + integer, intent(in) :: im, levs, ntqv, nsamftrac, index_for_cause_scnv, dtidx(:,:) logical, intent(in) :: ldiag3d, qdiag3d, flag_for_scnv_generic_tend - real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0, gq0_water_vapor - - real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_u, save_v, save_t, save_qv + real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0 + real(kind=kind_phys), intent(in) :: gq0(:,:,:) + real(kind=kind_phys), intent(inout) :: save_q(:,:,:) + real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_u, save_v, save_t character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k + integer :: i, k, n ! Initialize CCPP error handling variables errmsg = '' @@ -44,11 +46,15 @@ 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) - enddo - enddo + if(nsamftrac>0) then + do n=1,nsamftrac + if(n==ntqv .or. dtidx(ntqv,index_for_cause_scnv)>1) then + save_q(:,:,n) = gq0(:,:,n) + endif + enddo + else + save_q(:,:,ntqv) = gq0(:,:,ntqv) + endif endif endif @@ -71,8 +77,8 @@ end subroutine GFS_SCNV_generic_post_finalize !! \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, clw, & - shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, & + 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_for_temperature, index_for_x_wind, index_for_y_wind, & index_for_cause_scnv, ntqv, flag_for_scnv_generic_tend, & @@ -82,11 +88,12 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl implicit none - integer, intent(in) :: im, levs, nn, ntqv + integer, intent(in) :: im, levs, nn, ntqv, nsamftrac logical, intent(in) :: lssav, ldiag3d, qdiag3d, cplchm, flag_for_scnv_generic_tend real(kind=kind_phys), intent(in) :: frain - real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0, gq0_water_vapor - real(kind=kind_phys), dimension(im,levs), intent(in) :: save_u, save_v, save_t, save_qv + real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0 + real(kind=kind_phys), dimension(im,levs), intent(in) :: save_u, save_v, save_t + real(kind=kind_phys), dimension(:,:,:), intent(in) :: save_q, gq0 ! dtend only allocated if ldiag3d == .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti @@ -111,7 +118,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k, idtend + integer :: i, k, n, idtend real(kind=kind_phys) :: tem ! Initialize CCPP error handling variables @@ -156,9 +163,18 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0 - save_v) * frain endif - idtend = dtidx(100+ntqv, index_for_cause_scnv) - if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0_water_vapor - save_qv) * frain + if(nsamftrac>0) then + do n=1,nsamftrac + idtend = dtidx(100+n, index_for_cause_scnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n) - save_q(:,:,n)) * frain + endif + enddo + else + idtend = dtidx(100+ntqv, index_for_cause_scnv) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain + endif endif endif endif @@ -166,7 +182,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 5fec5247b..9076e6050 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 = out 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 = out + 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,22 @@ type = logical intent = in optional = F +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[index_for_cause_scnv] + standard_name = index_for_cause_scnv + long_name = tracer changes caused by shallow convection scheme + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -239,11 +271,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 +307,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 @@ -418,6 +450,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 diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 1b323c553..5d34a8bc0 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -71,7 +71,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & ! fixme: delete ! du3dt_SCNV,dv3dt_SCNV,dt3dt_SCNV,dq3dt_SCNV, & ! du3dt_DCNV,dv3dt_DCNV,dt3dt_DCNV,dq3dt_DCNV, & - dtend,dtidx,ntqv,index_for_temperature,index_for_x_wind, & + dtend,dtidx,ntqv,ntiw,ntcw,index_for_temperature,index_for_x_wind,& index_for_y_wind,index_for_cause_scnv,index_for_cause_dcnv, & ldiag3d,qci_conv,errmsg,errflg) !------------------------------------------------------------- @@ -102,7 +102,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & index_for_x_wind, index_for_y_wind, index_for_temperature, & - index_for_cause_scnv, index_for_cause_dcnv, ntqv + index_for_cause_scnv, index_for_cause_dcnv, ntqv, ntcw, ntiw real(kind=kind_phys), dimension( im , km ), intent(in ) :: forcet,forceqv_spechum,w,phil real(kind=kind_phys), dimension( im , km ), intent(inout ) :: t,us,vs @@ -113,6 +113,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & real(kind=kind_phys), dimension( im , km ), intent(out ) :: cnvw_moist,cnvc real(kind=kind_phys), dimension( im , km ), intent(inout ) :: cliw, clcw + real(kind=kind_phys), allocatable :: clcw_save(:,:), cliw_save(:,:) + integer, dimension (im), intent(inout) :: hbot,htop,kcnv integer, dimension (im), intent(in) :: xland real(kind=kind_phys), dimension (im), intent(in) :: pbl @@ -173,7 +175,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep,uidx,vidx,tidx,qidx - integer :: itf,jtf,ktf,iss,jss,nbegin,nend + 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 @@ -188,6 +190,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)) @@ -196,6 +201,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=1 + clcw_deep_idx=1 + else + cliw_deep_idx=dtidx(100+ntiw,index_for_cause_dcnv) + clcw_deep_idx=dtidx(100+ntcw,index_for_cause_dcnv) + endif + if(flag_for_scnv_generic_tend) then + cliw_shal_idx=1 + clcw_shal_idx=1 + else + cliw_shal_idx=dtidx(100+ntiw,index_for_cause_scnv) + clcw_shal_idx=dtidx(100+ntcw,index_for_cause_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 ! @@ -898,7 +927,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & uidx=dtidx(index_for_x_wind,index_for_cause_dcnv) vidx=dtidx(index_for_y_wind,index_for_cause_dcnv) tidx=dtidx(index_for_temperature,index_for_cause_dcnv) - qidx=dtidx(100+ntqv,index_for_cause_dcnv) if(uidx>1) then do k=kts,ktf dtend(:,k,uidx) = dtend(:,k,uidx) + (cuten*outu(:,k)+cutenm*outum(:,k)) * dt @@ -914,6 +942,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & dtend(:,k,tidx) = dtend(:,k,tidx) + (cuten*outt(:,k)+cutenm*outtm(:,k)) * dt enddo endif + + qidx=dtidx(100+ntqv,index_for_cause_dcnv) if(qidx>1) then do k=kts,ktf do i=its,itf @@ -924,6 +954,40 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & enddo endif endif + if(allocated(clcw_save)) then + do k=kts,ktf + do i=its,itf + tem_shal = dt*(outqcs(i,k)*cutens(i)+outqcm(i,k)*cutenm(i)) + tem_deep = dt*(outqc(i,k)*cuten(i)+clw_ten1(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 + endif endif end subroutine cu_gf_driver_run !> @} diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 32ed8c38c..e8abd6797 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -392,6 +392,22 @@ 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 [index_for_temperature] standard_name = index_for_temperature long_name = index in dtidx first dimension of temperature field diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 538274249..d0ace8e9e 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -78,13 +78,14 @@ 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, & - & ntqv, dtend, dtidx, index_for_temperature, & - & index_for_x_wind, index_for_y_wind, & + & dtend, dtidx, index_for_temperature, & + & index_for_x_wind, index_for_y_wind, ntke, & + & ntqv, ntcw, ntiw, ntoz, ntlnc, ntinc, ntwa, ntia, & & index_for_cause_pbl, htrsw, htrlw, xmu, & & grav_settling, bl_mynn_tkebudget, bl_mynn_tkeadvect, & & bl_mynn_cloudpdf, bl_mynn_mixlength, & @@ -212,8 +213,9 @@ SUBROUTINE mynnedmf_wrapper_run( & !TENDENCY DIAGNOSTICS real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) - integer, intent(in) :: index_for_temperature, index_for_x_wind, ntqv, & + integer, intent(in) :: index_for_temperature, index_for_x_wind, & index_for_y_wind, index_for_cause_pbl + integer, intent(in) :: ntoz, ntqv, ntcw, ntiw, ntlnc, ntinc, ntwa, ntia, ntke !MISC CONFIGURATION OPTIONS INTEGER, PARAMETER :: & @@ -322,6 +324,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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 = '' @@ -334,6 +337,14 @@ SUBROUTINE mynnedmf_wrapper_run( & write(0,*)"flag_restart=",flag_restart endif + if(flag_for_pbl_generic_tend .and. ldiag3d) then + idtend = dtidx(ntke+100,index_for_cause_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 @@ -704,19 +715,11 @@ 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 - idtend=dtidx(index_for_x_wind,index_for_cause_pbl) - if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RUBLTEN*dtf - - idtend=dtidx(index_for_y_wind,index_for_cause_pbl) - if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RVBLTEN*dtf - endif - - if (lsidea .or. (ldiag3d .and. .not. flag_for_pbl_generic_tend)) then - idtend=dtidx(index_for_temperature,index_for_cause_pbl) - if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + RTHBLTEN*exner*dtf - endif + accum_duvt3dt: if(ldiag3d .or. lsidea) then + call dtend_helper(index_for_x_wind,RUBLTEN) + call dtend_helper(index_for_y_wind,RVBLTEN) + call dtend_helper(index_for_temperature,RTHBLTEN,exner) + call dtend_helper(100+ntoz,dqdt_ozone) endif accum_duvt3dt !Update T, U and V: !do k = 1, levs @@ -738,6 +741,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 @@ -762,6 +770,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 @@ -785,6 +802,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 @@ -808,6 +831,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 @@ -829,13 +857,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 - idtend=dtidx(100+ntqv,index_for_cause_pbl) - if(idtend>1) dtend(:,:,idtend) = dtend(:,:,idtend) + dqdt_water_vapor*dtf - endif - if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" @@ -877,6 +905,27 @@ SUBROUTINE mynnedmf_wrapper_run( & print* endif + if(allocated(save_qke_adv)) then + 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_for_cause_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 8b3c742a4..99f911b03 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1011,14 +1011,6 @@ type = logical 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 [dtend] standard_name = diagnostic_3d_tendencies long_name = diagnostic 3d tendencies for tracers and other fields @@ -1060,6 +1052,78 @@ 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 +[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_for_cause_pbl] standard_name = index_for_cause_pbl long_name = tracer changes caused by PBL scheme diff --git a/physics/moninedmf.f b/physics/moninedmf.f index bd52544ba..818ce4a41 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -1312,18 +1312,17 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo enddo - if(.not.flag_for_pbl_generic_tend) then - idtend1 = dtidx(100+ntoz,index_for_cause_pbl) - if(idtend1>1) then - kk = ntoz + if(.not.flag_for_pbl_generic_tend .and. ldiag3d) then + do kk = 2, ntrac + idtend1 = dtidx(100+kk,index_for_cause_pbl) is = (kk-1) * km do k = 1, km do i = 1, im - qtend = (a2(i,k+is)-q1(i,k,kk)) + qtend = (a2(i,k+is)-q1(i,k,kk))*rdt dtend(i,k,idtend1) = dtend(i,k,idtend1)+qtend enddo enddo - endif + enddo endif endif ! diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 8092a0df4..9360fdc14 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -1432,6 +1432,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo endif + ! Send tendencies just for QV; other tracers are below. idtend=dtidx(100+ntqv,index_for_cause_pbl) if(idtend>1) then do k = 1,km @@ -1453,18 +1454,18 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo enddo - if(ldiag3d .and. .not. gen_tend .and. ntoz>0) then - idtend=dtidx(ntoz+100,index_for_cause_pbl) - if(idtend>1) then - kk=ntoz + 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_for_cause_pbl) 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 + enddo endif endif ! From 520f97f070a9403ed2ee85cf7eb73f5950587293 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Mon, 1 Feb 2021 17:41:56 +0000 Subject: [PATCH 06/34] Revert a change mistakenly applied --- physics/GFS_debug.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 2d3bad477..d3966ebb4 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -642,10 +642,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, endif enddo enddo - 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) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cldcov ', Diag%cldcov) +- !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 if(Model%lradar) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%refl_10cm ', Diag%refl_10cm) From 4333db090badbd4cd6779d1c290ca1d2c18af7d3 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Tue, 2 Mar 2021 21:56:19 +0000 Subject: [PATCH 07/34] Diagnostics match dX3dt version for all five targeted suites. --- physics/GFS_PBL_generic.F90 | 23 ++++++-- physics/GFS_PBL_generic.meta | 16 ++++++ physics/GFS_suite_interstitial.F90 | 3 +- physics/module_MYNNPBL_wrapper.F90 | 14 ++++- physics/moninedmf.f | 91 +++++++++++++++++++----------- physics/moninedmf.meta | 8 +++ 6 files changed, 112 insertions(+), 43 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 82efda4e3..d0c1d41ad 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(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs), 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) @@ -610,7 +621,7 @@ 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 idtend = dtidx(index_for_temperature, index_for_cause_pbl) if(idtend>1) then diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index d65508f37..5a7678c63 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 diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index dcdce44d6..e55c8deef 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -161,12 +161,13 @@ end subroutine GFS_suite_interstitial_2_finalize !! \htmlinclude GFS_suite_interstitial_2_run.html !! #endif + subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, 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, dtend, dtidx, index_for_cause_longwave, index_for_cause_shortwave, & index_for_cause_pbl, index_for_cause_dcnv, index_for_cause_scnv, index_for_cause_mp, index_for_temperature, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_GP_jacobian, skt, sktp1r, fluxlwUP, fluxlwUP_jac, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, errmsg, errflg) implicit none diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index d0ace8e9e..70818d69d 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -282,6 +282,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & RQNWFABLTEN, RQNIFABLTEN, & & dqke,qWT,qSHEAR,qBUOY,qDISS, & & pattern_spp_pbl + real(kind=kind_phys), allocatable :: oldzone(:,:) !MYNN-CHEM arrays real(kind=kind_phys), dimension(im,nchem) :: chem3d @@ -494,7 +495,10 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo endif - + if(ldiag3d .and. dtidx(100+ntoz,index_for_cause_pbl)>1) then + allocate(oldzone(im,levs)) + oldzone = ozone + endif if (lprnt)write(0,*)"prepping MYNN-EDMF variables..." do k=1,levs @@ -719,7 +723,13 @@ SUBROUTINE mynnedmf_wrapper_run( & call dtend_helper(index_for_x_wind,RUBLTEN) call dtend_helper(index_for_y_wind,RVBLTEN) call dtend_helper(index_for_temperature,RTHBLTEN,exner) - call dtend_helper(100+ntoz,dqdt_ozone) + if(ldiag3d) then + idtend = dtidx(100+ntoz,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + (ozone-oldzone) + deallocate(oldzone) + endif + endif endif accum_duvt3dt !Update T, U and V: !do k = 1, levs diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 818ce4a41..148f2210f 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -65,7 +65,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & & xkzminv,moninq_fac,hurr_pbl,islimsk,var_ric, & - & coef_ric_l,coef_ric_s,ldiag3d,ntqv,ntoz, & + & coef_ric_l,coef_ric_s,ldiag3d,ntqv,rtg_ozone_index,ntoz, & & dtend,dtidx,index_for_cause_pbl,index_for_x_wind, & & index_for_y_wind,index_for_temperature, & & flag_for_pbl_generic_tend,errmsg,errflg) @@ -84,7 +84,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! logical, intent(in) :: lprnt, hurr_pbl, ldiag3d logical, intent(in) :: flag_for_pbl_generic_tend - integer, intent(in) :: ipr, islimsk(im) + integer, intent(in) :: ipr, islimsk(im), ntoz integer, intent(in) :: im, km, ntrac, ntcw, kinver(im) integer, intent(out) :: kpbl(im) @@ -98,7 +98,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_for_x_wind, index_for_y_wind, & - & index_for_cause_pbl, index_for_temperature, ntqv, ntoz + & index_for_cause_pbl, index_for_temperature, ntqv, rtg_ozone_index real(kind=kind_phys), intent(in) :: & & u1(im,km), v1(im,km), & & t1(im,km), q1(im,km,ntrac), & @@ -1282,10 +1282,6 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! recover tendencies of heat and moisture ! !> After returning with the solution, the tendencies for temperature and moisture are recovered. - if(.not.flag_for_pbl_generic_tend) then - idtend1=dtidx(index_for_temperature,index_for_cause_pbl) - idtend2=dtidx(ntqv+100,index_for_cause_pbl) - endif do k = 1,km do i = 1,im ttend = (a1(i,k)-t1(i,k)) * rdt @@ -1294,14 +1290,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(idtend1>1) then - dtend(i,k,idtend1) = dtend(i,k,idtend1) + ttend*delt - endif - if(idtend2>1) then - dtend(i,k,idtend2) = dtend(i,k,idtend2) + qtend*delt - endif enddo enddo + if(.not.flag_for_pbl_generic_tend) then + idtend1=dtidx(index_for_temperature,index_for_cause_pbl) + idtend2=dtidx(ntqv+100,index_for_cause_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 @@ -1312,17 +1322,19 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo enddo - if(.not.flag_for_pbl_generic_tend .and. ldiag3d) then - do kk = 2, ntrac - idtend1 = dtidx(100+kk,index_for_cause_pbl) - is = (kk-1) * km - do k = 1, km - do i = 1, im - qtend = (a2(i,k+is)-q1(i,k,kk))*rdt - dtend(i,k,idtend1) = dtend(i,k,idtend1)+qtend - enddo - enddo - enddo + if(.not.flag_for_pbl_generic_tend .and. ldiag3d .and. & + & rtg_ozone_index>0) then + idtend1 = dtidx(100+ntoz,index_for_cause_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 ! @@ -1423,10 +1435,6 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! recover tendencies of momentum ! !> Finally, the tendencies are recovered from the tridiagonal solutions. - if(.not.flag_for_pbl_generic_tend) then - idtend1 = dtidx(index_for_x_wind,index_for_cause_pbl) - idtend2 = dtidx(index_for_y_wind,index_for_cause_pbl) - endif do k = 1,km do i = 1,im utend = (a1(i,k)-u1(i,k))*rdt @@ -1435,12 +1443,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(idtend1>1) then - dtend(i,k,idtend1) = dtend(i,k,idtend1) + utend*delt - endif - if(idtend2>1) then - dtend(i,k,idtend2) = dtend(i,k,idtend2) + vtend*delt - endif ! ! for dissipative heating for ecmwf model ! @@ -1453,6 +1455,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_for_x_wind,index_for_cause_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_for_y_wind,index_for_cause_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 fd2247d20..16abc742b 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -554,6 +554,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 = in + optional = F [ntoz] standard_name = index_for_ozone long_name = tracer index for ozone mixing ratio From ca076e5f9e261332c941a0458f666451528722ba Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 4 Mar 2021 16:25:41 +0000 Subject: [PATCH 08/34] New tendencies work, except maybe TKE and CLD_AMT --- physics/GFS_PBL_generic.F90 | 11 +++++++ physics/GFS_suite_interstitial.F90 | 33 +++++++++++++++++-- physics/GFS_suite_interstitial.meta | 49 +++++++++++++++++++++++++++++ physics/module_MYNNPBL_wrapper.F90 | 8 ++++- physics/satmedmfvdifq.F | 23 ++++++++++---- 5 files changed, 115 insertions(+), 9 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index d0c1d41ad..097ff0b58 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -296,6 +296,13 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, 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 @@ -649,6 +656,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, 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_for_cause_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 endif ! end if_lssav diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index e55c8deef..3181aaeaf 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -686,7 +686,8 @@ 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, dtf, save_qc, save_qi, con_pi, & - gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, errmsg, errflg) + gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, dtidx, dtend, ntk, ntke, ldiag3d, & + index_for_cause_conv_trans, errmsg, errflg) use machine, only: kind_phys use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber @@ -706,6 +707,12 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), dimension(:, :), intent(in) :: save_qi + ! dtend and dtidx are only allocated if ldiag3d + logical, intent(in) :: ldiag3d + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + integer, dimension(:,:), intent(in) :: dtidx + integer, intent(in) :: index_for_cause_conv_trans,ntk,ntke + real(kind=kind_phys), dimension(im,levs,ntrac), intent(inout) :: gq0 real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw real(kind=kind_phys), dimension(im,levs), intent(in) :: prsl @@ -722,7 +729,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to integer, intent(out) :: errflg ! local variables - integer :: i,k,n,tracers + integer :: i,k,n,tracers,idtend real(kind=kind_phys), dimension(im,levs) :: rho_dryair real(kind=kind_phys), dimension(im,levs) :: qv_mp !< kg kg-1 (dry mixing ratio) @@ -735,6 +742,28 @@ 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_for_cause_conv_trans) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk) + endif + endif + if(ntclamt<=size(clw,3) .and. ntclamt>0) then + idtend=dtidx(100+ntclamt,index_for_cause_conv_trans) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntclamt) + endif + endif + endif + + if(ldiag3d .and. ntk>0) then + idtend=dtidx(100+ntke,index_for_cause_conv_trans) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk) + endif + endif + ! --- update the tracers due to deep & shallow cumulus convective transport ! (except for suspended water and ice) diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 59570d407..91aa9f6f7 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1905,6 +1905,55 @@ kind = kind_phys intent = inout optional = F +[dtidx] + standard_name = dtend_outer_index + long_name = index in outer dimension of dtend of a tracer-cause pair + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_possible_causes_of_tracer_changes) + type = integer + intent = in + optional = F +[dtend] + standard_name = diagnostic_3d_tendencies + long_name = diagnostic 3d tendencies for tracers and other fields + units = various + dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + 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 +[index_for_cause_conv_trans] + standard_name = index_for_cause_conv_trans + long_name = tracer changes caused by convective transport of tracers + 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/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 70818d69d..5d317d23b 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -338,7 +338,7 @@ SUBROUTINE mynnedmf_wrapper_run( & write(0,*)"flag_restart=",flag_restart endif - if(flag_for_pbl_generic_tend .and. ldiag3d) then + if(.not. flag_for_pbl_generic_tend .and. ldiag3d) then idtend = dtidx(ntke+100,index_for_cause_pbl) if(idtend>1) then allocate(save_qke_adv(im,levs)) @@ -916,6 +916,12 @@ SUBROUTINE mynnedmf_wrapper_run( & endif if(allocated(save_qke_adv)) then + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then + idtend = dtidx(100+ntke,index_for_cause_pbl) + if(idtend>1) then + dtend(:,:,idtend) = dtend(:,:,idtend) + qke_adv-save_qke_adv + endif + endif deallocate(save_qke_adv) endif diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 9360fdc14..f0ef9e890 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -1459,12 +1459,23 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & do kk = 2, ntrac1 is = (kk-1) * km idtend = dtidx(kk+100,index_for_cause_pbl) - 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 + if(idtend>1) then + if(kk==ntke) then + do k = 1, km + do i = 1, im + qtend = (f1(i,k)-q1(i,k,kk))*rdt + dtend(i,k,idtend) = dtend(i,k,idtend)+qtend*delt + enddo + enddo + else + 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 From 5e169e8f185039844cd908c8f060244bcdddf4da Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Wed, 24 Mar 2021 19:17:35 +0000 Subject: [PATCH 09/34] Rename many variables --- physics/GFS_DCNV_generic.F90 | 24 +++++----- physics/GFS_DCNV_generic.meta | 48 +++++++++---------- physics/GFS_GWD_generic.F90 | 28 +++++------ physics/GFS_GWD_generic.meta | 72 ++++++++++++++--------------- physics/GFS_MP_generic.F90 | 8 ++-- physics/GFS_MP_generic.meta | 26 +++++------ physics/GFS_PBL_generic.F90 | 20 ++++---- physics/GFS_PBL_generic.meta | 36 +++++++-------- physics/GFS_SCNV_generic.F90 | 22 ++++----- physics/GFS_SCNV_generic.meta | 48 +++++++++---------- physics/GFS_suite_interstitial.F90 | 36 +++++++-------- physics/GFS_suite_interstitial.meta | 72 ++++++++++++++--------------- physics/cires_ugwp.F90 | 20 ++++---- physics/cires_ugwp.meta | 42 ++++++++--------- physics/cu_gf_driver.F90 | 32 ++++++------- physics/cu_gf_driver.meta | 42 ++++++++--------- physics/gwdc.f | 12 ++--- physics/gwdc.meta | 30 ++++++------ physics/module_MYJPBL_wrapper.F90 | 16 +++---- physics/module_MYJPBL_wrapper.meta | 36 +++++++-------- physics/module_MYNNPBL_wrapper.F90 | 26 +++++------ physics/module_MYNNPBL_wrapper.meta | 36 +++++++-------- physics/moninedmf.f | 18 ++++---- physics/moninedmf.meta | 36 +++++++-------- physics/moninshoc.f | 18 ++++---- physics/moninshoc.meta | 36 +++++++-------- physics/ozphys.f | 18 ++++---- physics/ozphys.meta | 36 +++++++-------- physics/ozphys_2015.f | 18 ++++---- physics/ozphys_2015.meta | 36 +++++++-------- physics/phys_tend.F90 | 12 ++--- physics/phys_tend.meta | 30 ++++++------ physics/rayleigh_damp.f | 16 +++---- physics/rayleigh_damp.meta | 36 +++++++-------- physics/satmedmfvdif.F | 16 +++---- physics/satmedmfvdif.meta | 36 +++++++-------- physics/satmedmfvdifq.F | 21 ++++----- physics/satmedmfvdifq.meta | 36 +++++++-------- physics/shinhongvdif.F90 | 18 ++++---- physics/shinhongvdif.meta | 36 +++++++-------- physics/unified_ugwp.F90 | 22 ++++----- physics/unified_ugwp.meta | 42 ++++++++--------- physics/ysuvdif.F90 | 18 ++++---- 43 files changed, 643 insertions(+), 644 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 7b9ff1a9a..c5043e6a1 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -18,13 +18,13 @@ end subroutine GFS_DCNV_generic_pre_finalize 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, & - dtidx, index_for_cause_dcnv, errmsg, errflg) + dtidx, index_of_process_dcnv, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, nsamftrac, ntqv, index_for_cause_dcnv, dtidx(:,:) + integer, intent(in) :: im, levs, nsamftrac, ntqv, index_of_process_dcnv, dtidx(:,:) logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 @@ -65,7 +65,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc if ((ldiag3d.and.qdiag3d) .or. cplchm) then if(nsamftrac>0) then do n=1,nsamftrac - if(n==ntqv .or. dtidx(n+100,index_for_cause_dcnv)) then + if(n==ntqv .or. dtidx(n+100,index_of_process_dcnv)) then save_q(:,:,n) = gq0(:,:,n) endif enddo @@ -102,8 +102,8 @@ end subroutine GFS_DCNV_generic_post_finalize subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, 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_for_cause_dcnv, & - index_for_temperature, index_for_x_wind, index_for_y_wind, ntqv, gq0, save_q, & + 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, errmsg, errflg) @@ -130,8 +130,8 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & real(kind=kind_phys), dimension(im,levs), intent(inout) :: cnvw, cnvc real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend - integer, intent(in) :: dtidx(:,:), index_for_cause_dcnv, index_for_temperature, & - index_for_x_wind, index_for_y_wind, ntqv + integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_temperature, & + index_of_x_wind, index_of_y_wind, ntqv ! 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, @@ -178,30 +178,30 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & enddo if (ldiag3d .and. flag_for_dcnv_generic_tend) then - idtend=dtidx(index_for_temperature,index_for_cause_dcnv) + 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_for_x_wind,index_for_cause_dcnv) + 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_for_y_wind,index_for_cause_dcnv) + idtend=dtidx(index_of_y_wind,index_of_process_dcnv) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0-save_v)*frain endif if(nsamftrac>0) then do n=1,nsamftrac - idtend=dtidx(100+n,index_for_cause_dcnv) + idtend=dtidx(100+n,index_of_process_dcnv) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain endif enddo else - idtend=dtidx(100+ntqv,index_for_cause_dcnv) + idtend=dtidx(100+ntqv,index_of_process_dcnv) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv)-save_q(:,:,ntqv))*frain endif diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index e49c8ff73..8ddace1cc 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -153,16 +153,16 @@ intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_cause_dcnv] - standard_name = index_for_cause_dcnv - long_name = tracer changes caused by deep convection scheme +[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 @@ -362,49 +362,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_cause_dcnv] - standard_name = index_for_cause_dcnv - long_name = tracer changes caused by deep convection scheme +[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_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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 diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 40fdd6198..b89f54610 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -20,8 +20,8 @@ subroutine GFS_GWD_generic_pre_run( & & oc, oa4, clx, theta, & & varss, ocss, oa4ss, clxss, & & sigma, gamma, elvmax, lssav, ldiag3d, & - & dtend, dtidx, index_for_temperature, index_for_x_wind, & - & index_for_y_wind, index_for_cause_orographic_gwd, & + & 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) @@ -40,8 +40,8 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(in) :: dtdt(im,levs), dudt(im,levs), dvdt(im,levs) ! dtend only allocated only if ldiag3d is .true. real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_for_temperature, & - & index_for_x_wind, index_for_y_wind, index_for_cause_orographic_gwd + 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 @@ -122,17 +122,17 @@ subroutine GFS_GWD_generic_pre_run( & endif ! end if_nmtvr if (lssav .and. ldiag3d .and. flag_for_gwd_generic_tend) then - idtend = dtidx(index_for_temperature, index_for_cause_orographic_gwd) + idtend = dtidx(index_of_temperature, index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) - dtdt*dtf endif - idtend = dtidx(index_for_x_wind, index_for_cause_orographic_gwd) + 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_for_y_wind, index_for_cause_orographic_gwd) + idtend = dtidx(index_of_y_wind, index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) - dvdt*dtf endif @@ -163,8 +163,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, flag_for_gwd_generic_tend, dtend, dtidx, index_for_temperature, index_for_x_wind, & - & index_for_y_wind, index_for_cause_orographic_gwd, 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 @@ -179,8 +179,8 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d ! dtend only allocated only if ldiag3d is .true. real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_for_temperature, & - & index_for_x_wind, index_for_y_wind, index_for_cause_orographic_gwd + 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 @@ -196,17 +196,17 @@ 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 - idtend = dtidx(index_for_temperature, index_for_cause_orographic_gwd) + idtend = dtidx(index_of_temperature, index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtdt*dtf endif - idtend = dtidx(index_for_x_wind, index_for_cause_orographic_gwd) + 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_for_y_wind, index_for_cause_orographic_gwd) + idtend = dtidx(index_of_y_wind, index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dvdt*dtf endif diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 27297ff36..0920a9504 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -183,49 +183,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_orographic_gwd] - standard_name = index_for_cause_orographic_gwd - long_name = tracer changes caused by orographic gravity wave drag +[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 @@ -365,49 +365,49 @@ intent = inout optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_orographic_gwd] - standard_name = index_for_cause_orographic_gwd - long_name = tracer changes caused by orographic gravity wave drag +[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 diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 38e6d3feb..977d0342c 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -90,7 +90,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, pwat, & do_sppt, ca_global, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, & - dtend, dtidx, ncause, index_for_temperature, index_for_cause_mp,ldiag3d, qdiag3d, lssav, & + dtend, dtidx, ncause, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d, lssav, & errmsg, errflg) ! use machine, only: kind_phys @@ -100,7 +100,7 @@ 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_for_temperature,index_for_cause_mp,ncause + integer, intent(in) :: index_of_temperature,index_of_process_mp,ncause real(kind=kind_phys), intent(in) :: dtf, frain, con_g real(kind=kind_phys), dimension(im), intent(in) :: rain1, xlat, xlon, tsfc @@ -343,7 +343,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, enddo if_tendency_diagnostics: if (ldiag3d) then - idtend = dtidx(index_for_temperature,index_for_cause_mp) + idtend = dtidx(index_of_temperature,index_of_process_mp) if(idtend>1) then do k=1,levs do i=1,im @@ -353,7 +353,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, endif if_tracer_diagnostics: if (qdiag3d) then dtend_q: do itrac=1,ntrac - idtend = dtidx(itrac+100,index_for_cause_mp) + idtend = dtidx(itrac+100,index_of_process_mp) if(idtend>1) then do k=1,levs do i=1,im diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 3added996..c3f611366 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -853,41 +853,41 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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 [ncause] - standard_name = number_of_possible_causes_of_tracer_changes - long_name = number of possible causes of tracer changes + 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 -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_cause_mp] - standard_name = index_for_cause_mp - long_name = tracer changes caused by microphysics scheme +[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 diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 097ff0b58..65e8ff4fa 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -331,8 +331,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, imp_physics_fer_hires, & 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, dtend, dtidx, index_for_temperature, index_for_x_wind, index_for_y_wind, & - index_for_cause_pbl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, & + 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, flag_cice, 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, & @@ -381,7 +381,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, 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_for_temperature, index_for_x_wind, index_for_y_wind, index_for_cause_pbl + 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 @@ -630,33 +630,33 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (ldiag3d .and. flag_for_pbl_generic_tend) then if (lsidea) then - idtend = dtidx(index_for_temperature, index_for_cause_pbl) + 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 - idtend = dtidx(index_for_temperature, index_for_cause_pbl) + 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 - idtend = dtidx(index_for_x_wind, index_for_cause_pbl) + 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_for_y_wind, index_for_cause_pbl) + 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_for_cause_pbl) + 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_for_cause_pbl) + 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_for_cause_pbl) + 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 diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 5a7678c63..6d00aabd0 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -825,49 +825,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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 diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 22897c1c4..23351e99e 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -16,13 +16,13 @@ end subroutine GFS_SCNV_generic_pre_finalize !! 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_for_cause_scnv, errmsg, errflg) + dtidx, index_of_process_scnv, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, ntqv, nsamftrac, index_for_cause_scnv, dtidx(:,:) + integer, intent(in) :: im, levs, ntqv, nsamftrac, index_of_process_scnv, dtidx(:,:) logical, intent(in) :: ldiag3d, qdiag3d, flag_for_scnv_generic_tend real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0 real(kind=kind_phys), intent(in) :: gq0(:,:,:) @@ -48,7 +48,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, if (qdiag3d) then if(nsamftrac>0) then do n=1,nsamftrac - if(n==ntqv .or. dtidx(ntqv,index_for_cause_scnv)>1) then + if(n==ntqv .or. dtidx(ntqv,index_of_process_scnv)>1) then save_q(:,:,n) = gq0(:,:,n) endif enddo @@ -80,8 +80,8 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl 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_for_temperature, index_for_x_wind, index_for_y_wind, & - index_for_cause_scnv, ntqv, flag_for_scnv_generic_tend, & + dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & + index_of_process_scnv, ntqv, flag_for_scnv_generic_tend, & imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) use machine, only: kind_phys @@ -99,7 +99,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) - integer, intent(in) :: index_for_temperature, index_for_x_wind, index_for_y_wind, index_for_cause_scnv + integer, intent(in) :: index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_scnv real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw ! Post code for SAS/SAMF @@ -148,30 +148,30 @@ 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 - idtend = dtidx(index_for_temperature, index_for_cause_scnv) + 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_for_x_wind, index_for_cause_scnv) + 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_for_y_wind, index_for_cause_scnv) + idtend = dtidx(index_of_y_wind, index_of_process_scnv) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0 - save_v) * frain endif if(nsamftrac>0) then do n=1,nsamftrac - idtend = dtidx(100+n, index_for_cause_scnv) + idtend = dtidx(100+n, index_of_process_scnv) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n) - save_q(:,:,n)) * frain endif enddo else - idtend = dtidx(100+ntqv, index_for_cause_scnv) + idtend = dtidx(100+ntqv, index_of_process_scnv) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain endif diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 9076e6050..c56ec9aa3 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -136,16 +136,16 @@ intent = in optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_cause_scnv] - standard_name = index_for_cause_scnv - long_name = tracer changes caused by shallow convection scheme +[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 @@ -326,49 +326,49 @@ intent = inout optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_scnv] - standard_name = index_for_cause_scnv - long_name = tracer changes caused by shallow convection scheme +[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 diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 3181aaeaf..04cbf01f4 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -165,8 +165,8 @@ end subroutine GFS_suite_interstitial_2_finalize subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, 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, dtend, dtidx, index_for_cause_longwave, index_for_cause_shortwave, & - index_for_cause_pbl, index_for_cause_dcnv, index_for_cause_scnv, index_for_cause_mp, index_for_temperature, & + 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, errmsg, errflg) implicit none @@ -192,9 +192,9 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! 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_for_cause_longwave, index_for_cause_shortwave, & - index_for_cause_pbl, index_for_cause_dcnv, index_for_cause_scnv, & - index_for_cause_mp, index_for_temperature + 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(im) :: dry, icy, wet real(kind=kind_phys), intent(in ), dimension(im) :: frland @@ -283,42 +283,42 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (ldiag3d) then if (lsidea) then - idtend = dtidx(index_for_temperature,index_for_cause_longwave) + idtend = dtidx(index_of_temperature,index_of_process_longwave) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,1)*dtf endif - idtend = dtidx(index_for_temperature,index_for_cause_shortwave) + idtend = dtidx(index_of_temperature,index_of_process_shortwave) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,2)*dtf endif - idtend = dtidx(index_for_temperature,index_for_cause_pbl) + idtend = dtidx(index_of_temperature,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,3)*dtf endif - idtend = dtidx(index_for_temperature,index_for_cause_dcnv) + idtend = dtidx(index_of_temperature,index_of_process_dcnv) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,4)*dtf endif - idtend = dtidx(index_for_temperature,index_for_cause_scnv) + idtend = dtidx(index_of_temperature,index_of_process_scnv) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,5)*dtf endif - idtend = dtidx(index_for_temperature,index_for_cause_mp) + idtend = dtidx(index_of_temperature,index_of_process_mp) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,6)*dtf endif else - idtend = dtidx(index_for_temperature,index_for_cause_longwave) + idtend = dtidx(index_of_temperature,index_of_process_longwave) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + htrlw(:,:)*dtf endif - idtend = dtidx(index_for_temperature,index_for_cause_shortwave) + idtend = dtidx(index_of_temperature,index_of_process_shortwave) if(idtend>1) then do k=1,levs do i=1,im @@ -687,7 +687,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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, dtf, save_qc, save_qi, con_pi, & gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, dtidx, dtend, ntk, ntke, ldiag3d, & - index_for_cause_conv_trans, errmsg, errflg) + index_of_process_conv_trans, errmsg, errflg) use machine, only: kind_phys use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber @@ -711,7 +711,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to logical, intent(in) :: ldiag3d real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend integer, dimension(:,:), intent(in) :: dtidx - integer, intent(in) :: index_for_cause_conv_trans,ntk,ntke + integer, intent(in) :: index_of_process_conv_trans,ntk,ntke real(kind=kind_phys), dimension(im,levs,ntrac), intent(inout) :: gq0 real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw @@ -744,13 +744,13 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to if(ldiag3d) then if(ntk>0 .and. ntk<=size(clw,3)) then - idtend=dtidx(100+ntke,index_for_cause_conv_trans) + idtend=dtidx(100+ntke,index_of_process_conv_trans) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk) endif endif if(ntclamt<=size(clw,3) .and. ntclamt>0) then - idtend=dtidx(100+ntclamt,index_for_cause_conv_trans) + idtend=dtidx(100+ntclamt,index_of_process_conv_trans) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntclamt) endif @@ -758,7 +758,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to endif if(ldiag3d .and. ntk>0) then - idtend=dtidx(100+ntke,index_for_cause_conv_trans) + idtend=dtidx(100+ntke,index_of_process_conv_trans) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk) endif diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 91aa9f6f7..bbe5d4828 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -673,73 +673,73 @@ intent = inout optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_cause_longwave] - standard_name = index_for_cause_longwave - long_name = tracer changes caused by long wave radiation +[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 -[index_for_cause_shortwave] - standard_name = index_for_cause_shortwave - long_name = tracer changes caused by short wave radiation +[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 -[index_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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_for_cause_dcnv] - standard_name = index_for_cause_dcnv - long_name = tracer changes caused by deep convection scheme +[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_for_cause_scnv] - standard_name = index_for_cause_scnv - long_name = tracer changes caused by shallow convection scheme +[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_for_cause_mp] - standard_name = index_for_cause_mp - long_name = tracer changes caused by microphysics scheme +[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_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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 @@ -1906,18 +1906,18 @@ intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout @@ -1946,9 +1946,9 @@ type = logical intent = in optional = F -[index_for_cause_conv_trans] - standard_name = index_for_cause_conv_trans - long_name = tracer changes caused by convective transport of tracers +[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 diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 12ab27ac7..5689d5a63 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -157,8 +157,8 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr 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, & ! FIXME: delete ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & - dtend, dtidx, index_for_x_wind, index_for_y_wind, index_for_temperature, & - index_for_cause_orographic_gwd, index_for_cause_convective_gwd, & + 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 @@ -187,8 +187,8 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr ! dtend is only allocated if ldiag=.true. real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & - index_for_x_wind, index_for_y_wind, index_for_temperature, & - index_for_cause_orographic_gwd, index_for_cause_convective_gwd + 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 @@ -285,15 +285,15 @@ 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 - idtend = dtidx(index_for_x_wind,index_for_cause_orographic_gwd) + 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_for_y_wind,index_for_cause_orographic_gwd) + 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_for_temperature,index_for_cause_orographic_gwd) + idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif @@ -376,15 +376,15 @@ 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 - idtend = dtidx(index_for_x_wind,index_for_cause_convective_gwd) + 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_for_y_wind,index_for_cause_convective_gwd) + 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_for_temperature,index_for_cause_convective_gwd) + idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dtdt - Pdtdt)*dtp endif diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 3dfc91b41..643ea3f18 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -868,58 +868,58 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + 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 = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_cause_orographic_gwd] - standard_name = index_for_cause_orographic_gwd - long_name = tracer changes caused by orographic gravity wave drag +[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_for_cause_convective_gwd] - standard_name = index_for_cause_convective_gwd - long_name = tracer changes caused by convective gravity wave drag +[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 diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 5d34a8bc0..6a2d75e24 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -71,8 +71,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & ! fixme: delete ! du3dt_SCNV,dv3dt_SCNV,dt3dt_SCNV,dq3dt_SCNV, & ! du3dt_DCNV,dv3dt_DCNV,dt3dt_DCNV,dq3dt_DCNV, & - dtend,dtidx,ntqv,ntiw,ntcw,index_for_temperature,index_for_x_wind,& - index_for_y_wind,index_for_cause_scnv,index_for_cause_dcnv, & + 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 @@ -101,8 +101,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ! dtend is only allocated if ldiag=.true. real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & - index_for_x_wind, index_for_y_wind, index_for_temperature, & - index_for_cause_scnv, index_for_cause_dcnv, ntqv, ntcw, ntiw + 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( im , km ), intent(in ) :: forcet,forceqv_spechum,w,phil real(kind=kind_phys), dimension( im , km ), intent(inout ) :: t,us,vs @@ -207,15 +207,15 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & cliw_deep_idx=1 clcw_deep_idx=1 else - cliw_deep_idx=dtidx(100+ntiw,index_for_cause_dcnv) - clcw_deep_idx=dtidx(100+ntcw,index_for_cause_dcnv) + 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=1 clcw_shal_idx=1 else - cliw_shal_idx=dtidx(100+ntiw,index_for_cause_scnv) - clcw_shal_idx=dtidx(100+ntcw,index_for_cause_scnv) + 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 @@ -894,10 +894,10 @@ 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 - uidx=dtidx(index_for_x_wind,index_for_cause_scnv) - vidx=dtidx(index_for_y_wind,index_for_cause_scnv) - tidx=dtidx(index_for_temperature,index_for_cause_scnv) - qidx=dtidx(100+ntqv,index_for_cause_scnv) + 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 @@ -924,9 +924,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & endif endif if((ideep.eq.1. .or. imid_gf.eq.1) .and. .not.flag_for_dcnv_generic_tend) then - uidx=dtidx(index_for_x_wind,index_for_cause_dcnv) - vidx=dtidx(index_for_y_wind,index_for_cause_dcnv) - tidx=dtidx(index_for_temperature,index_for_cause_dcnv) + 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 @@ -943,7 +943,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & enddo endif - qidx=dtidx(100+ntqv,index_for_cause_dcnv) + qidx=dtidx(100+ntqv,index_of_process_dcnv) if(qidx>1) then do k=kts,ktf do i=its,itf diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index e8abd6797..c6dcd1a33 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -368,19 +368,19 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F @@ -408,41 +408,41 @@ type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_scnv] - standard_name = index_for_cause_scnv - long_name = tracer changes caused by shallow convection scheme +[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_for_cause_dcnv] - standard_name = index_for_cause_dcnv - long_name = tracer changes caused by deep convection scheme +[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 diff --git a/physics/gwdc.f b/physics/gwdc.f index 608f6d39e..c43fbe481 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -1460,8 +1460,8 @@ end subroutine gwdc_post_init subroutine gwdc_post_run( & & im, levs, lssav, ldiag3d, dtf, dtp, con_cp, & & tauctx, taucty, gwdcu, gwdcv, & - & dugwd, dvgwd, dtend, dtidx, index_for_x_wind, index_for_y_wind, & - & index_for_cause_convective_gwd, 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 @@ -1476,8 +1476,8 @@ subroutine gwdc_post_run( & real(kind=kind_phys), intent(inout) :: dugwd(:,:), dvgwd(:,:), & & gu0(:,:), gv0(:,:), gt0(:,:) real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_for_cause_convective_gwd - integer, intent(in) :: index_for_x_wind, index_for_y_wind + integer, intent(in) :: dtidx(:,:), 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 @@ -1497,11 +1497,11 @@ subroutine gwdc_post_run( & endif ! end if_lssav if (ldiag3d) then - idtend = dtidx(index_for_x_wind,index_for_cause_convective_gwd) + idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + gwdcu(:,:) * dtf endif - idtend = dtidx(index_for_y_wind,index_for_cause_convective_gwd) + idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + gwdcv(:,:) * dtf endif diff --git a/physics/gwdc.meta b/physics/gwdc.meta index e9b4eaa4f..2298ed2c0 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -591,42 +591,42 @@ intent = inout optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + 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 = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_convective_gwd] - standard_name = index_for_cause_convective_gwd - long_name = tracer changes caused by convective gravity wave drag +[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 diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index e7230e90e..4db49cb5b 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -41,8 +41,8 @@ SUBROUTINE myjpbl_wrapper_run( & & dkt,xkzm_m, xkzm_h,xkzm_s, gamt,gamq, & & con_cp,con_g,con_rd, & & me, lprnt, gen_tend, ldiag3d, dtend, dtidx, & - & index_for_temperature, index_for_x_wind, & - & index_for_y_wind, index_for_cause_pbl, & + & index_of_temperature, index_of_x_wind, & + & index_of_y_wind, index_of_process_pbl, & & ntqv, errmsg, errflg ) ! @@ -80,8 +80,8 @@ SUBROUTINE myjpbl_wrapper_run( & real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) - integer, intent(in) :: index_for_temperature, index_for_x_wind, & - & index_for_y_wind, index_for_cause_pbl, ntqv + 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 @@ -586,10 +586,10 @@ SUBROUTINE myjpbl_wrapper_run( & end do end do if (ldiag3d .and. .not. gen_tend) then - uidx = dtidx(index_for_x_wind,index_for_cause_pbl) - vidx = dtidx(index_for_y_wind,index_for_cause_pbl) - tidx = dtidx(index_for_temperature,index_for_cause_pbl) - qidx = dtidx(ntqv+100,index_for_cause_pbl) + 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 diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index bc998c136..5dae227ed 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -631,49 +631,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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 diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 5d317d23b..353ce77bc 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -83,10 +83,10 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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, & - & dtend, dtidx, index_for_temperature, & - & index_for_x_wind, index_for_y_wind, ntke, & + & dtend, dtidx, index_of_temperature, & + & index_of_x_wind, index_of_y_wind, ntke, & & ntqv, ntcw, ntiw, ntoz, ntlnc, ntinc, ntwa, ntia, & - & index_for_cause_pbl, htrsw, htrlw, xmu, & + & 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, & @@ -213,8 +213,8 @@ SUBROUTINE mynnedmf_wrapper_run( & !TENDENCY DIAGNOSTICS real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) - integer, intent(in) :: index_for_temperature, index_for_x_wind, & - index_for_y_wind, index_for_cause_pbl + 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 @@ -339,7 +339,7 @@ SUBROUTINE mynnedmf_wrapper_run( & endif if(.not. flag_for_pbl_generic_tend .and. ldiag3d) then - idtend = dtidx(ntke+100,index_for_cause_pbl) + idtend = dtidx(ntke+100,index_of_process_pbl) if(idtend>1) then allocate(save_qke_adv(im,levs)) save_qke_adv=qke_adv @@ -495,7 +495,7 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo endif - if(ldiag3d .and. dtidx(100+ntoz,index_for_cause_pbl)>1) then + if(ldiag3d .and. dtidx(100+ntoz,index_of_process_pbl)>1) then allocate(oldzone(im,levs)) oldzone = ozone endif @@ -720,11 +720,11 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo accum_duvt3dt: if(ldiag3d .or. lsidea) then - call dtend_helper(index_for_x_wind,RUBLTEN) - call dtend_helper(index_for_y_wind,RVBLTEN) - call dtend_helper(index_for_temperature,RTHBLTEN,exner) + 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 - idtend = dtidx(100+ntoz,index_for_cause_pbl) + idtend = dtidx(100+ntoz,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (ozone-oldzone) deallocate(oldzone) @@ -917,7 +917,7 @@ SUBROUTINE mynnedmf_wrapper_run( & if(allocated(save_qke_adv)) then if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then - idtend = dtidx(100+ntke,index_for_cause_pbl) + idtend = dtidx(100+ntke,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + qke_adv-save_qke_adv endif @@ -933,7 +933,7 @@ SUBROUTINE dtend_helper(itracer,field,mult) integer, intent(in) :: itracer integer :: idtend - idtend=dtidx(itracer,index_for_cause_pbl) + idtend=dtidx(itracer,index_of_process_pbl) if(idtend>1) then if(present(mult)) then dtend(:,:,idtend) = dtend(:,:,idtend) + field*dtf*mult diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 99f911b03..4e490ff3d 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1012,41 +1012,41 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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 @@ -1124,9 +1124,9 @@ type = integer intent = in optional = F -[index_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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 diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 148f2210f..c34120e82 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -66,8 +66,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & & xkzminv,moninq_fac,hurr_pbl,islimsk,var_ric, & & coef_ric_l,coef_ric_s,ldiag3d,ntqv,rtg_ozone_index,ntoz, & - & dtend,dtidx,index_for_cause_pbl,index_for_x_wind, & - & index_for_y_wind,index_for_temperature, & + & 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 @@ -97,8 +97,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! 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_for_x_wind, index_for_y_wind, & - & index_for_cause_pbl, index_for_temperature, ntqv, rtg_ozone_index + 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(im,km), v1(im,km), & & t1(im,km), q1(im,km,ntrac), & @@ -1293,8 +1293,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo if(.not.flag_for_pbl_generic_tend) then - idtend1=dtidx(index_for_temperature,index_for_cause_pbl) - idtend2=dtidx(ntqv+100,index_for_cause_pbl) + 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 @@ -1324,7 +1324,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo if(.not.flag_for_pbl_generic_tend .and. ldiag3d .and. & & rtg_ozone_index>0) then - idtend1 = dtidx(100+ntoz,index_for_cause_pbl) + idtend1 = dtidx(100+ntoz,index_of_process_pbl) if(idtend1>1) then kk = rtg_ozone_index is = (kk-1) * km @@ -1456,7 +1456,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo if(.not.flag_for_pbl_generic_tend) then - idtend1 = dtidx(index_for_x_wind,index_for_cause_pbl) + idtend1 = dtidx(index_of_x_wind,index_of_process_pbl) if(idtend1>1) then do k = 1,km do i = 1,im @@ -1466,7 +1466,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo endif - idtend2 = dtidx(index_for_y_wind,index_for_cause_pbl) + idtend2 = dtidx(index_of_y_wind,index_of_process_pbl) if(idtend2>1) then do k = 1,km do i = 1,im diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 16abc742b..445dc99d9 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -571,50 +571,50 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + 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 = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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 diff --git a/physics/moninshoc.f b/physics/moninshoc.f index c92dc460f..a78bfb25a 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -32,8 +32,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, & grav,rd,cp,hvap,fv,ntoz,dtend,dtidx, - & index_for_temperature,index_for_x_wind, - & index_for_y_wind,index_for_cause_pbl, + & 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 @@ -64,8 +64,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend integer, dimension(:,:), intent(in) :: dtidx - integer, intent(in) :: index_for_temperature, index_for_x_wind, - & index_for_y_wind, index_for_cause_pbl, ntqv + integer, intent(in) :: index_of_temperature, index_of_x_wind, + & index_of_y_wind, index_of_process_pbl, ntqv logical, intent(in) :: ldiag3d, & gen_tend @@ -452,11 +452,11 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo if(ldiag3d .and. .not. gen_tend) then - idtend = dtidx(index_for_temperature,index_for_cause_pbl) + 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_for_cause_pbl) + idtend = dtidx(ntqv+100,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + a2-q1(:,:,1) endif @@ -479,7 +479,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, endif enddo if(ldiag3d .and. ntoz>0 .and. .not. gen_tend) then - idtend=dtidx(100+ntoz,index_for_cause_pbl) + idtend=dtidx(100+ntoz,index_of_process_pbl) if(idtend>0) then kk = ntoz is = (kk-1) * km @@ -537,11 +537,11 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo if (ldiag3d .and. .not. gen_tend) then - idtend = dtidx(index_for_x_wind,index_for_cause_pbl) + idtend = dtidx(index_of_x_wind,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + a1-u1 endif - idtend = dtidx(index_for_y_wind,index_for_cause_pbl) + idtend = dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + a1-v1 endif diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 2cc53ebd5..c5849fc39 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -476,49 +476,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = in optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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 diff --git a/physics/ozphys.f b/physics/ozphys.f index 551b89da0..7b03d8d84 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -47,9 +47,9 @@ end subroutine ozphys_finalize subroutine ozphys_run ( & & im, levs, ko3, dt, oz, tin, po3, & & prsl, prdout, oz_coeff, delp, ldiag3d, & - & ntoz, dtend, dtidx, index_for_cause_prod_loss, & - & index_for_cause_ozmix, index_for_cause_temp, & - & index_for_cause_overhead_ozone, con_g, me, errmsg, errflg) + & 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 @@ -64,8 +64,8 @@ subroutine ozphys_run ( & ! The dtend array may not be allocated and needs an assumed array size real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), ntoz, & - & index_for_cause_prod_loss, index_for_cause_ozmix, & - & index_for_cause_temp, index_for_cause_overhead_ozone + & 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(ko3), prdout(im,ko3,oz_coeff), & & prsl(im,levs), tin(im,levs), delp(im,levs), & @@ -93,10 +93,10 @@ subroutine ozphys_run ( & if(ldiag3d) then - idtend(1) = dtidx(100+ntoz,index_for_cause_prod_loss) ! was ozp1 - idtend(2) = dtidx(100+ntoz,index_for_cause_ozmix) ! was ozp2 - idtend(3) = dtidx(100+ntoz,index_for_cause_temp) ! was ozp3 - idtend(4) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp4 + 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=1 endif diff --git a/physics/ozphys.meta b/physics/ozphys.meta index aee1a8622..274c50210 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -141,20 +141,20 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + 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 = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F @@ -166,33 +166,33 @@ type = integer intent = in optional = F -[index_for_cause_prod_loss] - standard_name = index_for_cause_prod_loss - long_name = tracer changes caused by ozone production and loss +[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_for_cause_ozmix] - standard_name = index_for_cause_ozmix - long_name = tracer changes caused by ozone mixing ratio +[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_for_cause_temp] - standard_name = index_for_cause_temp - long_name = tracer changes caused by temperature +[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_for_cause_overhead_ozone] - standard_name = index_for_cause_overhead_ozone - long_name = tracer changes caused by overhead ozone column +[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 diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index f4561c769..3d44a4f92 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -50,9 +50,9 @@ end subroutine ozphys_2015_finalize !!\author June 2015 - Shrinivas Moorthi subroutine ozphys_2015_run ( & & im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_coeff, & - & delp, ldiag3d, dtend, dtidx, ntoz, index_for_cause_prod_loss,& - & index_for_cause_ozmix, index_for_cause_temp, & - & index_for_cause_overhead_ozone, con_g, me, errmsg, errflg) + & 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 @@ -68,8 +68,8 @@ subroutine ozphys_2015_run ( & ! dtend may not be allocated and needs an assumed array size real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), ntoz, & - & index_for_cause_prod_loss, index_for_cause_ozmix, & - & index_for_cause_temp, index_for_cause_overhead_ozone + & 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) @@ -88,10 +88,10 @@ subroutine ozphys_2015_run ( & errflg = 0 if(ldiag3d) then - idtend(1) = dtidx(100+ntoz,index_for_cause_prod_loss) ! was ozp1 - idtend(2) = dtidx(100+ntoz,index_for_cause_ozmix) ! was ozp2 - idtend(3) = dtidx(100+ntoz,index_for_cause_temp) ! was ozp3 - idtend(4) = dtidx(100+ntoz,index_for_cause_overhead_ozone) ! was ozp4 + 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=1 endif diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 8dc9ee994..5e59a13eb 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -141,20 +141,20 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + 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 = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F @@ -166,33 +166,33 @@ type = integer intent = in optional = F -[index_for_cause_prod_loss] - standard_name = index_for_cause_prod_loss - long_name = tracer changes caused by ozone production and loss +[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_for_cause_ozmix] - standard_name = index_for_cause_ozmix - long_name = tracer changes caused by ozone mixing ratio +[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_for_cause_temp] - standard_name = index_for_cause_temp - long_name = tracer changes caused by temperature +[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_for_cause_overhead_ozone] - standard_name = index_for_cause_overhead_ozone - long_name = tracer changes caused by overhead ozone column +[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 diff --git a/physics/phys_tend.F90 b/physics/phys_tend.F90 index e05b52416..5b0272caa 100644 --- a/physics/phys_tend.F90 +++ b/physics/phys_tend.F90 @@ -20,14 +20,14 @@ end subroutine phys_tend_finalize !! \htmlinclude phys_tend_run.html !! subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & - index_for_cause_physics, index_for_cause_non_physics, & + index_of_process_physics, index_of_process_non_physics, & ncause, errmsg, errflg) ! Interface variables logical, intent(in) :: ldiag3d real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_for_cause_physics, & - index_for_cause_non_physics, ntracp100, ncause + integer, intent(in) :: dtidx(:,:), index_of_process_physics, & + index_of_process_non_physics, ntracp100, ncause character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -44,13 +44,13 @@ subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & do itrac=2,ntracp100 first=.true. - iphys = dtidx(itrac,index_for_cause_physics) + iphys = dtidx(itrac,index_of_process_physics) if(iphys<2) then cycle ! No physics tendency requested for this tracer endif do icause=1,ncause - if(icause==index_for_cause_physics .or. & - icause==index_for_cause_non_physics) then + if(icause==index_of_process_physics .or. & + icause==index_of_process_non_physics) then cycle ! Don't sum up the sums. endif idtend = dtidx(itrac,icause) diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index bf3ff536c..fa11ba23c 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -16,49 +16,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F [ntracp100] standard_name = number_of_tracers_plus_one_hundred - long_name = number of tracers plus one_hundred + long_name = number of tracers plus one hundred units = count dimensions = () type = integer intent = in optional = F -[index_for_cause_physics] - standard_name = index_for_cause_physics - long_name = tracer changes caused by physics schemes +[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 -[index_for_cause_non_physics] - standard_name = index_for_cause_non_physics - long_name = tracer changes caused by everything except physics schemes +[index_of_process_non_physics] + standard_name = index_of_non_physics_process_in_cumulative_change_index + long_name = index of non-physics transport process in second dimension of array cumulative change index units = index dimensions = () type = integer intent = in optional = F [ncause] - standard_name = number_of_possible_causes_of_tracer_changes - long_name = number of possible causes of tracer changes + standard_name = number_of_cumulative_change_processes + long_name = number of processes that cause changes in state variables units = count dimensions = () type = integer diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index 730915c6d..d44c1b6cb 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -23,8 +23,8 @@ end subroutine rayleigh_damp_init !> @{ subroutine rayleigh_damp_run ( & & lsidea,IM,KM,A,B,C,U1,V1,DT,CP,LEVR,pgr,PRSL,PRSLRD0,ral_ts, & - & ldiag3d,dtend,dtidx,index_for_cause_rayleigh_damping, & - & index_for_temperature,index_for_x_wind,index_for_y_wind, & + & ldiag3d,dtend,dtidx,index_of_process_rayleigh_damping, & + & index_of_temperature,index_of_x_wind,index_of_y_wind, & & errmsg,errflg) ! ! ******************************************************************** @@ -74,8 +74,8 @@ subroutine rayleigh_damp_run ( & real(kind=kind_phys),intent(inout) :: A(IM,KM), B(IM,KM), C(IM,KM) real(kind=kind_phys),optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & - & index_for_cause_rayleigh_damping, index_for_temperature, & - & index_for_x_wind, index_for_y_wind + & 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 @@ -87,10 +87,10 @@ subroutine rayleigh_damp_run ( & integer i, k, uidx,vidx,tidx if(ldiag3d) then - uidx=dtidx(index_for_x_wind,index_for_cause_rayleigh_damping) - vidx=dtidx(index_for_y_wind,index_for_cause_rayleigh_damping) - tidx=dtidx(index_for_temperature, & - & index_for_cause_rayleigh_damping) + 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=1 vidx=1 diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 8300b7e07..059f8e08b 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -147,50 +147,50 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + 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 = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_cause_rayleigh_damping] - standard_name = index_for_cause_rayleigh_damping - long_name = tracer changes caused by Rayleigh damping +[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_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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 diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index c7acf9553..fdfa49e3e 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -61,8 +61,8 @@ 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, & - & index_for_temperature,index_for_x_wind,index_for_y_wind, & - & index_for_cause_pbl,ntqv,ntoz,dtend,dtidx, & + & 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 @@ -77,8 +77,8 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & ! logical, intent(in) :: gen_tend, ldiag3d real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend - integer, intent(in) :: index_for_temperature,index_for_x_wind, & - & index_for_y_wind, ntqv, ntoz, dtidx(:,:), index_for_cause_pbl + 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 @@ -1403,11 +1403,11 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if (ldiag3d .and. .not. gen_tend) then - idtend = dtidx(index_for_temperature,index_for_cause_pbl) + 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_for_cause_pbl) + idtend = dtidx(100+ntqv,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) +delt*rdt*(f2-q1(:,:,1)) endif @@ -1513,11 +1513,11 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if (ldiag3d .and. .not. gen_tend) then - idtend=dtidx(index_for_x_wind,index_for_cause_pbl) + 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_for_y_wind,index_for_cause_pbl) + idtend=dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f2-v1) endif diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 52ea8c4ff..612ec0601 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -550,49 +550,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = in optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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 diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index f0ef9e890..ae70a3227 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -65,8 +65,8 @@ subroutine satmedmfvdifq_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,dspfac,bl_upfr,bl_dnfr, & - & ntoz,ntqv,dtend,dtidx,index_for_temperature,index_for_x_wind,& - & index_for_y_wind,index_for_cause_pbl,gen_tend,ldiag3d, & + & 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 @@ -103,9 +103,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & prsl(im,km), prslk(im,km), & & phii(im,km+1), phil(im,km) real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend - integer, intent(in) :: dtidx(:,:), index_for_temperature, index_f & - & or_x_wind, index_for_y_wind, index_for_cause & - & _pbl + 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(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -1423,7 +1422,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if(ldiag3d .and. .not. gen_tend) then - idtend=dtidx(index_for_temperature,index_for_cause_pbl) + idtend=dtidx(index_of_temperature,index_of_process_pbl) if(idtend>1) then do k = 1,km do i = 1,im @@ -1433,7 +1432,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo endif ! Send tendencies just for QV; other tracers are below. - idtend=dtidx(100+ntqv,index_for_cause_pbl) + idtend=dtidx(100+ntqv,index_of_process_pbl) if(idtend>1) then do k = 1,km do i = 1,im @@ -1458,7 +1457,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & ! Send tendencies for all tracers that were selected. do kk = 2, ntrac1 is = (kk-1) * km - idtend = dtidx(kk+100,index_for_cause_pbl) + idtend = dtidx(kk+100,index_of_process_pbl) if(idtend>1) then if(kk==ntke) then do k = 1, km @@ -1492,7 +1491,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if(ldiag3d .and. .not. gen_tend) then - idtend=dtidx(index_for_temperature,index_for_cause_pbl) + idtend=dtidx(index_of_temperature,index_of_process_pbl) if(idtend>1) then do k = 1,km1 do i = 1,im @@ -1579,7 +1578,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo if(ldiag3d .and. .not. gen_tend) then - idtend=dtidx(index_for_x_wind,index_for_cause_pbl) + idtend=dtidx(index_of_x_wind,index_of_process_pbl) if(idtend>1) then do k = 1,km do i = 1,im @@ -1589,7 +1588,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo endif - idtend=dtidx(index_for_y_wind,index_for_cause_pbl) + idtend=dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>1) then do k = 1,km do i = 1,im diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index ee98d6494..3251071d9 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -610,49 +610,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = in optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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 diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index a50a5747a..52b2f4ba4 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -36,8 +36,8 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & u10,v10, & dx,lssav,ldiag3d, & flag_for_pbl_generic_tend,ntoz,ntqv,dtend,dtidx, & - index_for_cause_pbl,index_for_temperature,index_for_x_wind, & - index_for_y_wind,errmsg,errflg ) + index_of_process_pbl,index_of_temperature,index_of_x_wind, & + index_of_y_wind,errmsg,errflg ) use machine , only : kind_phys ! @@ -163,8 +163,8 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ! 3D diagnostic tendencies; dtend is only allocated if ldiag3d=.true. real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_for_cause_pbl, ntqv, & - index_for_x_wind, index_for_y_wind, index_for_temperature + 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 @@ -971,7 +971,7 @@ 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 - idtend = dtidx(index_for_temperature,index_for_cause_pbl) + idtend = dtidx(index_of_temperature,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-thx+300.)*rdt*pi2d endif @@ -1101,7 +1101,7 @@ 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 - idtend = dtidx(ntqv+100,index_for_cause_pbl) + idtend = dtidx(ntqv+100,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f3(:,:,1)-qx(:,:,1)) endif @@ -1137,7 +1137,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo if(lssav .and. ldiag3d .and. ntoz>0 .and. & & .not. flag_for_pbl_generic_tend) then - idtend=dtidx(ntoz+100,index_for_cause_pbl) + idtend=dtidx(ntoz+100,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + qtend*(f3(:,:,ntoz)-qx(:,:,ntoz)) endif @@ -1234,11 +1234,11 @@ 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 - idtend=dtidx(index_for_x_wind,index_for_cause_pbl) + 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_for_y_wind,index_for_cause_pbl) + idtend=dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f2-vx) endif diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 34a18d52d..9adacaa9c 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -458,49 +458,49 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_cause_pbl] - standard_name = index_for_cause_pbl - long_name = tracer changes caused by PBL scheme +[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_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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 diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index fd086a10c..af3204e90 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -206,8 +206,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, & - dtend, dtidx, index_for_temperature, index_for_x_wind, index_for_y_indw, & - index_for_cause_orographic_gwd, index_for_cause_convective_gwd, & + dtend, dtidx, index_of_temperature, index_of_x_wind, index_for_y_indw, & + 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) @@ -262,9 +262,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ! The dtend array is are only allocated if ldiag=.true. real(kind=kind_phys), intent(inout), optional :: dtend - integer, intent(in) :: dtidx, index_for_temperature, index_for_x_wind, & - index_for_y_wind, index_for_cause_convective_gwd, & - index_for_cause_orographic_gwd + 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. @@ -385,17 +385,17 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then - idtend = dtidx(index_for_cause_x_wind,index_for_cause_orographic_gwd) + idtend = dtidx(index_for_cause_x_wind,index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp endif - idtend = dtidx(index_for_cause_y_wind,index_for_cause_orographic_gwd) + idtend = dtidx(index_for_cause_y_wind,index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp endif - idtend = dtidx(index_for_cause_temperature,index_for_cause_orographic_gwd) + idtend = dtidx(index_of_process_temperature,index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif @@ -485,17 +485,17 @@ 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 - idtend = dtidx(index_for_cause_x_wind,index_for_cause_convective_gwd) + idtend = dtidx(index_for_cause_x_wind,index_of_process_nonorographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdudt*dtp endif - idtend = dtidx(index_for_cause_y_wind,index_for_cause_convective_gwd) + idtend = dtidx(index_for_cause_y_wind,index_of_process_nonorographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdvdt*dtp endif - idtend = dtidx(index_for_cause_temperature,index_for_cause_convective_gwd) + idtend = dtidx(index_of_process_temperature,index_of_process_nonorographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 2fa8a7a9c..a953acc7d 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1188,57 +1188,57 @@ intent = in optional = F [dtend] - standard_name = diagnostic_3d_tendencies - long_name = diagnostic 3d tendencies for tracers and other fields + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables units = various - dimensions = (horizontal_loop_extent,vertical_dimension,dtend_outer_index_max) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys intent = inout optional = F [dtidx] - standard_name = dtend_outer_index - long_name = index in outer dimension of dtend of a tracer-cause pair + 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_possible_causes_of_tracer_changes) + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) type = integer intent = in optional = F -[index_for_temperature] - standard_name = index_for_temperature - long_name = index in dtidx first dimension of temperature field +[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_for_x_wind] - standard_name = index_for_x_wind - long_name = index in dtidx first dimension of x wind field +[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_for_y_wind] - standard_name = index_for_y_wind - long_name = index in dtidx first dimension of x wind field +[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_for_cause_orographic_gwd] - standard_name = index_for_cause_orographic_gwd - long_name = tracer changes caused by orographic gravity wave drag +[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_for_cause_convective_gwd] - standard_name = index_for_cause_convective_gwd - long_name = tracer changes caused by convective gravity wave drag +[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 diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index 4ccc37a41..8f71bc56f 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -35,8 +35,8 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dusfc,dvsfc,dtsfc,dqsfc, & dt,kpbl1d,u10,v10,lssav,ldiag3d,qdiag3d, & flag_for_pbl_generic_tend,ntoz,ntqv,dtend,dtidx, & - index_for_temperature,index_for_x_wind,index_for_y_wind, & - index_for_cause_pbl,errmsg,errflg ) + index_of_temperature,index_of_x_wind,index_of_y_wind, & + index_of_process_pbl,errmsg,errflg ) use machine , only : kind_phys ! @@ -90,8 +90,8 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & real(kind=kind_phys), dimension( im,km,ntrac ) , & intent(inout) :: qtnp real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), ntqv, index_for_temperature, & - index_for_x_wind, index_for_y_wind, index_for_cause_pbl + integer, intent(in) :: dtidx(:,:), ntqv, index_of_temperature, & + index_of_x_wind, index_of_y_wind, index_of_process_pbl ! !--------------------------------------------------------------------------------- ! output variables @@ -856,7 +856,7 @@ 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 - idtend = dtidx(index_for_temperature,index_for_cause_pbl) + idtend = dtidx(index_of_temperature,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-thx+300.)*rdt*pi2d endif @@ -970,7 +970,7 @@ 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 - idtend = dtidx(ntqv+100,index_for_cause_pbl) + idtend = dtidx(ntqv+100,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f3(:,:,1)-qx(:,:,1))*rdt endif @@ -987,7 +987,7 @@ 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 - idtend = dtidx(100+ntoz,index_for_cause_pbl) + idtend = dtidx(100+ntoz,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + f3(:,:,ntoz)-qx(:,:,ntoz) endif @@ -1074,12 +1074,12 @@ 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 - idtend = dtidx(index_for_x_wind,index_for_cause_pbl) + 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_for_y_wind,index_for_cause_pbl) + idtend = dtidx(index_of_y_wind,index_of_process_pbl) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f2-vx)*rdt endif From 9c509c4be344f7aa970c66badb91dd8b3f9f9f94 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Mon, 29 Mar 2021 19:56:20 +0000 Subject: [PATCH 10/34] Fix syntax errors, indentation errors, and variable names. --- physics/GFS_GWD_generic.F90 | 6 +- physics/GFS_MP_generic.F90 | 6 +- physics/GFS_MP_generic.meta | 8 --- physics/GFS_debug.F90 | 8 +-- physics/cires_ugwp.F90 | 5 +- physics/cu_gf_driver.F90 | 6 +- physics/gwdc.f | 15 +++-- physics/module_MYJPBL_wrapper.F90 | 8 +-- physics/module_MYJPBL_wrapper.meta | 7 --- physics/module_MYNNPBL_wrapper.F90 | 16 ++--- physics/ozphys_2015.meta | 1 - physics/phys_tend.F90 | 14 ++--- physics/phys_tend.meta | 10 +++- physics/shinhongvdif.meta | 7 --- physics/ugwpv1_gsldrag.F90 | 66 +++++++++++---------- physics/ugwpv1_gsldrag.meta | 94 ++++++++++++++++-------------- physics/unified_ugwp.F90 | 24 ++++---- physics/ysuvdif.F90 | 3 +- physics/ysuvdif.meta | 93 +++++++++++++++++------------ 19 files changed, 203 insertions(+), 194 deletions(-) diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index b89f54610..84d7e4059 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -20,7 +20,7 @@ subroutine GFS_GWD_generic_pre_run( & & oc, oa4, clx, theta, & & varss, ocss, oa4ss, clxss, & & sigma, gamma, elvmax, lssav, ldiag3d, & - & dtend, dtidx, index_of_temperature, index_of_x_wind, & + & 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) @@ -40,7 +40,7 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(in) :: dtdt(im,levs), dudt(im,levs), dvdt(im,levs) ! dtend only allocated only if ldiag3d is .true. real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_temperature, & + 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 @@ -179,7 +179,7 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d ! dtend only allocated only if ldiag3d is .true. real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_temperature, & + 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 diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 977d0342c..2f77f7681 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -49,7 +49,7 @@ subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, enddo enddo else if(do_aw) then - ! if qdiag3d, all q are save already + ! 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) @@ -90,7 +90,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, pwat, & do_sppt, ca_global, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, & - dtend, dtidx, ncause, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d, lssav, & + dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d, lssav, & errmsg, errflg) ! use machine, only: kind_phys @@ -100,7 +100,7 @@ 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,ncause + 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(im), intent(in) :: rain1, xlat, xlon, tsfc diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index c3f611366..6e75005a3 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -869,14 +869,6 @@ type = integer intent = in optional = F -[ncause] - 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 [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 diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 3b25f6567..34cb77b4f 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -387,7 +387,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, integer, intent(out) :: errflg !--- local variables - integer :: impi, iomp, ierr, n, idtend, icause, itracer + integer :: impi, iomp, ierr, n, idtend, iprocess, itracer integer :: mpirank, mpisize, mpicomm integer :: omprank, ompsize @@ -633,12 +633,12 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%zmtnblck ', Diag%zmtnblck) if (Model%ldiag3d) then do itracer=2,Model%ntracp100 - do icause=1,Model%ncause - idtend = Model%dtidx(itracer,icause) + 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(icause), Diag%dtend(1,1,idtend)) + //Model%dtend_cause_labels(iprocess), Diag%dtend(1,1,idtend)) endif enddo enddo diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 5689d5a63..900d3d2f5 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -156,9 +156,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, & -! FIXME: delete 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, & + 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 diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 6a2d75e24..8936d16de 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -69,10 +69,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & hbot,htop,kcnv,xland,hfx2,qfx2,cliw,clcw, & pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & -! fixme: delete ! du3dt_SCNV,dv3dt_SCNV,dt3dt_SCNV,dq3dt_SCNV, & - ! du3dt_DCNV,dv3dt_DCNV,dt3dt_DCNV,dq3dt_DCNV, & - dtend,dtidx,ntqv,ntiw,ntcw,index_of_temperature,index_of_x_wind,& - index_of_y_wind,index_of_process_scnv,index_of_process_dcnv, & + 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 diff --git a/physics/gwdc.f b/physics/gwdc.f index c43fbe481..e2403fb23 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -1460,8 +1460,8 @@ end subroutine gwdc_post_init subroutine gwdc_post_run( & & im, levs, lssav, ldiag3d, dtf, dtp, con_cp, & & tauctx, taucty, gwdcu, gwdcv, & - & dugwd, dvgwd, dtend, dtidx, index_of_x_wind, index_of_y_wind, & - & index_of_process_nonorographic_gwd, 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 @@ -1473,10 +1473,11 @@ subroutine gwdc_post_run( & real(kind=kind_phys), intent(in) :: & & tauctx(:), taucty(:), gwdcu(:,:), gwdcv(:,:) - real(kind=kind_phys), intent(inout) :: dugwd(:,:), dvgwd(:,:), & + real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:), & & gu0(:,:), gv0(:,:), gt0(:,:) real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_process_nonorographic_gwd + integer, intent(in) :: dtidx(:,:), index_of_process_nonorographic_& + & gwd integer, intent(in) :: index_of_x_wind, index_of_y_wind character(len=*), intent(out) :: errmsg @@ -1497,11 +1498,13 @@ subroutine gwdc_post_run( & endif ! end if_lssav if (ldiag3d) then - idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd) + 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_gwd) + idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_g& + & wd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + gwdcv(:,:) * dtf endif diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index 4db49cb5b..2338aaa19 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -41,7 +41,7 @@ SUBROUTINE myjpbl_wrapper_run( & & dkt,xkzm_m, xkzm_h,xkzm_s, gamt,gamq, & & con_cp,con_g,con_rd, & & me, lprnt, gen_tend, ldiag3d, dtend, dtidx, & - & index_of_temperature, index_of_x_wind, & + & index_of_temperature, index_of_x_wind, & & index_of_y_wind, index_of_process_pbl, & & ntqv, errmsg, errflg ) @@ -87,7 +87,7 @@ SUBROUTINE myjpbl_wrapper_run( & 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 @@ -113,8 +113,6 @@ SUBROUTINE myjpbl_wrapper_run( & phii, prsi real(kind=kind_phys),dimension(im,levs),intent(in) :: & & ugrs, vgrs, tgrs, prsl -! real(kind=kind_phys),dimension(im,levs),intent(inout) :: & -! dudt, dvdt, dtdt, dkt real(kind=kind_phys),dimension(im,levs),intent(inout) :: & dudt, dvdt, dtdt real(kind=kind_phys),dimension(im,levs-1),intent(out) :: & @@ -598,7 +596,7 @@ SUBROUTINE myjpbl_wrapper_run( & 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 if + end do end if if (lprnt1) then diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index 5dae227ed..e428b3a2e 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -701,13 +701,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 353ce77bc..f4ecdb970 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -83,10 +83,10 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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, & - & dtend, dtidx, index_of_temperature, & - & index_of_x_wind, index_of_y_wind, ntke, & + & 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, & + & 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, & @@ -282,7 +282,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & RQNWFABLTEN, RQNIFABLTEN, & & dqke,qWT,qSHEAR,qBUOY,qDISS, & & pattern_spp_pbl - real(kind=kind_phys), allocatable :: oldzone(:,:) + real(kind=kind_phys), allocatable :: old_ozone(:,:) !MYNN-CHEM arrays real(kind=kind_phys), dimension(im,nchem) :: chem3d @@ -496,8 +496,8 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo endif if(ldiag3d .and. dtidx(100+ntoz,index_of_process_pbl)>1) then - allocate(oldzone(im,levs)) - oldzone = ozone + allocate(old_ozone(im,levs)) + old_ozone = ozone endif if (lprnt)write(0,*)"prepping MYNN-EDMF variables..." @@ -726,8 +726,8 @@ SUBROUTINE mynnedmf_wrapper_run( & if(ldiag3d) then idtend = dtidx(100+ntoz,index_of_process_pbl) if(idtend>1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (ozone-oldzone) - deallocate(oldzone) + dtend(:,:,idtend) = dtend(:,:,idtend) + (ozone-old_ozone) + deallocate(old_ozone) endif endif endif accum_duvt3dt diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 5e59a13eb..639917b85 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -147,7 +147,6 @@ 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] diff --git a/physics/phys_tend.F90 b/physics/phys_tend.F90 index 5b0272caa..300a4e9a9 100644 --- a/physics/phys_tend.F90 +++ b/physics/phys_tend.F90 @@ -21,17 +21,17 @@ end subroutine phys_tend_finalize !! subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & index_of_process_physics, index_of_process_non_physics, & - ncause, errmsg, errflg) + nprocess, nprocess_summed, errmsg, errflg) ! Interface variables logical, intent(in) :: ldiag3d real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), index_of_process_physics, & - index_of_process_non_physics, ntracp100, ncause + index_of_process_non_physics, ntracp100, nprocess, nprocess_summed character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: itrac, iphys, icause, idtend + integer :: itrac, iphys, iprocess, idtend logical :: first ! Initialize CCPP error handling variables @@ -48,12 +48,12 @@ subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & if(iphys<2) then cycle ! No physics tendency requested for this tracer endif - do icause=1,ncause - if(icause==index_of_process_physics .or. & - icause==index_of_process_non_physics) then + do iprocess=1,nprocess + if(iprocess>nprocess_summed .or. iprocess==index_of_process_physics .or. & + iprocess==index_of_process_non_physics) then cycle ! Don't sum up the sums. endif - idtend = dtidx(itrac,icause) + idtend = dtidx(itrac,iprocess) if(idtend>1) then ! This tendency was calculated for this tracer, so ! accumulate it into the total physics tendency. diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index fa11ba23c..b792ad238 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -56,7 +56,7 @@ type = integer intent = in optional = F -[ncause] +[nprocess] standard_name = number_of_cumulative_change_processes long_name = number of processes that cause changes in state variables units = count @@ -64,6 +64,14 @@ type = integer intent = in optional = F +[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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 9adacaa9c..ad0d23665 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -427,13 +427,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 diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 00fd42dbd..98e31f27b 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -319,8 +319,9 @@ 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, & - lprnt, ipr, errmsg, errflg) + 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) ! !######################################################################## ! Attention New Arrays and Names must be ADDED inside @@ -428,15 +429,11 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! real(kind=kind_phys), intent(inout), dimension(im, levs) :: 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 - - + ! 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 real(kind=kind_phys), intent(out), dimension(im) :: rdxzb ! for stoch phys. mtb-level @@ -467,7 +464,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 @@ -624,15 +621,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 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -686,18 +688,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..c751b901c 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/ugwpv1_gsldrag.meta @@ -1149,59 +1149,63 @@ 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 + 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_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 af3204e90..76c7d2fa5 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -203,11 +203,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & - dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & + 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, & - dtend, dtidx, index_of_temperature, index_of_x_wind, index_for_y_indw, & - index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, & + 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) @@ -261,8 +261,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), intent(out), dimension(:,:) :: dtaux2d_ls, dtauy2d_ls ! The dtend array is are only allocated if ldiag=.true. - real(kind=kind_phys), intent(inout), optional :: dtend - integer, intent(in) :: dtidx, index_of_temperature, index_of_x_wind, & + real(kind=kind_phys), intent(inout), optional :: 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 @@ -300,7 +300,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 @@ -385,17 +385,17 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then - idtend = dtidx(index_for_cause_x_wind,index_of_process_orographic_gwd) + 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_for_cause_y_wind,index_of_process_orographic_gwd) + 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_process_temperature,index_of_process_orographic_gwd) + idtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif @@ -485,17 +485,17 @@ 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 - idtend = dtidx(index_for_cause_x_wind,index_of_process_nonorographic_gwd) + 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_for_cause_y_wind,index_of_process_nonorographic_gwd) + 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_process_temperature,index_of_process_nonorographic_gwd) + idtend = dtidx(index_of_temperature,index_of_process_nonorographic_gwd) if(idtend>1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index 8f71bc56f..be452a154 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -35,7 +35,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & dusfc,dvsfc,dtsfc,dqsfc, & dt,kpbl1d,u10,v10,lssav,ldiag3d,qdiag3d, & flag_for_pbl_generic_tend,ntoz,ntqv,dtend,dtidx, & - index_of_temperature,index_of_x_wind,index_of_y_wind, & + index_of_temperature,index_of_x_wind,index_of_y_wind, & index_of_process_pbl,errmsg,errflg ) use machine , only : kind_phys @@ -197,6 +197,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 ! !------------------------------------------------------------------------------- ! diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index 9ba31ed27..1faa3ec15 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -467,46 +467,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 From ff49546d849f2ed3e69b794a1e465816e0410022 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Mon, 29 Mar 2021 23:34:54 +0000 Subject: [PATCH 11/34] dtend(:,:,1) is used, dtend_o3_photochem sums all four ozphys values, rename variables, use nprocess_summed to avoid summing sums --- physics/GFS_DCNV_generic.F90 | 12 ++--- physics/GFS_GWD_generic.F90 | 12 ++--- physics/GFS_MP_generic.F90 | 4 +- physics/GFS_PBL_generic.F90 | 14 ++--- physics/GFS_SCNV_generic.F90 | 12 ++--- physics/GFS_debug.F90 | 2 +- physics/GFS_suite_interstitial.F90 | 22 ++++---- physics/cires_ugwp.F90 | 12 ++--- physics/cu_gf_driver.F90 | 38 ++++++------- physics/gwdc.f | 4 +- physics/module_MYJPBL_wrapper.F90 | 8 +-- physics/module_MYNNPBL_wrapper.F90 | 8 +-- physics/moninedmf.f | 14 ++--- physics/moninshoc.f | 10 ++-- physics/ozphys.f | 14 ++--- physics/ozphys_2015.f | 10 ++-- physics/phys_tend.F90 | 87 +++++++++++++++++++----------- physics/phys_tend.meta | 22 ++++++-- physics/rayleigh_damp.f | 12 ++--- physics/satmedmfvdif.F | 8 +-- physics/satmedmfvdifq.F | 12 ++--- physics/shinhongvdif.F90 | 10 ++-- physics/ugwpv1_gsldrag.F90 | 12 ++--- physics/unified_ugwp.F90 | 12 ++--- physics/ysuvdif.F90 | 10 ++-- 25 files changed, 210 insertions(+), 171 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index c5043e6a1..dd7374ca9 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -65,7 +65,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc if ((ldiag3d.and.qdiag3d) .or. cplchm) then if(nsamftrac>0) then do n=1,nsamftrac - if(n==ntqv .or. dtidx(n+100,index_of_process_dcnv)) then + if(n==ntqv .or. dtidx(n+100,index_of_process_dcnv)>=1) then save_q(:,:,n) = gq0(:,:,n) endif enddo @@ -179,30 +179,30 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & if (ldiag3d .and. flag_for_dcnv_generic_tend) then idtend=dtidx(index_of_temperature,index_of_process_dcnv) - if(idtend>1) then + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0-save_v)*frain endif if(nsamftrac>0) then do n=1,nsamftrac idtend=dtidx(100+n,index_of_process_dcnv) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain endif enddo else idtend=dtidx(100+ntqv,index_of_process_dcnv) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv)-save_q(:,:,ntqv))*frain endif endif diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 84d7e4059..e2d81fcb3 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -123,17 +123,17 @@ subroutine GFS_GWD_generic_pre_run( & 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 + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) - dvdt*dtf endif endif @@ -197,17 +197,17 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d if (ldiag3d .and. flag_for_gwd_generic_tend) then idtend = dtidx(index_of_temperature, index_of_process_orographic_gwd) - if(idtend>1) then + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dvdt*dtf endif endif diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 2f77f7681..c90e64bf4 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -344,7 +344,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, if_tendency_diagnostics: if (ldiag3d) then idtend = dtidx(index_of_temperature,index_of_process_mp) - if(idtend>1) then + 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 @@ -354,7 +354,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, if_tracer_diagnostics: if (qdiag3d) then dtend_q: do itrac=1,ntrac idtend = dtidx(itrac+100,index_of_process_mp) - if(idtend>1) then + 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 diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 65e8ff4fa..99be58509 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -631,33 +631,33 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (ldiag3d .and. flag_for_pbl_generic_tend) then if (lsidea) then idtend = dtidx(index_of_temperature, index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(1:im,1:levs,idtend) = dtend(1:im,1:levs,idtend) + dtdt(1:im,1:levs)*dtf endif else idtend = dtidx(index_of_temperature, index_of_process_pbl) - if(idtend>1) then + 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 idtend = dtidx(index_of_x_wind, index_of_process_pbl) - if(idtend>1) then + 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 + 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 + 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 + 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 + 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_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 23351e99e..205495529 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -48,7 +48,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, if (qdiag3d) then if(nsamftrac>0) then do n=1,nsamftrac - if(n==ntqv .or. dtidx(ntqv,index_of_process_scnv)>1) then + if(n==ntqv .or. dtidx(ntqv,index_of_process_scnv)>=1) then save_q(:,:,n) = gq0(:,:,n) endif enddo @@ -149,30 +149,30 @@ 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 idtend = dtidx(index_of_temperature, index_of_process_scnv) - if(idtend>1) then + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0 - save_v) * frain endif if(nsamftrac>0) then do n=1,nsamftrac idtend = dtidx(100+n, index_of_process_scnv) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n) - save_q(:,:,n)) * frain endif enddo else idtend = dtidx(100+ntqv, index_of_process_scnv) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain endif endif diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 34cb77b4f..02d60a093 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -635,7 +635,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, do itracer=2,Model%ntracp100 do iprocess=1,Model%nprocess idtend = Model%dtidx(itracer,iprocess) - if(idtend>1) then + 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)) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 04cbf01f4..791926388 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -284,42 +284,42 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (ldiag3d) then if (lsidea) then idtend = dtidx(index_of_temperature,index_of_process_longwave) - if(idtend>1) then + 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 + 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 + 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 + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + lwhd(:,:,6)*dtf endif else idtend = dtidx(index_of_temperature,index_of_process_longwave) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + htrlw(:,:)*dtf endif idtend = dtidx(index_of_temperature,index_of_process_shortwave) - if(idtend>1) then + 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) @@ -745,13 +745,13 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk) endif endif if(ntclamt<=size(clw,3) .and. ntclamt>0) then idtend=dtidx(100+ntclamt,index_of_process_conv_trans) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntclamt) endif endif @@ -759,7 +759,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to if(ldiag3d .and. ntk>0) then idtend=dtidx(100+ntke,index_of_process_conv_trans) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk) endif endif diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 900d3d2f5..f8ade39a9 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -285,15 +285,15 @@ 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 idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) - if(idtend>1) then + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif endif @@ -376,15 +376,15 @@ 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 idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd) - if(idtend>1) then + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (gw_dtdt - Pdtdt)*dtp endif endif diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 8936d16de..85c523ed5 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -202,21 +202,21 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & if(ldiag3d) then if(flag_for_dcnv_generic_tend) then - cliw_deep_idx=1 - clcw_deep_idx=1 + 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=1 - clcw_shal_idx=1 + 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 + 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 @@ -896,22 +896,22 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & 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 + if(uidx>=1) then do k=kts,ktf dtend(:,k,uidx) = dtend(:,k,uidx) + cutens(:)*outus(:,k) * dt enddo endif - if(vidx>1) then + if(vidx>=1) then do k=kts,ktf dtend(:,k,vidx) = dtend(:,k,vidx) + cutens(:)*outvs(:,k) * dt enddo endif - if(tidx>1) then + if(tidx>=1) then do k=kts,ktf dtend(:,k,tidx) = dtend(:,k,tidx) + cutens(:)*outts(:,k) * dt enddo endif - if(qidx>1) then + if(qidx>=1) then do k=kts,ktf do i=its,itf tem = cutens(i)*outqs(i,k)* dt @@ -925,24 +925,24 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & 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 + 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 + 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 + 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 + if(qidx>=1) then do k=kts,ktf do i=its,itf tem = (cuten(i)*outq(i,k) + cutenm(i)*outqm(i,k))* dt @@ -967,20 +967,20 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & 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 + 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 + 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 + 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 + 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 + 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 diff --git a/physics/gwdc.f b/physics/gwdc.f index e2403fb23..6a4863055 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -1500,12 +1500,12 @@ subroutine gwdc_post_run( & if (ldiag3d) then idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_g& & wd) - if(idtend>1) then + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + gwdcv(:,:) * dtf endif endif diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index 2338aaa19..026ea1b64 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -592,10 +592,10 @@ SUBROUTINE myjpbl_wrapper_run( & ! cumulative value with the instantaneous value. do k=1,levs k1=levs+1-k - 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 + 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 end if diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index f4ecdb970..bbaed874f 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -340,7 +340,7 @@ SUBROUTINE mynnedmf_wrapper_run( & if(.not. flag_for_pbl_generic_tend .and. ldiag3d) then idtend = dtidx(ntke+100,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then allocate(save_qke_adv(im,levs)) save_qke_adv=qke_adv endif @@ -725,7 +725,7 @@ SUBROUTINE mynnedmf_wrapper_run( & call dtend_helper(index_of_temperature,RTHBLTEN,exner) if(ldiag3d) then idtend = dtidx(100+ntoz,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (ozone-old_ozone) deallocate(old_ozone) endif @@ -918,7 +918,7 @@ SUBROUTINE mynnedmf_wrapper_run( & 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + qke_adv-save_qke_adv endif endif @@ -934,7 +934,7 @@ SUBROUTINE dtend_helper(itracer,field,mult) integer :: idtend idtend=dtidx(itracer,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then if(present(mult)) then dtend(:,:,idtend) = dtend(:,:,idtend) + field*dtf*mult else diff --git a/physics/moninedmf.f b/physics/moninedmf.f index c34120e82..e9db1ba77 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -275,8 +275,8 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & km1 = km - 1 kmpbl = km / 2 - idtend1 = 1 - idtend2 = 1 + idtend1 = 0 + idtend2 = 0 !> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) do k=1,km @@ -1295,7 +1295,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & 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 + if(idtend1>=1) then do k = 1,km do i = 1,im ttend = (a1(i,k)-t1(i,k)) * rdt @@ -1303,7 +1303,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo endif - if(idtend2>1) then + if(idtend2>=1) then do k = 1,km do i = 1,im qtend = (a2(i,k)-q1(i,k,1))*rdt @@ -1325,7 +1325,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & 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 + if(idtend1>=1) then kk = rtg_ozone_index is = (kk-1) * km do k = 1, km @@ -1457,7 +1457,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo if(.not.flag_for_pbl_generic_tend) then idtend1 = dtidx(index_of_x_wind,index_of_process_pbl) - if(idtend1>1) then + if(idtend1>=1) then do k = 1,km do i = 1,im utend = (a1(i,k)-u1(i,k))*rdt @@ -1467,7 +1467,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & endif idtend2 = dtidx(index_of_y_wind,index_of_process_pbl) - if(idtend2>1) then + if(idtend2>=1) then do k = 1,km do i = 1,im vtend = (a2(i,k)-v1(i,k))*rdt diff --git a/physics/moninshoc.f b/physics/moninshoc.f index a78bfb25a..b22a59daa 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -453,11 +453,11 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo if(ldiag3d .and. .not. gen_tend) then idtend = dtidx(index_of_temperature,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + (a1-t1) endif idtend = dtidx(ntqv+100,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + a2-q1(:,:,1) endif endif @@ -480,7 +480,7 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo if(ldiag3d .and. ntoz>0 .and. .not. gen_tend) then idtend=dtidx(100+ntoz,index_of_process_pbl) - if(idtend>0) then + if(idtend>=1) then kk = ntoz is = (kk-1) * km do k = 1, km @@ -538,11 +538,11 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo if (ldiag3d .and. .not. gen_tend) then idtend = dtidx(index_of_x_wind,index_of_process_pbl) - if(idtend>1) then + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + a1-v1 endif endif diff --git a/physics/ozphys.f b/physics/ozphys.f index 7b03d8d84..26916a459 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -98,7 +98,7 @@ subroutine ozphys_run ( & 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=1 + idtend=0 endif ! @@ -167,11 +167,11 @@ subroutine ozphys_run ( & oz(i,l) = (ozib(i) + prod(i,1)*dt) / (1.0 + prod(i,2)*dt) enddo ! - if(idtend(1)>1) then + if(idtend(1)>=1) then dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 & prod(:,1)*dt endif - if(idtend(2)>1) then + if(idtend(2)>=1) then dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 & (oz(:,l) - ozib(:)) endif @@ -190,19 +190,19 @@ 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(idtend(1)>1) then + if(idtend(1)>=1) then dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 & prod(:,1)*dt endif - if(idtend(2)>1) then + if(idtend(2)>=1) then dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 & (oz(:,l)-ozib(:)) endif - if(idtend(3)>1) then + 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 + if(idtend(4)>=1) then dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 & prod(:,4)*colo3(:,l+1)*dt endif diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index 3d44a4f92..fac917c95 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -93,7 +93,7 @@ subroutine ozphys_2015_run ( & 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=1 + idtend=0 endif !ccpp: save input oz in ozi @@ -169,19 +169,19 @@ 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(idtend(1)>1) then + 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 + if(idtend(2)>=1) then dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 & (oz(:,l) - ozib(:)) endif - if(idtend(3)>1) then + 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 + if(idtend(4)>=1) then dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 & prod(:,4) * (colo3(:,l)-coloz(:,l))*dt endif diff --git a/physics/phys_tend.F90 b/physics/phys_tend.F90 index 300a4e9a9..b444f2d97 100644 --- a/physics/phys_tend.F90 +++ b/physics/phys_tend.F90 @@ -20,19 +20,19 @@ end subroutine phys_tend_finalize !! \htmlinclude phys_tend_run.html !! subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & - index_of_process_physics, index_of_process_non_physics, & - nprocess, nprocess_summed, errmsg, errflg) + index_of_process_physics, index_of_process_photochem, & + nprocess, nprocess_summed, is_photochem, ntoz, errmsg, errflg) ! Interface variables - logical, intent(in) :: ldiag3d + logical, intent(in) :: ldiag3d, is_photochem(:) real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_process_physics, & - index_of_process_non_physics, ntracp100, nprocess, nprocess_summed + 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 :: itrac, iphys, iprocess, idtend - logical :: first + integer :: ichem, iphys, itrac + logical :: all_true(nprocess) ! Initialize CCPP error handling variables errmsg = '' @@ -42,36 +42,59 @@ subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & 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 - first=.true. + ! Total physics tendencies iphys = dtidx(itrac,index_of_process_physics) - if(iphys<2) then - cycle ! No physics tendency requested for this tracer - endif - do iprocess=1,nprocess - if(iprocess>nprocess_summed .or. iprocess==index_of_process_physics .or. & - iprocess==index_of_process_non_physics) then - cycle ! Don't sum up the sums. - endif - idtend = dtidx(itrac,iprocess) - if(idtend>1) then - ! This tendency was calculated for this tracer, so - ! accumulate it into the total physics tendency. - if(first) then - dtend(:,:,iphys) = dtend(:,:,idtend) - first=.false. - else - dtend(:,:,iphys) = dtend(:,:,iphys) + dtend(:,:,idtend) - endif - endif - enddo - if(first) then - ! No physics tendencies were calculated for this tracer, - ! so total physics tendency is 0. - dtend(:,:,iphys) = 0 + 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 b792ad238..d9331c4f1 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -48,9 +48,9 @@ type = integer intent = in optional = F -[index_of_process_non_physics] - standard_name = index_of_non_physics_process_in_cumulative_change_index - long_name = index of non-physics transport process in second dimension of array cumulative change index +[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 @@ -72,6 +72,22 @@ type = integer intent = in optional = F +[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 +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + 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/rayleigh_damp.f b/physics/rayleigh_damp.f index d44c1b6cb..76d15777b 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -92,9 +92,9 @@ subroutine rayleigh_damp_run ( & tidx=dtidx(index_of_temperature, & & index_of_process_rayleigh_damping) else - uidx=1 - vidx=1 - tidx=1 + uidx=0 + vidx=0 + tidx=0 endif ! ! Initialize CCPP error handling variables @@ -133,13 +133,13 @@ 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(vidx>1) THEN + IF(vidx>=1) THEN dtend(i,k,vidx) = dtend(i,k,vidx) + deltaA ENDIF - IF(uidx>1) THEN + IF(uidx>=1) THEN dtend(i,k,uidx) = dtend(i,k,uidx) + deltaB ENDIF - IF(tidx>1) THEN + IF(tidx>=1) THEN dtend(i,k,tidx) = dtend(i,k,tidx) + deltaC ENDIF ENDDO diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index fdfa49e3e..a74e15f19 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -1404,11 +1404,11 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo if (ldiag3d .and. .not. gen_tend) then idtend = dtidx(index_of_temperature,index_of_process_pbl) - if(idtend>1) then + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) +delt*rdt*(f2-q1(:,:,1)) endif endif @@ -1514,11 +1514,11 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo if (ldiag3d .and. .not. gen_tend) then idtend=dtidx(index_of_x_wind,index_of_process_pbl) - if(idtend>1) then + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + delt*rdt*(f2-v1) endif endif diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index ae70a3227..dddbae0d6 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -1423,7 +1423,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo if(ldiag3d .and. .not. gen_tend) then idtend=dtidx(index_of_temperature,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then do k = 1,km do i = 1,im ttend = (f1(i,k)-t1(i,k))*rdt @@ -1433,7 +1433,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & endif ! Send tendencies just for QV; other tracers are below. idtend=dtidx(100+ntqv,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then do k = 1,km do i = 1,im qtend = (f2(i,k)-q1(i,k,1))*rdt @@ -1458,7 +1458,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & do kk = 2, ntrac1 is = (kk-1) * km idtend = dtidx(kk+100,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then if(kk==ntke) then do k = 1, km do i = 1, im @@ -1492,7 +1492,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo if(ldiag3d .and. .not. gen_tend) then idtend=dtidx(index_of_temperature,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then do k = 1,km1 do i = 1,im ttend = diss(i,k) / cp @@ -1579,7 +1579,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & enddo if(ldiag3d .and. .not. gen_tend) then idtend=dtidx(index_of_x_wind,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then do k = 1,km do i = 1,im utend = (f1(i,k)-u1(i,k))*rdt @@ -1589,7 +1589,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & endif idtend=dtidx(index_of_y_wind,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then do k = 1,km do i = 1,im vtend = (f2(i,k)-v1(i,k))*rdt diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index 52b2f4ba4..108169e24 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -972,7 +972,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend = dtidx(index_of_temperature,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-thx+300.)*rdt*pi2d endif endif @@ -1102,7 +1102,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f3(:,:,1)-qx(:,:,1)) endif endif @@ -1138,7 +1138,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & if(lssav .and. ldiag3d .and. ntoz>0 .and. & & .not. flag_for_pbl_generic_tend) then idtend=dtidx(ntoz+100,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + qtend*(f3(:,:,ntoz)-qx(:,:,ntoz)) endif endif @@ -1235,11 +1235,11 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend=dtidx(index_of_x_wind,index_of_process_pbl) - if(idtend>1) then + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*rdt*(f2-vx) endif endif diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 98e31f27b..fbe871f42 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -623,15 +623,15 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! 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 + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif endif @@ -690,15 +690,15 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd 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 + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtdt_ngw(i,k)*dtp endif endif diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 76c7d2fa5..3380c20c2 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -386,17 +386,17 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, 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 + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif endif @@ -486,17 +486,17 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, 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 + 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 + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif endif diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index be452a154..ab51819f9 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -858,7 +858,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend = dtidx(index_of_temperature,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f1-thx+300.)*rdt*pi2d endif endif @@ -972,7 +972,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo if(lssav .and. ldiag3d .and. qdiag3d .and. .not. flag_for_pbl_generic_tend) then idtend = dtidx(ntqv+100,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f3(:,:,1)-qx(:,:,1))*rdt endif endif @@ -989,7 +989,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & & .not. flag_for_pbl_generic_tend) then idtend = dtidx(100+ntoz,index_of_process_pbl) - if(idtend>1) then + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + f3(:,:,ntoz)-qx(:,:,ntoz) endif endif @@ -1076,12 +1076,12 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & enddo if(lssav .and. ldiag3d .and. .not. flag_for_pbl_generic_tend) then idtend = dtidx(index_of_x_wind,index_of_process_pbl) - if(idtend>1) then + 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 + if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dtstep*(f2-vx)*rdt endif endif From 1057ff427c89e1e1edb7a4c262e491d82d247458 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Mon, 5 Apr 2021 16:05:22 +0000 Subject: [PATCH 12/34] Corrections to argument lists after merge --- physics/GFS_MP_generic.F90 | 8 ++++---- physics/GFS_PBL_generic.F90 | 2 +- physics/GFS_suite_interstitial.F90 | 6 +++--- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 31a3558b6..9216ead40 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -85,12 +85,12 @@ end subroutine GFS_MP_generic_post_init !> @{ 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, 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, & + 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, rain_cpl, rainc_cpl, snow_cpl, pwat, & - do_sppt, ca_global, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & - graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, & - dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d, lssav, & + drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & + 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 diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index a397c15b5..76f41df9a 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -334,7 +334,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, 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, flag_cice, dusfc_cice, dvsfc_cice, & + 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) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 85b58f3c4..76b18e95f 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -680,9 +680,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, dtf, save_qc, save_qi, con_pi, & - gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, dtidx, dtend, ntk, ntke, ldiag3d, & - index_of_process_conv_trans, 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, & + ntk, ntke, errmsg, errflg) use machine, only: kind_phys use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber From 4043ea9b9d8753644549f20d6b96eae2bf82769a Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 7 Apr 2021 11:57:50 +0000 Subject: [PATCH 13/34] Revert an accidental change to GFS_debug.F90 --- physics/GFS_debug.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index e0de4b225..f4a290884 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -642,9 +642,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, endif enddo enddo -- !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) + !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 if(Model%lradar) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%refl_10cm ', Diag%refl_10cm) From 959e76bf1023838b1e25658944b14e9d8f08ec2f Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 7 Apr 2021 12:01:30 +0000 Subject: [PATCH 14/34] Point to the correct hash of rte-rrtmgp --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From 2aa3ce20dfd136381e5eef216585f29366c3011b Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Mon, 12 Apr 2021 16:38:02 +0000 Subject: [PATCH 15/34] Fix whitespace issues. --- physics/GFS_DCNV_generic.F90 | 13 +++++++------ physics/GFS_MP_generic.F90 | 6 +++--- physics/GFS_SCNV_generic.F90 | 10 +++++----- physics/GFS_suite_interstitial.F90 | 4 ++-- physics/gwdc.f | 4 ++-- physics/ozphys.f | 9 ++++----- physics/ozphys_2015.f | 2 +- physics/shinhongvdif.F90 | 5 ++--- physics/ugwpv1_gsldrag.F90 | 6 +++--- 9 files changed, 29 insertions(+), 30 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 40f42561a..12a8e961d 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -99,12 +99,13 @@ 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, 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, errmsg, errflg) + subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, 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, & + errmsg, errflg) use machine, only: kind_phys diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 9216ead40..db24ee452 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -84,10 +84,10 @@ 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, 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, & + 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, 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, & dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d, lssav, & diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 205495529..d37d96d71 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -76,11 +76,11 @@ 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, 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, & + 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, & imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 76b18e95f..771c346b6 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -162,8 +162,8 @@ end subroutine GFS_suite_interstitial_2_finalize subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, 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, 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, & + 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, errmsg, errflg) implicit none diff --git a/physics/gwdc.f b/physics/gwdc.f index 6a4863055..f286f5ecb 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -1476,8 +1476,8 @@ subroutine gwdc_post_run( & real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:), & & gu0(:,:), gv0(:,:), gt0(:,:) real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_process_nonorographic_& - & gwd + 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 diff --git a/physics/ozphys.f b/physics/ozphys.f index 26916a459..011b63fac 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -47,8 +47,8 @@ end subroutine ozphys_finalize subroutine ozphys_run ( & & im, levs, ko3, dt, oz, tin, po3, & & prsl, prdout, oz_coeff, delp, ldiag3d, & - & ntoz, dtend, dtidx, index_of_process_prod_loss, & - & index_of_process_ozmix, index_of_process_temp, & + & 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 @@ -59,12 +59,11 @@ subroutine ozphys_run ( & ! ! Interface variables integer, intent(in) :: im, levs, ko3, oz_coeff, me - real(kind=kind_phys), intent(inout) :: & - & oz(im,levs) + real(kind=kind_phys), intent(inout) :: oz(im,levs) ! The dtend array may not be allocated and needs an assumed array size real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), ntoz, & - & index_of_process_prod_loss, index_of_process_ozmix, & + & 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(ko3), prdout(im,ko3,oz_coeff), & diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index fac917c95..2499f3218 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -68,7 +68,7 @@ subroutine ozphys_2015_run ( & ! dtend may not be allocated and needs an assumed array size real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), ntoz, & - & index_of_process_prod_loss, index_of_process_ozmix, & + & 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) diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index 108169e24..0b88f2978 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -36,7 +36,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & u10,v10, & 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_process_pbl,index_of_temperature,index_of_x_wind, & index_of_y_wind,errmsg,errflg ) use machine , only : kind_phys @@ -109,8 +109,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, & - flag_for_pbl_generic_tend + logical, intent(in ) :: lssav, ldiag3d, flag_for_pbl_generic_tend ! 3D in real(kind=kind_phys), dimension(im, km) , & intent(in ) :: phil, & diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 62f482021..b9828ccb4 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -318,7 +318,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd dudt_oss, dvdt_oss, du_osscol, dv_osscol, & dudt_ofd, dvdt_ofd, du_ofdcol, dv_ofdcol, & dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, dudt_gw, dvdt_gw, dtdt_gw, kdis_gw, & - tau_ogw, tau_ngw, tau_oss, & + tau_ogw, tau_ngw, tau_oss, & zogw, zlwb, zobl, zngw, dusfcg, dvsfcg, dudt, dvdt, dtdt, rdxzb, & dtend, dtidx, index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd, & @@ -432,8 +432,8 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! 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, & + 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(im) :: rdxzb ! for stoch phys. mtb-level From 1da87101a430202cc5daa24ae4968ac49d42ef40 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 21 May 2021 07:01:57 -0600 Subject: [PATCH 16/34] Bug fixes from merge of main into gsl/develop --- physics/GFS_DCNV_generic.F90 | 22 ++++++++++------------ physics/GFS_DCNV_generic.meta | 8 ++++++++ physics/GFS_suite_interstitial.F90 | 2 +- 3 files changed, 19 insertions(+), 13 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 2db3f13a7..bc0c823f4 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -99,8 +99,8 @@ 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, ras, cscnv, & - frain, rain1, dtf, cld1d, save_u, save_v, save_t, gu0, gv0, gt0, & + 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, & @@ -113,7 +113,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & implicit none integer, intent(in) :: im, levs, nsamftrac - logical, intent(in) :: lssav, ldiag3d, ras, cscnv + logical, intent(in) :: lssav, ldiag3d, qdiag3d, ras, cscnv logical, intent(in) :: flag_for_dcnv_generic_tend real(kind=kind_phys), intent(in) :: frain, dtf @@ -205,15 +205,13 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & ! 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 8ddace1cc..e14820044 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -228,6 +228,14 @@ 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 [ras] standard_name = flag_for_ras_deep_convection long_name = flag for ras convection scheme diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 8a58212e7..e68927cb1 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -315,7 +315,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ idtend = dtidx(index_of_temperature,index_of_process_longwave) if(idtend>=1) then if (use_LW_jacobian) then - dtend(:,:,idtend)) = dtend(:,:,idtend) + htrlwu(:,:)*dtf + dtend(:,:,idtend) = dtend(:,:,idtend) + htrlwu(:,:)*dtf else dtend(:,:,idtend) = dtend(:,:,idtend) + htrlw(:,:)*dtf endif From 2f38f276e2f807b3d5656ff08640f170299ead0b Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Mon, 24 May 2021 15:20:12 +0000 Subject: [PATCH 17/34] Bug fixes to dtend support: 1. Store rtg (AKA clw AKA qtr) instead of gq0 in DCNV and SCNV pre/post for schemes that use convective transport. Tracers handled solely by convective transport (ones not in rtg) are reported as convective transport tendencies. Tendencies for variables in rtg are reported as dcnv and scnv tendencies. 2. Report TKE tendencies from gfs v16 PBL. 3. Add diagnostic tendencies to drag_suite --- physics/GFS_DCNV_generic.F90 | 91 +++++++---- physics/GFS_DCNV_generic.meta | 242 +++++++++++++++++++++++++++- physics/GFS_SCNV_generic.F90 | 85 +++++++--- physics/GFS_SCNV_generic.meta | 233 ++++++++++++++++++++++++++ physics/GFS_suite_interstitial.F90 | 80 ++++++--- physics/GFS_suite_interstitial.meta | 92 +++++++++++ physics/drag_suite.F90 | 49 +++++- physics/drag_suite.meta | 58 +++++++ physics/module_MYNNPBL_wrapper.F90 | 11 +- physics/rayleigh_damp.f | 7 +- physics/satmedmfvdifq.F | 16 +- 11 files changed, 866 insertions(+), 98 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 12a8e961d..420aca498 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -17,14 +17,17 @@ end subroutine GFS_DCNV_generic_pre_finalize !! 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, & + 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, nsamftrac, ntqv, index_of_process_dcnv, dtidx(:,:) + 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(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 @@ -38,9 +41,11 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc 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, n + real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw + + integer :: i, k, n, tracers ! Initialize CCPP error handling variables errmsg = '' @@ -63,19 +68,28 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc endif if ((ldiag3d.and.qdiag3d) .or. cplchm) then - if(nsamftrac>0) then - do n=1,nsamftrac - if(n==ntqv .or. dtidx(n+100,index_of_process_dcnv)>=1) then - save_q(:,:,n) = gq0(:,:,n) - endif - enddo - else - do k=1,levs - do i=1,im - save_q(i,k,ntqv) = gq0(i,k,ntqv) + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + print *,'dcnv store clw' + 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 - enddo - endif + else + print *,'dcnv store gq0' + 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 @@ -105,7 +119,8 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & 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, & - errmsg, errflg) + ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc, ntrac,clw, & + satmedmf, trans_trac, errmsg, errflg) use machine, only: kind_phys @@ -124,6 +139,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & real(kind=kind_phys), dimension(im,levs), 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(im), intent(inout) :: rainc, cldwrk ! dtend, upd_mf, dwn_mf, det_mf only allocated if ldiag3d == .true. @@ -133,6 +149,9 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & 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 + ! 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, @@ -143,7 +162,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: i, k, n, idtend + integer :: i, k, n, idtend, tracers ! Initialize CCPP error handling variables errmsg = '' @@ -194,18 +213,32 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, & dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0-save_v)*frain endif - if(nsamftrac>0) then - do n=1,nsamftrac - idtend=dtidx(100+n,index_of_process_dcnv) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n)-save_q(:,:,n))*frain - endif - enddo + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + print *,'dcnv accum clw' + 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 - idtend=dtidx(100+ntqv,index_of_process_dcnv) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv)-save_q(:,:,ntqv))*frain - endif + print *,'dcnv accume gq0' + 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 + 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 diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 8ddace1cc..08e015427 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -168,6 +168,127 @@ 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 @@ -236,14 +357,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 @@ -566,6 +679,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_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index d37d96d71..352273b06 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -16,13 +16,15 @@ end subroutine GFS_SCNV_generic_pre_finalize !! 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, errmsg, errflg) + 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, 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(im,levs), intent(in) :: gu0, gv0, gt0 real(kind=kind_phys), intent(in) :: gq0(:,:,:) @@ -30,8 +32,10 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, real(kind=kind_phys), dimension(im,levs), 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, n + integer :: i, k, n, tracers ! Initialize CCPP error handling variables errmsg = '' @@ -46,17 +50,30 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, enddo enddo if (qdiag3d) then - if(nsamftrac>0) then - do n=1,nsamftrac - if(n==ntqv .or. dtidx(ntqv,index_of_process_scnv)>=1) then - save_q(:,:,n) = gq0(:,:,n) - endif - enddo - else - save_q(:,:,ntqv) = gq0(:,:,ntqv) - endif + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + print *,'scnv store clw' + 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 + else + print *,'scnv store gq0' + 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 @@ -82,13 +99,16 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & 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, & - imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) + 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, 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(im,levs), intent(in) :: gu0, gv0, gt0 @@ -114,11 +134,12 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & ! 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, n, idtend + integer :: i, k, n, idtend, tracers real(kind=kind_phys) :: tem ! Initialize CCPP error handling variables @@ -163,18 +184,32 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & dtend(:,:,idtend) = dtend(:,:,idtend) + (gv0 - save_v) * frain endif - if(nsamftrac>0) then - do n=1,nsamftrac - idtend = dtidx(100+n, index_of_process_scnv) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,n) - save_q(:,:,n)) * frain - endif - enddo + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then + print *,'scnv accum clw' + 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 - idtend = dtidx(100+ntqv, index_of_process_scnv) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (gq0(:,:,ntqv) - save_q(:,:,ntqv)) * frain - endif + print *,'scnv accum gq0' + 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 diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index c56ec9aa3..25140aaba 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -151,6 +151,127 @@ 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 @@ -535,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_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 771c346b6..fed0bec01 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -513,10 +513,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 @@ -526,9 +527,12 @@ 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, dimension(im), intent(in) :: 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(kind=kind_phys), intent(in) :: rhcbot, rhcmax, rhcpbl, rhctop real(kind=kind_phys), dimension(im), intent(in) :: work1, work2 @@ -540,7 +544,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & real(kind=kind_phys), dimension(im, levs), intent(inout) :: rhc, save_qc ! save_qi is not allocated for Zhao-Carr MP - real(kind=kind_phys), dimension(:, :), intent(inout) :: save_qi + real(kind=kind_phys), dimension(:, :), intent(inout) :: save_qi, save_lnc, save_inc real(kind=kind_phys), dimension(:, :), intent(inout) :: save_tcp real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw @@ -661,6 +665,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 @@ -682,7 +695,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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, dtidx, dtend,& index_of_process_conv_trans, gq0, clw, prsl, save_tcp, con_rd, con_eps, nwfa, spechum, dqdti, ldiag3d, & - ntk, ntke, errmsg, errflg) + 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 @@ -700,10 +713,10 @@ 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), dimension(im,levs), intent(in) :: save_qc ! save_qi is not allocated for Zhao-Carr MP - real(kind=kind_phys), dimension(:, :), intent(in) :: save_qi + real(kind=kind_phys), dimension(:, :), intent(in) :: save_qi, save_lnc, save_inc ! dtend and dtidx are only allocated if ldiag3d - logical, intent(in) :: 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 @@ -741,24 +754,35 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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) + dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk)-gq0(:,:,ntk) endif endif - if(ntclamt<=size(clw,3) .and. ntclamt>0) then - idtend=dtidx(100+ntclamt,index_of_process_conv_trans) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntclamt) + 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 - if(ldiag3d .and. ntk>0) then - idtend=dtidx(100+ntke,index_of_process_conv_trans) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + clw(:,:,ntk) - endif - endif - ! --- update the tracers due to deep & shallow cumulus convective transport ! (except for suspended water and ice) @@ -770,6 +794,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) @@ -845,6 +875,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 cf8629a8b..f1836b54f 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1576,6 +1576,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 @@ -1823,6 +1889,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 @@ -1954,6 +2038,14 @@ 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 diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 2e68ceb12..495f32362 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -199,7 +199,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 <---------- @@ -302,7 +304,10 @@ subroutine drag_suite_run( & logical, intent(in) :: lprnt integer, intent(in) :: KPBL(im) real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, cdmbgwd(2) - + 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 real(kind=kind_phys), intent(in) :: fv, pi @@ -473,6 +478,8 @@ 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 @@ -482,6 +489,12 @@ subroutine drag_suite_run( & var_temp2 = 0. + 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 !-------------------------------------------------------------------- @@ -1015,6 +1028,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 @@ -1073,6 +1092,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 @@ -1266,6 +1291,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 3035a2c95..b1bb7a975 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -615,6 +615,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/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index bbaed874f..7516e6d66 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -724,11 +724,12 @@ SUBROUTINE mynnedmf_wrapper_run( & call dtend_helper(index_of_y_wind,RVBLTEN) call dtend_helper(index_of_temperature,RTHBLTEN,exner) if(ldiag3d) then - idtend = dtidx(100+ntoz,index_of_process_pbl) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + (ozone-old_ozone) - deallocate(old_ozone) - endif + 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: diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index 76d15777b..75ad0789b 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -85,6 +85,9 @@ subroutine rayleigh_damp_run ( & &, ENG0, ENG1, tem1, tem2, dti, hfbcpdt, rtrd real(kind=kind_phys) tx1(im), deltaA, deltaB, deltaC integer i, k, uidx,vidx,tidx + logical saw_non_zero + + saw_non_zero = .false. if(ldiag3d) then uidx=dtidx(index_of_x_wind,index_of_process_rayleigh_damping) @@ -133,6 +136,8 @@ 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 + saw_non_zero = saw_non_zero .or. abs(deltaA)>0 .or. & + & abs(deltaB)>0 .or. abs(deltaC)>0 IF(vidx>=1) THEN dtend(i,k,vidx) = dtend(i,k,vidx) + deltaA ENDIF @@ -144,7 +149,7 @@ subroutine rayleigh_damp_run ( & ENDIF ENDDO ENDDO - + if(saw_non_zero) print *,'Saw non-zero rayleigh_damp changes!' RETURN end subroutine rayleigh_damp_run !> @} diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index dddbae0d6..a20202fea 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -1295,6 +1295,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 @@ -1459,14 +1466,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & 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 = (f1(i,k)-q1(i,k,kk))*rdt - dtend(i,k,idtend) = dtend(i,k,idtend)+qtend*delt - enddo - enddo - else + if(kk/=ntke) then do k = 1, km do i = 1, im qtend = (f2(i,k+is)-q1(i,k,kk))*rdt From 6d75cde2b9313783bbd9545270ae982270c6de77 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Mon, 24 May 2021 21:47:45 +0000 Subject: [PATCH 18/34] Remove some debug prints --- physics/GFS_DCNV_generic.F90 | 4 ---- physics/GFS_SCNV_generic.F90 | 4 ---- physics/GFS_suite_interstitial.F90 | 1 + physics/rayleigh_damp.f | 7 +------ 4 files changed, 2 insertions(+), 14 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index d5f5e240e..f03e1d298 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -69,7 +69,6 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc if ((ldiag3d.and.qdiag3d) .or. cplchm) then if (cscnv .or. satmedmf .or. trans_trac .or. ras) then - print *,'dcnv store clw' tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & @@ -82,7 +81,6 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc endif enddo else - print *,'dcnv store gq0' do n=2,ntrac if(dtidx(100+n,index_of_process_dcnv)>0) then save_q(:,:,n) = gq0(:,:,n) @@ -209,7 +207,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & endif if (cscnv .or. satmedmf .or. trans_trac .or. ras) then - print *,'dcnv accum clw' tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & @@ -223,7 +220,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & endif enddo else - print *,'dcnv accume gq0' do n=2,ntrac idtend = dtidx(100+n,index_of_process_dcnv) if(idtend>0) then diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index ccc9860c0..ac77eaa68 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -51,7 +51,6 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, enddo if (qdiag3d) then if (cscnv .or. satmedmf .or. trans_trac .or. ras) then - print *,'scnv store clw' tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & @@ -64,7 +63,6 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, endif enddo else - print *,'scnv store gq0' do n=2,ntrac if(dtidx(100+n,index_of_process_scnv)>0) then save_q(:,:,n) = gq0(:,:,n) @@ -185,7 +183,6 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & endif if (cscnv .or. satmedmf .or. trans_trac .or. ras) then - print *,'scnv accum clw' tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & @@ -199,7 +196,6 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & endif enddo else - print *,'scnv accum gq0' do n=2,ntrac idtend = dtidx(100+n,index_of_process_scnv) if(idtend>0) then diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 575b13b32..b793c2902 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -540,6 +540,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & 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 diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index 82deb83eb..70ed997a2 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -85,9 +85,6 @@ subroutine rayleigh_damp_run ( & &, ENG0, ENG1, tem1, tem2, dti, hfbcpdt, rtrd real(kind=kind_phys) tx1(im), deltaA, deltaB, deltaC integer i, k, uidx,vidx,tidx - logical saw_non_zero - - saw_non_zero = .false. if(ldiag3d) then uidx=dtidx(index_of_x_wind,index_of_process_rayleigh_damping) @@ -136,8 +133,6 @@ 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 - saw_non_zero = saw_non_zero .or. abs(deltaA)>0 .or. & - & abs(deltaB)>0 .or. abs(deltaC)>0 IF(vidx>=1) THEN dtend(i,k,vidx) = dtend(i,k,vidx) + deltaA ENDIF @@ -149,7 +144,7 @@ subroutine rayleigh_damp_run ( & ENDIF ENDDO ENDDO - if(saw_non_zero) print *,'Saw non-zero rayleigh_damp changes!' + RETURN end subroutine rayleigh_damp_run !> @} From 09494e6132acba744085a96243c66a4a3c164701 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 1 Jun 2021 08:24:46 -0600 Subject: [PATCH 19/34] Several bug fixes to UGWP v1 and GSL drag suite related to updated tendencies code --- physics/drag_suite.F90 | 8 ++++++-- physics/ugwpv1_gsldrag.F90 | 17 +++++++++-------- physics/ugwpv1_gsldrag.meta | 1 - physics/unified_ugwp.F90 | 4 +++- 4 files changed, 18 insertions(+), 12 deletions(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 7f9da6f4f..9b110d689 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -218,7 +218,7 @@ subroutine drag_suite_run( & & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & & dtend, dtidx, index_of_process_orographic_gwd, & & index_of_temperature, index_of_x_wind, & - & index_of_y_wind, ldiag3d, errmsg, errflg ) + & 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 <---------- @@ -504,8 +504,12 @@ subroutine drag_suite_run( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - var_temp2 = 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) diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 518aefab4..104fc8e3f 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -429,8 +429,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt - ! dtend is only allocated if ldiag=.true. - real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + 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 @@ -548,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 ! diff --git a/physics/ugwpv1_gsldrag.meta b/physics/ugwpv1_gsldrag.meta index c751b901c..5cfae9dd1 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/ugwpv1_gsldrag.meta @@ -1156,7 +1156,6 @@ 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] diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 587885cc6..def7ba141 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -342,7 +342,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, con_fvirt,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) ! ! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ls,dvsfc_ls ! From df632d81c8f5c3f2e8199953bb86bebf59cad6c7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Jun 2021 13:01:02 -0600 Subject: [PATCH 20/34] Add missing variables to physics/GFS_debug.F90, comment out erroneous tendencies code --- physics/GFS_debug.F90 | 38 +++++++++++++++++++++++++------------- 1 file changed, 25 insertions(+), 13 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 0218affa0..567cbbd32 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -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,19 +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 - 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 - !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) From 10ab813d658c288e2b872406a5f15d991d3cb6d6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 2 Jun 2021 13:02:06 -0600 Subject: [PATCH 21/34] Fix b4b issue for restart runs with RUC LSM --- physics/GFS_surface_composites.F90 | 6 +++--- physics/GFS_surface_composites.meta | 8 ++++++++ 2 files changed, 11 insertions(+), 3 deletions(-) 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 From ef5db3119c2f924dfe2c1da180b92f388b1a82f7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 3 Jun 2021 10:19:07 -0600 Subject: [PATCH 22/34] More bug fixes related to tendencies in physics/unified_ugwp.F90 --- physics/unified_ugwp.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index def7ba141..da79ecde8 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -268,8 +268,7 @@ 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 - ! The dtend array is are only allocated if ldiag=.true. - real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + 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 @@ -340,7 +339,7 @@ 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, & dtend, dtidx, index_of_process_orographic_gwd, & index_of_temperature, index_of_x_wind, & From 9841a990779b8b50ed6b5bcd3d04f2330048fb0e Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Tue, 22 Jun 2021 01:38:25 +0000 Subject: [PATCH 23/34] Updating MYNN-EDMF --- physics/module_MYNNPBL_wrapper.F90 | 19 +- physics/module_MYNNPBL_wrapper.meta | 8 - physics/module_bl_mynn.F90 | 2297 +++++++++++++++++++-------- 3 files changed, 1640 insertions(+), 684 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 532fc7b16..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 @@ -101,7 +101,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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, & @@ -212,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, & @@ -231,8 +230,9 @@ SUBROUTINE mynnedmf_wrapper_run( & !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 @@ -565,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) @@ -622,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) @@ -691,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 diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 453fb8963..1b77d101e 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1231,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..b63da6223 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,31 @@ ! 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. +! Not yet: Addition of Greg Thompsons SGS cloud option (bl_mynn_cloudpdf = 3). +! 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. Sušelj, 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, +! Otávio 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 +271,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 teo 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 +287,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. @@ -294,7 +322,6 @@ MODULE module_bl_mynn !JOE & JAYMES'S mods ! ! Mixing Length Options -!\authors Joe and Jaymes ! specifed through namelist: bl_mynn_mixlength ! added: 16 Apr 2015 ! @@ -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, sh, sm, & & ust, rmo, el, & & Qke, Tsq, Qsq, Cov, Psig_bl, cldfra_bl1D, & & bl_mynn_mixlength, & @@ -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, 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, qw, & + & ql, vt, vq, & & 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 @@ -719,6 +746,7 @@ 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 ! dtl(k) = dtz @@ -734,21 +762,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 +784,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 +880,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 @@ -1038,31 +1067,37 @@ SUBROUTINE mym_length ( & CASE (2) !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 = 2.0 !JOE-test 2.0 + alp4 = 10.0 !JOE-test 20. !10. 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 +!JOE-test +! zi2=MAX(zi, 100.) + zi2=MAX(zi, 200.) +!JOE-test +! h1=MAX(0.3*zi2,mindz) +! h1=MIN(h1,maxdz) ! 1/2 transition layer depth +! h1=MAX(0.3*zi2,100.) + 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 @@ -1091,18 +1126,29 @@ 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) +! elf = elb/(1. + (elb/600.)) !bound free-atmos mixing length to < 600 m. + +!orig: 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 +1167,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.) +!orig: 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 +1199,10 @@ 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)) +! el(k) = MIN(el_unstab, elb_mf) +!try squared-blending + el(k) = SQRT( els**2/(1. + (els1**2/elt**2) +(els1**2/elb_mf**2))) el(k) = el(k)*(1.-wt) + elf*wt ! include scale-awareness. For now, use simple asymptotic kz -> 12 m. @@ -1494,8 +1549,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 +1596,14 @@ END SUBROUTINE boulac_length !! is set to True) SUBROUTINE mym_turbulence ( & & kts,kte, & - & levflag, & + & closure, & & dz, dx, zw, & & u, v, thl, 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,7 +1622,8 @@ 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 @@ -1596,10 +1651,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 +1663,8 @@ SUBROUTINE mym_turbulence ( & ! Stochastic INTEGER, INTENT(IN) :: spp_pbl REAL, DIMENSION(KTS:KTE) :: rstoch_col - REAL :: prlimit + REAL :: Prnum + REAL, PARAMETER :: Prlimit = 10.0 ! @@ -1624,11 +1680,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, qw, & + & ql, vt, vq, & + & dtl, dqw, dtv, gm, gh, sm, sh ) ! CALL mym_length ( & & kts,kte, & @@ -1648,20 +1704,35 @@ 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 - -!JOE-Canuto/Kitamura mod + q2sq = b1*elsq*( sm(k)*gm(k)+sh(k)*gh(k) ) + !Remove possiblity of contamination due to spikes, but + !allow for very large variations - no impact on idealized cases +! elsq = MIN(MAX(elsq,0.1), 160000.) !max el = 400 m +! q3sq = MIN(MAX(q3sq,0.01), 75.) !max tke = 75 m2/s2 +! q2sq = MIN(MAX(q2sq,0.01), 75.) + !end constraints + sh20 = MAX(sh(k), 1e-6) + sm20 = MAX(sm(k), 1e-6) + sh(k)= MAX(sh(k), 1e-6) + + !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.8 + 4.0*MAX(ri,-0.013), 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,85 @@ 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 + ! sm(k) = sm(k) * qdiv + ! sh(k) = sh(k) * qdiv ! !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 ) + + !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) 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 from HL88: + 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) .AND. ri < 0.5) THEN + print*,"MYNN; mym_turbulence2.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 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 +1850,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 +1865,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 +1894,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 +!JOE clow = q3sq*( Rsl -cw25 )*eden/wden +!JOE cupp = q3sq*( Rsl2-cw25 )*eden/wden ! IF ( wden .GT. 0.0 ) THEN c3sq = MIN( MAX( c3sq, c2sq+clow ), c2sq+cupp ) @@ -1834,7 +1925,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 +1954,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 @@ -1893,15 +1984,19 @@ SUBROUTINE mym_turbulence ( & gamq = 0.0 gamv = 0.0 END IF + +! Prandtl number limit +! Prlimit = 4.0 +! IF (sm(k) > sh(k)*Prlimit) sm(k) = sh(k)*Prlimit ! ! Add min background stability function (diffusivity) within model levels ! with active plumes and low cloud fractions. 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 +2005,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 +2013,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 +2036,35 @@ 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) !staggared !!!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) !staggared + !! - !!!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 +2087,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 +2150,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 +2168,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 +2212,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 +2275,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 @@ -2179,73 +2301,96 @@ SUBROUTINE mym_predict (kts,kte, & d(kte)=0. ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) + CALL tridiag3(kte,a,b,c,d,x) 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) !unstaggared + !! >> 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. d(kte)=0. -! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) - + !CALL tridiag(kte,a,b,c,d) + CALL tridiag3(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,32 +2399,37 @@ 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. b(kte)=1. c(kte)=0. d(kte)=0. - -! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) +! CALL tridiag(kte,a,b,c,d) + CALL tridiag3(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 +2447,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 @@ -2316,15 +2471,16 @@ SUBROUTINE mym_predict (kts,kte, & d(kte)=0. ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) - + CALL tridiag3(kte,a,b,c,d,x) + DO k=kts,kte ! cov(k)=d(k-kts+1) cov(k)=x(k) 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 +2489,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 +2572,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 +2580,14 @@ SUBROUTINE mym_condensation (kts,kte, & REAL :: erf - !JOE: NEW VARIABLES FOR ALTERNATE SIGMA + !VARIABLES FOR ALTERNATIVE SIMGA 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 = 2 !sigma form, 1: use state variables, 2: higher-order variables !JAYMES: variables for tropopause-height estimation REAL :: theta1, theta2, ht1, ht2 @@ -2511,6 +2662,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 +2675,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 +2752,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 +2906,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 +2915,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 +2963,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 +2980,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 +3018,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 +3037,6 @@ SUBROUTINE mym_condensation (kts,kte, & qc_bl1D(kte)=0. qi_bl1D(kte)=0. cldfra_bl1D(kte)=0. - RETURN #ifdef HARDCODE_VERTICAL @@ -2831,10 +3051,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 +3069,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 +3092,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 +3110,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 +3122,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 +3138,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 +3159,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 +3186,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 +3258,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 +3337,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 +3408,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 +3473,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 +3530,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 @@ -3793,48 +4011,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 +4070,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 +4124,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 +4159,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 +4336,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 +4354,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 +4377,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 +4391,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 +4411,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 @@ -4129,12 +4430,12 @@ SUBROUTINE mynn_bl_driver( & &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 + &ch,ts,qsfc,qcg,ps,hfx,qfx,wspd,uoce,voce,vdfg,znt REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), 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) :: & &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,& @@ -4153,8 +4454,11 @@ 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,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), INTENT(inout) :: & - &Pblh,wstar,delta !JOE-added for GRIMS + &Pblh,wstar,delta,rmol REAL, DIMENSION(IMS:IME,JMS:JME) :: & &Psig_bl,Psig_shcu @@ -4176,7 +4480,7 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: Sh3D - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & + REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), 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 @@ -4186,6 +4490,8 @@ SUBROUTINE mynn_bl_driver( & 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,jms:jme), 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 +4504,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,36 +4512,26 @@ 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(KTS:KTE) :: KHtopdown,TKEprodTD !JOE-end top down -!for WRF INTEGER, SAVE :: levflag - LOGICAL :: INITIALIZE_QKE ! Stochastic fields @@ -4263,9 +4558,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 @@ -4288,6 +4580,15 @@ SUBROUTINE mynn_bl_driver( & ENDIF maxKHtopdown(its:ite,jts:jte)=0. + IF (bl_mynn_edmf_dd > 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 + ! 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, !! If true, a three-dimensional initialization loop is entered. Within this loop, @@ -4335,6 +4636,9 @@ 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 @@ -4470,7 +4774,7 @@ SUBROUTINE mynn_bl_driver( & &kts,kte, & &dz1, dx(i,j), zw, & &u1, v1, thl, sqv, & - &PBLH(i,j), th1, sh, & + &PBLH(i,j), th1, sh, sm, & &ust(i,j), rmol(i,j), & &el, Qke1, Tsq1, Qsq1, Cov1, & &Psig_bl(i,j), cldfra_bl1D, & @@ -4532,6 +4836,13 @@ SUBROUTINE mynn_bl_driver( & 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) + 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) @@ -4591,7 +4902,7 @@ SUBROUTINE mynn_bl_driver( & & - xlscp/exner(i,k,j)*sqi9 ENDIF thetav(k)=th(i,k,j)*(1.+0.608*sqv(k)) - thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) + thvl(k) =thlsg(k) *(1.+0.608*sqv(k)) IF (PRESENT(qni) .AND. FLAG_QNI ) THEN qni1(k)=qni(i,k,j) @@ -4649,6 +4960,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,7 +4983,7 @@ 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 @@ -4707,6 +5030,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. @@ -4743,42 +5074,44 @@ SUBROUTINE mynn_bl_driver( & !----------------------------------------------------- ! 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) + !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 ) + !----------------------------------------------------- + flqv = qfx(i,j)/rho1(kts) flqc = -vdfg(i,j)*(sqc(kts) - sqcg ) th_sfc = ts(i,j)/ex1(kts) + ! TURBULENT FLUX FOR TKE BOUNDARY CONDITIONS + flq =flqv+flqc !! LATENT + flt =hfx(i,j)/(rho1(kts)*cpm )-xlvcp*flqc/exner(i,kts,j) !! 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,j) = -vk*gtr*fltv/max(ust(i,j)**3,1.0e-6) 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 + 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, & @@ -4790,103 +5123,20 @@ SUBROUTINE mynn_bl_driver( & &Vt, Vq, th1, sgm, rmol(i,j), & &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,j),kpbl(i,j),PBLH(i,j), & + &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & + &cldfra_bl1D,rthraten, & + &maxKHtopdown(i,j),KHtopdown,TKEprodTD ) ELSE - maxKHtopdown(i,j)=0.0 + maxKHtopdown(i,j) = 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 @@ -4919,6 +5169,7 @@ 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, & @@ -4928,22 +5179,36 @@ SUBROUTINE mynn_bl_driver( & & Psig_shcu(i,j), & & nupdraft(i,j),ktop_plume(i,j), & & maxmf(i,j),ztop_plume, & - & spp_pbl,rstoch_col & - ) + & 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,j),flt,flq, & + &PBLH(i,j),KPBL(i,j), & + &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,:,j) ) ENDIF !> - Call mym_turbulence() to collect the necessary variable !! to carry out successive claculations. CALL mym_turbulence ( & - &kts,kte,levflag, & + &kts,kte,closure, & &dz1, DX(i,j), zw, & &u1, v1, thl, sqc, sqw, & &qke1, tsq1, qsq1, cov1, & &vt, vq, & &rmol(i,j), flt, flq, & &PBLH(i,j),th1, & - &Sh,el, & + &Sh,Sm,el, & &Dfm,Dfh,Dfq, & &Tcd,Qcd,Pdk, & &Pdt,Pdq,Pdc, & @@ -4958,27 +5223,29 @@ 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, & + &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,j), p1, ex1, thl, & + &sqv, sqc, sqi, sqw, & &qnwfa1, qnifa1, ozone1, & &ust(i,j),flt,flq,flqv,flqc, & &wspd(i,j),qcg(i,j), & @@ -4995,6 +5262,8 @@ SUBROUTINE mynn_bl_driver( & &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, & @@ -5009,29 +5278,36 @@ SUBROUTINE mynn_bl_driver( & &bl_mynn_mixscalars ) #if (WRF_CHEM == 1) - IF (bl_mynn_mixchem == 1) THEN - CALL mynn_mix_chem(kts,kte, & - levflag,grav_settling, & - delt, dz1, & + IF ( mynn_chem_vertmx ) THEN + CALL mynn_mix_chem(kts,kte,i,j, & + grav_settling, & + delt, dz1, pblh(i,j), & nchem, kdvel, ndvel, num_vert_mix, & chem1, vd1, & qnc1,qni1, & p1, ex1, thl, sqv, sqc, sqi, sqw,& - ust(i,j),flt,flq,flqv,flqc, & + rho1, 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, & ! mass flux components & s_aw1, & & s_awchem1, & - &bl_mynn_cloudmix) + &bl_mynn_cloudmix, & + EMIS_ANT_NO(i,j), & + FRP_MEAN(i,j), & + enh_vermix) + IF (PRESENT(chem3d) ) THEN + DO ic = 1,nchem + DO k = kts,kte + chem3d(i,k,j,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) @@ -5101,13 +5377,26 @@ SUBROUTINE mynn_bl_driver( & 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,j)**3*phi_m/(vk*dz(i,k,j)))-qSHEAR1(k+1) !! staggered + qBUOY1(k)=4.*(-ust(i,j)**3*zet/(vk*dz(i,k,j)))-qBUOY1(k+1) !! staggered + !! unstaggering SHEAR and BUOY and trasfering all TKE budget to 3D array + DO k = kts,kte-1 + qSHEAR(i,k,j)=0.5*(qSHEAR1(k)+qSHEAR1(k+1)) !!! unstaggering in z + qBUOY(i,k,j)=0.5*(qBUOY1(k)+qBUOY1(k+1)) !!! unstaggering in z + qWT(i,k,j)=qWT1(k) + qDISS(i,k,j)=qDISS1(k) + dqke(i,k,j)=(qke1(k)-dqke(i,k,j))*0.5/delt ENDDO + !! Upper boundary conditions + k=kte + qSHEAR(i,k,j)=0. + qBUOY(i,k,j)=0. + qWT(i,k,j)=0. + qDISS(i,k,j)=0. + dqke(i,k,j)=0. ENDIF !update updraft properties @@ -5124,6 +5413,15 @@ 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 @@ -5441,7 +5739,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 +5759,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 +5788,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 +5866,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 +5904,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 +5913,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 +5945,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 +5958,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 +5976,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 +6008,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 +6181,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 +6200,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 +6230,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 +6263,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 +6313,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 TEST 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 = ENT * 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 +6436,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 +6501,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 +6560,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 +6581,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 +6598,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 +6663,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 +6753,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 +6798,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 +6807,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 +6822,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 +6944,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 +7521,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 ! ddenon/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,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-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 +! ================================================================== ! =================================================================== ! =================================================================== From c02da687ab6dc80a9b8905f2d6d646ca42467bc9 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Fri, 9 Jul 2021 20:27:10 +0000 Subject: [PATCH 24/34] Final updates for the MYNN-EDMF for HFIP --- physics/module_bl_mynn.F90 | 244 ++++++++++++++++++++----------------- 1 file changed, 133 insertions(+), 111 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index b63da6223..04c6049f5 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -275,7 +275,7 @@ MODULE module_bl_mynn LOGICAL, PARAMETER :: mynn_chem_vertmx = .false. LOGICAL, PARAMETER :: enh_vermix = .false. - !>Of the following teo options, use one OR the other, not both. + !>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 = 0 !>Option to activate downdrafts, from Elynn Wu (0: deactive, 1: active) @@ -322,6 +322,7 @@ MODULE module_bl_mynn !JOE & JAYMES'S mods ! ! Mixing Length Options +!\authors Joe and Jaymes ! specifed through namelist: bl_mynn_mixlength ! added: 16 Apr 2015 ! @@ -489,7 +490,7 @@ SUBROUTINE mym_initialize ( & & dz, dx, zw, & & u, v, thl, qw, & ! & ust, rmo, pmz, phh, flt, flq, & - & zi, theta, sh, sm, & + & zi, theta, thetav, sh, sm, & & ust, rmo, el, & & Qke, Tsq, Qsq, Cov, Psig_bl, cldfra_bl1D, & & bl_mynn_mixlength, & @@ -517,7 +518,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 @@ -532,7 +533,7 @@ SUBROUTINE mym_initialize ( & !> - Call mym_level2() to calculate the stability functions at level 2. CALL mym_level2 ( kts,kte, & & dz, & - & u, v, thl, qw, & + & u, v, thl, thetav, qw, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! @@ -690,7 +691,7 @@ END SUBROUTINE mym_initialize !! @ { SUBROUTINE mym_level2 (kts,kte, & & dz, & - & u, v, thl, qw, & + & u, v, thl, thetav, qw, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! @@ -704,8 +705,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 @@ -746,8 +747,9 @@ 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 @@ -972,30 +974,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 @@ -1014,9 +1017,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 @@ -1031,11 +1034,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 @@ -1057,35 +1063,35 @@ 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 = 3.5 + dz(kts)*0.1 Ugrid = sqrt(u1(kts)**2 + v1(kts)**2) cns = 3.5 !JOE-test * (1.0 - MIN(MAX(Ugrid - Uonset, 0.0)/10.0, 1.0)) alp1 = 0.23 alp2 = 0.30 - alp3 = 2.0 !JOE-test 2.0 - alp4 = 10.0 !JOE-test 20. !10. + 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) -!JOE-test -! zi2=MAX(zi, 100.) zi2=MAX(zi, 200.) -!JOE-test -! h1=MAX(0.3*zi2,mindz) -! h1=MIN(h1,maxdz) ! 1/2 transition layer depth -! h1=MAX(0.3*zi2,100.) + !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 @@ -1109,14 +1115,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 @@ -1138,9 +1144,8 @@ SUBROUTINE mym_length ( & & alp6*edmf_a1(k)*edmf_w1(k)) / bv & & *( 1.0 + alp3*SQRT( vsc/( bv*elt ) ) ) elb = MIN(MAX(alp5*qkw(k), alp6*edmf_a1(k)*edmf_w1(k))/bv, zwk) -! elf = elb/(1. + (elb/600.)) !bound free-atmos mixing length to < 600 m. -!orig: tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(vflx,1.0e-4))**onethird),30.),150.) + !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. @@ -1167,12 +1172,12 @@ 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. -!orig: tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(vflx,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),40.)), zwk) @@ -1199,10 +1204,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) -!try squared-blending + !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. @@ -1598,7 +1604,7 @@ SUBROUTINE mym_turbulence ( & & kts,kte, & & closure, & & dz, dx, zw, & - & u, v, thl, ql, qw, & + & u, v, thl, thetav, ql, qw, & & qke, tsq, qsq, cov, & & vt, vq, & & rmo, flt, flq, & @@ -1627,7 +1633,7 @@ SUBROUTINE mym_turbulence ( & 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 @@ -1664,7 +1670,7 @@ SUBROUTINE mym_turbulence ( & INTEGER, INTENT(IN) :: spp_pbl REAL, DIMENSION(KTS:KTE) :: rstoch_col REAL :: Prnum - REAL, PARAMETER :: Prlimit = 10.0 + REAL, PARAMETER :: Prlimit = 5.0 ! @@ -1682,7 +1688,7 @@ SUBROUTINE mym_turbulence ( & CALL mym_level2 (kts,kte, & & dz, & - & u, v, thl, qw, & + & u, v, thl, theta, qw, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! @@ -1706,15 +1712,10 @@ SUBROUTINE mym_turbulence ( & elsq = el (k)**2 q3sq = qkw(k)**2 q2sq = b1*elsq*( sm(k)*gm(k)+sh(k)*gh(k) ) - !Remove possiblity of contamination due to spikes, but - !allow for very large variations - no impact on idealized cases -! elsq = MIN(MAX(elsq,0.1), 160000.) !max el = 400 m -! q3sq = MIN(MAX(q3sq,0.01), 75.) !max tke = 75 m2/s2 -! q2sq = MIN(MAX(q2sq,0.01), 75.) - !end constraints - sh20 = MAX(sh(k), 1e-6) - sm20 = MAX(sm(k), 1e-6) - sh(k)= MAX(sh(k), 1e-6) + + sh20 = MAX(sh(k), 1e-5) + sm20 = MAX(sm(k), 1e-5) + sh(k)= MAX(sh(k), 1e-5) !Canuto/Kitamura mod duz = ( u(k)-u(k-1) )**2 +( v(k)-v(k-1) )**2 @@ -1732,7 +1733,7 @@ SUBROUTINE mym_turbulence ( & !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.8 + 4.0*MAX(ri,-0.013), Prlimit) + Prnum = MIN(0.76 + 4.0*MAX(ri,0.0), Prlimit) ! ! Modified: Dec/22/2005, from here, (dlsq -> elsq) gmel = gm (k)*elsq @@ -1761,9 +1762,26 @@ SUBROUTINE mym_turbulence ( & IF ( q3sq .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 @@ -1775,12 +1793,9 @@ SUBROUTINE mym_turbulence ( & e4 = e1 - e4c*ghel*a2fac * qdiv**2 eden = e2*e4 + e3*e5c*gmel * qdiv**2 eden = MAX( eden, 1.0d-20 ) - - !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 + !!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 @@ -1804,7 +1819,7 @@ SUBROUTINE mym_turbulence ( & sm(k) = Prnum*sh(k) END IF !end Helfand & Labraga check - !Impose broad limits on Sh and Sm from HL88: + !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) @@ -1815,8 +1830,8 @@ SUBROUTINE mym_turbulence ( & ! HL88 , lev2.5 criteria from eqs. 3.17, 3.19, & 3.20 IF ( debug_code ) THEN IF ((sh(k)sh25max .OR. sm(k)>sm25max) .AND. ri < 0.5) THEN - print*,"MYNN; mym_turbulence2.5: k=",k + 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) @@ -1829,12 +1844,12 @@ SUBROUTINE mym_turbulence ( & ENDIF ENDIF - !Enforce 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) + !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 ( closure .GE. 3.0 ) THEN @@ -1909,8 +1924,8 @@ SUBROUTINE mym_turbulence ( & !JOE: test dynamic limits clow = q3sq*( 0.12-cw25 )*eden/wden cupp = q3sq*( 0.76-cw25 )*eden/wden -!JOE clow = q3sq*( Rsl -cw25 )*eden/wden -!JOE cupp = q3sq*( Rsl2-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 ) @@ -1984,10 +1999,6 @@ SUBROUTINE mym_turbulence ( & gamq = 0.0 gamv = 0.0 END IF - -! Prandtl number limit -! Prlimit = 4.0 -! IF (sm(k) > sh(k)*Prlimit) sm(k) = sh(k)*Prlimit ! ! Add min background stability function (diffusivity) within model levels ! with active plumes and low cloud fractions. @@ -2059,7 +2070,6 @@ SUBROUTINE mym_turbulence ( & !! Buoyncy term takes the TKEprodTD(k) production now qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggared - !! !!!Dissipation Term (now it evaluated on mym_predict) !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE @@ -2301,7 +2311,7 @@ SUBROUTINE mym_predict (kts,kte, & d(kte)=0. ! CALL tridiag(kte,a,b,c,d) - CALL tridiag3(kte,a,b,c,d,x) + CALL tridiag2(kte,a,b,c,d,x) DO k=kts,kte ! qke(k)=max(d(k-kts+1), 1.e-4) @@ -2357,9 +2367,9 @@ SUBROUTINE mym_predict (kts,kte, & c(kte)=0. d(kte)=0. - !CALL tridiag(kte,a,b,c,d) - CALL tridiag3(kte,a,b,c,d,x) - +! CALL tridiag(kte,a,b,c,d) + CALL tridiag2(kte,a,b,c,d,x) + DO k=kts,kte !qsq(k)=d(k-kts+1) qsq(k)=MAX(x(k),1e-12) @@ -2421,10 +2431,10 @@ SUBROUTINE mym_predict (kts,kte, & b(kte)=1. c(kte)=0. d(kte)=0. - -! CALL tridiag(kte,a,b,c,d) - CALL tridiag3(kte,a,b,c,d,x) +! CALL tridiag(kte,a,b,c,d) + CALL tridiag2(kte,a,b,c,d,x) + DO k=kts,kte ! tsq(k)=d(k-kts+1) tsq(k)=x(k) @@ -2471,8 +2481,8 @@ SUBROUTINE mym_predict (kts,kte, & d(kte)=0. ! CALL tridiag(kte,a,b,c,d) - CALL tridiag3(kte,a,b,c,d,x) - + CALL tridiag2(kte,a,b,c,d,x) + DO k=kts,kte ! cov(k)=d(k-kts+1) cov(k)=x(k) @@ -2580,14 +2590,14 @@ SUBROUTINE mym_condensation (kts,kte, & REAL :: erf - !VARIABLES FOR ALTERNATIVE SIMGA + !VARIABLES FOR ALTERNATIVE SIGMA REAL::dth,dtl,dqw,dzk,els REAL, DIMENSION(kts:kte), INTENT(IN) :: Sh,el !variables for SGS BL clouds REAL :: zagl,damp,PBLH2 REAL :: lfac - INTEGER, PARAMETER :: sig_order = 2 !sigma form, 1: use state variables, 2: higher-order variables + 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 @@ -2735,7 +2745,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 @@ -3874,8 +3884,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 @@ -3956,6 +3969,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 !=================== @@ -4678,7 +4700,7 @@ SUBROUTINE mynn_bl_driver( & 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)) + thetav(k)=th(i,k,j)*(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) @@ -4770,17 +4792,17 @@ 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, sm, & - &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,j), zw, & + &u1, v1, thl, sqv, & + &PBLH(i,j), th1, thetav, sh, sm,& + &ust(i,j), rmol(i,j), & + &el, Qke1, Tsq1, Qsq1, Cov1, & + &Psig_bl(i,j), 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 @@ -5203,7 +5225,7 @@ SUBROUTINE mynn_bl_driver( & CALL mym_turbulence ( & &kts,kte,closure, & &dz1, DX(i,j), zw, & - &u1, v1, thl, sqc, sqw, & + &u1, v1, thl, thetav, sqc, sqw, & &qke1, tsq1, qsq1, cov1, & &vt, vq, & &rmol(i,j), flt, flq, & @@ -6313,10 +6335,10 @@ 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 TEST 5/7/20 for accelerating plumes above cloud base, add entrainment +! 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 = ENT * 2.0 + 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 From d35b3d56ac9c07a9899ad78dac6e9f6a8c13c21b Mon Sep 17 00:00:00 2001 From: hannah barnes Date: Fri, 9 Jul 2021 14:39:33 -0600 Subject: [PATCH 25/34] Update of GF aerosol treatment and tunings --- physics/cu_gf_deep.F90 | 181 +++++++++++++++++++++++--------------- physics/cu_gf_driver.F90 | 106 ++++++++++++++++------ physics/cu_gf_driver.meta | 25 ++++++ 3 files changed, 213 insertions(+), 99 deletions(-) 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 157247f6a..025cbf7bd 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,14 +75,14 @@ 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, & dtend,dtidx,ntqv,ntiw,ntcw,index_of_temperature,index_of_x_wind, & - index_of_y_wind,index_of_process_scnv,index_of_process_dcnv, & + index_of_y_wind,index_of_process_scnv,index_of_process_dcnv, & ldiag3d,qci_conv,errmsg,errflg) !------------------------------------------------------------- implicit none @@ -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,14 +107,14 @@ 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 ) :: 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 real(kind=kind_phys), dimension( : , : ), intent(inout ) :: qci_conv @@ -133,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 ! @@ -140,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 @@ -151,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 @@ -179,9 +184,9 @@ 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 @@ -190,7 +195,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & 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) @@ -200,7 +205,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ! qfx2 -- latent heat flux (kg/kg m/s), positive upward from sfc ! 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) trash,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 @@ -280,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 @@ -335,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. @@ -558,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 & @@ -638,7 +660,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & ,dicycle & ,ichoice & ,ipr & - ,ccn & + ,ccn_gf & + ,ccnclean & ,dt & ,0 & @@ -761,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)) @@ -851,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 @@ -893,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 ! @@ -958,7 +1008,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & 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 = (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 @@ -976,7 +1026,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & 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) diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 84db197bc..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 From 3cb6b75726987dfe766ff1b60c32afa20b770f5e Mon Sep 17 00:00:00 2001 From: hannah barnes Date: Mon, 12 Jul 2021 09:38:02 -0600 Subject: [PATCH 26/34] Bug fix --- physics/cu_gf_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 025cbf7bd..d1dd7171a 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -1019,7 +1019,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,cactiv,cactiv_m, & do k=kts,ktf do i=its,itf tem_shal = dt*(outqcs(i,k)*cutens(i)+outqcm(i,k)*cutenm(i)) - tem_deep = dt*(outqc(i,k)*cuten(i)+clw_ten1(k)) + 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) From 42b95180f64684824ef7985b287a4d341b13ecea Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 12 Jul 2021 19:55:14 +0000 Subject: [PATCH 27/34] Bug fixes/clean up: (1) removing doxygen bug, (2) removing j indices from the driver. --- physics/module_bl_mynn.F90 | 678 ++++++++++++++++++------------------- 1 file changed, 333 insertions(+), 345 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 04c6049f5..9f9d69d5d 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -135,11 +135,10 @@ ! 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. -! Not yet: Addition of Greg Thompsons SGS cloud option (bl_mynn_cloudpdf = 3). ! Many miscellaneous tweaks. ! ! Many of these changes are now documented in: -! Olson, J. B., J. S. Kenyon, W. M. Angevine, J. M. Brown, M. Pagowski, and K. Sušelj, 2019: +! 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, @@ -933,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) @@ -4444,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,& + 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 - 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 @@ -4476,33 +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,KMS:KME) :: & + !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), INTENT(inout) :: & - &Pblh,wstar,delta,rmol + REAL, DIMENSION(IMS:IME), INTENT(inout) :: Pblh,wstar,delta,rmol - REAL, DIMENSION(IMS:IME,JMS:JME) :: & - &Psig_bl,Psig_shcu + REAL, DIMENSION(IMS:IME) :: Psig_bl,Psig_shcu - INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: & + 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), optional :: & + 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 @@ -4510,9 +4507,9 @@ 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,jms:jme), INTENT(IN), OPTIONAL ::FRP_MEAN,EMIS_ANT_NO + 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 @@ -4550,15 +4547,15 @@ SUBROUTINE mynn_bl_driver( & & th_sfc,ztop_plume,sqc9,sqi9 !JOE-top-down diffusion - REAL, DIMENSION(ITS:ITE,JTS:JTE) :: maxKHtopdown + REAL, DIMENSION(ITS:ITE) :: maxKHtopdown REAL,DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD !JOE-end top down 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 @@ -4596,19 +4593,21 @@ 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,jts:jte)=0. + maxKHtopdown(its:ite)=0. IF (bl_mynn_edmf_dd > 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. + 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 ! DH* CHECK HOW MUCH OF THIS INIT IF-BLOCK IS ACTUALLY NEEDED FOR RESTARTS @@ -4620,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 @@ -4633,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 @@ -4665,55 +4664,50 @@ SUBROUTINE mynn_bl_driver( & 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.608*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 @@ -4723,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) @@ -4740,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 @@ -4794,12 +4788,12 @@ SUBROUTINE mynn_bl_driver( & !! within mym_initialize(): mym_level2() and mym_length(). CALL mym_initialize ( & &kts,kte, & - &dz1, dx(i,j), zw, & + &dz1, dx(i), zw, & &u1, v1, thl, sqv, & - &PBLH(i,j), th1, thetav, sh, sm,& - &ust(i,j), rmol(i,j), & + &PBLH(i), th1, thetav, sh, sm, & + &ust(i), rmol(i), & &el, Qke1, Tsq1, Qsq1, Cov1, & - &Psig_bl(i,j), cldfra_bl1D, & + &Psig_bl(i), cldfra_bl1D, & &bl_mynn_mixlength, & &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf,& &INITIALIZE_QKE, & @@ -4808,32 +4802,33 @@ SUBROUTINE mynn_bl_driver( & 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 @@ -4844,20 +4839,19 @@ 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 @@ -4866,17 +4860,17 @@ SUBROUTINE mynn_bl_driver( & 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 @@ -4885,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 @@ -4902,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) @@ -4920,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)) + 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 @@ -4951,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 @@ -5009,12 +5003,12 @@ SUBROUTINE mynn_bl_driver( & 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 @@ -5034,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. @@ -5068,51 +5062,51 @@ 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 ) + !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,j)/rho1(kts) - flqc = -vdfg(i,j)*(sqc(kts) - sqcg ) - th_sfc = ts(i,j)/ex1(kts) + 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,j)/(rho1(kts)*cpm )-xlvcp*flqc/exner(i,kts,j) !! Temperature flux + 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,j) = -vk*gtr*fltv/max(ust(i,j)**3,1.0e-6) - zet = 0.5*dz(i,kts,j)*rmol(i,j) + 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 @@ -5137,31 +5131,31 @@ SUBROUTINE mynn_bl_driver( & !! 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 !! \p bl_mynn_topdown =1. IF (bl_mynn_topdown.eq.1)then - CALL topdown_cloudrad(kts,kte,dz1,zw, & - &xland(i,j),kpbl(i,j),PBLH(i,j), & - &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & - &cldfra_bl1D,rthraten, & - &maxKHtopdown(i,j),KHtopdown,TKEprodTD ) + 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 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, & @@ -5171,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, & @@ -5198,9 +5192,9 @@ SUBROUTINE mynn_bl_driver( & & 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, & + & Psig_shcu(i), & + & nupdraft(i),ktop_plume(i), & + & maxmf(i),ztop_plume, & & spp_pbl,rstoch_col ) ENDIF @@ -5208,8 +5202,8 @@ SUBROUTINE mynn_bl_driver( & CALL DDMF_JPL(kts,kte,delt,zw,dz1,p1, & &u1,v1,th1,thl,thetav,tk1, & sqw,sqv,sqc,rho1,ex1, & - &ust(i,j),flt,flq, & - &PBLH(i,j),KPBL(i,j), & + &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, & @@ -5217,26 +5211,26 @@ SUBROUTINE mynn_bl_driver( & &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1, & &sd_awqke1, & &qc_bl1d,cldfra_bl1d, & - &rthraten(i,:,j) ) + &rthraten(i,:) ) ENDIF !> - Call mym_turbulence() to collect the necessary variable !! to carry out successive claculations. CALL mym_turbulence ( & &kts,kte,closure, & - &dz1, DX(i,j), zw, & + &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, & + &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, & @@ -5247,7 +5241,7 @@ SUBROUTINE mynn_bl_driver( & !! for the following time step. CALL mym_predict (kts,kte,closure, & &delt, dz1, & - &ust(i,j), flt, flq, pmz, phh, & + &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,& @@ -5266,19 +5260,19 @@ SUBROUTINE mynn_bl_driver( & &delt, dz1, rho1, & &u1, v1, th1, tk1, qv1, & &qc1, qi1, qnc1, qni1, & - &ps(i,j), p1, ex1, thl, & + &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, & @@ -5297,32 +5291,32 @@ 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 ( mynn_chem_vertmx ) THEN - CALL mynn_mix_chem(kts,kte,i,j, & - grav_settling, & - delt, dz1, pblh(i,j), & - nchem, kdvel, ndvel, num_vert_mix, & - chem1, vd1, & - qnc1,qni1, & - p1, ex1, thl, sqv, sqc, sqi, sqw,& - rho1, ust(i,j),flt,flq,flqv,flqc,& - wspd(i,j),qcg(i,j), & - tcd, qcd, & - &dfm, dfh, dfq, & + 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, & - EMIS_ANT_NO(i,j), & - FRP_MEAN(i,j), & + & 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,j,ic) = chem1(k,ic) + chem3d(i,k,ic) = chem1(k,ic) ENDDO ENDDO ENDIF @@ -5335,29 +5329,29 @@ SUBROUTINE mynn_bl_driver( & !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) @@ -5367,34 +5361,34 @@ 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 @@ -5402,23 +5396,23 @@ SUBROUTINE mynn_bl_driver( & !! 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,j)**3*phi_m/(vk*dz(i,k,j)))-qSHEAR1(k+1) !! staggered - qBUOY1(k)=4.*(-ust(i,j)**3*zet/(vk*dz(i,k,j)))-qBUOY1(k+1) !! staggered + 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,j)=0.5*(qSHEAR1(k)+qSHEAR1(k+1)) !!! unstaggering in z - qBUOY(i,k,j)=0.5*(qBUOY1(k)+qBUOY1(k+1)) !!! unstaggering in z - qWT(i,k,j)=qWT1(k) - qDISS(i,k,j)=qDISS1(k) - dqke(i,k,j)=(qke1(k)-dqke(i,k,j))*0.5/delt + 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,j)=0. - qBUOY(i,k,j)=0. - qWT(i,k,j)=0. - qDISS(i,k,j)=0. - dqke(i,k,j)=0. + qSHEAR(i,k)=0. + qBUOY(i,k)=0. + qWT(i,k)=0. + qDISS(i,k)=0. + dqke(i,k)=0. ENDIF !update updraft properties @@ -5450,36 +5444,36 @@ SUBROUTINE mynn_bl_driver( & 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 @@ -5487,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 @@ -5533,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) @@ -5548,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 @@ -5695,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 @@ -7694,7 +7682,7 @@ SUBROUTINE topdown_cloudrad(kts,kte,dz1,zw,xland,kpbl,PBLH, & zl1 = dz1(kts) k = MAX(kpbl-1, kminrad-1) !Best estimate of height of TKE source (top of downdrafts): - !zminrad = 0.5*pblh(i,j) + 0.5*zminrad + !zminrad = 0.5*pblh(i) + 0.5*zminrad templ=thl(k)*ex1(k) !rvls is ws at full level From e2126f1c3a09ee160b7c545b018271a4ac6c8b30 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 12 Jul 2021 20:00:33 +0000 Subject: [PATCH 28/34] Bug fixes - removing a 2nd doxygen bug --- physics/module_bl_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 9f9d69d5d..694a4a0d6 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -142,7 +142,7 @@ ! 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, -! Otávio C. Acevedo, Felipe D. Costa, and Vagner Anabor, 2020: Turbulent Kinetic Energy +! 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. !------------------------------------------------------------------- From 9a1dc8d8cdb4cce79c6d678ebb64b184310c694d Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 12 Jul 2021 20:03:04 +0000 Subject: [PATCH 29/34] Bug fixes - removing a 3rd doxygen bug --- physics/module_bl_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 694a4a0d6..0daad2442 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -7535,7 +7535,7 @@ 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 + !! 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)]. From 3fe76cad35ff409b30f80f0a1003e19bc8ac55b7 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 12 Jul 2021 20:06:23 +0000 Subject: [PATCH 30/34] Bug fixes - complaining about comments again... --- physics/module_bl_mynn.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 0daad2442..1506691c7 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -7533,12 +7533,12 @@ 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)]. + ! 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 From a5909a7e49aa448959881a27bd4dabf9e8688d01 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 12 Jul 2021 20:23:08 +0000 Subject: [PATCH 31/34] more doxygen complaints (I think), but they dont make sense. Testing changes by trial and error... --- physics/module_bl_mynn.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 1506691c7..66d3cc962 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -7536,8 +7536,8 @@ 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 + ! 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 @@ -7571,7 +7571,7 @@ FUNCTION phim(zet) dummy_0 = zet**2 dummy_1 = 1./(1.+dummy_0) ! denon - dummy_11 = 2.*zet ! ddenon/dzet + 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 @@ -7585,12 +7585,12 @@ 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)]. + ! 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 From c127524cd6938bf1a867a9e12ee43e2db873526b Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 12 Jul 2021 20:25:10 +0000 Subject: [PATCH 32/34] more doxygen complaints (I think), but they dont make sense. Testing changes by trial and error... --- physics/module_bl_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 66d3cc962..82d23bf57 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -7587,7 +7587,7 @@ 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 + ! 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)]. From adf420e50e183c8e175847255e62201cdfbac9b3 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 12 Jul 2021 20:27:40 +0000 Subject: [PATCH 33/34] fix spelling --- physics/module_bl_mynn.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 82d23bf57..36bb3d0e2 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -2060,7 +2060,7 @@ SUBROUTINE mym_turbulence ( & !!!Shear Term !!!qSHEAR1D(k)=-(upwp*dudz + vpwp*dvdz) - qSHEAR1D(k) = elq*sm(k)*gm(k) !staggared + qSHEAR1D(k) = elq*sm(k)*gm(k) !staggered !!!Buoyancy Term !!!qBUOY1D(k)=g*Tpwp/thl(k) @@ -2068,7 +2068,7 @@ SUBROUTINE mym_turbulence ( & !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) !staggared + qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered !!!Dissipation Term (now it evaluated on mym_predict) !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE @@ -2332,7 +2332,7 @@ SUBROUTINE mym_predict (kts,kte, & 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) !unstaggared + 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 From da8a13a62ab872aded4907e9bc5fcf15852267e5 Mon Sep 17 00:00:00 2001 From: hannah barnes Date: Mon, 12 Jul 2021 14:57:17 -0600 Subject: [PATCH 34/34] Remove unneeded variable --- physics/cu_gf_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index d1dd7171a..4579ed88d 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -205,7 +205,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,cactiv,cactiv_m, & ! qfx2 -- latent heat flux (kg/kg m/s), positive upward from sfc ! 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) trash,tem,tem1,tf,tcr,tcrf + 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