diff --git a/CMakeLists.txt b/CMakeLists.txt index cd0d1c6d9..5e0175d0c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -173,15 +173,17 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_sh.F90 ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bl_mynn.F90 ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNPBL_wrapper.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNSFC_wrapper.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_pre.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_post.F90 ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-r8 -ftz") + # Reduce optimization for module_sf_mynn.F90 (to avoid an apparent compiler bug with Intel 18 on Hera) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 + PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_OPT} -O1") + list(APPEND SCHEMES_SFX_OPT ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90) + # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I for certain files set(CMAKE_Fortran_FLAGS_LOPT1 ${CMAKE_Fortran_FLAGS_OPT}) string(REPLACE "-xHOST" "-xCORE-AVX-I" diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 1622f4b52..bfe97bc70 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -11,23 +11,21 @@ end subroutine GFS_DCNV_generic_pre_init subroutine GFS_DCNV_generic_pre_finalize() end subroutine GFS_DCNV_generic_pre_finalize -#if 0 !> \brief Interstitial scheme called prior to any deep convective scheme to save state variables for calculating tendencies after the deep convective scheme is executed !! \section arg_table_GFS_DCNV_generic_pre_run Argument Table !! \htmlinclude GFS_DCNV_generic_pre_run.html !! -#endif - subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, cplchm, & - gu0, gv0, gt0, gq0_water_vapor, & - save_u, save_v, save_t, save_qv, ca_deep, & - dqdti, errmsg, errflg) + 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) use machine, only: kind_phys implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d, do_cnvgwd, cplchm + 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 @@ -36,7 +34,6 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, cplchm, 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(im), intent(in) :: ca_deep ! dqdti only allocated if cplchm is .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti character(len=*), intent(out) :: errmsg @@ -65,7 +62,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, cplchm, enddo endif - if (ldiag3d .or. cplchm) then + if ((ldiag3d.and.qdiag3d) .or. cplchm) then do k=1,levs do i=1,im save_qv(i,k) = gq0_water_vapor(i,k) @@ -94,19 +91,20 @@ 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, save_qv, gu0, gv0, gt0, & - gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & - rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & - cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, & - errmsg, errflg) + subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cscnv, & + frain, rain1, dtf, cld1d, save_u, save_v, save_t, save_qv, gu0, gv0, gt0, & + gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & + rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & + cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, errmsg, errflg) + use machine, only: kind_phys implicit none integer, intent(in) :: im, levs - 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 real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d @@ -165,11 +163,10 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, cldwrk (i) = cldwrk (i) + cld1d(i) * dtf enddo - if (ldiag3d) then + 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 -! dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k)-save_qv(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 @@ -178,6 +175,13 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, ! 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 + endif endif ! if (ldiag3d) endif ! if (lssav) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index f632833f9..aa2c99c6a 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -25,6 +25,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 [do_cnvgwd] standard_name = flag_for_convective_gravity_wave_drag long_name = flag for convective gravity wave drag (gwd) @@ -113,15 +121,6 @@ kind = kind_phys intent = inout optional = F -[ca_deep] - standard_name = fraction_of_cellular_automata_for_deep_convection - long_name = fraction of cellular automata for deep convection - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [dqdti] standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection long_name = instantaneous moisture tendency due to convection @@ -185,6 +184,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 @@ -486,6 +493,13 @@ kind = kind_phys intent = inout optional = F +[flag_for_dcnv_generic_tend] + standard_name = flag_for_generic_deep_convection_tendency + long_name = true if GFS_DCNV_generic should calculate tendencies + 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/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 0915dd170..09c969162 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -18,8 +18,10 @@ end subroutine GFS_GWD_generic_pre_init subroutine GFS_GWD_generic_pre_run( & & im, levs, nmtvr, mntvar, & & oc, oa4, clx, theta, & + & varss, ocss, oa4ss, clxss, & & sigma, gamma, elvmax, lssav, ldiag3d, & - & dtdt, dt3dt, dtf, errmsg, errflg) + & dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, & + & flag_for_gwd_generic_tend, errmsg, errflg) use machine, only : kind_phys implicit none @@ -29,12 +31,13 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(out) :: & & oc(im), oa4(im,4), clx(im,4), & + & varss(:), ocss(:), oa4ss(:,:), clxss(:,:), & & theta(im), sigma(im), gamma(im), elvmax(im) - logical, intent(in) :: lssav, ldiag3d - real(kind=kind_phys), intent(in) :: dtdt(im,levs) + 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(:,:) + real(kind=kind_phys), intent(inout) :: dt3dt(:,:), du3dt(:,:), dv3dt(:,:) real(kind=kind_phys), intent(in) :: dtf character(len=*), intent(out) :: errmsg @@ -80,6 +83,26 @@ subroutine GFS_GWD_generic_pre_run( & clx(:,2) = 0.0 clx(:,3) = 0.0 clx(:,4) = 0.0 + elseif (nmtvr == 24) then ! GSD_drag_suite + oc(:) = mntvar(:,2) + oa4(:,1) = mntvar(:,3) + oa4(:,2) = mntvar(:,4) + oa4(:,3) = mntvar(:,5) + oa4(:,4) = mntvar(:,6) + clx(:,1) = mntvar(:,7) + clx(:,2) = mntvar(:,8) + clx(:,3) = mntvar(:,9) + clx(:,4) = mntvar(:,10) + varss(:) = mntvar(:,15) + ocss(:) = mntvar(:,16) + oa4ss(:,1) = mntvar(:,17) + oa4ss(:,2) = mntvar(:,18) + oa4ss(:,3) = mntvar(:,19) + oa4ss(:,4) = mntvar(:,20) + clxss(:,1) = mntvar(:,21) + clxss(:,2) = mntvar(:,22) + clxss(:,3) = mntvar(:,23) + clxss(:,4) = mntvar(:,24) else oc = 0 oa4 = 0 @@ -91,10 +114,12 @@ subroutine GFS_GWD_generic_pre_run( & endif ! end if_nmtvr if (lssav) then - if (ldiag3d) 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 endif @@ -125,12 +150,12 @@ 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, errmsg, errflg) + & dugwd, dvgwd, du3dt, dv3dt, dt3dt, flag_for_gwd_generic_tend, errmsg, errflg) use machine, only : kind_phys implicit none - logical, intent(in) :: lssav, ldiag3d + logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend real(kind=kind_phys), intent(in) :: dusfcg(:), dvsfcg(:) real(kind=kind_phys), intent(in) :: dudt(:,:), dvdt(:,:), dtdt(:,:) @@ -150,7 +175,7 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d dugwd(:) = dugwd(:) + dusfcg(:)*dtf dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf - if (ldiag3d) then + if (ldiag3d .and. flag_for_gwd_generic_tend) then du3dt(:,:) = du3dt(:,:) + dudt(:,:) * dtf dv3dt(:,:) = dv3dt(:,:) + dvdt(:,:) * dtf dt3dt(:,:) = dt3dt(:,:) + dtdt(:,:) * dtf diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 94a4abab1..7f987f28f 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -66,6 +66,42 @@ kind = kind_phys intent = out optional = F +[varss] + standard_name = standard_deviation_of_subgrid_orography_small_scale + long_name = standard deviation of subgrid orography small scale + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ocss] + standard_name = convexity_of_subgrid_orography_small_scale + long_name = convexity of subgrid orography small scale + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[oa4ss] + standard_name = asymmetry_of_subgrid_orography_small_scale + long_name = asymmetry of subgrid orography small scale + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = out + optional = F +[clxss] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = out + optional = F [theta] standard_name = angle_from_east_of_maximum_subgrid_orographic_variations long_name = angle with_respect to east of maximum subgrid orographic variations @@ -118,6 +154,22 @@ type = logical intent = in optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout [dtdt] standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature @@ -127,6 +179,22 @@ 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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout [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 @@ -145,6 +213,13 @@ kind = kind_phys intent = in optional = F +[flag_for_gwd_generic_tend] + standard_name = flag_for_generic_gravity_wave_drag_tendency + long_name = true if GFS_GWD_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -287,6 +362,12 @@ kind = kind_phys intent = inout optional = F +[flag_for_gwd_generic_tend] + standard_name = flag_for_generic_gravity_wave_drag_tendency + long_name = true if GFS_GWD_generic should calculate tendencies + units = flag + dimensions = () + type = logical [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 291808fb8..73b26c7a3 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -16,17 +16,17 @@ 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, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_q, errmsg, errflg) + 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) ! use machine, only: kind_phys implicit none integer, intent(in) :: im, levs, ntcw, nncl, ntrac - logical, intent(in) :: ldiag3d, do_aw + logical, intent(in) :: ldiag3d, qdiag3d, do_aw 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 + real(kind=kind_phys), dimension(im, levs), intent(inout) :: save_t, save_qv real(kind=kind_phys), dimension(im, levs, ntrac), intent(inout) :: save_q character(len=*), intent(out) :: errmsg @@ -42,12 +42,24 @@ subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, do_aw, ntcw, nncl, ntrac, g do k=1,levs do i=1,im save_t(i,k) = gt0(i,k) - save_q(1:im,:,1) = gq0(1:im,:,1) enddo enddo - do n=ntcw,ntcw+nncl-1 - save_q(1:im,:,n) = gq0(1:im,:,n) - 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) + enddo + enddo + endif + if(do_aw) then + save_q(1:im,:,1) = gq0(1:im,:,1) + do n=ntcw,ntcw+nncl-1 + save_q(1:im,:,n) = gq0(1:im,:,n) + enddo + endif endif end subroutine GFS_MP_generic_pre_run @@ -80,8 +92,8 @@ end subroutine GFS_MP_generic_post_init !! !> \section gfs_mp_gen GFS MP Generic Post General Algorithm !> @{ - subroutine GFS_MP_generic_post_run(im, ix, 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, cplflx, cplchm, con_g, dtf, frain, rainc, rain1, & + 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, & 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, & @@ -92,15 +104,15 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt implicit none - integer, intent(in) :: im, ix, 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, cplflx, cplchm + logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm real(kind=kind_phys), intent(in) :: dtf, frain, con_g real(kind=kind_phys), dimension(im), intent(in) :: rainc, rain1, xlat, xlon, tsfc real(kind=kind_phys), dimension(im), intent(inout) :: ice, snow, graupel real(kind=kind_phys), dimension(im), intent(in) :: rain0, ice0, snow0, graupel0 - real(kind=kind_phys), dimension(ix,nrcm), intent(in) :: rann + 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+1), intent(in) :: prsi, phii real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: gq0 @@ -110,8 +122,9 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt srflag, cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, & totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, & snow_cpl, pwat - ! These arrays are only allocated if ldiag3d is .true. - real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt + + real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt ! only if ldiag3d + real(kind=kind_phys), dimension(:,:), intent(inout) :: dq3dt ! only if ldiag3d and qdiag3d ! Stochastic physics / surface perturbations logical, intent(in) :: do_sppt, ca_global @@ -211,7 +224,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (cal_pre) then ! hchuang: add dominant precipitation type algorithm ! - call calpreciptype (kdt, nrcm, im, ix, levs, levs+1, & + call calpreciptype (kdt, nrcm, im, im, levs, levs+1, & rann, xlat, xlon, gt0, & gq0(:,:,1), prsl, prsi, & rain, phii, tsfc, & ! input @@ -262,9 +275,15 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do k=1,levs do i=1,im dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain -! dq3dt(i,k) = dq3dt(i,k) + (gq0(i,k,1)-save_qv(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 diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index c7082da3a..c4eacb758 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -30,6 +30,14 @@ 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 [do_aw] standard_name = flag_for_Arakawa_Wu_adjustment long_name = flag for Arakawa Wu scale-aware adjustment @@ -89,6 +97,15 @@ 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_dimension,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 @@ -138,14 +155,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [levs] standard_name = vertical_dimension long_name = vertical layer dimension @@ -266,6 +275,14 @@ 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) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index abce53772..77be662fa 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,8 +84,8 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, 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, lheatstrg, z0fac, e0fac, zorl, & - u10m, v10m, hflx, evap, hflxq, evapq, hffac, hefac, errmsg, errflg) + hybedmf, do_shoc, satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q, & + ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -95,33 +95,23 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, 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 + 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 - real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs + real(kind=kind_phys), dimension(im, levs), intent(in) :: ugrs, vgrs, tgrs real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra - - ! For canopy heat storage - logical, intent(in) :: lheatstrg - real(kind=kind_phys), intent(in) :: z0fac, e0fac - real(kind=kind_phys), dimension(im), intent(in) :: zorl, u10m, v10m - real(kind=kind_phys), dimension(im), intent(in) :: hflx, evap - real(kind=kind_phys), dimension(im), intent(out) :: hflxq, evapq - real(kind=kind_phys), dimension(im), intent(out) :: hffac, hefac + real(kind=kind_phys), dimension(im, levs), intent(out) :: save_u, save_v, save_t + real(kind=kind_phys), dimension(im, levs, ntrac), intent(out) :: save_q ! CCPP error handling variables character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! Parameters for canopy heat storage parametrization - real (kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 - real (kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 - ! Local variables integer :: i, k, kk, k1, n - real(kind=kind_phys) :: tem, tem1, tem2 ! Initialize CCPP error handling variables errmsg = '' @@ -165,11 +155,13 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,3) = qgrs(i,k,ntiw) vdftra(i,k,4) = qgrs(i,k,ntrw) vdftra(i,k,5) = qgrs(i,k,ntsw) - vdftra(i,k,6) = qgrs(i,k,ntlnc) - vdftra(i,k,7) = qgrs(i,k,ntinc) - vdftra(i,k,8) = qgrs(i,k,ntoz) - vdftra(i,k,9) = qgrs(i,k,ntwa) - vdftra(i,k,10) = qgrs(i,k,ntia) + vdftra(i,k,6) = qgrs(i,k,ntgl) + vdftra(i,k,7) = qgrs(i,k,ntlnc) + vdftra(i,k,8) = qgrs(i,k,ntinc) + vdftra(i,k,9) = qgrs(i,k,ntrnc) + vdftra(i,k,10) = qgrs(i,k,ntoz) + vdftra(i,k,11) = qgrs(i,k,ntwa) + vdftra(i,k,12) = qgrs(i,k,ntia) enddo enddo else @@ -180,8 +172,10 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, vdftra(i,k,3) = qgrs(i,k,ntiw) vdftra(i,k,4) = qgrs(i,k,ntrw) vdftra(i,k,5) = qgrs(i,k,ntsw) - vdftra(i,k,6) = qgrs(i,k,ntinc) - vdftra(i,k,7) = qgrs(i,k,ntoz) + vdftra(i,k,6) = qgrs(i,k,ntgl) + vdftra(i,k,7) = qgrs(i,k,ntinc) + vdftra(i,k,8) = qgrs(i,k,ntrnc) + vdftra(i,k,9) = qgrs(i,k,ntoz) enddo enddo endif @@ -273,33 +267,22 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ! endif -! --- ... Boundary Layer and Free atmospheic turbulence parameterization -! -! in order to achieve heat storage within canopy layer, in the canopy heat -! storage parameterization the kinematic sensible and latent heat fluxes -! (hflx & evap) as surface boundary forcings to the pbl scheme are -! reduced as a function of surface roughness -! - do i=1,im - hflxq(i) = hflx(i) - evapq(i) = evap(i) - hffac(i) = 1.0 - hefac(i) = 1.0 - enddo - if (lheatstrg) then - do i=1,im - tem = 0.01 * zorl(i) ! change unit from cm to m - tem1 = (tem - z0min) / (z0max - z0min) - hffac(i) = z0fac * min(max(tem1, 0.0), 1.0) - tem = sqrt(u10m(i)**2+v10m(i)**2) - tem1 = (tem - u10min) / (u10max - u10min) - tem2 = 1.0 - min(max(tem1, 0.0), 1.0) - hffac(i) = tem2 * hffac(i) - hefac(i) = 1. + e0fac * hffac(i) - hffac(i) = 1. + hffac(i) - hflxq(i) = hflx(i) / hffac(i) - evapq(i) = evap(i) / hefac(i) + if(ldiag3d .and. lssav) then + do k=1,levs + do i=1,im + save_t(i,k) = tgrs(i,k) + save_u(i,k) = ugrs(i,k) + save_v(i,k) = vgrs(i,k) + enddo enddo + if(qdiag3d) then + do k=1,levs + do i=1,im + save_q(i,k,ntqv) = qgrs(i,k,ntqv) + save_q(i,k,ntoz) = qgrs(i,k,ntoz) + enddo + enddo + endif endif end subroutine GFS_PBL_generic_pre_run @@ -325,14 +308,14 @@ 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, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf, shinhong, do_ysu, & - dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & + ltaerosol, cplflx, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, qdiag3d, 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, & + dq3dt_ozone, 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, & - errmsg, errflg) + ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -344,16 +327,24 @@ 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, lsidea + logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu logical, dimension(:), intent(in) :: flag_cice + logical, intent(in) :: flag_for_pbl_generic_tend + real(kind=kind_phys), dimension(im, levs), intent(in) :: save_u, save_v, save_t + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: save_q + real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac real(kind=kind_phys), dimension(:,:), intent(in) :: prsl real(kind=kind_phys), dimension(:), intent(in) :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, & wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1 + + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs + real(kind=kind_phys), dimension(im, levs), intent(in) :: ugrs, vgrs, tgrs + real(kind=kind_phys), dimension(im, levs, nvdiff), intent(in) :: dvdftra real(kind=kind_phys), dimension(im), intent(in) :: dusfc1, dvsfc1, dtsfc1, dqsfc1, xmu real(kind=kind_phys), dimension(im, levs), intent(in) :: dudt, dvdt, dtdt, htrsw, htrlw @@ -456,11 +447,13 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntiw) = dvdftra(i,k,3) dqdt(i,k,ntrw) = dvdftra(i,k,4) dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntlnc) = dvdftra(i,k,6) - dqdt(i,k,ntinc) = dvdftra(i,k,7) - dqdt(i,k,ntoz) = dvdftra(i,k,8) - dqdt(i,k,ntwa) = dvdftra(i,k,9) - dqdt(i,k,ntia) = dvdftra(i,k,10) + dqdt(i,k,ntgl) = dvdftra(i,k,6) + dqdt(i,k,ntlnc) = dvdftra(i,k,7) + dqdt(i,k,ntinc) = dvdftra(i,k,8) + dqdt(i,k,ntrnc) = dvdftra(i,k,9) + dqdt(i,k,ntoz) = dvdftra(i,k,10) + dqdt(i,k,ntwa) = dvdftra(i,k,11) + dqdt(i,k,ntia) = dvdftra(i,k,12) enddo enddo else @@ -471,8 +464,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntiw) = dvdftra(i,k,3) dqdt(i,k,ntrw) = dvdftra(i,k,4) dqdt(i,k,ntsw) = dvdftra(i,k,5) - dqdt(i,k,ntinc) = dvdftra(i,k,6) - dqdt(i,k,ntoz) = dvdftra(i,k,7) + dqdt(i,k,ntgl) = dvdftra(i,k,6) + dqdt(i,k,ntinc) = dvdftra(i,k,7) + dqdt(i,k,ntrnc) = dvdftra(i,k,8) + dqdt(i,k,ntoz) = dvdftra(i,k,9) enddo enddo endif @@ -610,25 +605,30 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqsfci_diag(i) = dqsfc1(i)*hefac(i) enddo - if (ldiag3d) then + if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then if (lsidea) then dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf else do k=1,levs do i=1,im - tem = dtdt(i,k) - (htrlw(i,k)+htrsw(i,k)*xmu(i)) - dt3dt(i,k) = dt3dt(i,k) + tem*dtf + dt3dt(i,k) = dt3dt(i,k) + (tgrs(i,k) - save_t(i,k)) enddo enddo endif do k=1,levs do i=1,im - du3dt_PBL(i,k) = du3dt_PBL(i,k) + dudt(i,k) * dtf - du3dt_OGWD(i,k) = du3dt_OGWD(i,k) - dudt(i,k) * dtf - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + dvdt(i,k) * dtf - dv3dt_OGWD(i,k) = dv3dt_OGWD(i,k) - dvdt(i,k) * dtf + 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 + endif endif endif ! end if_lssav diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index c94d15916..1e08e3ef0 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -307,113 +307,78 @@ kind = kind_phys intent = inout optional = F -[lheatstrg] - standard_name = flag_for_canopy_heat_storage - long_name = flag for canopy heat storage parameterization - units = flag - dimensions = () - type = logical - intent = in - optional = F -[z0fac] - standard_name = surface_roughness_fraction_factor - long_name = surface roughness fraction factor for canopy heat storage parameterization - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[e0fac] - standard_name = latent_heat_flux_fraction_factor_relative_to_sensible_heat_flux - long_name = latent heat flux fraction factor relative to sensible heat flux for canopy heat storage parameterization - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[u10m] - standard_name = x_wind_at_10m - long_name = 10 meter u wind speed +[save_u] + standard_name = x_wind_save + long_name = x-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = in - optional = F -[v10m] - standard_name = y_wind_at_10m - long_name = 10 meter v wind speed +[save_v] + standard_name = y_wind_save + long_name = y-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = in - optional = F -[hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux - units = K m s-1 - dimensions = (horizontal_dimension) +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = in - optional = F -[evap] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux - units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) type = real kind = kind_phys +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical intent = in optional = F -[hflxq] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward sensible heat flux reduced by surface roughness - units = K m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in optional = F -[evapq] - standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward latent heat flux reduced by surface roughness - units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out - optional = F -[hefac] - standard_name = surface_upward_latent_heat_flux_reduction_factor - long_name = surface upward latent heat flux reduction factor from canopy heat storage - units = none - dimensions = (horizontal_dimension) +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out - optional = F -[hffac] - standard_name = surface_upward_sensible_heat_flux_reduction_factor - long_name = surface upward sensible heat flux reduction factor from canopy heat storage - units = none - dimensions = (horizontal_dimension) +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,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 @@ -716,6 +681,13 @@ type = logical 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 + units = flag + dimensions = () + type = logical + intent = in [ldiag3d] standard_name = flag_diagnostics_3D long_name = flag for 3d diagnostic fields @@ -724,6 +696,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 [lsidea] standard_name = flag_idealized_physics long_name = flag for idealized physics @@ -1344,6 +1324,62 @@ kind = kind_phys intent = in optional = F +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys +[save_u] + standard_name = x_wind_save + long_name = x-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys +[save_v] + standard_name = y_wind_save + long_name = y-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys +[save_t] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys +[save_q] + standard_name = tracer_concentration_save + long_name = tracer concentration before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys [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 d8784dc62..ae8fac5f9 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -14,18 +14,18 @@ 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, gt0, gq0_water_vapor, & - save_t, save_qv, errmsg, errflg) + 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) use machine, only: kind_phys implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d - real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, gq0_water_vapor + 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_t, save_qv + real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_u, save_v, save_t, save_qv character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -35,20 +35,22 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, gt0, gq0_water_vapor, & errmsg = '' errflg = 0 - if (ldiag3d) then + if (ldiag3d .and. flag_for_scnv_generic_tend) then do k=1,levs do i=1,im + save_u(i,k) = gu0(i,k) + save_v(i,k) = gv0(i,k) save_t(i,k) = gt0(i,k) enddo enddo - endif -! if (ldiag3d) then -! do k=1,levs -! do i=1,im -! save_qv(i,k) = gq0_water_vapor(i,k) -! enddo -! enddo -! endif + if (qdiag3d) then + do k=1,levs + do i=1,im + save_qv(i,k) = gq0_water_vapor(i,k) + enddo + enddo + endif + endif end subroutine GFS_SCNV_generic_pre_run @@ -68,10 +70,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, cplchm, & - frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, dt3dt, dq3dt, clw, & + subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cplchm, & + frain, gu0, gv0, gt0, gq0_water_vapor, save_u, save_v, save_t, save_qv, dqdti, du3dt, dv3dt, dt3dt, dq3dt, clw, & shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, & rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & + flag_for_scnv_generic_tend, & imfshalcnv, imfshalcnv_sas, imfshalcnv_samf, errmsg, errflg) use machine, only: kind_phys @@ -79,14 +82,14 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & implicit none integer, intent(in) :: im, levs, nn - logical, intent(in) :: lssav, ldiag3d, cplchm + 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) :: gt0, gq0_water_vapor - real(kind=kind_phys), dimension(im,levs), intent(in) :: 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, save_qv ! dqdti, dt3dt, dq3dt, only allocated if ldiag3d == .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti - real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt, dq3dt + real(kind=kind_phys), dimension(:,:), intent(inout) :: du3dt, dv3dt, dt3dt, dq3dt real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw ! Post code for SAS/SAMF @@ -133,16 +136,24 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & endif endif - if (lssav) then + if (lssav .and. flag_for_scnv_generic_tend) then 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 -! dq3dt(i,k) = dq3dt(i,k) + (gq0_water_vapor(i,k) - save_qv(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 + 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 + endif endif - endif ! end if_lssav + endif ! if (cplchm) then do k=1,levs diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 79f4eab11..702fe6df0 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -25,6 +25,32 @@ 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 +[gu0] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [gt0] standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics @@ -43,6 +69,22 @@ kind = kind_phys intent = in optional = F +[save_u] + standard_name = x_wind_save + long_name = x-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[save_v] + standard_name = y_wind_save + long_name = y-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in [save_t] standard_name = air_temperature_save long_name = air temperature before entering a physics scheme @@ -61,6 +103,13 @@ kind = kind_phys intent = inout optional = F +[flag_for_scnv_generic_tend] + standard_name = flag_for_generic_shallow_convection_tendency + long_name = true if GFS_SCNV_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -115,6 +164,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 [ldiag3d] standard_name = flag_diagnostics_3D long_name = flag for 3d diagnostic fields @@ -140,6 +197,24 @@ kind = kind_phys intent = in optional = F +[gu0] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gv0] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [gt0] standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics @@ -158,6 +233,22 @@ kind = kind_phys intent = in optional = F +[save_u] + standard_name = x_wind_save + long_name = x-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[save_v] + standard_name = y_wind_save + long_name = y-wind before entering a physics scheme + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in [save_t] standard_name = air_temperature_save long_name = air temperature before entering a physics scheme @@ -185,8 +276,24 @@ 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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout [dt3dt] - standard_name = cumulative_change_in_temperature_due_to_shal_convection + standard_name = cumulative_change_in_temperature_due_to_shallow_convection long_name = cumulative change in temperature due to shal conv. units = K dimensions = (horizontal_dimension,vertical_dimension) @@ -195,7 +302,7 @@ intent = inout optional = F [dq3dt] - standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shal_convection + 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_dimension,vertical_dimension) @@ -316,6 +423,13 @@ kind = kind_phys intent = inout optional = F +[flag_for_scnv_generic_tend] + standard_name = flag_for_generic_shallow_convection_tendency + long_name = true if GFS_SCNV_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in [imfshalcnv] standard_name = flag_for_mass_flux_shallow_convection_scheme long_name = flag for mass-flux shallow convection scheme diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 4a096449d..d1e42f162 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -227,6 +227,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Tbd%acv' , Tbd%acv) call print_var(mpirank,omprank, blkno, 'Tbd%acvb' , Tbd%acvb) call print_var(mpirank,omprank, blkno, 'Tbd%acvt' , Tbd%acvt) + call print_var(mpirank,omprank, blkno, 'Tbd%hpbl' , Tbd%hpbl) if (Model%do_sppt) then call print_var(mpirank,omprank, blkno, 'Tbd%dtdtr' , Tbd%dtdtr) call print_var(mpirank,omprank, blkno, 'Tbd%dtotprcp' , Tbd%dtotprcp) @@ -296,7 +297,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Diag%dpt2m ', Diag%dpt2m) call print_var(mpirank,omprank, blkno, 'Diag%zlvl ', Diag%zlvl) call print_var(mpirank,omprank, blkno, 'Diag%psurf ', Diag%psurf) - call print_var(mpirank,omprank, blkno, 'Diag%hpbl ', Diag%hpbl) call print_var(mpirank,omprank, blkno, 'Diag%pwat ', Diag%pwat) call print_var(mpirank,omprank, blkno, 'Diag%t1 ', Diag%t1) call print_var(mpirank,omprank, blkno, 'Diag%q1 ', Diag%q1) @@ -312,6 +312,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Diag%tdomzr ', Diag%tdomzr) call print_var(mpirank,omprank, blkno, 'Diag%tdomip ', Diag%tdomip) call print_var(mpirank,omprank, blkno, 'Diag%tdoms ', Diag%tdoms) + ! CCPP/RUC only if (Model%lsm == Model%lsm_ruc) then call print_var(mpirank,omprank, blkno, 'Diag%wet1 ', Sfcprop%wetness) else @@ -347,16 +348,23 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, if(Model%lradar) then call print_var(mpirank,omprank, blkno, 'Diag%refl_10cm ', Diag%refl_10cm) end if + ! CCPP/MYNNPBL only if (Model%do_mynnedmf) then - call print_var(mpirank,omprank, blkno, 'Diag%edmf_a ', Diag%edmf_a) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_w ', Diag%edmf_w) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_qt ', Diag%edmf_qt) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_thl ', Diag%edmf_thl) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_ent ', Diag%edmf_ent) - call print_var(mpirank,omprank, blkno, 'Diag%edmf_qc ', Diag%edmf_qc) + if (Model%bl_mynn_output .ne. 0) then + call print_var(mpirank,omprank, blkno, 'Diag%edmf_a ', Diag%edmf_a) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_w ', Diag%edmf_w) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_qt ', Diag%edmf_qt) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_thl ', Diag%edmf_thl) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_ent ', Diag%edmf_ent) + call print_var(mpirank,omprank, blkno, 'Diag%edmf_qc ', Diag%edmf_qc) + call print_var(mpirank,omprank, blkno, 'Diag%sub_thl ', Diag%sub_thl) + call print_var(mpirank,omprank, blkno, 'Diag%sub_sqv ', Diag%sub_sqv) + call print_var(mpirank,omprank, blkno, 'Diag%det_thl ', Diag%det_thl) + call print_var(mpirank,omprank, blkno, 'Diag%det_sqv ', Diag%det_sqv) + end if call print_var(mpirank,omprank, blkno, 'Diag%nupdraft ', Diag%nupdraft) call print_var(mpirank,omprank, blkno, 'Diag%maxMF ', Diag%maxMF) - call print_var(mpirank,omprank, blkno, 'Diag%ktop_shallow', Diag%ktop_shallow) + call print_var(mpirank,omprank, blkno, 'Diag%ktop_plume ', Diag%ktop_plume) call print_var(mpirank,omprank, blkno, 'Diag%exch_h ', Diag%exch_h) call print_var(mpirank,omprank, blkno, 'Diag%exch_m ', Diag%exch_m) end if diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index ac2ccbf3c..199cc362c 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -5,7 +5,7 @@ standard_name = GFS_data_type_instance_all_blocks long_name = Fortran DDT containing FV3-GFS data units = DDT - dimensions = (ccpp_block_number) + dimensions = (ccpp_block_count) type = GFS_data_type intent = inout optional = F @@ -21,7 +21,7 @@ standard_name = GFS_interstitial_type_instance_all_threads long_name = Fortran DDT containing FV3-GFS interstitial data units = DDT - dimensions = (ccpp_thread_number) + dimensions = (omp_threads) type = GFS_interstitial_type intent = inout optional = F @@ -81,7 +81,7 @@ standard_name = GFS_data_type_instance_all_blocks long_name = Fortran DDT containing FV3-GFS data units = DDT - dimensions = (ccpp_block_number) + dimensions = (ccpp_block_count) type = GFS_data_type intent = inout optional = F diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 381930d49..d0826eb17 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -21,6 +21,7 @@ end subroutine GFS_rrtmg_pre_init subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & Radtend, & ! input/output + imfdeepcnv, imfdeepcnv_gf, & f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only lm, im, lmk, lmp, & ! input kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output @@ -50,7 +51,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & epsm1 => con_epsm1, & & fvirt => con_fvirt & &, rog => con_rog & - &, rocp => con_rocp + &, rocp => con_rocp & + &, con_rd use radcons, only: itsfc,ltp, lextop, qmin, & qme5, qme6, epsq, prsmin use funcphys, only: fpvs @@ -70,6 +72,13 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & proflw_type, NBDLW use surface_perturbation, only: cdfnor + ! For Thompson MP + use module_mp_thompson, only: calc_effectRad, Nt_c + use module_mp_thompson_make_number_concentrations, only: & + make_IceNumber, & + make_DropletNumber, & + make_RainNumber + implicit none type(GFS_control_type), intent(in) :: Model @@ -82,6 +91,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input type(GFS_coupling_type), intent(in) :: Coupling integer, intent(in) :: im, lm, lmk, lmp + integer, intent(in) :: imfdeepcnv, imfdeepcnv_gf integer, intent(out) :: kd, kt, kb ! F-A mp scheme only @@ -123,11 +133,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW), intent(out) :: faerlw3 real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(out) :: aerodp - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds2 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds3 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds4 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds5 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(inout) :: clouds1 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(inout) :: clouds2 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(inout) :: clouds3 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(inout) :: clouds4 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(inout) :: clouds5 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds6 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds7 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds8 @@ -142,7 +152,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer, intent(out) :: errflg ! Local variables - integer :: me, nfxr, ntrac, ntcw, ntiw, ncld, ntrw, ntsw, ntgl, ncndl + integer :: me, nfxr, ntrac, ntcw, ntiw, ncld, ntrw, ntsw, ntgl, ncndl, ntlnc, ntinc, ntwa integer :: i, j, k, k1, k2, lsk, lv, n, itop, ibtc, LP1, lla, llb, lya, lyb @@ -154,7 +164,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & cldcov, deltaq, cnvc, cnvw, & - effrl, effri, effrr, effrs + effrl, effri, effrr, effrs, rho, orho + ! for Thompson MP + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & + re_cloud, re_ice, re_snow, qv_mp, qc_mp, & + qi_mp, qs_mp, nc_mp, ni_mp, nwfa real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db ! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz @@ -165,6 +179,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw + + real(kind=kind_phys) :: qvs ! !===> ... begin here ! @@ -180,10 +196,13 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input NTRAC = Model%ntrac ! tracers in grrad strip off sphum - start tracer1(2:NTRAC) ntcw = Model%ntcw ntiw = Model%ntiw + ntlnc = Model%ntlnc + ntinc = Model%ntinc ncld = Model%ncld ntrw = Model%ntrw ntsw = Model%ntsw ntgl = Model%ntgl + ntwa = Model%ntwa ncndl = min(Model%ncnd,4) LP1 = LM + 1 ! num of in/out levels @@ -256,6 +275,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input plyr(i,k1) = Statein%prsl(i,k2) * 0.01 ! pa to mb (hpa) tlyr(i,k1) = Statein%tgrs(i,k2) prslk1(i,k1) = Statein%prslk(i,k2) + rho(i,k1) = plyr(i,k1)/(con_rd*tlyr(i,k1)) + orho(i,k1) = 1.0/rho(i,k1) !> - Compute relative humidity. es = min( Statein%prsl(i,k2), fpvs( Statein%tgrs(i,k2) ) ) ! fpvs and prsl in pa @@ -552,9 +573,36 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water ccnd(i,k,2) = tracer1(i,k,ntiw) ! ice water ccnd(i,k,3) = tracer1(i,k,ntrw) ! rain water - ccnd(i,k,4) = tracer1(i,k,ntsw) + tracer1(i,k,ntgl) ! snow + grapuel + ccnd(i,k,4) = tracer1(i,k,ntsw) + tracer1(i,k,ntgl) ! snow + graupel enddo enddo + ! for Thompson MP - prepare variables for calc_effr + if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then + do k=1,LMK + do i=1,IM + qvs = Statein%qgrs(i,k,1) + qv_mp (i,k) = qvs/(1.-qvs) + qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) + qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) + qs_mp (i,k) = tracer1(i,k,ntsw)/(1.-qvs) + nc_mp (i,k) = tracer1(i,k,ntlnc)/(1.-qvs) + ni_mp (i,k) = tracer1(i,k,ntinc)/(1.-qvs) + nwfa (i,k) = tracer1(i,k,ntwa) + enddo + enddo + elseif (Model%imp_physics == Model%imp_physics_thompson) then + do k=1,LMK + do i=1,IM + qvs = Statein%qgrs(i,k,1) + qv_mp (i,k) = qvs/(1.-qvs) + qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) + qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) + qs_mp (i,k) = tracer1(i,k,ntsw)/(1.-qvs) + nc_mp (i,k) = nt_c*orho(i,k1) + ni_mp (i,k) = tracer1(i,k,ntinc)/(1.-qvs) + enddo + enddo + endif endif do n=1,ncndl do k=1,LMK @@ -563,7 +611,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo enddo - if (Model%imp_physics == 11 ) then + if (Model%imp_physics == Model%imp_physics_gfdl ) then if (.not. Model%lgfdlmprad) then @@ -613,7 +661,23 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo endif elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP - cldcov(1:IM,1+kd:LM+kd) = tracer1(1:IM,1:LM,Model%ntclamt) + if (Model%do_mynnedmf .and. Model%kdt>1) THEN + do k=1,lm + k1 = k + kd + do i=1,im + if (tracer1(i,k1,ntrw)>1.0e-7 .OR. tracer1(i,k1,ntsw)>1.0e-7) then + ! GFDL cloud fraction + cldcov(i,k1) = tracer1(I,k1,Model%ntclamt) + else + ! MYNN sub-grid cloud fraction + cldcov(i,k1) = clouds1(i,k1) + endif + enddo + enddo + else + ! GFDL cloud fraction + cldcov(1:IM,1+kd:LM+kd) = tracer1(1:IM,1:LM,Model%ntclamt) + endif if(Model%effr_in) then do k=1,lm k1 = k + kd @@ -635,7 +699,58 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo endif - else ! neither of the other two cases + elseif (Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP + ! + ! Compute effective radii for QC, QI, QS with (GF, MYNN) or without (all others) sub-grid clouds + ! + ! Update number concentration, consistent with sub-grid clouds (GF, MYNN) or without (all others) + do k=1,lm + do i=1,im + if (Model%ltaerosol .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then + nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)) * orho(i,k) + endif + if (qi_mp(i,k)>1.e-12 .and. ni_mp(i,k)<100.) then + ni_mp(i,k) = make_IceNumber(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k) + endif + end do + end do + ! Call Thompson's subroutine to compute effective radii + do i=1,im + ! Effective radii [m] are now intent(out), bounds applied in calc_effectRad + !tgs: progclduni has different limits for ice radii (10.0-150.0) than + ! calc_effectRad (4.99-125.0 for WRFv3.8.1; 2.49-125.0 for WRFv4+) + ! it will raise the low limit from 5 to 10, but the high limit will remain 125. + call calc_effectRad (tlyr(i,:), plyr(i,:), qv_mp(i,:), qc_mp(i,:), & + nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & + re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, lm ) + end do + ! Scale Thompson's effective radii from meter to micron + do k=1,lm + do i=1,im + re_cloud(i,k) = re_cloud(i,k)*1.e6 + re_ice(i,k) = re_ice(i,k)*1.e6 + re_snow(i,k) = re_snow(i,k)*1.e6 + end do + end do + do k=1,lm + k1 = k + kd + do i=1,im + effrl(i,k1) = re_cloud (i,k) + effri(i,k1) = re_ice (i,k) + effrr(i,k1) = 1000. ! rrain_def=1000. + effrs(i,k1) = re_snow(i,k) + enddo + enddo + ! Update global arrays + do k=1,lm + k1 = k + kd + do i=1,im + Tbd%phy_f3d(i,k,Model%nleffr) = effrl(i,k1) + Tbd%phy_f3d(i,k,Model%nieffr) = effri(i,k1) + Tbd%phy_f3d(i,k,Model%nseffr) = effrs(i,k1) + enddo + enddo + else ! all other cases cldcov = 0.0 endif @@ -749,8 +864,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif - elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6 .or. & - Model%imp_physics == 15) then + elseif(Model%imp_physics == 6 .or. Model%imp_physics == 15) then if (Model%kdt == 1) then Tbd%phy_f3d(:,:,Model%nleffr) = 10. Tbd%phy_f3d(:,:,Model%nieffr) = 50. @@ -767,6 +881,40 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + + elseif(Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP + + if(Model%do_mynnedmf .or. & + Model%imfdeepcnv == Model%imfdeepcnv_gf ) then ! MYNN PBL or GF conv + !-- MYNN PBL or convective GF + !-- use cloud fractions with SGS clouds + do k=1,lmk + do i=1,im + clouds(i,k,1) = clouds1(i,k) + enddo + enddo + + ! --- use clduni as with the GFDL microphysics. + ! --- make sure that effr_in=.true. in the input.nml! + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs + Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & + IM, LMK, LMP, clouds(:,1:LMK,1), & + effrl, effri, effrr, effrs, Model%effr_in , & + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + + else + ! MYNN PBL or GF convective are not used + call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lmk, lmp, Model%uni_cld, & + Model%lmfshal,Model%lmfdeep2, & + cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & + Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + endif ! MYNN PBL or GF + endif ! end if_imp_physics ! endif ! end_if_ntcw diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 7b40e2c1d..a06e718a5 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -270,6 +270,22 @@ kind = kind_phys intent = out optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [gasvmr_co2] standard_name = volume_mixing_ratio_co2 long_name = CO2 volume mixing ratio @@ -430,7 +446,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [clouds2] standard_name = cloud_liquid_water_path @@ -439,7 +455,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [clouds3] standard_name = mean_effective_radius_for_liquid_cloud @@ -448,7 +464,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [clouds4] standard_name = cloud_ice_water_path @@ -457,7 +473,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [clouds5] standard_name = mean_effective_radius_for_ice_cloud @@ -466,7 +482,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [clouds6] standard_name = cloud_rain_water_path diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 8405d160d..ad98575ca 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -195,8 +195,8 @@ intent = in optional = F [im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent + standard_name = horizontal_dimension + long_name = horizontal dimension units = count dimensions = () type = integer diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 1344f269c..a95a0fffd 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -85,12 +85,10 @@ module GFS_rrtmgp_pre !! \section arg_table_GFS_rrtmgp_pre_init !! \htmlinclude GFS_rrtmgp_pre_init.html !! - subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errflg) + subroutine GFS_rrtmgp_pre_init(Model, active_gases_array, errmsg, errflg) ! Inputs type(GFS_control_type), intent(inout) :: & Model ! DDT: FV3-GFS model control parameters - type(GFS_radtend_type), intent(inout) :: & - Radtend ! DDT: FV3-GFS radiation tendencies ! Outputs character(len=*),dimension(Model%ngases), intent(out) :: & diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index c80098709..ae94ddf20 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -9,14 +9,6 @@ type = GFS_control_type intent = inout optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = instance of derived type GFS_radtend_type - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 4e9f8a33f..3b09298c4 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -93,7 +93,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & + type(cmpfsw_type), dimension(nCol), intent(inout) :: & scmpsw ! 2D surface fluxes, components: ! uvbfc - total sky downward uv-b flux at (W/m2) ! uvbf0 - clear sky downward uv-b flux at (W/m2) @@ -105,7 +105,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein integer :: i, j, k, iSFC, iTOA, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky - logical :: l_fluxessw2d, top_at_1, l_sfcFluxessw1D + logical :: l_fluxessw2d, top_at_1 ! Initialize CCPP error handling variables errmsg = '' @@ -116,7 +116,6 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! Are any optional outputs requested? l_fluxessw2d = present(flxprf_sw) - l_sfcfluxessw1D = present(scmpsw) ! ####################################################################################### ! What is vertical ordering? diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index a817d9332..806bd49e4 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -56,7 +56,7 @@ dimensions = (horizontal_dimension) type = cmpfsw_type intent = inout - optional = T + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/GFS_suite_init_finalize_test.F90 b/physics/GFS_suite_init_finalize_test.F90 deleted file mode 100644 index 0a958d2fc..000000000 --- a/physics/GFS_suite_init_finalize_test.F90 +++ /dev/null @@ -1,59 +0,0 @@ - module GFS_suite_ini_fini_test - - contains - -!> \section arg_table_GFS_suite_ini_fini_test_init Argument Table -!! \htmlinclude GFS_suite_ini_fini_test_init.html -!! - subroutine GFS_suite_ini_fini_test_init (errmsg, errflg) - - implicit none - - ! interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - errmsg = '' - errflg = 0 - - write(0,*) "DH DEBUG: IN GFS_suite_ini_fini_test_init" - - end subroutine GFS_suite_ini_fini_test_init - -!> \section arg_table_GFS_suite_ini_fini_test_finalize Argument Table -!! \htmlinclude GFS_suite_ini_fini_test_finalize.html -!! - subroutine GFS_suite_ini_fini_test_finalize(errmsg, errflg) - - implicit none - - ! interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - errmsg = '' - errflg = 0 - - write(0,*) "DH DEBUG: IN GFS_suite_ini_fini_test_finalize" - - end subroutine GFS_suite_ini_fini_test_finalize - -!> \section arg_table_GFS_suite_ini_fini_test_run Argument Table -!! \htmlinclude GFS_suite_ini_fini_test_run.html -!! - subroutine GFS_suite_ini_fini_test_run (errmsg, errflg) - - use GFS_typedefs, only: GFS_interstitial_type - - implicit none - - ! interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - write(errmsg,'(a)') "DH ERROR: GFS_suite_ini_fini_test_run should not be called" - errflg = 1 - - end subroutine GFS_suite_ini_fini_test_run - - end module GFS_suite_ini_fini_test diff --git a/physics/GFS_suite_init_finalize_test.meta b/physics/GFS_suite_init_finalize_test.meta deleted file mode 100644 index cdca8b0e0..000000000 --- a/physics/GFS_suite_init_finalize_test.meta +++ /dev/null @@ -1,64 +0,0 @@ -[ccpp-arg-table] - name = GFS_suite_ini_fini_test_init - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F - -######################################################################## -[ccpp-arg-table] - name = GFS_suite_ini_fini_test_finalize - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F - -######################################################################## -[ccpp-arg-table] - name = GFS_suite_ini_fini_test_run - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 2f14f0fec..694487704 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -460,25 +460,25 @@ end subroutine GFS_suite_interstitial_3_finalize !! \htmlinclude GFS_suite_interstitial_3_run.html !! #endif - subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & - satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & - ntiw, ntlnc, ntinc, ntclamt, ntrw, ntsw, ntrnc, ntsnc, & - ntgl, ntgnc, xlon, xlat, 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, & - prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & - work1, work2, kpbl, kinver, ras, me, & - clw, rhc, save_qc, save_qi, errmsg, errflg) + subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & + satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & + 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, & + prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & + work1, work2, kpbl, kinver, ras, me, & + clw, rhc, save_qc, save_qi, save_tcp, errmsg, errflg) use machine, only: kind_phys implicit none ! interface variables - integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntlnc, ntinc, & - 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 + 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 integer, dimension(im), intent(in) :: islmsk, kpbl, kinver logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras @@ -487,11 +487,13 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & real(kind=kind_phys), dimension(im, levs), intent(in) :: prsl, prslk real(kind=kind_phys), dimension(im, levs+1), intent(in) :: prsi real(kind=kind_phys), dimension(im), intent(in) :: xlon, xlat + 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) :: 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_tcp ! ONLY ALLOCATE FOR THOMPSON! TODO real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw character(len=*), intent(out) :: errmsg @@ -512,40 +514,11 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & errmsg = '' errflg = 0 -! -!GF* The following section (initializing convective variables) is already executed in GFS_typedefs%interstitial_phys_reset -! do k=1,levs -! do i=1,im -! clw(i,k,1) = 0.0 -! clw(i,k,2) = -999.9 -! enddo -! enddo -! if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0 .or. & -! (Model%npdf3d == 3 .and. Model%num_p3d == 4) .or. & -! (Model%npdf3d == 0 .and. Model%ncnvcld3d == 1) ) then -! do k=1,levs -! do i=1,im -! cnvc(i,k) = 0.0 -! cnvw(i,k) = 0.0 -! enddo -! enddo -! endif -! if(imp_physics == Model%imp_physics_thompson) then -! if(Model%ltaerosol) then -! ice00 (:,:) = 0.0 -! liq0 (:,:) = 0.0 -! else -! ice00 (:,:) = 0.0 -! endif -! endif -!*GF - if (cscnv .or. satmedmf .or. trans_trac .or. ras) then tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & -! n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc) then tracers = tracers + 1 do k=1,levs @@ -598,6 +571,8 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & enddo enddo endif + else + rhc(:,:) = 1.0 endif if (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_zhao_carr_pdf) then ! zhao-carr microphysics @@ -617,8 +592,9 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & elseif (imp_physics == imp_physics_thompson) then do k=1,levs do i=1,im - clw(i,k,1) = gq0(i,k,ntiw) ! ice - clw(i,k,2) = gq0(i,k,ntcw) ! water + clw(i,k,1) = gq0(i,k,ntiw) ! ice + clw(i,k,2) = gq0(i,k,ntcw) ! water + save_tcp(i,k) = gt0(i,k) enddo enddo if(ltaerosol) then @@ -634,15 +610,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & clw(i,k,2) = gq0(i,k,ntcw) ! water enddo enddo - else ! if_ntcw - !GF* never executed unless imp_physics = imp_physics_zhao_carr or imp_physics_zhao_carr_pdf - ! do i=1,im - ! psautco_l(i) = Model%psautco(1)*work1(i) + Model%psautco(2)*work2(i) - ! prautco_l(i) = Model%prautco(1)*work1(i) + Model%prautco(2)*work2(i) - ! enddo - !*GF - rhc(:,:) = 1.0 - endif ! end if_ntcw + endif end subroutine GFS_suite_interstitial_3_run @@ -664,9 +632,10 @@ 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, gt0, dqdti, imfdeepcnv, imfdeepcnv_gf, errmsg, errflg) + gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, errmsg, errflg) use machine, only: kind_phys + use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber implicit none @@ -674,17 +643,22 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to integer, intent(in) :: im, levs, 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, imfdeepcnv, imfdeepcnv_gf + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf logical, intent(in) :: ltaerosol, cplchm real(kind=kind_phys), intent(in) :: con_pi, dtf - real(kind=kind_phys), dimension(im,levs), intent(in) :: save_qc, gt0 + 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(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 + real(kind=kind_phys), intent(in) :: con_rd + real(kind=kind_phys), dimension(:,:), intent(in) :: nwfa, save_tcp + real(kind=kind_phys), dimension(im,levs), intent(in) :: spechum + ! dqdti may not be allocated real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti @@ -695,10 +669,12 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! local variables integer :: i,k,n,tracers - real(kind=kind_phys) :: liqm, icem - - liqm = 4./3.*con_pi*1.e-12 - icem = 4./3.*con_pi*3.2768*1.e-14*890. + real(kind=kind_phys), dimension(im,levs) :: rho_dryair + real(kind=kind_phys), dimension(im,levs) :: qv_mp !< kg kg-1 (dry mixing ratio) + real(kind=kind_phys), dimension(im,levs) :: qc_mp !< kg kg-1 (dry mixing ratio) + real(kind=kind_phys), dimension(im,levs) :: qi_mp !< kg kg-1 (dry mixing ratio) + real(kind=kind_phys), dimension(im,levs) :: nc_mp !< kg-1 (dry mixing ratio) + real(kind=kind_phys), dimension(im,levs) :: ni_mp !< kg-1 (dry mixing ratio) ! Initialize CCPP error handling variables errmsg = '' @@ -713,7 +689,6 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt) then if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & -! n /= ntlnc .and. n /= ntinc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc ) then tracers = tracers + 1 do k=1,levs @@ -732,6 +707,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to imp_physics == imp_physics_zhao_carr_pdf .or. & imp_physics == imp_physics_gfdl) then gq0(1:im,:,ntcw) = clw(1:im,:,1) + clw(1:im,:,2) + elseif (ntiw > 0) then do k=1,levs do i=1,im @@ -739,25 +715,34 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to gq0(i,k,ntcw) = clw(i,k,2) ! water enddo enddo -! if (imp_physics == imp_physics_thompson) then - if (imp_physics == imp_physics_thompson .and. imfdeepcnv /= imfdeepcnv_gf) then - if (ltaerosol) then - do k=1,levs - do i=1,im - gq0(i,k,ntlnc) = gq0(i,k,ntlnc) & - + max(0.0, (clw(i,k,2)-save_qc(i,k))) / liqm - gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem - enddo - enddo - else - do k=1,levs - do i=1,im - gq0(i,k,ntinc) = gq0(i,k,ntinc) & - + max(0.0, (clw(i,k,1)-save_qi(i,k))) / icem - enddo - enddo - endif + + if (imp_physics == imp_physics_thompson .and. (ntlnc>0 .or. ntinc>0)) then + do k=1,levs + do i=1,im + !> - Density of air in kg m-3 + rho_dryair(i,k) = prsl(i,k)/(con_rd*save_tcp(i,k)) + !> - Convert specific humidity to dry mixing ratio + qv_mp(i,k) = spechum(i,k)/(1.0_kind_phys-spechum(i,k)) + if (ntlnc>0) then + !> - Convert moist mixing ratio to dry mixing ratio + qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k))/(1.0_kind_phys-spechum(i,k)) + !> - Convert number concentration from moist to dry + nc_mp(i,k) = gq0(i,k,ntlnc)/(1.0_kind_phys-spechum(i,k)) + nc_mp(i,k) = max(0.0, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho_dryair(i,k), nwfa(i,k)) * (1.0/rho_dryair(i,k))) + !> - Convert number concentrations from dry to moist + gq0(i,k,ntlnc) = nc_mp(i,k)/(1.0_kind_phys+qv_mp(i,k)) + endif + if (ntinc>0) then + !> - Convert moist mixing ratio to dry mixing ratio + qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k))/(1.0_kind_phys-spechum(i,k)) + !> - Convert number concentration from moist to dry + ni_mp(i,k) = gq0(i,k,ntinc)/(1.0_kind_phys-spechum(i,k)) + ni_mp(i,k) = max(0.0, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho_dryair(i,k), save_tcp(i,k)) * (1.0/rho_dryair(i,k))) + !> - Convert number concentrations from dry to moist + gq0(i,k,ntinc) = ni_mp(i,k)/(1.0_kind_phys+qv_mp(i,k)) + endif + enddo + enddo endif else @@ -767,6 +752,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to enddo enddo endif ! end if_ntiw + else do k=1,levs do i=1,im @@ -798,11 +784,9 @@ end subroutine GFS_suite_interstitial_5_init subroutine GFS_suite_interstitial_5_finalize() end subroutine GFS_suite_interstitial_5_finalize -#if 0 !> \section arg_table_GFS_suite_interstitial_5_run Argument Table !! \htmlinclude GFS_suite_interstitial_5_run.html !! -#endif subroutine GFS_suite_interstitial_5_run (im, levs, ntrac, ntcw, ntiw, nn, gq0, clw, errmsg, errflg) use machine, only: kind_phys diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 08f8b2af0..127de9c6e 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -677,7 +677,7 @@ intent = inout optional = F [dt3dt_scnv] - standard_name = cumulative_change_in_temperature_due_to_shal_convection + standard_name = cumulative_change_in_temperature_due_to_shallow_convection long_name = cumulative change in temperature due to shal conv. units = K dimensions = (horizontal_dimension,vertical_dimension) @@ -1153,22 +1153,6 @@ 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 [ntclamt] standard_name = index_for_cloud_amount long_name = tracer index for cloud amount integer @@ -1243,6 +1227,15 @@ kind = kind_phys intent = in optional = F +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [gq0] standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics @@ -1473,6 +1466,15 @@ kind = kind_phys intent = inout optional = F +[save_tcp] + standard_name = air_temperature_save_from_cumulus_paramterization + long_name = air temperature after cumulus parameterization + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1733,14 +1735,50 @@ kind = kind_phys intent = inout optional = F -[gt0] - standard_name = air_temperature_updated_by_physics - long_name = temperature updated by physics +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[save_tcp] + standard_name = air_temperature_save_from_cumulus_paramterization + long_name = air temperature after cumulus parameterization units = K dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[nwfa] + standard_name = water_friendly_aerosol_number_concentration + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spechum] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout optional = F [dqdti] standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection @@ -1751,22 +1789,6 @@ kind = kind_phys intent = inout optional = F -[imfdeepcnv] - standard_name = flag_for_mass_flux_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imfdeepcnv_gf] - standard_name = flag_for_gf_deep_convection_scheme - long_name = flag for Grell-Freitas deep convection scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 57158321d..d5bc98322 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -28,10 +28,11 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl landfrac, lakefrac, oceanfrac, & frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorl_wat, & zorl_lnd, zorl_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & - tprcp_lnd, tprcp_ice, uustar, uustar_lnd, uustar_ice, weasd, weasd_wat, & - weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, tsfc_lnd, & - tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, gflx_ice, & - tgice, islmsk, semis_rad, semis_wat, semis_lnd, semis_ice, & + tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & + weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat,& + tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & + gflx_ice, tgice, islmsk, semis_rad, semis_wat, semis_lnd, semis_ice, & + qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & min_lakeice, min_seaice, errmsg, errflg) implicit none @@ -45,12 +46,13 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl real(kind=kind_phys), dimension(im), intent(in ) :: landfrac, lakefrac, oceanfrac real(kind=kind_phys), dimension(im), intent(inout) :: cice real(kind=kind_phys), dimension(im), intent( out) :: frland - real(kind=kind_phys), dimension(im), intent(in ) :: zorl, snowd, tprcp, uustar, weasd + real(kind=kind_phys), dimension(im), intent(in ) :: zorl, snowd, tprcp, uustar, weasd, qss, hflx real(kind=kind_phys), dimension(im), intent(inout) :: zorlo, zorll, tsfc, tsfco, tsfcl, tisfc, tsurf real(kind=kind_phys), dimension(im), intent(inout) :: snowd_wat, snowd_lnd, snowd_ice, tprcp_wat, & tprcp_lnd, tprcp_ice, zorl_wat, zorl_lnd, zorl_ice, tsfc_wat, tsfc_lnd, tsfc_ice, tsurf_wat, & - tsurf_lnd, tsurf_ice, uustar_lnd, uustar_ice, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, gflx_ice + tsurf_lnd, tsurf_ice, uustar_wat, uustar_lnd, uustar_ice, weasd_wat, weasd_lnd, weasd_ice, & + qss_wat, qss_lnd, qss_ice, hflx_wat, hflx_lnd, hflx_ice, ep1d_ice, gflx_ice real(kind=kind_phys), dimension(im), intent( out) :: tice real(kind=kind_phys), intent(in ) :: tgice integer, dimension(im), intent(in ) :: islmsk @@ -142,6 +144,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl tprcp_lnd(i) = tprcp(i) tprcp_ice(i) = tprcp(i) if (wet(i)) then ! Water + uustar_wat(i) = uustar(i) zorl_wat(i) = zorlo(i) tsfc_wat(i) = tsfco(i) tsurf_wat(i) = tsfco(i) @@ -150,6 +153,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl weasd_wat(i) = zero snowd_wat(i) = zero semis_wat(i) = 0.984d0 + qss_wat(i) = qss(i) + hflx_wat(i) = hflx(i) endif if (dry(i)) then ! Land uustar_lnd(i) = uustar(i) @@ -159,6 +164,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl tsurf_lnd(i) = tsfcl(i) snowd_lnd(i) = snowd(i) semis_lnd(i) = semis_rad(i) + qss_lnd(i) = qss(i) + hflx_lnd(i) = hflx(i) end if if (icy(i)) then ! Ice uustar_ice(i) = uustar(i) @@ -170,6 +177,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl ep1d_ice(i) = zero gflx_ice(i) = zero semis_ice(i) = 0.95d0 + qss_ice(i) = qss(i) + hflx_ice(i) = hflx(i) endif enddo diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 31ca88d3d..ff0ca9774 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -270,6 +270,15 @@ kind = kind_phys intent = in optional = F +[uustar_wat] + standard_name = surface_friction_velocity_over_ocean + long_name = surface friction velocity over ocean + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [uustar_lnd] standard_name = surface_friction_velocity_over_land long_name = surface friction velocity over land @@ -503,6 +512,78 @@ kind = kind_phys intent = inout optional = F +[qss] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qss_wat] + standard_name = surface_specific_humidity_over_ocean + long_name = surface air saturation specific humidity over ocean + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qss_lnd] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qss_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx_wat] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean + long_name = kinematic surface upward sensible heat flux over ocean + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_lnd] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [min_lakeice] standard_name = lake_ice_minimum long_name = minimum lake ice value diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 904e94dbc..d7debf1cc 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -221,7 +221,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt dvisdfi_cpl, dnirbm_cpl, dnirdf_cpl, dvisbm_cpl, dvisdf_cpl, nlwsfci_cpl, nlwsfc_cpl, t2mi_cpl, q2mi_cpl, u10mi_cpl, & v10mi_cpl, tsfci_cpl, psurfi_cpl, nnirbmi_cpl, nnirdfi_cpl, nvisbmi_cpl, nvisdfi_cpl, nswsfci_cpl, nswsfc_cpl, nnirbm_cpl, & nnirdf_cpl, nvisbm_cpl, nvisdf_cpl, gflux, evbsa, evcwa, transa, sbsnoa, snowca, snohfa, ep, & - runoff, srunoff, runof, drain, errmsg, errflg) + runoff, srunoff, runof, drain, lheatstrg, z0fac, e0fac, zorl, hflx, evap, hflxq, evapq, hffac, hefac, errmsg, errflg) implicit none @@ -243,13 +243,29 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt real(kind=kind_phys), dimension(im), intent(inout) :: runoff, srunoff real(kind=kind_phys), dimension(im), intent(in) :: drain, runof + ! For canopy heat storage + logical, intent(in) :: lheatstrg + real(kind=kind_phys), intent(in) :: z0fac, e0fac + real(kind=kind_phys), dimension(im), intent(in) :: zorl + real(kind=kind_phys), dimension(im), intent(in) :: hflx, evap + real(kind=kind_phys), dimension(im), intent(out) :: hflxq, evapq + real(kind=kind_phys), dimension(im), intent(out) :: hffac, hefac + + ! CCPP error handling variables character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Local variables + real(kind=kind_phys), parameter :: albdf = 0.06d0 + ! Parameters for canopy heat storage parametrization + real(kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 + real(kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 + integer :: i real(kind=kind_phys) :: xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl + real(kind=kind_phys) :: tem, tem1, tem2 ! Initialize CCPP error handling variables errmsg = '' @@ -354,6 +370,35 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt enddo endif +! --- ... Boundary Layer and Free atmospheic turbulence parameterization +! +! in order to achieve heat storage within canopy layer, in the canopy heat +! storage parameterization the kinematic sensible and latent heat fluxes +! (hflx & evap) as surface boundary forcings to the pbl scheme are +! reduced as a function of surface roughness +! + do i=1,im + hflxq(i) = hflx(i) + evapq(i) = evap(i) + hffac(i) = 1.0 + hefac(i) = 1.0 + enddo + if (lheatstrg) then + do i=1,im + tem = 0.01 * zorl(i) ! change unit from cm to m + tem1 = (tem - z0min) / (z0max - z0min) + hffac(i) = z0fac * min(max(tem1, 0.0), 1.0) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem1 = (tem - u10min) / (u10max - u10min) + tem2 = 1.0 - min(max(tem1, 0.0), 1.0) + hffac(i) = tem2 * hffac(i) + hefac(i) = 1. + e0fac * hffac(i) + hffac(i) = 1. + hffac(i) + hflxq(i) = hflx(i) / hffac(i) + evapq(i) = evap(i) / hefac(i) + enddo + endif + end subroutine GFS_surface_generic_post_run end module GFS_surface_generic_post diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 436e2dc55..fb4bd5944 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -1280,6 +1280,95 @@ kind = kind_phys intent = in optional = F +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[z0fac] + standard_name = surface_roughness_fraction_factor + long_name = surface roughness fraction factor for canopy heat storage parameterization + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[e0fac] + standard_name = latent_heat_flux_fraction_factor_relative_to_sensible_heat_flux + long_name = latent heat flux fraction factor relative to sensible heat flux for canopy heat storage parameterization + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflxq] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evapq] + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hefac] + standard_name = surface_upward_latent_heat_flux_reduction_factor + long_name = surface upward latent heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_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/GFS_time_vary_pre.fv3.F90 b/physics/GFS_time_vary_pre.fv3.F90 index 46284a1bb..98a0f6697 100644 --- a/physics/GFS_time_vary_pre.fv3.F90 +++ b/physics/GFS_time_vary_pre.fv3.F90 @@ -65,9 +65,9 @@ end subroutine GFS_time_vary_pre_finalize !> \section arg_table_GFS_time_vary_pre_run Argument Table !! \htmlinclude GFS_time_vary_pre_run.html !! - subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & - nslwr, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt, & - julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) + subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & + nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, & + kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) use machine, only: kind_phys @@ -77,7 +77,7 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & integer, intent(in) :: jdat(1:8), idat(1:8) integer, intent(in) :: lsm, lsm_noahmp, & nsswr, nslwr, me, & - master, nscyc + master, nscyc, nhfrad logical, intent(in) :: debug real(kind=kind_phys), intent(in) :: dtp @@ -169,6 +169,12 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & !--- allow for radiation to be called on every physics time step, if needed if (nsswr == 1) lsswr = .true. if (nslwr == 1) lslwr = .true. + !--- allow for radiation to be called on every physics time step + ! for the first nhfrad timesteps (for spinup, coldstarts only) + if (kdt<=nhfrad) then + lsswr = .true. + lslwr = .true. + end if !--- set the solar hour based on a combination of phour and time initial hour solhr = mod(phour+idate(1),con_24) diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/GFS_time_vary_pre.fv3.meta index 3dc91952e..14081f8e4 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/GFS_time_vary_pre.fv3.meta @@ -102,6 +102,14 @@ type = integer intent = in optional = F +[nhfrad] + standard_name = number_of_timesteps_for_radiation_calls_on_physics_timestep + long_name = number of timesteps for radiation calls on physics timestep (coldstarts only) + units = count + dimensions = () + type = integer + intent = in + optional = F [idate] standard_name = date_and_time_at_model_initialization_reordered long_name = initial date with different size and ordering diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 07b235c72..df0116cd0 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -155,7 +155,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & 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, & - rain, ntke, q_tke, dqdt_tke, lprnt, ipr, errmsg, errflg) + rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & + ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & + ldiag3d, lssav, flag_for_gwd_generic_tend, errmsg, errflg) implicit none @@ -163,6 +165,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr integer, intent(in) :: me, master, im, levs, ntrac, kdt, lonr, nmtvr integer, intent(in), dimension(im) :: kpbl real(kind=kind_phys), intent(in), dimension(im) :: oro, oro_uf, hprime, oc, theta, sigma, gamma + logical, intent(in) :: flag_for_gwd_generic_tend ! elvmax is intent(in) for CIRES UGWP, but intent(inout) for GFS GWDPS real(kind=kind_phys), intent(inout), dimension(im) :: elvmax real(kind=kind_phys), intent(in), dimension(im, 4) :: clx, oa4 @@ -178,6 +181,12 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr real(kind=kind_phys), intent(out), dimension(im) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw 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 + logical, intent(in) :: ldiag3d, lssav + ! These arrays only allocated if ldiag_ugwp = .true. real(kind=kind_phys), intent(out), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms @@ -251,7 +260,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr enddo if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then - call gwdps_run(im, im, levs, Pdvdt, Pdudt, Pdtdt, & + call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & ugrs, vgrs, tgrs, qgrs, & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & hprime, oc, oa4, clx, theta, sigma, gamma, & @@ -269,6 +278,18 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr endif ! do_ugwp + + 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 + endif + + if (cdmbgwd(3) > 0.0) then ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing @@ -344,8 +365,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. endif - return - +#if 0 !============================================================================= ! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving ! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" @@ -364,6 +384,17 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr gw_dtdt = gw_dtdt*(1.-pked) + ed_dtdt*pked gw_dvdt = gw_dvdt*(1.-pked) + ed_dvdt*pked gw_dudt = gw_dudt*(1.-pked) + ed_dudt*pked +#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 + endif end subroutine cires_ugwp_run !! @} diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 7f1118016..5d5e0dd1a 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -850,6 +850,74 @@ 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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,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 +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in +[flag_for_gwd_generic_tend] + standard_name = flag_for_generic_gravity_wave_drag_tendency + long_name = true if GFS_GWD_generic should calculate tendencies + 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/cnvc90.f b/physics/cnvc90.f index 87d034b77..9bef0ebf9 100644 --- a/physics/cnvc90.f +++ b/physics/cnvc90.f @@ -21,7 +21,7 @@ end subroutine cnvc90_init !! \htmlinclude cnvc90_run.html !! ! \section gen_cnvc_run GFS cnvc90_run General Algorithm - SUBROUTINE cnvc90_run(CLSTP,IM,IX,RN,KBOT,KTOP,KM,PRSI, & + SUBROUTINE cnvc90_run(CLSTP,IM,RN,KBOT,KTOP,KM,PRSI, & & ACV,ACVB,ACVT,CV,CVB,CVT,errmsg,errflg) USE MACHINE, ONLY :kind_phys @@ -29,11 +29,11 @@ SUBROUTINE cnvc90_run(CLSTP,IM,IX,RN,KBOT,KTOP,KM,PRSI, & ! Interface variables real(kind=kind_phys), intent(in) :: clstp - integer, intent(in) :: im, ix, km + integer, intent(in) :: im, km real(kind=kind_phys), intent(in) :: RN(IM) integer, intent(in) :: KBOT(IM) integer, intent(in) :: KTOP(IM) - real(kind=kind_phys), intent(in) :: prsi(ix,km+1) + real(kind=kind_phys), intent(in) :: prsi(IM,km+1) real(kind=kind_phys), intent(inout) :: ACV(IM) real(kind=kind_phys), intent(inout) :: ACVB(IM) real(kind=kind_phys), intent(inout) :: ACVT(IM) diff --git a/physics/cnvc90.meta b/physics/cnvc90.meta index 57290c9c5..0cf7c22a4 100644 --- a/physics/cnvc90.meta +++ b/physics/cnvc90.meta @@ -23,14 +23,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [rn] standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rainfall amount on dynamics timestep diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index 29044e4ec..386349422 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -289,7 +289,7 @@ end subroutine cs_conv_finalize !! !! \section general_cs_conv CS Convection Scheme General Algorithm !> @{ - subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & + subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & NTR , nctp , & !DD dimensions otspt , lat , kdt , & t , q , rain1 , clw , & @@ -308,24 +308,24 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! ! input arguments ! - INTEGER, INTENT(IN) :: IM,IJSDIM, KMAX, ntracp1, nn, NTR, mype, nctp, mp_phys, kdt, lat !! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IJSDIM, KMAX, ntracp1, nn, NTR, mype, nctp, mp_phys, kdt, lat !! DD, for GFS, pass in logical, intent(in) :: otspt(1:ntracp1,1:2)! otspt(:,1) - on/off switch for tracer transport by updraft and ! downdraft. should not include subgrid PDF and turbulence ! otspt(:,2) - on/off switch for tracer transport by subsidence ! should include subgrid PDF and turbulence - real(r8), intent(inout) :: t(IM,KMAX) ! temperature at mid-layer (K) - real(r8), intent(inout) :: q(IM,KMAX) ! water vapor array including moisture (kg/kg) - real(r8), intent(inout) :: clw(IM,KMAX,nn) ! tracer array including cloud condensate (kg/kg) - real(r8), intent(in) :: pap(IM,KMAX) ! pressure at mid-layer (Pa) - real(r8), intent(in) :: paph(IM,KMAX+1) ! pressure at boundaries (Pa) - real(r8), intent(in) :: zm(IM,KMAX) ! geopotential at mid-layer (m) - real(r8), intent(in) :: zi(IM,KMAX+1) ! geopotential at boundaries (m) + real(r8), intent(inout) :: t(IJSDIM,KMAX) ! temperature at mid-layer (K) + real(r8), intent(inout) :: q(IJSDIM,KMAX) ! water vapor array including moisture (kg/kg) + real(r8), intent(inout) :: clw(IJSDIM,KMAX,nn) ! tracer array including cloud condensate (kg/kg) + real(r8), intent(in) :: pap(IJSDIM,KMAX) ! pressure at mid-layer (Pa) + real(r8), intent(in) :: paph(IJSDIM,KMAX+1) ! pressure at boundaries (Pa) + real(r8), intent(in) :: zm(IJSDIM,KMAX) ! geopotential at mid-layer (m) + real(r8), intent(in) :: zi(IJSDIM,KMAX+1) ! geopotential at boundaries (m) real(r8), intent(in) :: fscav(ntr), fswtr(ntr), wcbmaxm(ijsdim) real(r8), intent(in) :: precz0in, preczhin, clmdin ! added for cs_convr - real(r8), intent(inout) :: u(IM,KMAX) ! zonal wind at mid-layer (m/s) - real(r8), intent(inout) :: v(IM,KMAX) ! meridional wind at mid-layer (m/s) + real(r8), intent(inout) :: u(IJSDIM,KMAX) ! zonal wind at mid-layer (m/s) + real(r8), intent(inout) :: v(IJSDIM,KMAX) ! meridional wind at mid-layer (m/s) real(r8), intent(in) :: DELTA ! physics time step real(r8), intent(in) :: DELTI ! dynamics time step (model time increment in seconds) @@ -333,7 +333,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! ! modified arguments ! - real(r8), intent(inout) :: CBMFX(IM,nctp) ! cloud base mass flux (kg/m2/s) + real(r8), intent(inout) :: CBMFX(IJSDIM,nctp) ! cloud base mass flux (kg/m2/s) ! ! output arguments ! @@ -348,21 +348,21 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & cnv_dqldt, clcn, cnv_fice, & cnv_ndrop, cnv_nice, cf_upi ! *GJF - integer, intent(inout) :: kcnv(im) ! zero if no deep convection and 1 otherwise + integer, intent(inout) :: kcnv(ijsdim) ! zero if no deep convection and 1 otherwise character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg !DDsigma - output added for AW sigma diagnostics ! interface sigma and vertical velocity by cloud type (1=sfc) -! real(r8), intent(out), dimension(IM,KMAX,nctp) :: sigmai, vverti - real(r8), intent(out), dimension(IM,KMAX) :: sigma ! sigma sigma totaled over cloud type - on interfaces (1=sfc) +! real(r8), intent(out), dimension(IJSDIM,KMAX,nctp) :: sigmai, vverti + real(r8), intent(out), dimension(IJSDIM,KMAX) :: sigma ! sigma sigma totaled over cloud type - on interfaces (1=sfc) ! sigma terms in eq 91 and 92 -! real(r8), dimension(IM,KMAX) :: sfluxterm, qvfluxterm, condterm +! real(r8), dimension(IJSDIM,KMAX) :: sfluxterm, qvfluxterm, condterm !DDsigma ! ! output arguments of CS_CUMLUS ! - real(r8), dimension(IM,KMAX,nctp) :: vverti + real(r8), dimension(IJSDIM,KMAX,nctp) :: vverti real(r8) GTT(IJSDIM,KMAX) !< temperature tendency [K/s] real(r8) GTQ(IJSDIM,KMAX,NTR) !< tracer tendency [kg/kg/s] @@ -528,7 +528,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & enddo ! !> -# Call cs_cumlus() for the main CS cumulus parameterization - call CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions + call CS_CUMLUS (IJSDIM, IJSDIM, KMAX , NTR , & !DD dimensions otspt(1:ntr,1), otspt(1:ntr,2), & lprnt , ipr , & GTT , GTQ , GTU , GTV , & ! output diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index d499885c7..b19a42a5b 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -266,14 +266,6 @@ [ccpp-arg-table] name = cs_conv_run type = scheme -[im] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [ijsdim] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 53e26fb46..5c43709d1 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -9,7 +9,6 @@ module cu_gf_driver use machine , only: kind_phys use cu_gf_deep, only: cu_gf_deep_run,neg_check,autoconv,aeroevap,fct1d3 use cu_gf_sh , only: cu_gf_sh_run - use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber implicit none @@ -69,13 +68,15 @@ end subroutine cu_gf_driver_finalize !! !>\section gen_gf_driver GSD GF Cumulus Scheme General Algorithm !> @{ - subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & + subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,cactiv, & 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, & pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & - nwfa,con_rd,gq0,ntinc,ntlnc,imp_physics,imp_physics_thompson, & - errmsg,errflg) + 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) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -96,42 +97,41 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,ix,km,ntracer + integer, intent(in ) :: im,km,ntracer + logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend + logical, intent(in ) :: ldiag3d,qdiag3d + + 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 + real(kind=kind_phys), dimension( im ) :: rand_mom,rand_vmas + 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 , 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 - real(kind=kind_phys), dimension( ix , km ), intent(in ) :: forcet,forceqv_spechum,w,phil - real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: t,us,vs - real(kind=kind_phys), dimension( ix ) :: rand_mom,rand_vmas - real(kind=kind_phys), dimension( ix,4 ) :: rand_clos - real(kind=kind_phys), dimension( ix , km, 11 ) :: gdc,gdc2 - real(kind=kind_phys), dimension( ix , km ), intent(out ) :: cnvw_moist,cnvc - real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: cliw, clcw - -! change from ix to im integer, dimension (im), intent(inout) :: hbot,htop,kcnv integer, dimension (im), intent(in) :: xland real(kind=kind_phys), dimension (im), intent(in) :: pbl - integer, dimension (ix) :: tropics + integer, dimension (im) :: tropics ! ruc variable real(kind=kind_phys), dimension (im) :: hfx2,qfx2,psuri real(kind=kind_phys), dimension (im,km) :: ud_mf,dd_mf,dt_mf real(kind=kind_phys), dimension (im), intent(inout) :: raincv,cld1d -! end change ix to im - real(kind=kind_phys), dimension (ix,km) :: t2di,p2di + real(kind=kind_phys), dimension (im,km) :: t2di,p2di ! Specific humidity from FV3 - real(kind=kind_phys), dimension (ix,km), intent(in) :: qv2di_spechum - real(kind=kind_phys), dimension (ix,km), intent(inout) :: qv_spechum + real(kind=kind_phys), dimension (im,km), intent(in) :: qv2di_spechum + real(kind=kind_phys), dimension (im,km), intent(inout) :: qv_spechum ! Local water vapor mixing ratios and cloud water mixing ratios - real(kind=kind_phys), dimension (ix,km) :: qv2di, qv, forceqv, cnvw + real(kind=kind_phys), dimension (im,km) :: qv2di, qv, forceqv, cnvw ! real(kind=kind_phys), dimension( im ),intent(in) :: garea real(kind=kind_phys), intent(in ) :: dt -! additional variables for number concentrations - real(kind=kind_phys), intent(in) :: nwfa(1:im,1:km) - real(kind=kind_phys), intent(in) :: con_rd - real(kind=kind_phys), dimension(im,km,ntracer), intent(inout) :: gq0 - integer, intent(in) :: imp_physics,imp_physics_thompson,ntlnc,ntinc - integer, intent(in ) :: imfshalcnv character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -751,6 +751,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & gdc(i,k,1)= max(0.,tun_rad_shall(i)*cupclws(i,k)*cutens(i)) ! my mod gdc2(i,k,1)=max(0.,tun_rad_deep(i)*(cupclwm(i,k)*cutenm(i)+cupclw(i,k)*cuten(i))) + qci_conv(i,k)=gdc2(i,k,1) gdc(i,k,2)=(outt(i,k))*86400. gdc(i,k,3)=(outtm(i,k))*86400. gdc(i,k,4)=(outts(i,k))*86400. @@ -826,26 +827,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & cliw(i,k) = max(0.,cliw(i,k) + tem) endif -! -!> calculate cloud water and cloud ice number concentrations -! - rho_dryar(i,k) = p2di(i,k)/(con_rd*t(i,k)) ! Density of dry air in kg m-3 - if (imp_physics == imp_physics_thompson) then - if ((tem*tem1)>1.e-5) then - gq0(i,k,ntinc) = max(0., gq0(i,k,ntinc) + & - make_IceNumber(tem*tem1*rho_dryar(i,k), t(i,k)) * & - (1/rho_dryar(i,k))) - end if - if ((tem*(1-tem1))>1.e-5) then - gq0(i,k,ntlnc) = max(0., gq0(i,k,ntlnc) + & - make_DropletNumber(tem*(1-tem1)*rho_dryar(i,k), nwfa(i,k)) & - * (1/rho_dryar(i,k))) - end if - end if - enddo - gdc(i,1,10)=forcing(i,1) gdc(i,2,10)=forcing(i,2) gdc(i,3,10)=forcing(i,3) @@ -879,6 +862,34 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & qv_spechum = qv/(1.0_kind_phys+qv) cnvw_moist = cnvw/(1.0_kind_phys+qv) ! +! Diagnostic tendency updates +! + 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) + outus(i,k) * dt + dv3dt_SCNV(i,k) = dv3dt_SCNV(i,k) + outvs(i,k) * dt + dt3dt_SCNV(i,k) = dt3dt_SCNV(i,k) + outts(i,k) * dt + if(qdiag3d) then + dq3dt_SCNV(i,k) = dq3dt_SCNV(i,k) + outqs(i,k) * dt + endif + enddo + enddo + 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) + (outu(i,k)+outum(i,k)) * dt + dv3dt_DCNV(i,k) = dv3dt_DCNV(i,k) + (outv(i,k)+outvm(i,k)) * dt + dt3dt_DCNV(i,k) = dt3dt_DCNV(i,k) + (outt(i,k)+outtm(i,k)) * dt + if(qdiag3d) then + dq3dt_DCNV(i,k) = dq3dt_DCNV(i,k) + (outq(i,k)+outqm(i,k)) * dt + endif + enddo + enddo + endif + endif end subroutine cu_gf_driver_run !> @} end module cu_gf_driver diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index cce69c43b..e92949080 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -69,14 +69,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = vertical layer dimension @@ -261,8 +253,8 @@ intent = in optional = F [hfx2] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real @@ -270,8 +262,8 @@ intent = in optional = F [qfx2] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real @@ -358,64 +350,106 @@ type = integer intent = in optional = F -[nwfa] - standard_name = water_friendly_aerosol_number_concentration - long_name = number concentration of water-friendly aerosols - units = kg-1 +[flag_for_scnv_generic_tend] + standard_name = flag_for_generic_shallow_convection_tendency + long_name = true if GFS_SCNV_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in +[flag_for_dcnv_generic_tend] + standard_name = flag_for_generic_deep_convection_tendency + long_name = true if GFS_DCNV_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in +[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_dimension,vertical_dimension) type = real kind = kind_phys - intent = in - optional = F -[con_rd] - standard_name = gas_constant_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 - dimensions = () + intent = inout +[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_dimension,vertical_dimension) type = real kind = kind_phys - intent = in - optional = F -[gq0] - standard_name = tracer_concentration_updated_by_physics - long_name = tracer concentration updated by physics + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension,number_of_tracers) - type = real + dimensions = (horizontal_dimension,vertical_dimension) + type = real kind = kind_phys intent = inout - 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 -[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 -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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_dimension,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 = integer + dimensions = () + type = logical intent = in - optional = F -[imp_physics_thompson] - standard_name = flag_for_thompson_microphysics_scheme - long_name = choice of Thompson microphysics scheme +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields units = flag dimensions = () - type = integer + type = logical intent = in +[qci_conv] + standard_name = convective_cloud_condesate_after_rainout + long_name = convective cloud condesate after rainout + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index 156e75c70..a824c6af4 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -148,8 +148,8 @@ end subroutine cu_ntiedtke_finalize !----------------------------------------------------------------------- ! level 1 subroutine 'tiecnvn' !----------------------------------------------------------------- - subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & - evap,hfx,zprecc,lmask,lq,ix,km,dt,dx,kbot,ktop,kcnv,& + subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & + evap,hfx,zprecc,lmask,lq,km,dt,dx,kbot,ktop,kcnv, & ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,errmsg,errflg) !----------------------------------------------------------------- ! this is the interface between the model and the mass @@ -157,14 +157,14 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, !----------------------------------------------------------------- implicit none ! in&out variables - integer, intent(in) :: lq, ix, km, ktrac + integer, intent(in) :: lq, km, ktrac real(kind=kind_phys), intent(in ) :: dt integer, dimension( lq ), intent(in) :: lmask real(kind=kind_phys), dimension( lq ), intent(in ) :: evap, hfx, dx - real(kind=kind_phys), dimension( ix , km ), intent(inout) :: pu, pv, pt, pqv - real(kind=kind_phys), dimension( ix , km ), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf - real(kind=kind_phys), dimension( ix , km+1 ), intent(in ) :: pzz, prsi - real(kind=kind_phys), dimension( ix , km, ktrac ), intent(inout ) :: clw + real(kind=kind_phys), dimension( lq , km ), intent(inout) :: pu, pv, pt, pqv + real(kind=kind_phys), dimension( lq , km ), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf + real(kind=kind_phys), dimension( lq , km+1 ), intent(in ) :: pzz, prsi + real(kind=kind_phys), dimension( lq , km, ktrac ), intent(inout ) :: clw integer, dimension( lq ), intent(out) :: kbot, ktop, kcnv real(kind=kind_phys), dimension( lq ), intent(out) :: zprecc diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 4208b6e46..0e6a3d4b0 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -171,8 +171,8 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real @@ -180,8 +180,8 @@ intent = in optional = F [hfx] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real @@ -213,14 +213,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 7f052cbf3..f5967f7a2 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -52,7 +52,7 @@ end subroutine dcyc2t3_finalize ! sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, ! ! sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, ! ! sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, ! -! ix, im, levs, deltim, fhswr, ! +! im, levs, deltim, fhswr, ! ! dry, icy, wet ! ! input/output: ! ! dtdt,dtdtc, ! @@ -83,10 +83,10 @@ end subroutine dcyc2t3_finalize ! sfcdsw (im) - real, total sky sfc downward sw flux ( w/m**2 ) ! ! sfcnsw (im) - real, total sky sfc net sw into ground (w/m**2) ! ! sfcdlw (im) - real, total sky sfc downward lw flux ( w/m**2 ) ! -! swh(ix,levs) - real, total sky sw heating rates ( k/s ) ! -! swhc(ix,levs) - real, clear sky sw heating rates ( k/s ) ! -! hlw(ix,levs) - real, total sky lw heating rates ( k/s ) ! -! hlwc(ix,levs) - real, clear sky lw heating rates ( k/s ) ! +! swh(im,levs) - real, total sky sw heating rates ( k/s ) ! +! swhc(im,levs) - real, clear sky sw heating rates ( k/s ) ! +! hlw(im,levs) - real, total sky lw heating rates ( k/s ) ! +! hlwc(im,levs) - real, clear sky lw heating rates ( k/s ) ! ! sfcnirbmu(im)- real, tot sky sfc nir-beam sw upward flux (w/m2) ! ! sfcnirdfu(im)- real, tot sky sfc nir-diff sw upward flux (w/m2) ! ! sfcvisbmu(im)- real, tot sky sfc uv+vis-beam sw upward flux (w/m2)! @@ -95,7 +95,7 @@ end subroutine dcyc2t3_finalize ! sfcnirdfd(im)- real, tot sky sfc nir-diff sw downward flux (w/m2) ! ! sfcvisbmd(im)- real, tot sky sfc uv+vis-beam sw dnward flux (w/m2)! ! sfcvisdfd(im)- real, tot sky sfc uv+vis-diff sw dnward flux (w/m2)! -! ix, im - integer, horiz. dimention and num of used points ! +! im - integer, horizontal dimension ! ! levs - integer, vertical layer dimension ! ! deltim - real, physics time step in seconds ! ! fhswr - real, Short wave radiation time step in seconds ! @@ -184,7 +184,7 @@ subroutine dcyc2t3_run & & sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, & & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & - & ix, im, levs, deltim, fhswr, & + & im, levs, deltim, fhswr, & & dry, icy, wet, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: @@ -212,7 +212,7 @@ subroutine dcyc2t3_run & & pid12 = con_pi / hour12 ! --- inputs: - integer, intent(in) :: ix, im, levs + integer, intent(in) :: im, levs ! integer, intent(in) :: ipr ! logical lprnt @@ -232,7 +232,7 @@ subroutine dcyc2t3_run & & sfcnirbmu, sfcnirdfu, sfcvisbmu, sfcvisdfu, & & sfcnirbmd, sfcnirdfd, sfcvisbmd, sfcvisdfd - real(kind=kind_phys), dimension(ix,levs), intent(in) :: swh, hlw & + real(kind=kind_phys), dimension(im,levs), intent(in) :: swh, hlw & &, swhc, hlwc ! --- input/output: diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 53b702b64..69f787ea0 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -290,14 +290,6 @@ kind = kind_phys intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 0189785e3..725011ee4 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -194,10 +194,10 @@ end subroutine drag_suite_init ! & nmtvr, cdmbgwd, me, lprnt, ipr, rdxzb, errmsg, errflg) ! subroutine drag_suite_run( & - & IM,IX,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & + & IM,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & - & VAR,oc1,oa4,ol4, & -! & varss,oc1ss,oa4ss,ol4ss, & + & var,oc1,oa4,ol4, & + & varss,oc1ss,oa4ss,ol4ss, & & THETA,SIGMA,GAMMA,ELVMAX, & & dtaux2d_ls,dtauy2d_ls,dtaux2d_bl,dtauy2d_bl, & & dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd, & @@ -295,7 +295,7 @@ subroutine drag_suite_run( & implicit none ! Interface variables - integer, intent(in) :: im, ix, km, imx, kdt, ipr, me, master + integer, intent(in) :: im, km, imx, kdt, ipr, me, master integer, intent(in) :: gwd_opt logical, intent(in) :: lprnt integer, intent(in) :: KPBL(im) @@ -307,9 +307,10 @@ subroutine drag_suite_run( & real(kind=kind_phys) :: rcl, cdmb real(kind=kind_phys) :: g_inv - real(kind=kind_phys), intent(out) :: & + real(kind=kind_phys), intent(inout) :: & & dudt(im,km),dvdt(im,km), & - & dtdt(im,km), rdxzb(im) + & dtdt(im,km) + real(kind=kind_phys), intent(out) :: rdxzb(im) real(kind=kind_phys), intent(in) :: & & u1(im,km),v1(im,km), & & t1(im,km),q1(im,km), & @@ -320,8 +321,7 @@ subroutine drag_suite_run( & real(kind=kind_phys), intent(in) :: var(im),oc1(im), & & oa4(im,4),ol4(im,4), & & dx(im) - !real(kind=kind_phys), intent(in) :: varss(im),oc1ss(im), & - real(kind=kind_phys) :: varss(im),oc1ss(im), & + real(kind=kind_phys), intent(in) :: varss(im),oc1ss(im), & & oa4ss(im,4),ol4ss(im,4) real(kind=kind_phys), intent(in) :: THETA(im),SIGMA(im), & & GAMMA(im),ELVMAX(im) @@ -474,7 +474,7 @@ subroutine drag_suite_run( & errmsg = '' errflg = 0 -if (me==master) print *,"Running drag suite" + !-------------------------------------------------------------------- ! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME !-------------------------------------------------------------------- @@ -527,14 +527,14 @@ subroutine drag_suite_run( & enddo !temporary use of large-scale data: - do i=1,im - varss(i)=var(i) - oc1ss(i)=oc1(i) - do j=1,4 - oa4ss(i,j)=oa4(i,j) - ol4ss(i,j)=ol4(i,j) - enddo - enddo +! do i=1,im +! varss(i)=var(i) +! oc1ss(i)=oc1(i) +! do j=1,4 +! oa4ss(i,j)=oa4(i,j) +! ol4ss(i,j)=ol4(i,j) +! enddo +! enddo ! !--- calculate scale-aware tapering factors !NOTE: if dx(1) is not representative of most/all dx, this needs to change... @@ -548,7 +548,7 @@ subroutine drag_suite_run( & (dxmax_ls-dxmin_ls)) + 1. ) end if end if -if (me==master) print *,"in Drag Suite, dx(1:2):",dx(1),dx(2) +! if (me==master) print *,"in Drag Suite, dx(1:2):",dx(1),dx(2) if ( dx(1) .ge. dxmax_ss ) then ss_taper = 1. else @@ -558,7 +558,7 @@ subroutine drag_suite_run( & ss_taper = dxmax_ss * (1. - dxmin_ss/dx(1))/(dxmax_ss-dxmin_ss) end if end if -if (me==master) print *,"in Drag Suite, ss_taper:",ss_taper +! if (me==master) print *,"in Drag Suite, ss_taper:",ss_taper !--- calculate length of grid for flow-blocking drag ! @@ -907,7 +907,7 @@ subroutine drag_suite_run( & vtendwave=0. ! IF ( (gwd_opt_ss .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN - if (me==master) print *,"in Drag Suite: Running small-scale gravity wave drag" + ! if (me==master) print *,"in Drag Suite: Running small-scale gravity wave drag" ! ! declaring potential temperature ! @@ -943,11 +943,11 @@ subroutine drag_suite_run( & enddo if((xland(i)-1.5).le.0. .and. 2.*varss(i).le.hpbl(i))then if(br1(i).gt.0. .and. thvx(i,kpbl2)-thvx(i,kts) > 0.)then -!WRF cleff_ss = sqrt(dxy(i)**2 + dxyp(i)**2) + cleff_ss = sqrt(dxy(i)**2 + dxyp(i)**2) ! WRF ! cleff_ss = 3. * max(dx(i),cleff_ss) ! cleff_ss = 10. * max(dxmax_ss,cleff_ss) -!WRF cleff_ss = 0.1 * max(dxmax_ss,cleff_ss) - cleff_ss = 0.1 * 12000. + cleff_ss = 0.1 * max(dxmax_ss,cleff_ss) ! WRF +! cleff_ss = 0.1 * 12000. coefm_ss(i) = (1. + olss(i)) ** (oass(i)+1.) xlinv(i) = coefm_ss(i) / cleff_ss !govrth(i)=g/(0.5*(thvx(i,kpbl(i))+thvx(i,kts))) @@ -1024,7 +1024,7 @@ subroutine drag_suite_run( & ! Topographic Form Drag from Beljaars et al. (2004, QJRMS, equ. 16): !================================================================ IF ( (gwd_opt_fd .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN - if (me==master) print *,"in Drag Suite: Running form drag" + ! if (me==master) print *,"in Drag Suite: Running form drag" utendform=0. vtendform=0. @@ -1080,7 +1080,7 @@ subroutine drag_suite_run( & !======================================================= ! More for the large-scale gwd component IF ( (gwd_opt_ls .EQ. 1).and.(ls_taper.GT.1.E-02) ) THEN - if (me==master) print *,"in Drag Suite: Running large-scale gravity wave drag" + ! if (me==master) print *,"in Drag Suite: Running large-scale gravity wave drag" ! ! now compute vertical structure of the stress. do k = kts,kpblmax @@ -1148,7 +1148,7 @@ subroutine drag_suite_run( & !COMPUTE BLOCKING COMPONENT !=============================================================== IF ( (gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN - if (me==master) print *,"in Drag Suite: Running blocking drag" + ! if (me==master) print *,"in Drag Suite: Running blocking drag" do i = its,im if(.not.ldrag(i)) then diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index dfb6f64b8..5e2565e22 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -14,14 +14,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = number of vertical layers @@ -208,6 +200,42 @@ kind = kind_phys intent = in optional = F +[varss] + standard_name = standard_deviation_of_subgrid_orography_small_scale + long_name = standard deviation of subgrid orography small scale + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oc1ss] + standard_name = convexity_of_subgrid_orography_small_scale + long_name = convexity of subgrid orography small scale + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oa4ss] + standard_name = asymmetry_of_subgrid_orography_small_scale + long_name = asymmetry of subgrid orography small scale + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[ol4ss] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F [theta] standard_name = angle_from_east_of_maximum_subgrid_orographic_variations long_name = angle with respect to east of maximum subgrid orographic variations diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index b32843bc1..f9f2d4c0a 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -19,12 +19,10 @@ end subroutine shoc_init subroutine shoc_finalize () end subroutine shoc_finalize -#if 0 !> \section arg_table_shoc_run Argument Table !! \htmlinclude shoc_run.html !! -#endif -subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, & +subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, & con_pi, con_fvirt, dtp, prsl, delp, phii, phil, u, v, omega, rhc, & supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & @@ -32,7 +30,7 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, implicit none - integer, intent(in) :: ix, nx, nzm, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc + integer, intent(in) :: nx, nzm, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc real(kind=kind_phys), intent(in) :: tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt ! @@ -114,7 +112,7 @@ subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, ! phy_f3d(1,1,ntot3d-1) - shoc determined diffusion coefficients ! phy_f3d(1,1,ntot3d ) - shoc determined w'theta' - call shoc_work (ix, nx, nzm, nzm+1, dtp, prsl, delp, & + call shoc_work (nx, nx, nzm, nzm+1, dtp, prsl, delp, & phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, & diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index f4d2f3ae9..5bd59c589 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = shoc_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [nx] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/gscond.f b/physics/gscond.f index 6dd77d87e..28f24763c 100644 --- a/physics/gscond.f +++ b/physics/gscond.f @@ -41,7 +41,7 @@ end subroutine zhaocarr_gscond_finalize !! -# Update \f$t\f$, \f$q\f$, \f$cwm\f$ due to cloud evaporation and condensation processes. !> \section Zhao-Carr_cond_detailed GFS gscond Scheme Detailed Algorithm !> @{ - subroutine zhaocarr_gscond_run (im,ix,km,dt,dtf,prsl,ps,q,clw1 & + subroutine zhaocarr_gscond_run (im,km,dt,dtf,prsl,ps,q,clw1 & &, clw2, cwm, t, tp, qp, psp & &, tp1, qp1, psp1, u, lprnt, ipr, errmsg, errflg) @@ -71,15 +71,15 @@ subroutine zhaocarr_gscond_run (im,ix,km,dt,dtf,prsl,ps,q,clw1 & implicit none ! ! Interface variables - integer, intent(in) :: im, ix, km, ipr + integer, intent(in) :: im, km, ipr real(kind=kind_phys), intent(in) :: dt, dtf - real(kind=kind_phys), intent(in) :: prsl(ix,km), ps(im) - real(kind=kind_phys), intent(inout) :: q(ix,km) - real(kind=kind_phys), intent(in) :: clw1(ix,km), clw2(ix,km) - real(kind=kind_phys), intent(out) :: cwm(ix,km) - real(kind=kind_phys), intent(inout) :: t(ix,km) & - &, tp(ix,km), qp(ix,km), psp(im) & - &, tp1(ix,km), qp1(ix,km), psp1(im) + real(kind=kind_phys), intent(in) :: prsl(im,km), ps(im) + real(kind=kind_phys), intent(inout) :: q(im,km) + real(kind=kind_phys), intent(in) :: clw1(im,km), clw2(im,km) + real(kind=kind_phys), intent(out) :: cwm(im,km) + real(kind=kind_phys), intent(inout) :: t(im,km) & + &, tp(im,km), qp(im,km), psp(im) & + &, tp1(im,km), qp1(im,km), psp1(im) real(kind=kind_phys), intent(in) :: u(im,km) logical, intent(in) :: lprnt ! @@ -124,7 +124,7 @@ subroutine zhaocarr_gscond_run (im,ix,km,dt,dtf,prsl,ps,q,clw1 & ! el2orc = hvap*hvap / (rv*cp) albycp = hvap / cp -! write(0,*)' in gscond im=',im,' ix=',ix +! write(0,*)' in gscond im=',im ! rdt = h1/dt us = h1 diff --git a/physics/gscond.meta b/physics/gscond.meta index f2046df0a..9302dc8ca 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -19,14 +19,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/gwdc.f b/physics/gwdc.f index 9909a3100..5c6f8ecd7 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -141,7 +141,7 @@ end subroutine gwdc_init !! !> \section al_gwdc GFS Convective GWD Scheme Detailed Algorithm !> @{ - subroutine gwdc_run (im,ix,km,lat,u1,v1,t1,q1,deltim, & + subroutine gwdc_run (im,km,lat,u1,v1,t1,q1,deltim, & & pmid1,pint1,dpmid1,qmax,ktop,kbot,kcnv,cldf, & & grav,cp,rd,fv,pi,dlength,lprnt,ipr,fhour, & & utgwc,vtgwc,tauctx,taucty,errmsg,errflg) @@ -186,16 +186,16 @@ subroutine gwdc_run (im,ix,km,lat,u1,v1,t1,q1,deltim, & ! !----------------------------------------------------------------------- - integer, intent(in) :: im, ix, km, lat, ipr + integer, intent(in) :: im, km, lat, ipr integer, intent(in) :: ktop(im),kbot(im),kcnv(im) real(kind=kind_phys), intent(in) :: grav,cp,rd,fv,fhour,deltim,pi real(kind=kind_phys), dimension(im), intent(in) :: qmax real(kind=kind_phys), dimension(im), intent(out) :: tauctx,taucty real(kind=kind_phys), dimension(im), intent(in) :: cldf,dlength - real(kind=kind_phys), dimension(ix,km), intent(in) :: u1,v1,t1, & + real(kind=kind_phys), dimension(im,km), intent(in) :: u1,v1,t1, & & q1,pmid1,dpmid1 - real(kind=kind_phys), dimension(ix,km), intent(out) :: utgwc,vtgwc - real(kind=kind_phys), dimension(ix,km+1), intent(in) :: pint1 + real(kind=kind_phys), dimension(im,km), intent(out) :: utgwc,vtgwc + real(kind=kind_phys), dimension(im,km+1), intent(in) :: pint1 ! logical, intent(in) :: lprnt ! @@ -375,7 +375,7 @@ subroutine gwdc_run (im,ix,km,lat,u1,v1,t1,q1,deltim, & ! print *,' ' ! write(*,*) 'Inside GWDC raw input start print at fhour = ', ! & fhour -! write(*,*) 'IX IM KM ',ix,im,km +! write(*,*) 'IM KM ',im,km ! write(*,*) 'KBOT KTOP QMAX DLENGTH kcnv ', ! + kbot(ipr),ktop(ipr),qmax(ipr),dlength(ipr),kcnv(ipr) ! write(*,*) 'grav cp rd ',grav,cp,rd @@ -1498,13 +1498,13 @@ subroutine gwdc_post_run( & if (lssav) then dugwd(:) = dugwd(:) + tauctx(:)*dtf dvgwd(:) = dvgwd(:) + taucty(:)*dtf - - if (ldiag3d) then - du3dt(:,:) = du3dt(:,:) + gwdcu(:,:) * dtf - dv3dt(:,:) = dv3dt(:,:) + gwdcv(:,:) * dtf - endif endif ! end if_lssav + if (ldiag3d) then + du3dt(:,:) = du3dt(:,:) + gwdcu(:,:) * dtf + dv3dt(:,:) = dv3dt(:,:) + gwdcv(:,:) * dtf + endif + ! --- ... update the wind components with gwdc tendencies do k = 1, levs diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 2151cc5f7..fc57604fb 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -185,14 +185,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = number of vertical layers diff --git a/physics/gwdps.f b/physics/gwdps.f index 96ce0205b..b09413f02 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -196,7 +196,7 @@ end subroutine gwdps_init !> \section det_gwdps GFS Orographic GWD Scheme Detailed Algorithm !> @{ subroutine gwdps_run( & - & IM,IX,KM,A,B,C,U1,V1,T1,Q1,KPBL, & + & IM,KM,A,B,C,U1,V1,T1,Q1,KPBL, & & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DELTIM,KDT, & & HPRIME,OC,OA4,CLX4,THETA,SIGMA,GAMMA,ELVMAX, & & DUSFC,DVSFC,G, CP, RD, RV, IMX, & @@ -269,13 +269,13 @@ subroutine gwdps_run( & ! CRITICAL LEVELS ! ! INPUT -! A(IX,KM) NON-LIN TENDENCY FOR V WIND COMPONENT -! B(IX,KM) NON-LIN TENDENCY FOR U WIND COMPONENT -! C(IX,KM) NON-LIN TENDENCY FOR TEMPERATURE -! U1(IX,KM) ZONAL WIND M/SEC AT T0-DT -! V1(IX,KM) MERIDIONAL WIND M/SEC AT T0-DT -! T1(IX,KM) TEMPERATURE DEG K AT T0-DT -! Q1(IX,KM) SPECIFIC HUMIDITY AT T0-DT +! A(IM,KM) NON-LIN TENDENCY FOR V WIND COMPONENT +! B(IM,KM) NON-LIN TENDENCY FOR U WIND COMPONENT +! C(IM,KM) NON-LIN TENDENCY FOR TEMPERATURE +! U1(IM,KM) ZONAL WIND M/SEC AT T0-DT +! V1(IM,KM) MERIDIONAL WIND M/SEC AT T0-DT +! T1(IM,KM) TEMPERATURE DEG K AT T0-DT +! Q1(IM,KM) SPECIFIC HUMIDITY AT T0-DT ! ! DELTIM TIME STEP SECS ! SI(N) P/PSFC AT BASE OF LAYER N @@ -297,24 +297,24 @@ subroutine gwdps_run( & implicit none ! ! Interface variables - integer, intent(in) :: im, ix, km, imx, kdt, ipr, me + integer, intent(in) :: im, km, imx, kdt, ipr, me integer, intent(in) :: KPBL(IM) ! Index for the PBL top layer! real(kind=kind_phys), intent(in) :: & & deltim, G, CP, RD, RV, cdmbgwd(4) real(kind=kind_phys), intent(inout) :: & - & A(IX,KM), B(IX,KM), C(IX,KM) + & A(IM,KM), B(IM,KM), C(IM,KM) real(kind=kind_phys), intent(in) :: & - & U1(IX,KM), V1(IX,KM), T1(IX,KM), & - & Q1(IX,KM), PRSI(IX,KM+1), DEL(IX,KM), & - & PRSL(IX,KM), PRSLK(IX,KM), PHIL(IX,KM), & - & PHII(IX,KM+1) + & U1(IM,KM), V1(IM,KM), T1(IM,KM), & + & Q1(IM,KM), PRSI(IM,KM+1), DEL(IM,KM), & + & PRSL(IM,KM), PRSLK(IM,KM), PHIL(IM,KM), & + & PHII(IM,KM+1) real(kind=kind_phys), intent(in) :: & - & OC(IM), OA4(IX,4), CLX4(IX,4), HPRIME(IM) + & OC(IM), OA4(IM,4), CLX4(IM,4), HPRIME(IM) real(kind=kind_phys), intent(inout) :: ELVMAX(IM) real(kind=kind_phys), intent(in) :: & & THETA(IM), SIGMA(IM), GAMMA(IM) real(kind=kind_phys), intent(out) :: DUSFC(IM), DVSFC(IM), & - & RDXZB(IX) + & RDXZB(IM) integer, intent(in) :: nmtvr logical, intent(in) :: lprnt character(len=*), intent(out) :: errmsg @@ -471,7 +471,7 @@ subroutine gwdps_run( & ! kreflm(i) = 0 enddo ! if (lprnt) -! & print *,' in gwdps_lm.f npt,IM,IX,IY,km,me=',npt,IM,IX,IY,km,me +! & print *,' in gwdps_lm.f npt,IM,IY,km,me=',npt,IM,IY,km,me ! ! !> --- Subgrid Mountain Blocking Section diff --git a/physics/gwdps.meta b/physics/gwdps.meta index 677dc6502..d843e6d53 100644 --- a/physics/gwdps.meta +++ b/physics/gwdps.meta @@ -14,14 +14,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = number of vertical layers diff --git a/physics/h2ophys.f b/physics/h2ophys.f index 929b38aa7..b3bdd279f 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -26,7 +26,7 @@ end subroutine h2ophys_init !! !! \section genal_h2ophys GFS H2O Physics Scheme General Algorithm !> @{ - subroutine h2ophys_run(ix, im, levs, kh2o, dt, h2o, ph2o, prsl, & + subroutine h2ophys_run(im, levs, kh2o, dt, h2o, ph2o, prsl, & & h2opltc, h2o_coeff, ldiag3d, me, & & errmsg, errflg) ! @@ -39,14 +39,14 @@ subroutine h2ophys_run(ix, im, levs, kh2o, dt, h2o, ph2o, prsl, & use machine , only : kind_phys implicit none ! interface variables - integer, intent(in) :: ix, im, levs, kh2o, h2o_coeff, me + integer, intent(in) :: im, levs, kh2o, h2o_coeff, me real(kind=kind_phys), intent(in) :: dt - real(kind=kind_phys), intent(inout) :: h2o(ix,levs) + real(kind=kind_phys), intent(inout) :: h2o(im,levs) real(kind=kind_phys), intent(in) :: ph2o(kh2o) - real(kind=kind_phys), intent(in) :: prsl(ix,levs) - real(kind=kind_phys), intent(in) :: h2opltc(ix,kh2o,h2o_coeff) + 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(ix,levs,h2o_coeff) + !real(kind=kind_phys), intent(inout) :: h2op(im,levs,h2o_coeff) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! local variables @@ -61,7 +61,7 @@ subroutine h2ophys_run(ix, im, levs, kh2o, dt, h2o, ph2o, prsl, & errmsg = '' errflg = 0 ! -! write(1000+me,*)' in h2ophys ix=',ix, im, levs, kh2o, dt +! write(1000+me,*)' in h2ophys im=', im, levs, kh2o, dt do l=1,levs pmin = 1.0e10 pmax = -1.0e10 diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 9aed54eb2..995e25436 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -6,14 +6,6 @@ [ccpp-arg-table] name = h2ophys_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 8b2b4c99f..f3420e094 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -111,7 +111,7 @@ end subroutine m_micro_finalize !! !>\section detail_m_micro_run MG m_micro_run Detailed Algorithm !> @{ - subroutine m_micro_run( im, ix, lm, flipv, dt_i & + subroutine m_micro_run( im, lm, flipv, dt_i & &, prsl_i, prsi_i, phil, phii & &, omega_i, QLLS_i, QLCN_i, QILS_i, QICN_i& &, lwheat_i, swheat_i, w_upi, cf_upi & @@ -174,15 +174,15 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 integer, parameter :: ncolmicro = 1 - integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag + integer,intent(in) :: im, lm, kdt, fprcp, pdfflag logical,intent(in) :: flipv, skip_macro integer,intent(in) :: iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) - real (kind=kind_phys), dimension(ix,lm),intent(in) :: & + real (kind=kind_phys), dimension(im,lm),intent(in) :: & & prsl_i,u_i,v_i,phil, omega_i, QLLS_i,QILS_i, & & lwheat_i,swheat_i - real (kind=kind_phys), dimension(ix,0:lm),intent(in):: prsi_i, & + real (kind=kind_phys), dimension(im,0:lm),intent(in):: prsi_i, & & phii ! GJF* These variables are conditionally allocated depending on whether the ! Morrison-Gettelman microphysics is used, so they must be declared @@ -202,7 +202,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! & CNVPRCP ! output - real (kind=kind_phys),dimension(ix,lm), intent(out) :: lwm_o, qi_o, & + real (kind=kind_phys),dimension(im,lm), intent(out) :: lwm_o, qi_o, & cldreffl, cldreffi, cldreffr, cldreffs, cldreffg real (kind=kind_phys),dimension(im), intent(out) :: rn_o, sr_o character(len=*), intent(out) :: errmsg @@ -211,7 +211,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! input and output ! Anning Cheng 10/24/2016 twat for total water, diagnostic purpose integer, dimension(IM), intent(inout):: KCBL - real (kind=kind_phys),dimension(ix,lm),intent(inout):: q_io, t_io, & + real (kind=kind_phys),dimension(im,lm),intent(inout):: q_io, t_io, & & ncpl_io,ncpi_io,CLLS_io ! GJF* These variables are conditionally allocated depending on whether the ! Morrison-Gettelman microphysics is used, so they must be declared diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 8ea90f7b9..b0b0c3522 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -309,14 +309,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [lm] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index e28cf5e69..d239013b4 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -21,8 +21,8 @@ end subroutine myjpbl_wrapper_finalize !! !###=================================================================== SUBROUTINE myjpbl_wrapper_run( & - & restart,do_myjsfc, & - & ix,im,levs,dt_phs, & + & restart,do_myjsfc, & + & im,levs,dt_phs, & & kdt,ntrac,ntke, & & ntcw,ntiw,ntrw,ntsw,ntgl, & & ugrs, vgrs, tgrs, qgrs, & @@ -76,7 +76,7 @@ SUBROUTINE myjpbl_wrapper_run( & integer, intent(out) :: errflg !MYJ-1D - integer,intent(in) :: im, ix, levs + 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 diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index dd2560e06..c8a4a0b9e 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -17,14 +17,6 @@ type = logical intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/module_MYJSFC_wrapper.F90 b/physics/module_MYJSFC_wrapper.F90 index 8a093cddf..e3dcf4111 100644 --- a/physics/module_MYJSFC_wrapper.F90 +++ b/physics/module_MYJSFC_wrapper.F90 @@ -22,7 +22,7 @@ end subroutine myjsfc_wrapper_finalize !###=================================================================== SUBROUTINE myjsfc_wrapper_run( & & restart, & - & ix,im,levs, & + & im,levs, & & kdt,ntrac,ntke, & & ntcw,ntiw,ntrw,ntsw,ntgl, & & iter,flag_iter, & @@ -84,7 +84,7 @@ SUBROUTINE myjsfc_wrapper_run( & integer, intent(out) :: errflg !MYJ-1D - integer,intent(in) :: im, ix, levs + integer,intent(in) :: im, levs integer,intent(in) :: kdt, iter, me integer,intent(in) :: ntrac,ntke,ntcw,ntiw,ntrw,ntsw,ntgl logical,intent(in) :: restart, lprnt diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index 67294e6fc..0ee3f521e 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -9,14 +9,6 @@ type = logical intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 396699d9f..06385b0b1 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -10,22 +10,37 @@ MODULE mynnedmf_wrapper contains - subroutine mynnedmf_wrapper_init () + subroutine mynnedmf_wrapper_init (lheatstrg, errmsg, errflg) + implicit none + + logical, intent(in) :: lheatstrg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lheatstrg) then + errmsg = 'Logic error: lheatstrg not implemented for MYNN PBL' + errflg = 1 + return + end if + end subroutine mynnedmf_wrapper_init subroutine mynnedmf_wrapper_finalize () end subroutine mynnedmf_wrapper_finalize ! \brief This scheme (1) performs pre-mynnedmf work, (2) runs the mynnedmf, and (3) performs post-mynnedmf work -#if 0 !> \section arg_table_mynnedmf_wrapper_run Argument Table !! \htmlinclude mynnedmf_wrapper_run.html !! -#endif SUBROUTINE mynnedmf_wrapper_run( & - & ix,im,levs, & - & flag_init,flag_restart, & - & lssav, ldiag3d, lsidea, & + & im,levs, & + & flag_init,flag_restart,cycling, & + & lssav, ldiag3d, qdiag3d, & + & lsidea, cplflx, & & delt,dtf,dx,zorl, & & phii,u,v,omega,t3d, & & qgrs_water_vapor, & @@ -40,27 +55,41 @@ SUBROUTINE mynnedmf_wrapper_run( & & slmsk,tsurf,qsfc,ps, & & ust,ch,hflx,qflx,wspd,rb, & & dtsfc1,dqsfc1, & + & dusfc1,dvsfc1, & + & dusfci_diag,dvsfci_diag, & & dtsfci_diag,dqsfci_diag, & + & dusfc_diag,dvsfc_diag, & & dtsfc_diag,dqsfc_diag, & + & dusfc_cice,dvsfc_cice, & + & dtsfc_cice,dqsfc_cice, & + & hflx_ocn,qflx_ocn,stress_ocn, & + & oceanfrac,fice,wet,icy,dry, & + & dusfci_cpl,dvsfci_cpl, & + & dtsfci_cpl,dqsfci_cpl, & + & dusfc_cpl,dvsfc_cpl, & + & dtsfc_cpl,dqsfc_cpl, & & recmol, & & qke,qke_adv,Tsq,Qsq,Cov, & & el_pbl,sh3d,exch_h,exch_m, & & Pblh,kpbl, & - & qc_bl,cldfra_bl, & + & qc_bl,qi_bl,cldfra_bl, & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & - & nupdraft,maxMF,ktop_shallow, & + & 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, & - & dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, & + & du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, & + & do3dt_PBL, dq3dt_PBL, dt3dt_PBL, & & htrsw, htrlw, xmu, & & grav_settling, bl_mynn_tkebudget, bl_mynn_tkeadvect, & & bl_mynn_cloudpdf, bl_mynn_mixlength, & & bl_mynn_edmf, bl_mynn_edmf_mom, bl_mynn_edmf_tke, & & bl_mynn_edmf_part, bl_mynn_cloudmix, bl_mynn_mixqt,& + & bl_mynn_output, & & icloud_bl, do_mynnsfclay, & & imp_physics, imp_physics_gfdl, & & imp_physics_thompson, imp_physics_wsm6, & @@ -150,13 +179,18 @@ SUBROUTINE mynnedmf_wrapper_run( & REAL, PARAMETER :: TKmin=253.0 !< for total water conversion, Tripoli and Cotton (1981) REAL, PARAMETER :: tv0=p608*tref, tv1=(1.+p608)*tref, gtr=g/tref, g_inv=1./g + REAL, PARAMETER :: zero=0.0d0, one=1.0d0 + REAL, PARAMETER :: huge=9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - - LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea + + LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea, qdiag3d + LOGICAL, INTENT(IN) :: cplflx + ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & - lprnt, do_mynnsfclay + lprnt, do_mynnsfclay, cycling INTEGER, INTENT(IN) :: & & bl_mynn_cloudpdf, & & bl_mynn_mixlength, & @@ -168,6 +202,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_cloudmix, & & bl_mynn_mixqt, & & bl_mynn_tkebudget, & + & bl_mynn_output, & & grav_settling, & & imp_physics, imp_physics_wsm6, & & imp_physics_thompson, imp_physics_gfdl @@ -186,7 +221,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !MYNN-1D REAL(kind=kind_phys), intent(in) :: delt, dtf - INTEGER, intent(in) :: im, ix, levs + INTEGER, intent(in) :: im, levs LOGICAL, intent(in) :: flag_init, flag_restart INTEGER :: initflag, k, i INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & @@ -205,10 +240,12 @@ SUBROUTINE mynnedmf_wrapper_run( & & dqdt_ozone, dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc real(kind=kind_phys), dimension(im,levs), intent(inout) :: & & qke, qke_adv, EL_PBL, Sh3D, & - & qc_bl, cldfra_bl - real(kind=kind_phys), dimension(im,levs), intent(inout) :: & + & qc_bl, qi_bl, cldfra_bl +!These 10 arrays are only allocated when bl_mynn_output > 0 + real(kind=kind_phys), dimension(:,:), intent(inout) :: & & edmf_a,edmf_w,edmf_qt, & - & edmf_thl,edmf_ent,edmf_qc + & edmf_thl,edmf_ent,edmf_qc, & + & sub_thl,sub_sqv,det_thl,det_sqv real(kind=kind_phys), dimension(im,levs), intent(in) :: & & u,v,omega,t3d, & & exner,prsl, & @@ -222,14 +259,15 @@ 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) :: dt3dt, & - & du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD + 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 real(kind=kind_phys), dimension(im,levs) :: & - & qvsh,qc,qi,qnc,qni,ozone,qnwfa,qnifa, & - & dz, w, p, rho, th, qv, tke_pbl, & + & sqv,sqc,sqi,qnc,qni,ozone,qnwfa,qnifa, & + & dz, w, p, rho, th, qv, & & RUBLTEN, RVBLTEN, RTHBLTEN, RQVBLTEN, & & RQCBLTEN, RQNCBLTEN, RQIBLTEN, RQNIBLTEN, & & RQNWFABLTEN, RQNIFABLTEN, & @@ -247,20 +285,37 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind=kind_phys), dimension(im), intent(in) :: & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol + + real(kind=kind_phys), dimension(im), intent(in) :: & + & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice, & + & stress_ocn,hflx_ocn,qflx_ocn, & + & oceanfrac,fice + + logical, dimension(im), intent(in) :: & + & wet, dry, icy + real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh real(kind=kind_phys), dimension(im), intent(out) :: & - & ch,dtsfc1,dqsfc1, & + & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, & & dtsfci_diag,dqsfci_diag,dtsfc_diag,dqsfc_diag, & + & dusfci_diag,dvsfci_diag,dusfc_diag,dvsfc_diag, & & maxMF - integer, dimension(im), intent(inout) :: & - & kpbl,nupdraft,ktop_shallow + integer, dimension(im), intent(inout) :: & + & kpbl,nupdraft,ktop_plume + + real(kind=kind_phys), dimension(:), intent(inout) :: & + & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl + real(kind=kind_phys), dimension(:), intent(inout) :: & + & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL real, dimension(im) :: & & WSTAR,DELTA,qcg,hfx,qfx,rmol,xland, & & uoce,voce,vdfg,znt,ts + real, dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -300,9 +355,9 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = qgrs_ice_cloud(i,k) + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice_cloud(i,k) ozone(i,k) = qgrs_ozone(i,k) qnc(i,k) = 0. qni(i,k) = 0. @@ -328,9 +383,9 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = qgrs_ice_cloud(i,k) + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice_cloud(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -354,9 +409,9 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = qgrs_ice_cloud(i,k) + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice_cloud(i,k) qnc(i,k) = 0. qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -382,13 +437,14 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = qgrs_ice_cloud(i,k) + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice_cloud(i,k) qnc(i,k) = 0. qni(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + ozone(i,k) = qgrs_ozone(i,k) enddo enddo else @@ -409,13 +465,14 @@ SUBROUTINE mynnedmf_wrapper_run( & p_qni= 0 do k=1,levs do i=1,im - qvsh(i,k) = qgrs_water_vapor(i,k) - qc(i,k) = qgrs_liquid_cloud(i,k) - qi(i,k) = 0. + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = 0. qnc(i,k) = 0. qni(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + ozone(i,k) = qgrs_ozone(i,k) enddo enddo endif @@ -426,9 +483,10 @@ SUBROUTINE mynnedmf_wrapper_run( & do i=1,im dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv th(i,k)=t3d(i,k)/exner(i,k) - qv(i,k)=qvsh(i,k)/(1.0 - qvsh(i,k)) - qc(i,k)=qc(i,k)/(1.0 - qvsh(i,k)) - qi(i,k)=qi(i,k)/(1.0 - qvsh(i,k)) + ! keep as specific humidity + ! qv(i,k)=qvsh(i,k)/(1.0 - qvsh(i,k)) + ! qc(i,k)=qc(i,k)/(1.0 - qvsh(i,k)) + ! qi(i,k)=qi(i,k)/(1.0 - qvsh(i,k)) rho(i,k)=prsl(i,k)/(r_d*t3d(i,k)) w(i,k) = -omega(i,k)/(rho(i,k)*g) pattern_spp_pbl(i,k)=0.0 @@ -451,12 +509,20 @@ SUBROUTINE mynnedmf_wrapper_run( & delta(i)=0.0 qcg(i)=0.0 - dtsfc1(i)=hfx(i) - dqsfc1(i)=qfx(i)*XLV - dtsfci_diag(i)=dtsfc1(i) - dqsfci_diag(i)=dqsfc1(i) - dtsfc_diag(i)=dtsfc_diag(i) + dtsfc1(i)*delt - dqsfc_diag(i)=dqsfc_diag(i) + dqsfc1(i)*delt + dtsfc1(i) = hfx(i) + dqsfc1(i) = qfx(i)*XLV + dusfc1(i) = -1.*rho(i,1)*ust(i)*ust(i)*u(i,1)/wspd(i) + dvsfc1(i) = -1.*rho(i,1)*ust(i)*ust(i)*v(i,1)/wspd(i) + + !BWG: diagnostic surface fluxes for scalars & momentum + dtsfci_diag(i) = dtsfc1(i) + dqsfci_diag(i) = dqsfc1(i) + dtsfc_diag(i) = dtsfc_diag(i) + dtsfc1(i)*delt + dqsfc_diag(i) = dqsfc_diag(i) + dqsfc1(i)*delt + dusfci_diag(i) = dusfc1(i) + dvsfci_diag(i) = dvsfc1(i) + dusfc_diag(i) = dusfc_diag(i) + dusfci_diag(i)*delt + dvsfc_diag(i) = dvsfc_diag(i) + dvsfci_diag(i)*delt znt(i)=zorl(i)*0.01 !cm -> m? if (do_mynnsfclay) then @@ -479,6 +545,45 @@ SUBROUTINE mynnedmf_wrapper_run( & ! wspd(i)=wind(i) enddo + ! BWG: Coupling insertion + if (cplflx) then + do i=1,im + if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES + if ( .not. wet(i)) then ! no open water, use results from CICE + dusfci_cpl(i) = dusfc_cice(i) + dvsfci_cpl(i) = dvsfc_cice(i) + dtsfci_cpl(i) = dtsfc_cice(i) + dqsfci_cpl(i) = dqsfc_cice(i) + elseif (icy(i) .or. dry(i)) then ! use stress_ocean for opw component at mixed point + if (wspd(i) > zero) then + dusfci_cpl(i) = -1.*rho(i,1)*stress_ocn(i)*u(i,1)/wspd(i) ! U-momentum flux + dvsfci_cpl(i) = -1.*rho(i,1)*stress_ocn(i)*v(i,1)/wspd(i) ! V-momentum flux + else + dusfci_cpl(i) = zero + dvsfci_cpl(i) = zero + endif + dtsfci_cpl(i) = cp*rho(i,1)*hflx_ocn(i) ! sensible heat flux over open ocean + dqsfci_cpl(i) = XLV*rho(i,1)*qflx_ocn(i) ! latent heat flux over open ocean + else ! use results from this scheme for 100% open ocean + dusfci_cpl(i) = dusfci_diag(i) + dvsfci_cpl(i) = dvsfci_diag(i) + dtsfci_cpl(i) = dtsfci_diag(i) + dqsfci_cpl(i) = dqsfci_diag(i) + endif +! + dusfc_cpl (i) = dusfc_cpl(i) + dusfci_cpl(i) * delt + dvsfc_cpl (i) = dvsfc_cpl(i) + dvsfci_cpl(i) * delt + dtsfc_cpl (i) = dtsfc_cpl(i) + dtsfci_cpl(i) * delt + dqsfc_cpl (i) = dqsfc_cpl(i) + dqsfci_cpl(i) * delt + else ! If no ocean + dusfc_cpl(i) = huge + dvsfc_cpl(i) = huge + dtsfc_cpl(i) = huge + dqsfc_cpl(i) = huge + endif ! Ocean only, NO LAKES + enddo + endif ! End coupling insertion + if (lprnt) then print* write(0,*)"===CALLING mynn_bl_driver; input:" @@ -496,9 +601,9 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dz:",dz(1,1),dz(1,2),dz(1,levs) print*,"u:",u(1,1),u(1,2),u(1,levs) print*,"v:",v(1,1),v(1,2),v(1,levs) - print*,"qv:",qv(1,1),qv(1,2),qv(1,levs) - print*,"qc:",qc(1,1),qc(1,2),qc(1,levs) - print*,"qi:",qi(1,1),qi(1,2),qi(1,levs) + print*,"sqv:",sqv(1,1),sqv(1,2),sqv(1,levs) + print*,"sqc:",sqc(1,1),sqc(1,2),sqc(1,levs) + print*,"sqi:",sqi(1,1),sqi(1,2),sqi(1,levs) print*,"rmol:",rmol(1)," ust:",ust(1) print*," dx=",dx(1),"initflag=",initflag print*,"Tsurf:",tsurf(1)," Thetasurf:",ts(1) @@ -509,7 +614,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"im=",im," levs=",levs print*,"PBLH=",pblh(1)," KPBL=",KPBL(1)," xland=",xland(1) print*,"vdfg=",vdfg(1)," ch=",ch(1) - print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) + !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) print*,"qke:",qke(1,1),qke(1,2),qke(1,levs) print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs) print*,"Sh3d:",Sh3d(1,1),sh3d(1,2),sh3d(1,levs) @@ -521,17 +626,17 @@ SUBROUTINE mynnedmf_wrapper_run( & CALL mynn_bl_driver( & & initflag=initflag,restart=flag_restart, & + & cycling=cycling, & & grav_settling=grav_settling, & & delt=delt,dz=dz,dx=dx,znt=znt, & - & u=u,v=v,w=w,th=th,qv=qv,qc=qc, & - & qi=qi,qni=qni,qnc=qnc, & - & qnwfa=qnwfa,qnifa=qnifa, & + & u=u,v=v,w=w,th=th,sqv3D=sqv,sqc3D=sqc, & + & sqi3D=sqi,qni=qni,qnc=qnc, & + & qnwfa=qnwfa,qnifa=qnifa,ozone=ozone, & & p=prsl,exner=exner,rho=rho,T3D=t3d, & & xland=xland,ts=ts,qsfc=qsfc,qcg=qcg,ps=ps, & & ust=ust,ch=ch,hfx=hfx,qfx=qfx,rmol=rmol, & & wspd=wspd,uoce=uoce,voce=voce,vdfg=vdfg, & !input - & qke=QKE,TKE_PBL=TKE_PBL, & - & sh3d=Sh3d, & !output + & qke=QKE,sh3d=Sh3d, & !output & qke_adv=qke_adv,bl_mynn_tkeadvect=bl_mynn_tkeadvect,& #if (WRF_CHEM == 1) & chem3d=chem,vd3d=vd,nchem=nchem,kdvel=kdvel, & @@ -542,7 +647,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & RQVBLTEN=RQVBLTEN,RQCBLTEN=rqcblten, & & RQIBLTEN=rqiblten,RQNCBLTEN=rqncblten, & !output & RQNIBLTEN=rqniblten,RQNWFABLTEN=RQNWFABLTEN, & !output - & RQNIFABLTEN=RQNIFABLTEN, & !output + & RQNIFABLTEN=RQNIFABLTEN,dozone=dqdt_ozone, & !output & EXCH_H=exch_h,EXCH_M=exch_m, & !output & pblh=pblh,KPBL=KPBL & !output & ,el_pbl=el_pbl & !output @@ -553,17 +658,20 @@ SUBROUTINE mynnedmf_wrapper_run( & & ,bl_mynn_cloudpdf=bl_mynn_cloudpdf & !input parameter & ,bl_mynn_mixlength=bl_mynn_mixlength & !input parameter & ,icloud_bl=icloud_bl & !input parameter - & ,qc_bl=qc_bl,cldfra_bl=cldfra_bl & !output + & ,qc_bl=qc_bl,qi_bl=qi_bl,cldfra_bl=cldfra_bl & !output & ,levflag=levflag,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 + & ,bl_mynn_output=bl_mynn_output & !input parameter & ,bl_mynn_cloudmix=bl_mynn_cloudmix & !input parameter & ,bl_mynn_mixqt=bl_mynn_mixqt & !input parameter & ,edmf_a=edmf_a,edmf_w=edmf_w,edmf_qt=edmf_qt & !output & ,edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc &!output + & ,sub_thl3D=sub_thl,sub_sqv3D=sub_sqv & + & ,det_thl3D=det_thl,det_sqv3D=det_sqv & & ,nupdraft=nupdraft,maxMF=maxMF & !output - & ,ktop_shallow=ktop_shallow & !output + & ,ktop_plume=ktop_plume & !output & ,spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl & !input & ,RTHRATEN=htrlw & !input & ,FLAG_QI=flag_qi,FLAG_QNI=flag_qni & !input @@ -589,6 +697,26 @@ SUBROUTINE mynnedmf_wrapper_run( & dvdt(i,k) = dvdt(i,k) + RVBLTEN(i,k) enddo enddo + accum_duvt3dt: if(lssav) then + if(ldiag3d) then + do k = 1, levs + do i = 1, im + du3dt_PBL(i,k) = du3dt_PBL(i,k) + RUBLTEN(i,k)*dtf + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + RVBLTEN(i,k)*dtf + enddo + enddo + endif + if_lsidea: if (lsidea) then + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + RTHBLTEN(i,k)*exner(i,k)*dtf + elseif(ldiag3d) then + do k=1,levs + do i=1,im + tem = RTHBLTEN(i,k)*exner(i,k) - (htrlw(i,k)+htrsw(i,k)*xmu(i)) + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + tem*dtf + enddo + enddo + endif if_lsidea + endif accum_duvt3dt !Update T, U and V: !do k = 1, levs ! do i = 1, im @@ -603,12 +731,19 @@ SUBROUTINE mynnedmf_wrapper_run( & ! WSM6 do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 enddo enddo + if(lssav .and. ldiag3d .and. qdiag3d) then + do k=1,levs + do i=1,im + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf + enddo + enddo + endif !Update moist species: !do k=1,levs ! do i=1,im @@ -623,16 +758,23 @@ SUBROUTINE mynnedmf_wrapper_run( & if(ltaerosol) then do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) !dqdt_ozone(i,k) = 0.0 dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) enddo enddo + if(lssav .and. ldiag3d .and. qdiag3d) then + do k=1,levs + do i=1,im + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf + enddo + enddo + endif !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 @@ -649,13 +791,20 @@ SUBROUTINE mynnedmf_wrapper_run( & !Thompson (2008) do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) !dqdt_ozone(i,k) = 0.0 enddo enddo + if(lssav .and. ldiag3d .and. qdiag3d) then + do k=1,levs + do i=1,im + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf + enddo + enddo + endif !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 @@ -670,15 +819,22 @@ SUBROUTINE mynnedmf_wrapper_run( & ! GFDL MP do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_rain(i,k) = 0.0 !dqdt_snow(i,k) = 0.0 !dqdt_graupel(i,k) = 0.0 !dqdt_ozone(i,k) = 0.0 enddo enddo + if(lssav .and. ldiag3d .and. qdiag3d) then + do k=1,levs + do i=1,im + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + dqdt_water_vapor(i,k)*dtf + enddo + enddo + endif !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 @@ -691,8 +847,8 @@ SUBROUTINE mynnedmf_wrapper_run( & ! print*,"In MYNN wrapper. Unknown microphysics scheme, imp_physics=",imp_physics do k=1,levs do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k)/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k)/(1.0 + qv(i,k)) + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_cloud(i,k) = 0.0 !dqdt_rain(i,k) = 0.0 !dqdt_snow(i,k) = 0.0 @@ -700,29 +856,16 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_ozone(i,k) = 0.0 enddo enddo - endif - - if (lssav .and. ldiag3d) then - if (lsidea) then - dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf - else - do k=1,levs - do i=1,im - tem = dtdt(i,k) - (htrlw(i,k)+htrsw(i,k)*xmu(i)) - dt3dt(i,k) = dt3dt(i,k) + tem*dtf + if(lssav .and. ldiag3d .and. qdiag3d) 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 - enddo - endif - do k=1,levs - do i=1,im - du3dt_PBL(i,k) = du3dt_PBL(i,k) + dudt(i,k) * dtf - du3dt_OGWD(i,k) = du3dt_OGWD(i,k) - dudt(i,k) * dtf - dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + dvdt(i,k) * dtf - dv3dt_OGWD(i,k) = dv3dt_OGWD(i,k) - dvdt(i,k) * dtf - enddo - enddo + endif endif - + + if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" @@ -734,9 +877,9 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dz:",dz(1,1),dz(1,2),dz(1,levs) print*,"u:",u(1,1),u(1,2),u(1,levs) print*,"v:",v(1,1),v(1,2),v(1,levs) - print*,"qv:",qv(1,1),qv(1,2),qv(1,levs) - print*,"qc:",qc(1,1),qc(1,2),qc(1,levs) - print*,"qi:",qi(1,1),qi(1,2),qi(1,levs) + print*,"sqv:",sqv(1,1),sqv(1,2),sqv(1,levs) + print*,"sqc:",sqc(1,1),sqc(1,2),sqc(1,levs) + print*,"sqi:",sqi(1,1),sqi(1,2),sqi(1,levs) print*,"rmol:",rmol(1)," ust:",ust(1) print*,"dx(1)=",dx(1),"initflag=",initflag print*,"Tsurf:",tsurf(1)," Thetasurf:",ts(1) @@ -747,7 +890,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"im=",im," levs=",levs print*,"PBLH=",pblh(1)," KPBL=",KPBL(1)," xland=",xland(1) print*,"vdfg=",vdfg(1)," ch=",ch(1) - print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) + !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) print*,"qke:",qke(1,1),qke(1,2),qke(1,levs) print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs) print*,"Sh3d:",Sh3d(1,1),sh3d(1,2),sh3d(1,levs) @@ -759,7 +902,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dudt:",dudt(1,1),dudt(1,2),dudt(1,levs) print*,"dvdt:",dvdt(1,1),dvdt(1,2),dvdt(1,levs) print*,"dqdt:",dqdt_water_vapor(1,1),dqdt_water_vapor(1,2),dqdt_water_vapor(1,levs) - print*,"ktop_shallow:",ktop_shallow(1)," maxmf:",maxmf(1) + print*,"ktop_plume:",ktop_plume(1)," maxmf:",maxmf(1) print*,"nup:",nupdraft(1) print* endif diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index eb8fcb0fd..9833f7eba 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1,14 +1,36 @@ [ccpp-arg-table] - name = mynnedmf_wrapper_run + name = mynnedmf_wrapper_init type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag dimensions = () - type = integer + type = logical intent = in optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +##################################################################### +[ccpp-arg-table] + name = mynnedmf_wrapper_run + type = scheme [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -41,6 +63,14 @@ type = logical intent = in optional = F +[cycling] + standard_name = flag_for_cycling + long_name = flag for cycling or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [lssav] standard_name = flag_diagnostics long_name = logical flag for storing diagnostics @@ -57,6 +87,12 @@ 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 [lsidea] standard_name = flag_idealized_physics long_name = flag for idealized physics @@ -65,6 +101,14 @@ type = logical intent = in optional = F +[cplflx] + standard_name = flag_for_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F [delt] standard_name = time_step_for_physics long_name = time step for physics @@ -292,7 +336,7 @@ optional = F [hflx] standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward sensible heat flux + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real @@ -301,7 +345,7 @@ optional = F [qflx] standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward latent heat flux + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real @@ -344,6 +388,42 @@ kind = kind_phys intent = out optional = F +[dusfc1] + standard_name = instantaneous_surface_x_momentum_flux + long_name = surface momentum flux in the x-direction valid for current call + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc1] + standard_name = instantaneous_surface_y_momentum_flux + long_name = surface momentum flux in the y-direction valid for current call + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfci_diag] + standard_name = instantaneous_surface_x_momentum_flux_for_diag + long_name = instantaneous sfc x momentum flux multiplied by timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfci_diag] + standard_name = instantaneous_surface_y_momentum_flux_for_diag + long_name = instantaneous sfc y momentum flux multiplied by timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [dtsfci_diag] standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag long_name = instantaneous sfc sensible heat flux multiplied by timestep @@ -362,6 +442,24 @@ kind = kind_phys intent = out optional = F +[dusfc_diag] + standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc x momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfc_diag] + standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep + long_name = cumulative sfc y momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [dtsfc_diag] standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep @@ -369,7 +467,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [dqsfc_diag] standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep @@ -378,7 +476,184 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = inout + optional = F +[dusfc_cice] + standard_name = surface_x_momentum_flux_for_coupling + long_name = sfc x momentum flux for coupling + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvsfc_cice] + standard_name = surface_y_momentum_flux_for_coupling + long_name = sfc y momentum flux for coupling + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtsfc_cice] + standard_name = surface_upward_sensible_heat_flux_for_coupling + long_name = sfc sensible heat flux for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqsfc_cice] + standard_name = surface_upward_latent_heat_flux_for_coupling + long_name = sfc latent heat flux for coupling + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx_ocn] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean + long_name = kinematic surface upward sensible heat flux over ocean + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_ocn] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean + long_name = kinematic surface upward latent heat flux over ocean + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dusfci_cpl] + standard_name = instantaneous_surface_x_momentum_flux_for_coupling + long_name = instantaneous sfc u momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfci_cpl] + standard_name = instantaneous_surface_y_momentum_flux_for_coupling + long_name = instantaneous sfc v momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtsfci_cpl] + standard_name = instantaneous_surface_upward_sensible_heat_flux_for_coupling + long_name = instantaneous sfc sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsfci_cpl] + standard_name = instantaneous_surface_upward_latent_heat_flux_for_coupling + long_name = instantaneous sfc latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dusfc_cpl] + standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc u momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvsfc_cpl] + standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc v momentum flux multiplied by timestep + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtsfc_cpl] + standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc sensible heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsfc_cpl] + standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep + long_name = cumulative sfc latent heat flux multiplied by timestep + units = W m-2 s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout optional = F [recmol] standard_name = reciprocal_of_obukhov_length @@ -488,8 +763,17 @@ intent = inout optional = F [QC_BL] - standard_name = subgrid_cloud_mixing_ratio_pbl - long_name = subgrid cloud cloud mixing ratio from PBL scheme + standard_name = subgrid_cloud_water_mixing_ratio_pbl + long_name = subgrid cloud water mixing ratio from PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[QI_BL] + standard_name = subgrid_cloud_ice_mixing_ratio_pbl + long_name = subgrid cloud ice mixing ratio from PBL scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -559,6 +843,42 @@ kind = kind_phys intent = inout optional = F +[sub_thl] + standard_name = theta_subsidence_tendency + long_name = updraft theta subsidence tendency + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sub_sqv] + standard_name = water_vapor_subsidence_tendency + long_name = updraft water vapor subsidence tendency + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[det_thl] + standard_name = theta_detrainment_tendency + long_name = updraft theta detrainment tendency + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[det_sqv] + standard_name = water_vapor_detrainment_tendency + long_name = updraft water vapor detrainment tendency + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [nupdraft] standard_name = number_of_plumes long_name = number of plumes per grid column @@ -576,9 +896,9 @@ kind = kind_phys intent = out optional = F -[ktop_shallow] - standard_name = k_level_of_highest_reaching_plume - long_name = k-level of highest reaching plume +[ktop_plume] + standard_name = k_level_of_highest_plume + long_name = k-level of highest plume units = count dimensions = (horizontal_dimension) type = integer @@ -683,15 +1003,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_dimension,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 @@ -728,6 +1039,29 @@ kind = kind_phys intent = inout 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_dimension,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_dimension,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_dimension,vertical_dimension) + type = real + kind = kind_phys [htrsw] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate @@ -843,6 +1177,14 @@ type = integer intent = in optional = F +[bl_mynn_output] + standard_name = mynn_output_flag + long_name = flag initialize and output extra 3D variables + units = flag + dimensions = () + type = integer + intent = in + optional = F [icloud_bl] standard_name = couple_sgs_clouds_to_radiation_flag long_name = flag for coupling sgs clouds to radiation diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 5471c4825..496db7580 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -3,9 +3,15 @@ MODULE mynnsfc_wrapper + USE module_sf_mynn + contains subroutine mynnsfc_wrapper_init () + + ! initialize tables for psih and psim (stable and unstable) + CALL PSI_INIT + end subroutine mynnsfc_wrapper_init subroutine mynnsfc_wrapper_finalize () @@ -13,52 +19,65 @@ end subroutine mynnsfc_wrapper_finalize !>\defgroup gsd_mynn_sfc GSD MYNN Surface Layer Scheme Module !> \brief This scheme (1) performs pre-mynnsfc work, (2) runs the mynn sfc layer scheme, and (3) performs post-mynnsfc work -#if 0 !! \section arg_table_mynnsfc_wrapper_run Argument Table !! \htmlinclude mynnsfc_wrapper_run.html !! -#endif !###=================================================================== -SUBROUTINE mynnsfc_wrapper_run( & - & ix,im,levs, & - & iter,flag_init,flag_restart, & - & delt,dx, & - & u, v, t3d, qvsh, qc, prsl, phii,& - & exner, tsq, qsq, cov, sh3d, & - & el_pbl, qc_bl, cldfra_bl, & - & ps, PBLH, slmsk, TSK, & - & QSFC, snowd, & - & zorl,UST,USTM, ZOL,MOL,RMOL, & - & fm, fh, fm10, fh2, WSPD, br, ch,& - & HFLX, QFX, LH, FLHC, FLQC, & - & U10, V10, TH2, T2, Q2, & - & wstar, CHS2, CQS2, & - & cda, cka, stress, & +SUBROUTINE mynnsfc_wrapper_run( & + & im,levs, & + & itimestep,iter, & + & flag_init,flag_restart,lsm, & + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & z0pert,ztpert, & !intent(in) + & redrag,sfc_z0_type, & !intent(in) + & delt,dx, & + & u, v, t3d, qvsh, qc, prsl, phii, & + & exner, ps, PBLH, slmsk, & + & wet, dry, icy, & !intent(in) + & tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) + & tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) + & qsfc_ocn, qsfc_lnd, qsfc_ice, & !intent(in) + & snowh_ocn, snowh_lnd, snowh_ice, & !intent(in) + & znt_ocn, znt_lnd, znt_ice, & !intent(inout) + & ust_ocn, ust_lnd, ust_ice, & !intent(inout) + & cm_ocn, cm_lnd, cm_ice, & !intent(inout) + & ch_ocn, ch_lnd, ch_ice, & !intent(inout) + & rb_ocn, rb_lnd, rb_ice, & !intent(inout) + & stress_ocn,stress_lnd,stress_ice, & !intent(inout) + & fm_ocn, fm_lnd, fm_ice, & !intent(inout) + & fh_ocn, fh_lnd, fh_ice, & !intent(inout) + & fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) + & fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) + & hflx_ocn, hflx_lnd, hflx_ice, & + & qflx_ocn, qflx_lnd, qflx_ice, & + & QSFC, qsfc_ruc, USTM, ZOL, MOL, & + & RMOL, WSPD, ch, HFLX, QFLX, LH, & + & FLHC, FLQC, & + & U10, V10, TH2, T2, Q2, & + & wstar, CHS2, CQS2, & ! & CP, G, ROVCP, R, XLV, & ! & SVP1, SVP2, SVP3, SVPT0, & ! & EP1,EP2,KARMAN, & - & icloud_bl, bl_mynn_cloudpdf, & & lprnt, errmsg, errflg ) ! should be moved to inside the mynn: use machine , only : kind_phys -! use funcphys, only : fpvs - - use physcons, only : cp => con_cp, & - & g => con_g, & - & r_d => con_rd, & - & r_v => con_rv, & - & cpv => con_cvap, & - & cliq => con_cliq, & - & Cice => con_csol, & - & rcp => con_rocp, & - & XLV => con_hvap, & - & XLF => con_hfus, & - & EP_1 => con_fvirt, & - & EP_2 => con_eps - - USE module_sf_mynn, only : SFCLAY_mynn + +! use physcons, only : cp => con_cp, & +! & g => con_g, & +! & r_d => con_rd, & +! & r_v => con_rv, & +! & cpv => con_cvap, & +! & cliq => con_cliq, & +! & Cice => con_csol, & +! & rcp => con_rocp, & +! & XLV => con_hvap, & +! & XLF => con_hfus, & +! & EP_1 => con_fvirt, & +! & EP_2 => con_eps + +! USE module_sf_mynn, only : SFCLAY_mynn !------------------------------------------------------------------- implicit none @@ -73,50 +92,13 @@ SUBROUTINE mynnsfc_wrapper_run( & real(kind=kind_phys), parameter :: SVP3 = 29.65 real(kind=kind_phys), parameter :: SVPT0 = 273.15 -!------------------------------------------------------------------- -!For WRF: -!------------------------------------------------------------------- -! USE module_model_constants, only: & -! &karman, g, p1000mb, & -! &cp, r_d, r_v, rcp, xlv, xlf, xls, & -! &svp1, svp2, svp3, svpt0, ep_1, ep_2, rvovrd, & -! &cpv, cliq, cice - -!------------------------------------------------------------------- -!For reference -! REAL , PARAMETER :: karman = 0.4 -! REAL , PARAMETER :: g = 9.81 -! REAL , PARAMETER :: r_d = 287. -! REAL , PARAMETER :: cp = 7.*r_d/2. -! REAL , PARAMETER :: r_v = 461.6 -! REAL , PARAMETER :: cpv = 4.*r_v -! REAL , PARAMETER :: cliq = 4190. -! REAL , PARAMETER :: Cice = 2106. -! REAL , PARAMETER :: rcp = r_d/cp -! REAL , PARAMETER :: XLS = 2.85E6 -! REAL , PARAMETER :: XLV = 2.5E6 -! REAL , PARAMETER :: XLF = 3.50E5 -! REAL , PARAMETER :: p1000mb = 100000. -! REAL , PARAMETER :: rvovrd = r_v/r_d -! REAL , PARAMETER :: SVP1 = 0.6112 -! REAL , PARAMETER :: SVP2 = 17.67 -! REAL , PARAMETER :: SVP3 = 29.65 -! REAL , PARAMETER :: SVPT0 = 273.15 -! REAL , PARAMETER :: EP_1 = R_v/R_d-1. -! REAL , PARAMETER :: EP_2 = R_d/R_v - REAL, PARAMETER :: xlvcp=xlv/cp, xlscp=(xlv+xlf)/cp, ev=xlv, rd=r_d, & - &rk=cp/rd, svp11=svp1*1.e3, p608=ep_1, ep_3=1.-ep_2, g_inv=1/g + &rk=cp/rd, svp11=svp1*1.e3, p608=ep_1, ep_3=1.-ep_2, g_inv=1./g character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg -! NAMELIST OPTIONS (INPUT): - INTEGER, INTENT(IN) :: & - & bl_mynn_cloudpdf, & - & icloud_bl - !MISC CONFIGURATION OPTIONS INTEGER, PARAMETER :: & & spp_pbl = 0, & @@ -124,171 +106,234 @@ SUBROUTINE mynnsfc_wrapper_run( & & iz0tlnd = 0, & & isfflx = 1 + integer, intent(in) :: ivegsrc + integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) + +!Input data + integer, dimension(im), intent(in) :: vegtype + real(kind=kind_phys), dimension(im), intent(in) :: & + & sigmaf,shdmax,z0pert,ztpert + !MYNN-1D REAL :: delt - INTEGER :: im, ix, levs - INTEGER :: iter, k, i, itimestep + INTEGER :: im, levs + INTEGER :: iter, k, i, itimestep, lsm LOGICAL :: flag_init,flag_restart,lprnt INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & & IMS,IME,JMS,JME,KMS,KME, & & ITS,ITE,JTS,JTE,KTS,KTE -!MYNN-3D - real(kind=kind_phys), dimension(im,levs+1) :: phii - real(kind=kind_phys), dimension(im,levs) :: & - & exner, PRSL, & - & u, v, t3d, qvsh, qc, & - & Sh3D, EL_PBL, EXCH_H, & - & qc_bl, cldfra_bl, & - & Tsq, Qsq, Cov - !LOCAL + real(kind=kind_phys), dimension(im,levs+1), & + & intent(in) :: phii + real(kind=kind_phys), dimension(im,levs), & + & intent(in) :: exner, PRSL, & + & u, v, t3d, qvsh, qc + real(kind=kind_phys), dimension(im,levs) :: & - & dz, rho, th, qv, & - & pattern_spp_pbl + & pattern_spp_pbl, dz, th, qv + + logical, dimension(im), intent(in) :: wet, dry, icy + + real(kind=kind_phys), dimension(im), intent(in) :: & + & tskin_ocn, tskin_lnd, tskin_ice, & + & tsurf_ocn, tsurf_lnd, tsurf_ice, & + & snowh_ocn, snowh_lnd, snowh_ice + + real(kind=kind_phys), dimension(im), intent(inout) :: & + & znt_ocn, znt_lnd, znt_ice, & + & ust_ocn, ust_lnd, ust_ice, & + & cm_ocn, cm_lnd, cm_ice, & + & ch_ocn, ch_lnd, ch_ice, & + & rb_ocn, rb_lnd, rb_ice, & + & stress_ocn,stress_lnd,stress_ice, & + & fm_ocn, fm_lnd, fm_ice, & + & fh_ocn, fh_lnd, fh_ice, & + & fm10_ocn, fm10_lnd, fm10_ice, & + & fh2_ocn, fh2_lnd, fh2_ice, & + & hflx_ocn, hflx_lnd, hflx_ice, & + & qflx_ocn, qflx_lnd, qflx_ice, & + & qsfc_ocn, qsfc_lnd, qsfc_ice !MYNN-2D - real(kind=kind_phys), dimension(im) :: & - & dx, pblh, slmsk, tsk, qsfc, ps, & - & zorl, ust, ustm, hflx, qfx, br, wspd, snowd, & + real(kind=kind_phys), dimension(im), intent(in) :: & + & dx, pblh, slmsk, ps + + real(kind=kind_phys), dimension(im), intent(inout) :: & + & ustm, hflx, qflx, wspd, qsfc, qsfc_ruc, & & FLHC, FLQC, U10, V10, TH2, T2, Q2, & & CHS2, CQS2, rmol, zol, mol, ch, & - & fm, fh, fm10, fh2, & - & lh, cda, cka, stress, wstar + & lh, wstar !LOCAL real, dimension(im) :: & - & qcg, hfx, znt, ts, snowh, psim, psih, & - & chs, ck, cd, mavail, regime, xland, GZ1OZ0 + & hfx, znt, ts, psim, psih, & + & chs, ck, cd, mavail, xland, GZ1OZ0, & + & cpm, qgh, qfx ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (lprnt) then - write(0,*)"==============================================" - write(0,*)"in mynn surface layer wrapper..." - write(0,*)"flag_init=",flag_init - write(0,*)"flag_restart=",flag_restart - write(0,*)"iter=",iter - endif - - ! If initialization is needed and mynnsfc_wrapper is called - ! in a subcycling loop, then test for (flag_init==.T. .and. iter==1); - ! initialization in sfclay_mynn is triggered by itimestep == 1 - ! DH* TODO: Use flag_restart to distinguish which fields need - ! to be initialized and which are read from restart files - if (flag_init.and.iter==1) then - itimestep = 1 - else - itimestep = 2 - endif - - !prep MYNN-only variables - do k=1,levs - do i=1,im - dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv - th(i,k)=t3d(i,k)/exner(i,k) - !qc(i,k)=MAX(qgrs(i,k,ntcw),0.0) - qv(i,k)=qvsh(i,k)/(1.0 - qvsh(i,k)) - rho(i,k)=prsl(i,k)/(r_d*t3d(i,k)) !gt0(i,k)) - pattern_spp_pbl(i,k)=0.0 - enddo - enddo - do i=1,im - if (slmsk(i)==1. .or. slmsk(i)==2.)then !sea/land/ice mask (=0/1/2) in FV3 - xland(i)=1.0 !but land/water = (1/2) in SFCLAY_mynn - else - xland(i)=2.0 - endif -! ust(i) = sqrt(stress(i)) - !ch(i)=0.0 - HFX(i)=hflx(i)*rho(i,1)*cp - !QFX(i)=evap(i) - !wstar(i)=0.0 - qcg(i)=0.0 - snowh(i)=snowd(i)*800. !mm -> m - znt(i)=zorl(i)*0.01 !cm -> m? - ts(i)=tsk(i)/exner(i,1) !theta -! qsfc(i)=qss(i) -! ps(i)=pgr(i) -! wspd(i)=wind(i) - mavail(i)=1.0 !???? - enddo - - if (lprnt) then - write(0,*)"CALLING SFCLAY_mynn; input:" - print*,"T:",t3d(1,1),t3d(1,2),t3d(1,3) - print*,"TH:",th(1,1),th(1,2),th(1,3) - print*,"rho:",rho(1,1),rho(1,2),rho(1,3) - print*,"u:",u(1,1:3) - !print*,"qv:",qv(1,1:3,1) - print*,"p:",prsl(1,1)," snowh=",snowh(1) - print*,"dz:",dz(1,1)," qsfc=",qsfc(1) - print*,"rmol:",rmol(1)," ust:",ust(1) - print*,"Tsk:",tsk(1)," Thetasurf:",ts(1) - print*,"HFX:",hfx(1)," qfx",qfx(1) - print*,"qsfc:",qsfc(1)," ps:",ps(1) - print*,"wspd:",wspd(1),"br=",br(1) - print*,"znt:",znt(1)," delt=",delt - print*,"im=",im," levs=",levs - print*,"flag_init=",flag_init !," ntcw=",ntcw!," ntk=",ntk - print*,"flag_restart=",flag_restart !," ntcw=",ntcw!," ntk=",ntk - print*,"iter=",iter - !print*,"ncld=",ncld," ntrac(gq0)=",ntrac - print*,"zlvl(1)=",dz(1,1)*0.5 - print*,"PBLH=",pblh(1)," xland=",xland(1) - endif - - - CALL SFCLAY_mynn( & - u3d=u,v3d=v,t3d=t3d,qv3d=qv,p3d=prsl,dz8w=dz, & - CP=cp,G=g,ROVCP=rcp,R=r_d,XLV=xlv, & - PSFCPA=ps,CHS=chs,CHS2=chs2,CQS2=cqs2, & - ZNT=znt,UST=ust,PBLH=pblh,MAVAIL=mavail, & - ZOL=zol,MOL=mol,REGIME=regime,psim=psim,psih=psih, & - psix=fm,psit=fh,psix10=fm10,psit2=fh2, & -! fm=psix,fh=psit,fm10=psix10,fh2=psit2, & - XLAND=xland,HFX=hfx,QFX=qfx,LH=lh,TSK=tsk, & - FLHC=flhc,FLQC=flqc,QSFC=qsfc,RMOL=rmol, & - U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2,SNOWH=snowh, & - GZ1OZ0=GZ1OZ0,WSPD=wspd,BR=br,ISFFLX=isfflx,DX=dx, & - SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0, & - EP1=ep_1,EP2=ep_2,KARMAN=karman, & - itimestep=itimestep,ch=ch, & - th3d=th,pi3d=exner,qc3d=qc,rho3d=rho, & - tsq=tsq,qsq=qsq,cov=cov,sh3d=sh3d,el_pbl=el_pbl, & - qcg=qcg,wstar=wstar, & - icloud_bl=icloud_bl,qc_bl=qc_bl,cldfra_bl=cldfra_bl, & - spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl, & - ids=1,ide=im, jds=1,jde=1, kds=1,kde=levs, & - ims=1,ime=im, jms=1,jme=1, kms=1,kme=levs, & - its=1,ite=im, jts=1,jte=1, kts=1,kte=levs, & - ustm=ustm, ck=ck, cka=cka, cd=cd, cda=cda, & - isftcflx=isftcflx, iz0tlnd=iz0tlnd, & - bl_mynn_cloudpdf=bl_mynn_cloudpdf ) - - - ! POST MYNN SURFACE LAYER (INTERSTITIAL) WORK: - do i = 1, im - hflx(i)=hfx(i)/(rho(i,1)*cp) - !QFX(i)=evap(i) - zorl(i)=znt(i)*100. !m -> cm - stress(i) = ust(i)**2 +! if (lprnt) then +! write(0,*)"==============================================" +! write(0,*)"in mynn surface layer wrapper..." +! write(0,*)"flag_init=",flag_init +! write(0,*)"flag_restart=",flag_restart +! write(0,*)"iter=",iter +! endif + + ! prep MYNN-only variables + do k=1,2 !levs + do i=1,im + dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv + th(i,k)=t3d(i,k)/exner(i,k) + !qc(i,k)=MAX(qgrs(i,k,ntcw),0.0) + qv(i,k)=qvsh(i,k)/(1.0 - qvsh(i,k)) + pattern_spp_pbl(i,k)=0.0 enddo - - - if (lprnt) then - print* - print*,"finished with mynn_surface layer; output:" - print*,"xland=",xland(1)," cda=",cda(1) - print*,"rmol:",rmol(1)," ust:",ust(1) - print*,"Tsk:",tsk(1)," Thetasurf:",ts(1) - print*,"HFX:",hfx(1)," qfx",qfx(1) - print*,"qsfc:",qsfc(1)," ps:",ps(1) - print*,"wspd:",wspd(1)," br=",br(1) - print*,"znt:",znt(1),"pblh:",pblh(1) - print*,"FLHC=",FLHC(1)," CHS=",CHS(1) - print* - endif + enddo + do i=1,im + if (slmsk(i)==1. .or. slmsk(i)==2.)then !sea/land/ice mask (=0/1/2) in FV3 + xland(i)=1.0 !but land/water = (1/2) in SFCLAY_mynn + else + xland(i)=2.0 + endif + qgh(i)=0.0 + !snowh(i)=snowd(i)*800. !mm -> m + !znt_lnd(i)=znt_lnd(i)*0.01 !cm -> m + !znt_ocn(i)=znt_ocn(i)*0.01 !cm -> m + !znt_ice(i)=znt_ice(i)*0.01 !cm -> m + ! DH* do the following line only if wet(i)? + ts(i)=tskin_ocn(i)/exner(i,1) !theta + ! *DH + mavail(i)=1.0 !???? + cpm(i)=cp + enddo + + ! cm -> m + where (dry) znt_lnd=znt_lnd*0.01 + where (wet) znt_ocn=znt_ocn*0.01 + where (icy) znt_ice=znt_ice*0.01 + +! if (lprnt) then +! write(0,*)"CALLING SFCLAY_mynn; input:" +! write(0,*)"T:",t3d(1,1),t3d(1,2),t3d(1,3) +! write(0,*)"TH:",th(1,1),th(1,2),th(1,3) +! write(0,*)"u:",u(1,1:3) +! write(0,*)"v:",v(1,1:3) +! !write(0,*)"qv:",qv(1,1:3,1) +! write(0,*)"p:",prsl(1,1) +! write(0,*)"dz:",dz(1,1)," qsfc=",qsfc(1)," rmol:",rmol(1) +! write(0,*)" land water ice" +! write(0,*)dry(1),wet(1),icy(1) +! write(0,*)"ust:",ust_lnd(1),ust_ocn(1),ust_ice(1) +! write(0,*)"Tsk:",tskin_lnd(1),tskin_ocn(1),tskin_ice(1) +! write(0,*)"Tsurf:",tsurf_lnd(1),tsurf_ocn(1),tsurf_ice(1) +! write(0,*)"Qsfc:",qsfc_lnd(1),qsfc_ocn(1),qsfc_ice(1) +! write(0,*)"sno:",snowh_lnd(1),snowh_ocn(1),snowh_ice(1) +! write(0,*)"znt:",znt_lnd(1),znt_ocn(1),znt_ice(1) +! !write(0,*)"HFX:",hfx(1)," qfx",qfx(1) +! write(0,*)"qsfc:",qsfc(1)," ps:",ps(1) +! write(0,*)"wspd:",wspd(1),"rb=",rb_ocn(1) +! write(0,*)"delt=",delt," im=",im," levs=",levs +! write(0,*)"flag_init=",flag_init +! write(0,*)"flag_restart=",flag_restart +! write(0,*)"iter=",iter +! write(0,*)"zlvl(1)=",dz(1,1)*0.5 +! write(0,*)"PBLH=",pblh(1)," xland=",xland(1) +! endif + + + CALL SFCLAY_mynn( & + u3d=u,v3d=v,t3d=t3d,qv3d=qv,p3d=prsl,dz8w=dz, & + th3d=th,pi3d=exner,qc3d=qc, & + PSFCPA=ps,PBLH=pblh,MAVAIL=mavail,XLAND=xland,DX=dx, & + CP=cp,G=g,ROVCP=rcp,R=r_d,XLV=xlv, & + SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0, & + EP1=ep_1,EP2=ep_2,KARMAN=karman, & + ISFFLX=isfflx,isftcflx=isftcflx,LSM=lsm,iz0tlnd=iz0tlnd, & + & sigmaf=sigmaf,vegtype=vegtype,shdmax=shdmax,ivegsrc=ivegsrc, & !intent(in) + & z0pert=z0pert,ztpert=ztpert, & !intent(in) + & redrag=redrag,sfc_z0_type=sfc_z0_type, & !intent(in) + itimestep=itimestep,iter=iter, & + wet=wet, dry=dry, icy=icy, & !intent(in) + tskin_ocn=tskin_ocn, tskin_lnd=tskin_lnd, tskin_ice=tskin_ice, & !intent(in) + tsurf_ocn=tsurf_ocn, tsurf_lnd=tsurf_lnd, tsurf_ice=tsurf_ice, & !intent(in) + qsfc_ocn=qsfc_ocn, qsfc_lnd=qsfc_lnd, qsfc_ice=qsfc_ice, & !intent(in) + snowh_ocn=snowh_ocn, snowh_lnd=snowh_lnd, snowh_ice=snowh_ice, & !intent(in) + znt_ocn=znt_ocn, znt_lnd=znt_lnd, znt_ice=znt_ice, & !intent(inout) + ust_ocn=ust_ocn, ust_lnd=ust_lnd, ust_ice=ust_ice, & !intent(inout) + cm_ocn=cm_ocn, cm_lnd=cm_lnd, cm_ice=cm_ice, & !intent(inout) + ch_ocn=ch_ocn, ch_lnd=ch_lnd, ch_ice=ch_ice, & !intent(inout) + rb_ocn=rb_ocn, rb_lnd=rb_lnd, rb_ice=rb_ice, & !intent(inout) + stress_ocn=stress_ocn,stress_lnd=stress_lnd,stress_ice=stress_ice, & !intent(inout) + fm_ocn=fm_ocn, fm_lnd=fm_lnd, fm_ice=fm_ice, & !intent(inout) + fh_ocn=fh_ocn, fh_lnd=fh_lnd, fh_ice=fh_ice, & !intent(inout) + fm10_ocn=fm10_ocn, fm10_lnd=fm10_lnd, fm10_ice=fm10_ice, & !intent(inout) + fh2_ocn=fh2_ocn, fh2_lnd=fh2_lnd, fh2_ice=fh2_ice, & !intent(inout) + hflx_ocn=hflx_ocn, hflx_lnd=hflx_lnd, hflx_ice=hflx_ice, & + qflx_ocn=qflx_ocn, qflx_lnd=qflx_lnd, qflx_ice=qflx_ice, & + ch=ch,CHS=chs,CHS2=chs2,CQS2=cqs2,CPM=cpm, & + ZNT=znt,USTM=ustm,ZOL=zol,MOL=mol,RMOL=rmol, & + psim=psim,psih=psih, & + HFLX=hflx,HFX=hfx,QFLX=qflx,QFX=qfx,LH=lh,FLHC=flhc,FLQC=flqc, & + QGH=qgh,QSFC=qsfc,QSFC_RUC=qsfc_ruc, & + U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2, & + GZ1OZ0=GZ1OZ0,WSPD=wspd,wstar=wstar, & + spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl, & + ids=1,ide=im, jds=1,jde=1, kds=1,kde=levs, & + ims=1,ime=im, jms=1,jme=1, kms=1,kme=levs, & + its=1,ite=im, jts=1,jte=1, kts=1,kte=levs ) + + + !! POST MYNN SURFACE LAYER (INTERSTITIAL) WORK: + !do i = 1, im + ! !* Taken from sfc_nst.f + ! !* ch = surface exchange coeff heat & moisture(m/s) im + ! !* rch(i) = rho_a(i) * cp * ch(i) * wind(i) + ! !* hflx(i) = rch(i) * (tsurf(i) - theta1(i)) !K m s-1 + ! !* hflx(i)=hfx(i)/(rho(i,1)*cp) - now calculated inside module_sf_mynn.F90 + ! !* Taken from sfc_nst.f + ! !* evap(i) = elocp * rch(i) * (qss(i) - q0(i)) !kg kg-1 m s-1 + ! !NOTE: evap & qflx will be solved for later + ! !qflx(i)=QFX(i)/ + ! !evap(i)=QFX(i) !or /rho ?? + ! ! DH* note - this could be automated (CCPP knows how to convert m to cm) + ! znt_lnd(i)=znt_lnd(i)*100. !m -> cm + ! znt_ocn(i)=znt_ocn(i)*100. + ! znt_ice(i)=znt_ice(i)*100. + !enddo + + ! m -> cm + where (dry) znt_lnd=znt_lnd*100. + where (wet) znt_ocn=znt_ocn*100. + where (icy) znt_ice=znt_ice*100. + +! if (lprnt) then +! write(0,*) +! write(0,*)"finished with mynn_surface layer; output:" +! write(0,*)" land water ice" +! write(0,*)dry(1),wet(1),icy(1) +! write(0,*)"ust:",ust_lnd(1),ust_ocn(1),ust_ice(1) +! write(0,*)"Tsk:",tskin_lnd(1),tskin_ocn(1),tskin_ice(1) +! write(0,*)"Tsurf:",tsurf_lnd(1),tsurf_ocn(1),tsurf_ice(1) +! write(0,*)"Qsfc:",qsfc_lnd(1),qsfc_ocn(1),qsfc_ice(1) +! write(0,*)"sno:",snowh_lnd(1),snowh_ocn(1),snowh_ice(1) +! write(0,*)"znt (cm):",znt_lnd(1),znt_ocn(1),znt_ice(1) +! write(0,*)"cm:",cm_lnd(1),cm_ocn(1),cm_ice(1) +! write(0,*)"ch:",ch_lnd(1),ch_ocn(1),ch_ice(1) +! write(0,*)"fm:",fm_lnd(1),fm_ocn(1),fm_ice(1) +! write(0,*)"fh:",fh_lnd(1),fh_ocn(1),fh_ice(1) +! write(0,*)"rb:",rb_lnd(1),rb_ocn(1),rb_ice(1) +! write(0,*)"xland=",xland(1)," wstar:",wstar(1) +! write(0,*)"HFX:",hfx(1)," qfx:",qfx(1) +! write(0,*)"HFLX:",hflx(1)," evap:",evap(1) +! write(0,*)"qsfc:",qsfc(1)," ps:",ps(1)," wspd:",wspd(1) +! write(0,*)"ZOL:",ZOL(1)," rmol=",rmol(1) +! write(0,*)"psim:",psim(1)," psih=",psih(1)," pblh:",pblh(1) +! write(0,*)"FLHC=",FLHC(1)," CHS=",CHS(1) +! write(0,*) +! endif END SUBROUTINE mynnsfc_wrapper_run diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index da86a054b..cf366d3d4 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = mynnsfc_wrapper_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -25,6 +17,14 @@ type = integer intent = in optional = F +[itimestep] + standard_name = index_of_time_step + long_name = current number of time steps + units = index + dimensions = () + type = integer + intent = in + optional = F [iter] standard_name = ccpp_loop_counter long_name = loop counter for subcycling loops in CCPP @@ -49,6 +49,82 @@ type = logical intent = in optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractnl cover of green veg + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[z0pert] + standard_name = perturbation_of_momentum_roughness_length + long_name = perturbation of momentum roughness length + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ztpert] + standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = perturbation of heat to momentum roughness length ratio + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[redrag] + standard_name = flag_for_reduced_drag_coefficient_over_sea + long_name = flag for reduced drag coefficient over sea + units = flag + dimensions = () + type = logical + intent = in + optional = F +[sfc_z0_type] + standard_name = flag_for_surface_roughness_option_over_ocean + long_name = surface roughness options over ocean + units = flag + dimensions = () + type = integer + intent = in + optional = F [delt] standard_name = time_step_for_physics long_name = time step for physics @@ -139,116 +215,149 @@ kind = kind_phys intent = in optional = F -[tsq] - standard_name = t_prime_squared - long_name = temperature fluctuation squared - units = K2 - dimensions = (horizontal_dimension,vertical_dimension) +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[qsq] - standard_name = q_prime_squared - long_name = water vapor fluctuation squared - units = kg2 kg-2 - dimensions = (horizontal_dimension,vertical_dimension) +[PBLH] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[cov] - standard_name = t_prime_q_prime - long_name = covariance of temperature and moisture - units = K kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[el_pbl] - standard_name = mixing_length - long_name = mixing length in meters - units = m - dimensions = (horizontal_dimension,vertical_dimension) +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[tskin_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[Sh3D] - standard_name = stability_function_for_heat - long_name = stability function for heat - units = none - dimensions = (horizontal_dimension,vertical_dimension) +[tskin_lnd] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[QC_BL] - standard_name = subgrid_cloud_mixing_ratio_pbl - long_name = subgrid cloud cloud mixing ratio from PBL scheme - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) +[tskin_ice] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[CLDFRA_BL] - standard_name = subgrid_cloud_fraction_pbl - long_name = subgrid cloud fraction from PBL scheme - units = frac - dimensions = (horizontal_dimension,vertical_dimension) +[tsurf_ocn] + standard_name = surface_skin_temperature_after_iteration_over_ocean + long_name = surface skin temperature after iteration over ocean + units = K + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[ps] - standard_name = surface_air_pressure - long_name = surface pressure - units = Pa +[tsurf_lnd] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[PBLH] - standard_name = atmosphere_boundary_layer_thickness - long_name = PBL thickness - units = m +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag +[qsfc_ocn] + standard_name = surface_specific_humidity_over_ocean + long_name = surface air saturation specific humidity over ocean + units = kg kg-1 dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F -[tsk] - standard_name = surface_skin_temperature - long_name = surface temperature - units = K +[qsfc_lnd] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F -[qsfc] - standard_name = surface_specific_humidity - long_name = surface air saturation specific humidity +[qsfc_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice units = kg kg-1 dimensions = (horizontal_dimension) type = real kind = kind_phys + intent = inout + optional = F +[snowh_ocn] + standard_name = surface_snow_thickness_water_equivalent_over_ocean + long_name = water equivalent snow depth over ocean + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys intent = in optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent +[snowh_lnd] + standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm dimensions = (horizontal_dimension) @@ -256,114 +365,402 @@ kind = kind_phys intent = in optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length in cm +[snowh_ice] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[znt_ocn] + standard_name = surface_roughness_length_over_ocean_interstitial + long_name = surface roughness length over ocean (temporary use as interstitial) units = cm dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[ust] - standard_name = surface_friction_velocity - long_name = boundary layer parameter +[znt_lnd] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[znt_ice] + standard_name = surface_roughness_length_over_ice_interstitial + long_name = surface roughness length over ice (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ust_ocn] + standard_name = surface_friction_velocity_over_ocean + long_name = surface friction velocity over ocean units = m s-1 dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[ustm] - standard_name = surface_friction_velocity_drag - long_name = friction velocity isolated for momentum only +[ust_lnd] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land units = m s-1 dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[zol] - standard_name = surface_stability_parameter - long_name = monin obukhov surface stability parameter +[ust_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm_ocn] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean + long_name = surface exchange coeff for momentum over ocean units = none dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[mol] - standard_name = theta_star - long_name = temperature flux divided by ustar (temperature scale) - units = K +[cm_lnd] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[rmol] - standard_name = reciprocal_of_obukhov_length - long_name = one over obukhov length - units = m-1 +[cm_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[fm] - standard_name = Monin_Obukhov_similarity_function_for_momentum - long_name = Monin-Obukhov similarity parameter for momentum +[ch_ocn] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean + long_name = surface exchange coeff heat & moisture over ocean units = none dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[fh] - standard_name = Monin_Obukhov_similarity_function_for_heat - long_name = Monin-Obukhov similarity parameter for heat +[ch_lnd] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land units = none dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[fm10] - standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m - long_name = Monin-Obukhov similarity parameter for momentum +[ch_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice units = none dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[fh2] - standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m - long_name = Monin-Obukhov similarity parameter for heat +[rb_ocn] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean + long_name = bulk Richardson number at the surface over ocean units = none dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[wspd] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level +[rb_lnd] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb_ice] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ice + long_name = bulk Richardson number at the surface over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_lnd] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ice] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean + long_name = Monin-Obukhov similarity function for momentum over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_lnd] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity function for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice + long_name = Monin-Obukhov similarity function for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean + long_name = Monin-Obukhov similarity function for heat over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_lnd] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice + long_name = Monin-Obukhov similarity function for heat over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_lnd] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land + long_name = Monin-Obukhov similarity parameter for momentum at 10m over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean + long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_lnd] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land + long_name = Monin-Obukhov similarity parameter for heat at 2m over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + long_name = Monin-Obukhov similarity parameter for heat at 2m over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_ocn] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean + long_name = kinematic surface upward sensible heat flux over ocean + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_lnd] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qflx_ocn] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean + long_name = kinematic surface upward latent heat flux over ocean + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_lnd] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qflx_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qsfc] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsfc_ruc] + standard_name = water_vapor_mixing_ratio_at_surface + long_name = water vapor mixing ratio at surface + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustm] + standard_name = surface_friction_velocity_drag + long_name = friction velocity isolated for momentum only units = m s-1 dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[br] - standard_name = bulk_richardson_number_at_lowest_model_level - long_name = bulk Richardson number at the surface +[zol] + standard_name = surface_stability_parameter + long_name = monin obukhov surface stability parameter units = none dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F +[mol] + standard_name = theta_star + long_name = temperature flux divided by ustar (temperature scale) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rmol] + standard_name = reciprocal_of_obukhov_length + long_name = one over obukhov length + units = m-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wspd] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [ch] standard_name = surface_drag_wind_speed_for_momentum_in_air long_name = momentum exchange coefficient @@ -382,7 +779,7 @@ kind = kind_phys intent = inout optional = F -[QFX] +[qflx] standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 @@ -490,49 +887,6 @@ kind = kind_phys intent = inout optional = F -[cda] - standard_name = surface_drag_coefficient_for_momentum_in_air - long_name = surface exchange coeff for momentum - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cka] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air - long_name = surface exchange coeff heat & moisture - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[stress] - standard_name = surface_wind_stress - long_name = surface wind stress - units = m2 s-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[bl_mynn_cloudpdf] - standard_name = cloudpdf - long_name = flag to determine which cloud PDF to use - units = flag - dimensions = () - type = integer - intent = in - optional = F -[icloud_bl] - standard_name = couple_sgs_clouds_to_radiation_flag - long_name = flag for coupling sgs clouds to radiation - units = flag - dimensions = () - type = integer - intent = in - optional = F [lprnt] standard_name = flag_print long_name = control flag for diagnostic print out diff --git a/physics/module_MYNNrad_post.F90 b/physics/module_MYNNrad_post.F90 deleted file mode 100644 index 1364db62e..000000000 --- a/physics/module_MYNNrad_post.F90 +++ /dev/null @@ -1,75 +0,0 @@ -!> \file module_MYNNrad_post.F90 -!! Contains the post (interstitial) work after the call to the radiation schemes: -!! 1) Restores the original qc & qi - - MODULE mynnrad_post - - contains - - subroutine mynnrad_post_init () - end subroutine mynnrad_post_init - - subroutine mynnrad_post_finalize () - end subroutine mynnrad_post_finalize - -!>\defgroup gsd_mynnrad_post GSD mynnrad_post_run Module -!>\ingroup gsd_mynn_edmf -!! This interstitial code restores the original resolved-scale clouds (qc and qi). -#if 0 -!! \section arg_table_mynnrad_post_run Argument Table -!! \htmlinclude mynnrad_post_run.html -!! -#endif -SUBROUTINE mynnrad_post_run( & - & ix,im,levs, & - & flag_init,flag_restart, & - & qc,qi, & - & qc_save, qi_save, & - & errmsg, errflg ) - -! should be moved to inside the mynn: - use machine , only : kind_phys - -!------------------------------------------------------------------- - implicit none -!------------------------------------------------------------------- - - integer, intent(in) :: ix, im, levs - logical, intent(in) :: flag_init, flag_restart - real(kind=kind_phys), dimension(im,levs), intent(out) :: qc, qi - real(kind=kind_phys), dimension(im,levs), intent(in) :: qc_save, qi_save - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - ! Local variable - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - !write(0,*)"==============================================" - !write(0,*)"in mynn rad post" - - if (flag_init .and. (.not. flag_restart)) then - !write (0,*) 'Skip MYNNrad_post flag_init = ', flag_init - return - endif - - ! Add subgrid cloud information: - do k = 1, levs - do i = 1, im - - qc(i,k) = qc_save(i,k) - qi(i,k) = qi_save(i,k) - - enddo - enddo - - ! print*,"===Finished restoring the resolved-scale clouds" - ! print*,"qc_save:",qc_save(1,1)," qc:",qc(1,1) - - END SUBROUTINE mynnrad_post_run - -!###================================================================= - -END MODULE mynnrad_post diff --git a/physics/module_MYNNrad_pre.F90 b/physics/module_MYNNrad_pre.F90 deleted file mode 100644 index 95dc95445..000000000 --- a/physics/module_MYNNrad_pre.F90 +++ /dev/null @@ -1,131 +0,0 @@ -!> \file module_MYNNrad_pre.F90 -!! Contains the preliminary (interstitial) work to the call to the radiation schemes: -!! 1) Backs up the original qc & qi -!! 2) Adds the subgrid clouds mixing ratio and cloud fraction to the original qc, qi and cloud fraction coming from the microphysics scheme. - - MODULE mynnrad_pre - - contains - - subroutine mynnrad_pre_init () - end subroutine mynnrad_pre_init - - subroutine mynnrad_pre_finalize () - end subroutine mynnrad_pre_finalize - -!>\defgroup gsd_mynnrad_pre GSD mynnrad_pre_run Module -!>\ingroup gsd_mynn_edmf -!! This interstitial code adds the subgrid clouds to the resolved-scale clouds if there is no resolved-scale clouds in that particular grid box. -#if 0 -!> \section arg_table_mynnrad_pre_run Argument Table -!! \htmlinclude mynnrad_pre_run.html -!! -#endif -! -! cloud array description: ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path ! -! clouds(:,:,3) - mean effective radius for liquid cloud ! -! clouds(:,:,4) - layer cloud ice water path ! -! clouds(:,:,5) - mean effective radius for ice cloud ! -! -!###=================================================================== -SUBROUTINE mynnrad_pre_run( & - & ix,im,levs, & - & flag_init,flag_restart, & - & qc, qi, T3D, & - & qc_save, qi_save, & - & qc_bl,cldfra_bl, & - & delp,clouds1,clouds2,clouds3, & - & clouds4,clouds5,slmsk, & - & errmsg, errflg ) - -! should be moved to inside the mynn: - use machine , only : kind_phys - ! DH* TODO - input argument, not constant - use physcons, only : con_g - -!------------------------------------------------------------------- - implicit none -!------------------------------------------------------------------- - ! Interface variables - real (kind=kind_phys), parameter :: gfac=1.0e5/con_g - integer, intent(in) :: ix, im, levs - logical, intent(in) :: flag_init, flag_restart - real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc, qi - real(kind=kind_phys), dimension(im,levs), intent(in) :: T3D,delp - real(kind=kind_phys), dimension(im,levs), intent(inout) :: & - & clouds1,clouds2,clouds3,clouds4,clouds5 - real(kind=kind_phys), dimension(im,levs), intent(out) :: qc_save, qi_save - real(kind=kind_phys), dimension(im,levs), intent(in) :: qc_bl, cldfra_bl - ! DH* TODO add intent() information for delp,clouds1,clouds2,clouds3,clouds4,clouds5 - real(kind=kind_phys), dimension(im), intent(in) :: slmsk - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - ! Local variables - integer :: i, k - real :: Tc, iwc - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - !write(0,*)"==============================================" - !write(0,*)"in mynn rad pre" - - if (flag_init .and. (.not. flag_restart)) then - !write (0,*) 'Skip MYNNrad_pre flag_init = ', flag_init - return - endif - ! Add subgrid cloud information: - do k = 1, levs - do i = 1, im - - qc_save(i,k) = qc(i,k) - qi_save(i,k) = qi(i,k) - clouds1(i,k) = CLDFRA_BL(i,k) - - IF (qc(i,k) < 1.E-6 .AND. qi(i,k) < 1.E-8 .AND. CLDFRA_BL(i,k)>0.001) THEN - !Partition the BL clouds into water & ice according to a linear - !approximation of Hobbs et al. (1974). This allows us to only use - !one 3D array for both cloud water & ice. -! Wice = 1. - MIN(1., MAX(0., (t(i,k)-254.)/15.)) -! Wh2o = 1. - Wice - !clouds1(i,k)=MAX(clouds1(i,k),CLDFRA_BL(i,k)) - !clouds1(i,k)=MAX(0.0,MIN(1.0,clouds1(i,k))) - qc(i,k) = QC_BL(i,k)*(MIN(1., MAX(0., (T3D(i,k)-254.)/15.)))*CLDFRA_BL(i,k) - qi(i,k) = QC_BL(i,k)*(1. - MIN(1., MAX(0., (T3D(i,k)-254.)/15.)))*CLDFRA_BL(i,k) - - Tc = T3D(i,k) - 273.15 - !iwc = qi(i,k)*1.0e6*rho(i,k) - - IF (nint(slmsk(i)) == 1) then !land - IF(qc(i,k)>1.E-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos) - IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(173.45 + 2.14*Tc, 20.) - ELSE - !eff radius cloud water (microns), from Miles et al. - IF(qc(i,k)>1.E-8)clouds3(i,k)=9.6 - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(173.45 + 2.14*Tc, 20.) - !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b) - !IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) - ENDIF - - !water and ice paths - clouds2(i,k) = max(0.0, qc(i,k) * gfac * delp(i,k)) - clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) - - ENDIF - - enddo - enddo - - !print*,"===Finished adding subgrid clouds to the resolved-scale clouds" - !print*,"qc_save:",qc_save(1,1)," qi_save:",qi_save(1,1) - - END SUBROUTINE mynnrad_pre_run - -!###================================================================= - -END MODULE mynnrad_pre diff --git a/physics/module_MYNNrad_pre.meta b/physics/module_MYNNrad_pre.meta deleted file mode 100644 index 3b6a9ccbc..000000000 --- a/physics/module_MYNNrad_pre.meta +++ /dev/null @@ -1,186 +0,0 @@ -[ccpp-arg-table] - name = mynnrad_pre_run - type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[levs] - standard_name = vertical_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - 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 -[flag_restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - units = flag - dimensions = () - type = logical - intent = in - optional = F -[qc] - standard_name = cloud_condensed_water_mixing_ratio - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qi] - standard_name = ice_water_mixing_ratio - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[T3D] - standard_name = air_temperature - long_name = layer mean air temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qc_save] - standard_name = cloud_condensed_water_mixing_ratio_save - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[qi_save] - standard_name = ice_water_mixing_ratio_save - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[QC_BL] - standard_name = subgrid_cloud_mixing_ratio_pbl - long_name = subgrid cloud cloud mixing ratio from PBL scheme - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[CLDFRA_BL] - standard_name = subgrid_cloud_fraction_pbl - long_name = subgrid cloud fraction from PBL scheme - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[delp] - standard_name = layer_pressure_thickness_for_radiation - long_name = layer pressure thickness on radiation levels - units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = out - optional = F -[clouds1] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[clouds2] - standard_name = cloud_liquid_water_path - long_name = layer cloud liquid water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[clouds3] - standard_name = mean_effective_radius_for_liquid_cloud - long_name = mean effective radius for liquid cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[clouds4] - standard_name = cloud_ice_water_path - long_name = layer cloud ice water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[clouds5] - standard_name = mean_effective_radius_for_ice_cloud - long_name = mean effective radius for ice cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F diff --git a/physics/module_SGSCloud_RadPost.F90 b/physics/module_SGSCloud_RadPost.F90 new file mode 100644 index 000000000..bedb660a6 --- /dev/null +++ b/physics/module_SGSCloud_RadPost.F90 @@ -0,0 +1,69 @@ +!> \file module_SGSCloud_RadPost.F90 +!! Contains the post (interstitial) work after the call to the radiation schemes: +!! 1) Restores the original qc & qi + + module sgscloud_radpost + + contains + + subroutine sgscloud_radpost_init () + end subroutine sgscloud_radpost_init + + subroutine sgscloud_radpost_finalize () + end subroutine sgscloud_radpost_finalize + +!>\defgroup sgscloud_radpost GSD sgscloud_radpost_run Module +!>\ingroup gsd_mynn_edmf +!! This interstitial code restores the original resolved-scale clouds (qc and qi). +!! \section arg_table_sgscloud_radpost_run Argument Table +!! \htmlinclude sgscloud_radpost_run.html +!! + subroutine sgscloud_radpost_run( & + im,levs, & + flag_init,flag_restart, & + qc,qi, & + qc_save,qi_save, & + errmsg,errflg ) + +! should be moved to inside the mynn: + use machine , only : kind_phys + +!------------------------------------------------------------------- + implicit none +!------------------------------------------------------------------- + + integer, intent(in) :: im, levs + logical, intent(in) :: flag_init, flag_restart + real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc, qi + real(kind=kind_phys), dimension(im,levs), intent(in) :: qc_save, qi_save + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Local variable + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + !write(0,*)"==============================================" + !write(0,*)"in sgscloud rad post" + + if (flag_init .and. (.not. flag_restart)) then + !write (0,*) 'Skip MYNNrad_post flag_init = ', flag_init + return + endif + + ! Add subgrid cloud information: + do k = 1, levs + do i = 1, im + qc(i,k) = qc_save(i,k) + qi(i,k) = qi_save(i,k) + enddo + enddo + + ! print*,"===Finished restoring the resolved-scale clouds" + ! print*,"qc_save:",qc_save(1,1)," qc:",qc(1,1) + + end subroutine sgscloud_radpost_run + + end module sgscloud_radpost diff --git a/physics/module_MYNNrad_post.meta b/physics/module_SGSCloud_RadPost.meta similarity index 91% rename from physics/module_MYNNrad_post.meta rename to physics/module_SGSCloud_RadPost.meta index f6d1a41d7..da4191aad 100644 --- a/physics/module_MYNNrad_post.meta +++ b/physics/module_SGSCloud_RadPost.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] - name = mynnrad_post_run + name = sgscloud_radpost_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -48,7 +40,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [qi] standard_name = ice_water_mixing_ratio @@ -57,7 +49,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [qc_save] standard_name = cloud_condensed_water_mixing_ratio_save diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 new file mode 100644 index 000000000..5a1a2744f --- /dev/null +++ b/physics/module_SGSCloud_RadPre.F90 @@ -0,0 +1,319 @@ +!>\file module_SGSCloud_RadPre.F90 +!! Contains the preliminary (interstitial) work to the call to the radiation schemes: +!! 1) Backs up the original qc & qi +!! 2) Adds the partioning of convective condensate into liqice/ice for effective radii +!! 3) Adds the subgrid clouds mixing ratio and cloud fraction to the original (resolved- +!! scale) qc, qi and cloud fraction coming from the microphysics scheme. +!! 4) Recompute the diagnostic high, mid, low, total and bl clouds to be consistent with radiation + + module sgscloud_radpre + + contains + + subroutine sgscloud_radpre_init () + end subroutine sgscloud_radpre_init + + subroutine sgscloud_radpre_finalize () + end subroutine sgscloud_radpre_finalize + +!> \defgroup sgsrad_group GSD sgscloud_radpre_run Module +!> \ingroup sgscloud_radpre +!! This interstitial code adds the subgrid clouds to the resolved-scale clouds +!! if there is no resolved-scale clouds in that particular grid box. It can also +!! specify a cloud fraction for resolved-scale clouds, using Xu-Randall (1996), +!! if desired. +!> \section arg_table_sgscloud_radpre_run Argument Table +!! \htmlinclude sgscloud_radpre_run.html +!! +!! cloud array description: ! +!! clouds(:,:,1) - layer total cloud fraction ! +!! clouds(:,:,2) - layer cloud liq water path ! +!! clouds(:,:,3) - mean effective radius for liquid cloud ! +!! clouds(:,:,4) - layer cloud ice water path ! +!! clouds(:,:,5) - mean effective radius for ice cloud ! +!! +!>\section sgscloud_radpre GSD SGS Scheme General Algorithm +!> @{ + subroutine sgscloud_radpre_run( & + im,levs, & + flag_init,flag_restart, & + do_mynnedmf, & + qc, qi, qv, T3D, P3D, & + qr, qs, qg, & + qci_conv, & + imfdeepcnv, imfdeepcnv_gf, & + qc_save, qi_save, & + qc_bl,qi_bl,cldfra_bl, & + delp,clouds1,clouds2,clouds3, & + clouds4,clouds5,slmsk, & + nlay, plyr, xlat, dz,de_lgth, & + cldsa,mtopa,mbota, & + imp_physics, imp_physics_gfdl,& + errmsg, errflg ) + +! should be moved to inside the mynn: + use machine , only : kind_phys + use physcons, only : con_g, con_pi, & + eps => con_eps, & ! Rd/Rv + epsm1 => con_epsm1 ! Rd/Rv-1 + use module_radiation_clouds, only : gethml + use radcons, only: qmin ! Minimum vlaues for varius calculations + use funcphys, only: fpvs ! Function ot compute sat. vapor pressure over liq. +!------------------------------------------------------------------- + implicit none +!------------------------------------------------------------------- + ! Interface variables + real (kind=kind_phys), parameter :: gfac=1.0e5/con_g + integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, & + & nlay, imp_physics, imp_physics_gfdl + logical, intent(in) :: flag_init, flag_restart, do_mynnedmf + real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc, qi + real(kind=kind_phys), dimension(im,levs), intent(inout) :: qr, qs, qg + ! qci_conv only allocated if GF is used + real(kind=kind_phys), dimension(:,:), intent(inout) :: qci_conv + real(kind=kind_phys), dimension(im,levs), intent(in) :: T3D,delp, & + & qv,P3D + real(kind=kind_phys), dimension(im,levs), intent(inout) :: & + & clouds1,clouds2,clouds3,clouds4,clouds5 + real(kind=kind_phys), dimension(im,levs), intent(inout) :: qc_save, qi_save + real(kind=kind_phys), dimension(im,levs), intent(in) :: qc_bl, qi_bl, cldfra_bl + real(kind=kind_phys), dimension(im), intent(in) :: slmsk, xlat, de_lgth + real(kind=kind_phys), dimension(im,nlay), intent(in) :: plyr, dz + real(kind=kind_phys), dimension(im,5), intent(inout) :: cldsa + integer, dimension(im,3), intent(inout) :: mbota, mtopa + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Local variables + ! pressure limits of cloud domain interfaces (low,mid,high) in mb (0.1kPa) + real (kind=kind_phys) :: ptop1(im,3+1) !< pressure limits of cloud domain interfaces + real (kind=kind_phys) :: ptopc(3+1,2 ) !< pressure limits of cloud domain interfaces + !! (low, mid, high) in mb (0.1kPa) + data ptopc / 1050., 650., 400., 0.0, 1050., 750., 500., 0.0 / + real(kind=kind_phys), dimension(im,nlay) :: cldcnv + real(kind=kind_phys), dimension(im) :: rxlat + real (kind=kind_phys):: Tc, iwc + integer :: i, k, id + + ! PARAMETERS FOR RANDALL AND XU (1996) CLOUD FRACTION + REAL, PARAMETER :: coef_p = 0.25, coef_gamm = 0.49, coef_alph = 100. + REAL :: rhgrid,h2oliq,qsat,tem1,tem2,clwt,es,onemrh,value + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + !write(0,*)"==============================================" + !write(0,*)"in SGSCLoud_RadPre" + + if (flag_init .and. (.not. flag_restart)) then + !write (0,*) 'Skip this flag_init = ', flag_init + ! return + ! Need default cloud fraction when MYNN is not used: Resort to + ! Xu-Randall (1996). + ! cloud fraction = + ! {1-exp[-100.0*qc/((1-RH)*qsat)**0.49]}*RH**0.25 + do k = 1, levs + do i = 1, im + if ( qi(i,k) > 1E-7 .OR. qc(i,k) > 1E-7 ) then + es = min( p3d(i,k), fpvs( t3d(i,k) ) ) ! fpvs and prsl in pa + qsat = max( QMIN, eps * es / (p3d(i,k) + epsm1*es) ) + rhgrid = max( 0., min( 1., qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(i,k) + qr(i,k) + qs(i,k) + qg(i,k) ! g/kg + clwt = 1.0e-6 * (p3d(i,k)*0.00001) + + if (h2oliq > clwt) then + onemrh= max( 1.e-10, 1.0-rhgrid ) + tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan + tem1 = 100.0 / tem1 + value = max( min( tem1*(h2oliq-clwt), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + + endif + enddo + enddo + + else ! timestep > 1 or restart + + ! Back-up microphysics cloud information: + do k = 1, levs + do i = 1, im + qc_save(i,k) = qc(i,k) + qi_save(i,k) = qi(i,k) + end do + end do + + if ( do_mynnedmf ) then + + ! add boundary layer clouds - Note: now the temperature-dependent sorting of + ! ice and water subgrid-scale clouds is done inside the MYNN-EDMF + + do k = 1, levs + do i = 1, im + + !if (imp_physics == imp_physics_gfdl) then + ! ! only complement the GFDL cloud fractions + ! if (clouds1(i,k) < 0.01 .and. cldfra_bl(i,k) > 0.01) then + ! clouds1(i,k) = cldfra_bl(i,k) + ! endif + !else + clouds1(i,k) = cldfra_bl(i,k) + !endif + + !if( qr(i,k) > 1.0e-7 .OR. qs(i,k) > 1.0e-7.or.qci_conv(i,k)>1.0e-7)THEN + !Keep Xu-RandalL clouds fraction - do not overwrite + !else + ! clouds1(i,k) = cldfra_bl(i,k) + !endif + + if (qc(i,k) < 1.e-6 .and. cldfra_bl(i,k)>0.001) then + qc(i,k) = qc_bl(i,k)*cldfra_bl(i,k) + if (nint(slmsk(i)) == 1) then !land + if(qc(i,k)>1.E-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) + else + !eff radius cloud water (microns), from Miles et al. + if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 + endif + !calculate the liquid water path using additional BL clouds + clouds2(i,k) = max(0.0, qc(i,k) * gfac * delp(i,k)) + endif + if (qi(i,k) < 1.e-8 .and. cldfra_bl(i,k)>0.001) then + qi(i,k) = qi_bl(i,k)*cldfra_bl(i,k) + Tc = T3D(i,k) - 273.15 + !iwc = qi(i,k)*1.0e6*rho(i,k) + if (nint(slmsk(i)) == 1) then !land + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) + if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + else + if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b) + !IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) + endif + !calculate the ice water path using additional BL clouds + clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) + endif + + enddo + enddo + + elseif (imp_physics /= imp_physics_gfdl) then + + ! Non-MYNN cloud fraction AND non-GFDL microphysics, since both + ! have their own cloud fractions. In this case, we resort to + ! Xu-Randall (1996). + ! cloud fraction = + ! {1-exp[-100.0*qc/((1-RH)*qsat)**0.49]}*RH**0.25 + do k = 1, levs + do i = 1, im + if ( qi(i,k) > 1E-7 .OR. qc(i,k) > 1E-7 ) then + + es = min( p3d(i,k), fpvs( t3d(i,k) ) ) ! fpvs and prsl in pa + qsat = max( QMIN, eps * es / (p3d(i,k) + epsm1*es) ) + rhgrid = max( 0., min( 1., qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(i,k) + qr(i,k) + qs(i,k) + qg(i,k) ! g/kg + clwt = 1.0e-6 * (p3d(i,k)*0.00001) + + if (h2oliq > clwt) then + onemrh= max( 1.e-10, 1.0-rhgrid ) + tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan + tem1 = 100.0 / tem1 + value = max( min( tem1*(h2oliq-clwt), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + + endif + enddo + enddo + + endif ! end MYNN or OTHER choice for background clouds fractions + + ! At this point, we have cloud properties for all non-deep convective clouds. + ! So now we add the convective clouds, + + if (imfdeepcnv == imfdeepcnv_gf) then + do k = 1, levs + do i = 1, im + !if ( qci_conv(i,k) > 0. .AND. (qi(i,k) < 1E-7 .AND. qc(i,k) < 1E-7 ) ) then + if ( qci_conv(i,k) > 0. ) then + !Partition the convective clouds into water & ice according to a linear + qc(i,k) = qc(i,k)+qci_conv(i,k)*(min(1., max(0., (T3D(i,k)-244.)/25.))) + qi(i,k) = qi(i,k)+qci_conv(i,k)*(1. - min(1., max(0., (T3D(i,k)-244.)/25.))) + + Tc = T3D(i,k) - 273.15 + + if (nint(slmsk(i)) == 1) then !land + if(qc(i,k)>1.E-8)clouds3(i,k)=5.4 !eff radius cloud water (microns) + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos) + if(qi(i,k)>1.e-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + else + !eff radius cloud water (microns), from Miles et al. + if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 + !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) + if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + endif + + if ( do_mynnedmf .or. (imp_physics == imp_physics_gfdl) ) then + !print *,'MYNN PBL or GFDL MP cldcov used' + else + !print *,'GF with Xu-Randall cloud fraction' + ! Xu-Randall (1996) cloud fraction + es = min( p3d(i,k), fpvs( t3d(i,k) ) ) ! fpvs and prsl in pa + qsat = max( QMIN, eps * es / (p3d(i,k) + epsm1*es) ) + rhgrid = max( 0., min( 1.00, qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(i,k) + qr(i,k) + qs(i,k) + qg(i,k) ! g/kg + clwt = 1.0e-6 * (p3d(i,k)*0.00001) + + if (h2oliq > clwt) then + onemrh= max( 1.e-10, 1.0-rhgrid ) + tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan + tem1 = 100.0 / tem1 + value = max( min( tem1*(h2oliq-clwt), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + else + clouds1(i,k) = 0.0 + endif + !print*,"XuRandla- cf:",clouds1(i,k)," rh:",rhgrid," qt:",h2oliq + !print*,"XuRandlb- clwt:",clwt," qsat:",qsat," p:",p3d(i,k) + endif ! not MYNN PBL or GFDL MP + endif ! qci_conv + enddo + enddo + endif ! imfdeepcnv_gf + + endif ! timestep > 1 + +!> - Compute SFC/low/middle/high cloud top pressure for each cloud domain for given latitude. + + do i =1, im + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + + do id = 1, 4 + tem1 = ptopc(id,2) - ptopc(id,1) + do i =1, im + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) + enddo + enddo + + cldcnv = 0. + +!> - Recompute the diagnostic high, mid, low, total and bl cloud fraction + call gethml & +! --- inputs: + ( plyr, ptop1, clouds1, cldcnv, dz, de_lgth, im, nlay, & +! --- outputs: + cldsa, mtopa, mbota) + + !print*,"===Finished adding subgrid clouds to the resolved-scale clouds" + !print*,"qc_save:",qc_save(1,1)," qi_save:",qi_save(1,1) + + end subroutine sgscloud_radpre_run + + end module sgscloud_radpre diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta new file mode 100644 index 000000000..8a742a041 --- /dev/null +++ b/physics/module_SGSCloud_RadPre.meta @@ -0,0 +1,360 @@ +[ccpp-arg-table] + name = sgscloud_radpre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sgscloud_radpre_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = sgscloud_radpre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + 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 +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qi] + standard_name = ice_water_mixing_ratio + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[T3D] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[P3D] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qr] + standard_name = rain_water_mixing_ratio + long_name = moist (dry+vapor, no condensates) mixing ratio of rain water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qs] + standard_name = snow_water_mixing_ratio + long_name = moist (dry+vapor, no condensates) mixing ratio of snow water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qg] + standard_name = graupel_mixing_ratio + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qci_conv] + standard_name = convective_cloud_condesate_after_rainout + long_name = convective cloud condesate after rainout + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[qc_save] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qi_save] + standard_name = ice_water_mixing_ratio_save + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[QC_BL] + standard_name = subgrid_cloud_water_mixing_ratio_pbl + long_name = subgrid cloud water mixing ratio from PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[QI_BL] + standard_name = subgrid_cloud_ice_mixing_ratio_pbl + long_name = subgrid cloud ice mixing ratio from PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[CLDFRA_BL] + standard_name = subgrid_cloud_fraction_pbl + long_name = subgrid cloud fraction from PBL scheme + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delp] + standard_name = layer_pressure_thickness_for_radiation + long_name = layer pressure thickness on radiation levels + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[clouds1] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds2] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds3] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds4] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds5] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[nlay] + standard_name = adjusted_vertical_layer_dimension_for_radiation + long_name = number of vertical layers for radiation + units = count + dimensions = () + type = integer + intent = in + optional = F +[plyr] + standard_name = air_pressure_at_layer_for_radiation_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = grid latitude in radians + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dz] + standard_name = layer_thickness_for_radiation + long_name = layer thickness on radiation levels + units = km + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle,high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = inout + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = inout + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = inout + optional = F +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index e472a2873..2c1ce9fe0 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -1,118 +1,131 @@ !>\file module_bl_mynn.F90 !! 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 +! NOAA/GSD & CIRA/CSU, Feb 2008 +! changes to original code: +! 1. code is 1D (in z) +! 2. no advection of TKE, covariances and variances +! 3. Cranck-Nicholson replaced with the implicit scheme +! 4. removed terrain dependent grid since input in WRF in actual +! distances in z[m] +! 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 +! +! Departures from original MYNN (Nakanish & Niino 2009) +! 1. Addition of BouLac mixing length in the free atmosphere. +! 2. Changed the turbulent mixing length to be integrated from the +! surface to the top of the BL + a transition layer depth. +! v3.4.1: Option to use Kitamura/Canuto modification which removes +! the critical Richardson number and negative TKE (default). +! Hybrid PBL height diagnostic, which blends a theta-v-based +! definition in neutral/convective BL and a TKE-based definition +! in stable conditions. +! TKE budget output option (bl_mynn_tkebudget) +! v3.5.0: TKE advection option (bl_mynn_tkeadvect) +! v3.5.1: Fog deposition related changes. +! v3.6.0: Removed fog deposition from the calculation of tendencies +! Added mixing of qc, qi, qni +! Added output for wstar, delta, TKE_PBL, & KPBL for correct +! coupling to shcu schemes +! v3.8.0: Added subgrid scale cloud output for coupling to radiation +! schemes (activated by setting icloud_bl =1 in phys namelist). +! Added WRF_DEBUG prints (at level 3000) +! Added Tripoli and Cotton (1981) correction. +! Added namelist option bl_mynn_cloudmix to test effect of mixing +! cloud species (default = 1: on). +! Added mass-flux option (bl_mynn_edmf, = 1 for DMP mass-flux, 0: off). +! Related options: +! bl_mynn_edmf_mom = 1 : activate momentum transport in MF scheme +! bl_mynn_edmf_tke = 1 : activate TKE transport in MF scheme +! Added mixing length option (bl_mynn_mixlength, see notes below) +! Added more sophisticated saturation checks, following Thompson scheme +! Added new cloud PDF option (bl_mynn_cloudpdf = 2) from Chaboureau +! and Bechtold (2002, JAS, with mods) +! Added capability to mix chemical species when env variable +! WRF_CHEM = 1, thanks to Wayne Angevine. +! Added scale-aware mixing length, following Junshi Ito's work +! Ito et al. (2015, BLM). +! v3.9.0 Improvement to the mass-flux scheme (dynamic number of plumes, +! better plume/cloud depth, significant speed up, better cloud +! fraction). +! Added Stochastic Parameter Perturbation (SPP) implementation. +! Many miscellaneous tweaks to the mixing lengths and stratus +! component of the subgrid clouds. +! v.4.0 Removed or added alternatives to WRF-specific functions/modules +! for the sake of portability to other models. +! the sake of portability to other models. +! Further refinement of mass-flux scheme from SCM experiments with +! Wayne Angevine: switch to linear entrainment and back to +! Simpson and Wiggert-type w-equation. +! Addition of TKE production due to radiation cooling at top of +! clouds (proto-version); not activated by default. +! Some code rewrites to move if-thens out of loops in an attempt to +! improve computational efficiency. +! New tridiagonal solver, which is supposedly 14% faster and more +! conservative. Impact seems very small. +! Many miscellaneous tweaks to the mixing lengths and stratus +! component of the subgrid-scale (SGS) clouds. +! v4.1 Big improvements in downward SW radiation due to revision of subgrid clouds +! - better cloud fraction and subgrid scale mixing ratios. +! - may experience a small cool bias during the daytime now that high +! SW-down bias is greatly reduced... +! Some tweaks to increase the turbulent mixing during the daytime for +! bl_mynn_mixlength option 2 to alleviate cool bias (very small impact). +! Improved ensemble spread from changes to SPP in MYNN +! - now perturbing eddy diffusivity and eddy viscosity directly +! - now perturbing background rh (in SGS cloud calc only) +! - now perturbing entrainment rates in mass-flux scheme +! Added IF checks (within IFDEFS) to protect mixchem code from being used +! when HRRR smoke is used (no impact on regular non-wrf chem use) +! Important bug fix for wrf chem when transporting chemical species in MF scheme +! Removed 2nd mass-flux scheme (no only bl_mynn_edmf = 1, no option 2) +! Removed unused stochastic code for mass-flux scheme +! Changed mass-flux scheme to be integrated on interface levels instead of +! mass levels - impact is small +! Added option to mix 2nd moments in MYNN as opposed to the scalar_pblmix option. +! - activated with bl_mynn_mixscalars = 1; this sets scalar_pblmix = 0 +! - added tridagonal solver used in scalar_pblmix option to duplicate tendencies +! - this alone changes the interface call considerably from v4.0. +! Slight revision to TKE production due to radiation cooling at top of clouds +! Added the non-Guassian buoyancy flux function of Bechtold and Siebesma (1998, JAS). +! - improves TKE in SGS clouds +! Added heating due to dissipation of TKE (small impact, maybe + 0.1 C daytime PBL temp) +! Misc changes made for FV3/MPAS compatibility +! v4.2 A series of small tweaks to help reduce a cold bias in the PBL: +! - slight increase in diffusion in convective conditions +! - relaxed criteria for mass-flux activation/strength +! - added capability to cycle TKE for continuity in hourly updating HRRR +! - added effects of compensational environmental subsidence in mass-flux scheme, +! which resulted in tweaks to detrainment rates. +! Bug fix for diagnostic-decay of SGS clouds - noticed by Greg Thompson. This has +! a very small, but primarily positive, impact on SW-down biases. +! Tweak to calculation of KPBL - urged by Laura Fowler - to make more intuitive. +! Tweak to temperature range of blending for saturation check (water to ice). This +! slightly reduces excessive SGS clouds in polar region. No impact warm clouds. +! Added namelist option bl_mynn_output (0 or 1) to suppress or activate the +! allocation and output of 10 3D variables. Most people will want this +! set to 0 (default) to save memory and disk space. +! Added new array qi_bl as opposed to using qc_bl for both SGS qc and qi. This +! gives us more control of the magnitudes which can be confounded by using +! a single array. As a results, many subroutines needed to be modified, +! especially mym_condensation. +! Added the blending of the stratus component of the SGS clouds to the mass-flux +! clouds to account for situations where stratus and cumulus may exist in the +! grid cell. +! Misc small-impact bugfixes: +! 1) dz was incorrectly indexed in mym_condensation +! 2) configurations with icloud_bl = 0 were using uninitialized arrays +! +! 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: +!------------------------------------------------------------------- -!>\defgroup gsd_mynn_edmf GSD MYNN-EDMF PBL Scheme Module -!! The MYNN-EDMF scheme (Olson et al. 2019 \cite olson_et_al_2019) represents the local -!! mixing using an eddy-diffusivity approach tied to turbulent kinetic energy (TKE). -!! The nonlocal mixing, important for convective boundary layers, is represented using -!! a mass-flux approach. The scheme can be run with either a 2.5 or 3.0 closure and includes -!! a partial-condensation scheme, commonly referred to as a cloud PDF or statistical-cloud -!! scheme, to represent the effects of subgrid-scale (SGS) clouds on buoyancy. -!! This module was originally translated from Nakanishi and Niino (2009) \cite NAKANISHI_2009 -!! and put into the WRF model by Mariusz Pagowski NOAA/GSD and CIRA/CSU in 2008. It was -!! extensively modified by Joseph Olson and Jaymes Kenyon of NOAA/GSD and CU/CIRES. -!! -!! Changes to original code introduced by M. Pagowski in 2008: -!! -# Code is 1D (in z) -!! -# No advection of TKE, covariances and variances -!! -# Cranck-Nicholson replaced with the implicit scheme -!! -# Removed terrain dependent grid since input in WRF in actual distances in z[m] -!! -# Cosmetic changes to adhere to WRF standard (remove common blocks, intent etc) -!! -!! Further modifications implemented by J. Olson and J. Kenyon: -!! -!! Departures from original MYNN (Nakanish and Niino (2009) \cite NAKANISHI_2009) -!! -# Added the of BouLac mixing length in the free atmosphere. -!! -# Changed the turbulent mixing length to be integrated from the -!! surface to the top of the BL plus a transition layer depth. -!! -!! Changes made in various versions of the WRF model: -!!\version v3.4.1: -!! - Option to use Kitamura/Canuto modification which removes -!! the critical Richardson number and negative TKE (default) -!! - Hybrid PBL height diagnostic, which blends a theta-v-based -!! definition in neutral/convective BL and a TKE-based definition -!! in stable conditions. -!! - TKE budget output option (bl_mynn_tkebudget) -!!\version v3.5.0: -!! - TKE advection option (bl_mynn_tkeadvect) -!!\version v3.5.1: -!! - Fog deposition related changes -!!\version v3.6.0: -!! - Removed fog deposition from the calculation of tendencies -!! - Added mixing of qc, qi, qni -!! - Added output for wstar, delta, TKE_PBL, & KPBL for correct -!! coupling to shcu schemes -!!\version v3.8.0: -!! - Added subgrid scale cloud output for coupling to radiation -!! schemes (activated by setting icloud_bl =1 in phys namelist) -!! - Added WRF_DEBUG prints (at level 3000) -!! - Added Tripoli and Cotton (1981) \cite Tripoli_1981 correction -!! - Added namelist option bl_mynn_cloudmix to test effect of mixing cloud species (default = 1: on) -!! - Added mass-flux option (bl_mynn_edmf, = 1 for DMP mass-flux, 0: off). Related options: -!! - bl_mynn_edmf_mom = 1 : activate momentum transport in MF scheme -!! - bl_mynn_edmf_tke = 1 : activate TKE transport in MF scheme -!! - Added mixing length option (bl_mynn_mixlength, see notes below) -!! - Added more sophisticated saturation checks, following Thompson scheme -!! - Added new cloud PDF option (bl_mynn_cloudpdf = 2) from Chaboureau -!! and Bechtold (2002) \cite Chaboureau_2002 with modifications -!! - Added capability to mix chemical species when env variable -!! WRF_CHEM = 1, thanks to Wayne Angevine -!! - Added scale-aware mixing length, following Junshi Ito's work -!! Ito et al. (2015, BLM) \cite Ito_2015 -!!\version v3.9.0: -!! - Improvement to the mass-flux scheme (dynamic number of plumes, -!! better plume/cloud depth, significant speed up, better cloud fraction) -!! - Added Stochastic Parameter Perturbation (SPP) implementation -!! - Many miscellaneous tweaks to the mixing lengths and stratus -!! component of the subgrid clouds -!!\version v4.0: -!! - Removed or added alternatives to WRF-specific functions/modules -!! for the sake of portability to other models -!! - Further refinement of mass-flux scheme from SCM experiments with -!! Wayne Angevine: switch to linear entrainment and back to -!! Simpson and Wiggert-type w-equation -!! - Addition of TKE production due to radiation cooling at top of -!! clouds (proto-version); not activated by default -!! - Some code rewrites to move if-thens out of loops in an attempt to -!! improve computational efficiency -!! - New tridiagonal solver, which is supposedly 14% faster and more -!! conservative. Impact seems very small -!! - Many miscellaneous tweaks to the mixing lengths and stratus -!! component of the subgrid-scale (SGS) clouds -!!\version v4.1: -!! - Big improvements in downward SW radiation due to revision of subgrid clouds -!! - better cloud fraction and subgrid scale mixing ratios -!! - may experience a small cool bias during the daytime now that high -!! SW-down bias is greatly reduced -!! - Some tweaks to increase the turbulent mixing during the daytime for -!! bl_mynn_mixlength option 2 to alleviate cool bias (very small impact) -!! - Improved ensemble spread from changes to Stochastic Parameter Perturbation (SPP) in MYNN -!! - now perturbing eddy diffusivity and eddy viscosity directly -!! - now perturbing background rh (in SGS cloud calc only) -!! - now perturbing entrainment rates in mass-flux scheme -!! - Added IF checks (within IFDEFS) to protect mixchem code from being used -!! when HRRR smoke is used (no impact when WRF-CHEM is not used) -!! - Important bug fix for WRF-CHEM when transporting chemical species in MF scheme -!! - Removed 2nd mass-flux scheme (no only bl_mynn_edmf = 1, no option 2) -!! - Removed unused stochastic code for mass-flux scheme -!! - Changed mass-flux scheme to be integrated on interface levels instead of -!! mass levels - impact is small -!! - Added option to mix second moments in MYNN as opposed to the scalar_pblmix option. -!! - activated with bl_mynn_mixscalars = 1; this sets scalar_pblmix = 0 -!! - added tridagonal solver used in scalar_pblmix option to duplicate tendencies -!! - this alone changes the interface call considerably from v4.0 -!! - Slight revision to TKE production due to radiation cooling at top of clouds -!! - Added the non-Guassian buoyancy flux function of Bechtold and Siebesma (1998) \cite Bechtold_1998 -!! - improves TKE in SGS clouds -!! - Added heating due to dissipation of TKE (small impact, maybe + 0.1 C daytime PBL temp) -!! - Miscellaneous changes made for FV3/MPAS compatibility -!! -!!Many of these changes are now documented in Olson et al. (2019, -!! NOAA Technical Memorandum) MODULE module_bl_mynn !================================================================== @@ -219,7 +232,8 @@ MODULE module_bl_mynn REAL, PARAMETER :: rr2=0.7071068, rrp=0.3989423 ! 'parameters' for Poisson distribution (EDMF scheme) - REAL, PARAMETER :: zero = 0.0, half = 0.5, one = 1.0, two = 2.0 + REAL, PARAMETER :: zero = 0.0, half = 0.5, one = 1.0, two = 2.0, & + onethird = 1./3., twothirds = 2./3. !>Use Canuto/Kitamura mod (remove Ric and negative TKE) (1:yes, 0:no) !!For more info, see Canuto et al. (2008 JAS) and Kitamura (Journal of the @@ -245,7 +259,10 @@ MODULE module_bl_mynn !>Option to activate heating due to dissipation of TKE (to activate, set to 1.0) REAL, PARAMETER :: dheat_opt = 1. - !>option to print out more stuff for debugging purposes + !Option to activate environmental subsidence in mass-flux scheme + LOGICAL, PARAMETER :: env_subs = .true. + + !option to print out more stuff for debugging purposes LOGICAL, PARAMETER :: debug_code = .false. ! JAYMES- @@ -442,7 +459,7 @@ MODULE module_bl_mynn !> @{ SUBROUTINE mym_initialize ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & u, v, thl, qw, & ! & ust, rmo, pmz, phh, flt, flq, & & zi, theta, sh, & @@ -450,14 +467,16 @@ SUBROUTINE mym_initialize ( & & Qke, Tsq, Qsq, Cov, Psig_bl, cldfra_bl1D, & & bl_mynn_mixlength, & & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & + & INITIALIZE_QKE, & & spp_pbl,rstoch_col) ! !------------------------------------------------------------------- INTEGER, INTENT(IN) :: kts,kte INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf + LOGICAL, INTENT(IN) :: INITIALIZE_QKE ! REAL, INTENT(IN) :: ust, rmo, pmz, phh, flt, flq - REAL, INTENT(IN) :: ust, rmo, Psig_bl + REAL, INTENT(IN) :: ust, rmo, Psig_bl, dx REAL, DIMENSION(kts:kte), INTENT(in) :: dz REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,cldfra_bl1D,& @@ -493,7 +512,15 @@ SUBROUTINE mym_initialize ( & ! ** Preliminary setting ** el (kts) = 0.0 - qke(kts) = ust**2 * ( b1*pmz )**(2.0/3.0) + IF (INITIALIZE_QKE) THEN + !qke(kts) = ust**2 * ( b1*pmz )**(2.0/3.0) + qke(kts) = 1.5 * ust**2 * ( b1*pmz )**(2.0/3.0) + DO k = kts+1,kte + !qke(k) = 0.0 + !linearly taper off towards top of pbl + qke(k)=qke(kts)*MAX((ust*700. - zw(k))/(MAX(ust,0.01)*700.), 0.01) + ENDDO + ENDIF ! phm = phh*b2 / ( b1*pmz )**(1.0/3.0) tsq(kts) = phm*( flt/ust )**2 @@ -503,7 +530,7 @@ SUBROUTINE mym_initialize ( & DO k = kts+1,kte vkz = vk*zw(k) el (k) = vkz/( 1.0 + vkz/100.0 ) - qke(k) = 0.0 +! qke(k) = 0.0 ! tsq(k) = 0.0 qsq(k) = 0.0 @@ -512,17 +539,17 @@ SUBROUTINE mym_initialize ( & ! ! ** Initialization with an iterative manner ** ! ** lmax is the iteration count. This is arbitrary. ** - lmax = 5 + lmax = 5 ! DO l = 1,lmax ! !> - call mym_length() to calculate the master length scale. CALL mym_length ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & rmo, flt, flq, & & vt, vq, & - & qke, & + & u, v, qke, & & dtv, & & el, & & zi,theta, & @@ -540,34 +567,38 @@ SUBROUTINE mym_initialize ( & ! ! ** Strictly, vkz*h(i,j) -> vk*( 0.5*dz(1)*h(i,j)+z0 ) ** vkz = vk*0.5*dz(kts) -! - elv = 0.5*( el(kts+1)+el(kts) ) / vkz - qke(kts) = ust**2 * ( b1*pmz*elv )**(2.0/3.0) -! + elv = 0.5*( el(kts+1)+el(kts) ) / vkz + IF (INITIALIZE_QKE)THEN + !qke(kts) = ust**2 * ( b1*pmz*elv )**(2.0/3.0) + qke(kts) = 1.0 * MAX(ust,0.02)**2 * ( b1*pmz*elv )**(2.0/3.0) + ENDIF + phm = phh*b2 / ( b1*pmz/elv**2 )**(1.0/3.0) tsq(kts) = phm*( flt/ust )**2 qsq(kts) = phm*( flq/ust )**2 cov(kts) = phm*( flt/ust )*( flq/ust ) -! + DO k = kts+1,kte-1 b1l = b1*0.25*( el(k+1)+el(k) ) - tmpq=MAX(b1l*( pdk(k+1)+pdk(k) ),qkemin) + !tmpq=MAX(b1l*( pdk(k+1)+pdk(k) ),qkemin) + !add MIN to limit unreasonable QKE + tmpq=MIN(MAX(b1l*( pdk(k+1)+pdk(k) ),qkemin),125.) ! PRINT *,'tmpqqqqq',tmpq,pdk(k+1),pdk(k) - qke(k) = tmpq**(2.0/3.0) + IF (INITIALIZE_QKE)THEN + qke(k) = tmpq**twothirds + ENDIF -! IF ( qke(k) .LE. 0.0 ) THEN b2l = 0.0 ELSE b2l = b2*( b1l/b1 ) / SQRT( qke(k) ) 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 -! END DO !! qke(kts)=qke(kts+1) @@ -575,7 +606,10 @@ SUBROUTINE mym_initialize ( & !! qsq(kts)=qsq(kts+1) !! cov(kts)=cov(kts+1) - qke(kte)=qke(kte-1) + IF (INITIALIZE_QKE)THEN + qke(kts)=0.5*(qke(kts)+qke(kts+1)) + qke(kte)=qke(kte-1) + ENDIF tsq(kte)=tsq(kte-1) qsq(kte)=qsq(kte-1) cov(kte)=cov(kte-1) @@ -757,10 +791,10 @@ END SUBROUTINE mym_level2 !! This subroutine calculates the mixing lengths. SUBROUTINE mym_length ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & rmo, flt, flq, & & vt, vq, & - & qke, & + & u1, v1, qke, & & dtv, & & el, & & zi,theta, & @@ -779,8 +813,8 @@ SUBROUTINE mym_length ( & INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf REAL, DIMENSION(kts:kte), INTENT(in) :: dz REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl - REAL, DIMENSION(kts:kte), INTENT(IN) :: qke,vt,vq,cldfra_bl1D,& + REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,dx + REAL, DIMENSION(kts:kte), INTENT(IN) :: u1,v1,qke,vt,vq,cldfra_bl1D,& edmf_w1,edmf_a1,edmf_qc1 REAL, DIMENSION(kts:kte), INTENT(out) :: qkw, el REAL, DIMENSION(kts:kte), INTENT(in) :: dtv @@ -819,7 +853,8 @@ 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,el_les + & el_stab,el_unstab,el_mf,el_stab_mf,elb_mf,PBLH_PLUS_ENT, & + & Uonset,Ugrid,el_les ! tv0 = 0.61*tref ! gtr = 9.81/tref @@ -1003,13 +1038,15 @@ SUBROUTINE mym_length ( & CASE (2) !Experimental mixing length formulation - cns = 3.5 - alp1 = 0.25 + 0.02*MIN(MAX(zi-200.,0.),1000.)/1000. !0.23 - alp2 = 0.6 !0.3 - alp3 = 3.0 !2.0 - alp4 = 20. !10. - alp5 = 0.6 !0.3 !like alp2, but for free atmosphere - alp6 = 50.0 !used for MF mixing length instead of BouLac (x times MF) + Uonset = 2.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)) + alp1 = 0.23 + alp2 = 0.30 + 0.3*MIN(MAX((dx - 3000.)/10000., 0.0), 1.0) + alp3 = 2.0 + alp4 = 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) @@ -1025,7 +1062,7 @@ SUBROUTINE mym_length ( & 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) ! q -> TKE + qtke(k) = 0.5*qkw(k) ! qkw -> TKE END DO elt = 1.0e-5 @@ -1046,7 +1083,7 @@ SUBROUTINE mym_length ( & elt = MAX(alp1*elt/vsc, 10.) 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 @@ -1061,7 +1098,7 @@ SUBROUTINE mym_length ( & bv = SQRT( gtr*dtv(k) ) !elb_mf = alp2*qkw(k) / bv & elb_mf = MAX(alp2*qkw(k), & -! &MAX(1.-2.0*cldavg,0.0)**0.5*alp6*edmf_a1(k)*edmf_w1(k)) / bv & +! &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 & & *( 1.0 + alp3*SQRT( vsc/( bv*elt ) ) ) elb = MIN(alp5*qkw(k)/bv, zwk) @@ -1084,7 +1121,7 @@ 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))**(1.0/3.0)),50.),150.) + tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(flt,1.0e-4))**onethird),50.),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 @@ -1506,7 +1543,7 @@ END SUBROUTINE boulac_length SUBROUTINE mym_turbulence ( & & kts,kte, & & levflag, & - & dz, zw, & + & dz, dx, zw, & & u, v, thl, ql, qw, & & qke, tsq, qsq, cov, & & vt, vq, & @@ -1534,7 +1571,7 @@ SUBROUTINE mym_turbulence ( & INTEGER, INTENT(IN) :: levflag,bl_mynn_mixlength,bl_mynn_edmf 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 + REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,Psig_shcu,dx REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,& &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1,edmf_qc1,& &TKEprodTD @@ -1595,10 +1632,10 @@ SUBROUTINE mym_turbulence ( & ! CALL mym_length ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & rmo, flt, flq, & & vt, vq, & - & qke, & + & u, v, qke, & & dtv, & & el, & & zi,theta, & @@ -1857,14 +1894,6 @@ SUBROUTINE mym_turbulence ( & gamv = 0.0 END IF ! -! Add stochastic perturbation of prandtl number limit - if (spp_pbl==1) then - prlimit = MIN(MAX(1.,2.5 + 5.0*rstoch_col(k)), 10.) - IF(sm(k) > sh(k)*Prlimit) THEN - sm(k) = sh(k)*Prlimit - ENDIF - ENDIF -! ! 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)) @@ -1996,7 +2025,7 @@ END SUBROUTINE mym_turbulence ! ================================================================== ! SUBROUTINE mym_predict: ! -!! Input variables: see subroutine mym_initialize and turbulence +! Input variables: see subroutine mym_initialize and turbulence ! qke(nx,nz,ny) : qke at (n)th time level ! tsq, ...cov : ditto ! @@ -2361,11 +2390,12 @@ END SUBROUTINE mym_predict !! use of the namelist parameter \p bl_mynn_cloudpdf . SUBROUTINE mym_condensation (kts,kte, & & dx, dz, zw, & - & thl, qw, & + & thl, qw, qv, qc, qi, & & p,exner, & & tsq, qsq, cov, & & Sh, el, bl_mynn_cloudpdf,& - & qc_bl1D, cldfra_bl1D, & + & qc_bl1D, qi_bl1D, & + & cldfra_bl1D, & & PBLH1,HFX1, & & Vt, Vq, th, sgm, rmo, & & spp_pbl,rstoch_col ) @@ -2382,18 +2412,20 @@ SUBROUTINE mym_condensation (kts,kte, & REAL, INTENT(IN) :: dx,PBLH1,HFX1,rmo REAL, DIMENSION(kts:kte), INTENT(IN) :: dz REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw - REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner, thl, qw, & + REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw,qv,qc,qi, & &tsq, qsq, cov, th REAL, DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm - REAL, DIMENSION(kts:kte) :: qmq,alp,a,bet,b,ql,q1,cld,RH - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,cldfra_bl1D + REAL, DIMENSION(kts:kte) :: qmq,alp,a,bet,b,ql,q1,RH + REAL, DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & + cldfra_bl1D DOUBLE PRECISION :: t3sq, r3sq, c3sq REAL :: qsl,esat,qsat,tlk,qsat_tl,dqsl,cld0,q1k,eq1,qll,& &q2p,pt,rac,qt,t,xl,rsl,cpm,cdhdz,Fng,qww,alpha,beta,bb,& - &ls_min,ls,wt,cld_factor,fac_damp + &ls_min,ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water,& + &low_weight INTEGER :: i,j,k REAL :: erf @@ -2403,12 +2435,8 @@ SUBROUTINE mym_condensation (kts,kte, & REAL, DIMENSION(kts:kte), INTENT(IN) :: Sh,el !JOE: variables for BL clouds - REAL::zagl,cld9,damp,edown,RHcrit,RHmean,RHsum,RHnum,Hshcu,PBLH2,ql_limit - REAL, PARAMETER :: Hfac = 3.0 !cloud depth factor for HFX (m^3/W) - REAL, PARAMETER :: HFXmin = 50.0 !min W/m^2 for BL clouds - REAL :: RH_00L, RH_00O, phi_dz, lfac - REAL, PARAMETER :: cdz = 2.0 - REAL, PARAMETER :: mdz = 1.5 + REAL::zagl,damp,PBLH2,ql_limit + REAL :: lfac !JAYMES: variables for tropopause-height estimation REAL :: theta1, theta2, ht1, ht2 @@ -2463,14 +2491,10 @@ SUBROUTINE mym_condensation (kts,kte, & 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) - !NOTE: negative bl_mynn_cloudpdf will zero-out the stratus subgrid clouds - ! at the end of this subroutine. !Sommeria and Deardorff (1977) scheme, as implemented !in Nakanishi and Niino (2009), Appendix B t3sq = MAX( tsq(k), 0.0 ) @@ -2480,13 +2504,38 @@ SUBROUTINE mym_condensation (kts,kte, & r3sq = r3sq +bet(k)**2*t3sq -2.0*bet(k)*c3sq !DEFICIT/EXCESS WATER CONTENT qmq(k) = qw(k) -qsl - !ORIGINAL STANDARD DEVIATION: limit e-6 produces ~10% more BL clouds - !than e-10 + !ORIGINAL STANDARD DEVIATION sgm(k) = SQRT( MAX( r3sq, 1.0d-10 )) !NORMALIZED DEPARTURE FROM SATURATION q1(k) = qmq(k) / sgm(k) !CLOUD FRACTION. rr2 = 1/SQRT(2) = 0.707 - cld(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + cldfra_bl1D(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + + eq1 = rrp*EXP( -0.5*q1k*q1k ) + qll = MAX( cldfra_bl1D(k)*q1k + eq1, 0.0 ) + !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) + ql(k) = alp(k)*sgm(k)*qll + !LIMIT SPECIES TO TEMPERATURE RANGES + liq_frac = min(1.0, max(0.0,(t-240.0)/29.0)) + qc_bl1D(k) = liq_frac*ql(k) + qi_bl1D(k) = (1.0 - liq_frac)*ql(k) + + 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 + q2p = xlvcp/exner(k) + pt = thl(k) +q2p*ql(k) ! potential temp + + !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) + qt = 1.0 +p608*qw(k) -(1.+p608)*(qc_bl1D(k)+qi_bl1D(k))*cldfra_bl1D(k) + rac = alp(k)*( cldfra_bl1D(K)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) + + !BUOYANCY FACTORS: wherever vt and vq are used, there is a + !"+1" and "+tv0", respectively, so these are subtracted out here. + !vt is unitless and vq has units of K. + vt(k) = qt-1.0 -rac*bet(k) + vq(k) = p608*pt-tv0 +rac END DO @@ -2501,8 +2550,6 @@ SUBROUTINE mym_condensation (kts,kte, & 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) @@ -2510,7 +2557,7 @@ SUBROUTINE mym_condensation (kts,kte, & if (k .eq. kts) then dzk = 0.5*dz(k) else - dzk = 0.5*( dz(k) + dz(k-1) ) + dzk = dz(k) end if dth = 0.5*(thl(k+1)+thl(k)) - 0.5*(thl(k)+thl(MAX(k-1,kts))) dqw = 0.5*(qw(k+1) + qw(k)) - 0.5*(qw(k) + qw(MAX(k-1,kts))) @@ -2519,12 +2566,44 @@ SUBROUTINE mym_condensation (kts,kte, & (dqw/dzk - bet(k)*(dth/dzk ))**2 , 1.0e-10) ) qmq(k) = qw(k) -qsl q1(k) = qmq(k) / sgm(k) - cld(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + cldfra_bl1D(K) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) + + !now compute estimated lwc for PBL scheme's use + !qll IS THE NORMALIZED LIQUID WATER CONTENT (Sommeria and + !Deardorff (1977, eq 29a). rrp = 1/(sqrt(2*pi)) = 0.3989 + q1k = q1(k) + eq1 = rrp*EXP( -0.5*q1k*q1k ) + qll = MAX( cldfra_bl1D(K)*q1k + eq1, 0.0 ) + !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) + ql (k) = alp(k)*sgm(k)*qll + liq_frac = min(1.0, max(0.0,(t-240.0)/29.0)) + qc_bl1D(k) = liq_frac*ql(k) + qi_bl1D(k) = (1.0 - liq_frac)*ql(k) + + 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 + q2p = xlvcp/exner(k) + pt = thl(k) +q2p*ql(k) ! potential temp + + !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) + qt = 1.0 +p608*qw(k) -(1.+p608)*(qc_bl1D(k)+qi_bl1D(k))*cldfra_bl1D(k) + rac = alp(k)*( cldfra_bl1D(K)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) + + !BUOYANCY FACTORS: wherever vt and vq are used, there is a + !"+1" and "+tv0", respectively, so these are subtracted out here. + !vt is unitless and vq has units of K. + vt(k) = qt-1.0 -rac*bet(k) + vq(k) = p608*pt-tv0 +rac + END DO CASE (2, -2) - !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS - !JAYMES- this added 27 Apr 2015 + !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 @@ -2541,48 +2620,38 @@ SUBROUTINE mym_condensation (kts,kte, & 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) & & - 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))) if (k .eq. kts) then dzk = 0.5*dz(k) else - dzk = 0.5*( dz(k) + dz(k-1) ) + dzk = dz(k) end if 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 ! /(1.0 + 1.0*MIN( 0.5*dz(1)*MAX(rmo,0.0), 1. )) + 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(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 @@ -2590,7 +2659,6 @@ SUBROUTINE mym_condensation (kts,kte, & ! 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. @@ -2606,118 +2674,80 @@ SUBROUTINE mym_condensation (kts,kte, & ! based on tests q1(k) = qmq(k) / sgm(k) ! Q1, the normalized saturation - - cld(k) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 - - END DO - - END SELECT - - zagl = 0. - RHsum=0. - RHnum=0. - RHmean=0.1 !initialize with small value for small PBLH cases - damp =0 - PBLH2=MAX(10.,PBLH1) - - SELECT CASE(bl_mynn_cloudpdf) - - CASE (-1 : 1) ! ORIGINAL MYNN PARTIAL-CONDENSATION SCHEME - ! OR KUWANO ET AL. - DO k = kts,kte-1 - t = th(k)*exner(k) - q1k = q1(k) - zagl = zagl + dz(k) - !q1=0. - !cld(k)=0. - - !COMPUTE MEAN RH IN PBL (NOT PRESSURE WEIGHTED). - IF (zagl < PBLH2 .AND. PBLH2 > 400.) THEN - RHsum=RHsum+RH(k) - RHnum=RHnum+1.0 - RHmean=RHsum/RHnum - ENDIF - - RHcrit = 1. - 0.35*(1.0 - (MAX(250.- MAX(HFX1,HFXmin),0.0)/200.)**2) - if (HFX1 > HFXmin) then - cld9=MIN(MAX(0., (rh(k)-RHcrit)/(1.1-RHcrit)), 1.)**2 - else - cld9=0.0 - endif - - edown=PBLH2*.1 - !Vary BL cloud depth (Hshcu) by mean RH in PBL and HFX - !(somewhat following results from Zhang and Klein (2013, JAS)) - Hshcu=200. + (RHmean+0.5)**1.5*MAX(HFX1,0.)*Hfac - if (zagl < PBLH2-edown) then - damp=MIN(1.0,exp(-ABS(((PBLH2-edown)-zagl)/edown))) - elseif(zagl >= PBLH2-edown .AND. zagl < PBLH2+Hshcu)then - damp=1. - elseif (zagl >= PBLH2+Hshcu)then - damp=MIN(1.0,exp(-ABS((zagl-(PBLH2+Hshcu))/500.))) - endif - cldfra_bl1D(k)=cld9*damp - !cldfra_bl1D(k)=cld(k) ! JAYMES: use this form to retain the Sommeria-Deardorff value - - !use alternate cloud fraction to estimate qc for use in BL clouds-radiation - eq1 = rrp*EXP( -0.5*q1k*q1k ) - qll = MAX( cldfra_bl1D(k)*q1k + eq1, 0.0 ) - !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) - ql (k) = alp(k)*sgm(k)*qll - if(cldfra_bl1D(k)>0.01 .and. ql(k)<1.E-6)ql(k)=1.E-6 - qc_bl1D(k)=ql(k)*damp - !qc_bl1D(k)=ql(k) ! JAYMES: use this form to retain the Sommeria-Deardorff value - - !now recompute estimated lwc for PBL scheme's use - !qll IS THE NORMALIZED LIQUID WATER CONTENT (Sommeria and - !Deardorff (1977, eq 29a). rrp = 1/(sqrt(2*pi)) = 0.3989 - eq1 = rrp*EXP( -0.5*q1k*q1k ) - qll = MAX( cld(k)*q1k + eq1, 0.0 ) - !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) - ql (k) = alp(k)*sgm(k)*qll - - q2p = xlvcp/exner(k) - pt = thl(k) +q2p*ql(k) ! potential temp - - !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) - qt = 1.0 +p608*qw(k) -(1.+p608)*ql(k) - rac = alp(k)*( cld(k)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) - - !BUOYANCY FACTORS: wherever vt and vq are used, there is a - !"+1" and "+tv0", respectively, so these are subtracted out here. - !vt is unitless and vq has units of K. - vt(k) = qt-1.0 -rac*bet(k) - vq(k) = p608*pt-tv0 +rac + cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 END DO - CASE ( 2, -2) + ! 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 ! water flux; these formulations are from Cuijpers and Bechtold ! (1995), Eq. 7. CB95 also draws from Bechtold et al. 1995, ! hereafter BCMT95 + zagl = 0. DO k = kts,kte-1 t = th(k)*exner(k) q1k = q1(k) zagl = zagl + dz(k) - IF (q1k < 0.) THEN - ql (k) = sgm(k)*EXP(1.2*q1k-1) - ELSE IF (q1k > 2.) THEN - ql (k) = sgm(k)*q1k - ELSE - ql (k) = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) + + !CLOUD WATER AND ICE + IF (q1k < 0.) THEN !unstaurated + 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 +! low_weight = MIN(MAX(p(k)-40000.0, 0.0),40000.0)/40000.0 +! ql_ice = low_weight * sgm(k)*EXP(1.1*q1k-1.6) & !low-lev +! + (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 + 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) 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 + ql_ice = 0.0 + ql_water = 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 + 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 + liq_frac = 0.0 + ELSE IF ( (qc(k) >= 1.E-10) .AND. (qi(k) >= 1.E-10) ) THEN ! explicit contains mixed phase of workably + ! large amounts; assume subgrid follows + ! same partioning + liq_frac = qc(k) / ( qc(k) + qi(k) ) + ELSE + liq_frac = MIN(1.0, MAX(0.0, (t-238.)/31.)) ! explicit contains mixed phase, but at least one + ! species is very small, so make a temperature- + ! depedent guess + ENDIF + ELSE ! no explicit condensate, so make a temperature-dependent guess + liq_frac = MIN(1.0, MAX(0.0, (t-238.)/31.)) + ENDIF + + qc_bl1D(k) = liq_frac*ql_water ! apply liq_frac to ql_water and ql_ice + qi_bl1D(k) = (1.0-liq_frac)*ql_ice + !Above tropopause: eliminate subgrid clouds from CB scheme if (k .ge. k_tropo-1) then - cld(k) = 0. - ql(k) = 0. + cldfra_bl1D(K) = 0. + qc_bl1D(k) = 0. + qi_bl1D(k) = 0. endif !Buoyancy-flux-related calculations follow... ! "Fng" represents the non-Gaussian transport factor - ! (non-dimensional) from from Bechtold et al. 1995 + ! (non-dimensional) from Bechtold et al. 1995 ! (hereafter BCMT95), section 3(c). Their suggested ! forms for Fng (from their Eq. 20) are: !IF (q1k < -2.) THEN @@ -2732,9 +2762,9 @@ SUBROUTINE mym_condensation (kts,kte, & Q1(k)=MAX(Q1(k),-5.0) IF (Q1(k) .GE. 1.0) THEN Fng = 1.0 - ELSEIF (Q1(k) .GE. -1.7 .AND. Q1(k) < 1.0) THEN + 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) .LE. -1.7) THEN + ELSEIF (Q1(k) .GE. -2.5 .AND. Q1(k) .LT. -1.7) THEN Fng = 3.0 + EXP(-3.8*(Q1(k)+1.7)) ELSE Fng = MIN(23.9 + EXP(-1.6*(Q1(k)+2.5)), 60.) @@ -2751,33 +2781,21 @@ SUBROUTINE mym_condensation (kts,kte, & qww = 1.+0.61*qw(k) alpha = 0.61*th(k) beta = (th(k)/t)*(xl/cp) - 1.61*th(k) - - vt(k) = qww - MIN(cld(k),0.99)*beta*bb*Fng - 1. - vq(k) = alpha + MIN(cld(k),0.99)*beta*a(k)*Fng - tv0 + vt(k) = qww - MIN(cldfra_bl1D(K),0.5)*beta*bb*Fng - 1. + vq(k) = alpha + MIN(cldfra_bl1D(K),0.5)*beta*a(k)*Fng - tv0 ! vt and vq correspond to beta-theta and beta-q, respectively, ! in NN09, Eq. B8. They also correspond to the bracketed ! expressions in BCMT95, Eq. 15, since (s*ql/sigma^2) = cldfra*Fng ! The "-1" and "-tv0" terms are included for consistency with ! the legacy vt and vq formulations (above). - !OLD-- - ! increase the cloud fraction estimate below PBLH+1km - !if (zagl .lt. PBLH2+1000.) then - ! cld_factor = 1.0 + MAX(0.0, ( RH(k) - 0.83 ) / 0.18 ) - ! cld(k) = MIN( 1., cld_factor*cld(k) ) - !end if - !NEW-- ! dampen the amplification factor (cld_factor) with height in order ! to limit excessively large cloud fractions aloft fac_damp = 1. -MIN(MAX( zagl-(PBLH2+1000.),0.0)/ & MAX((zw(k_tropo)-(PBLH2+1000.)),500.), 1.) !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 - cld(k) = MIN( 1., cld_factor*cld(k) ) - - ! return a cloud condensate and cloud fraction for icloud_bl option: - cldfra_bl1D(k) = cld(k) - qc_bl1D(k) = ql(k) + 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 @@ -2786,16 +2804,17 @@ SUBROUTINE mym_condensation (kts,kte, & !FOR TESTING PURPOSES ONLY, ISOLATE ON THE MASS-CLOUDS. IF (bl_mynn_cloudpdf .LT. 0) THEN DO k = kts,kte-1 - cldfra_bl1D(k) = 0.0 - qc_bl1D(k) = 0.0 + cldfra_bl1D(k) = 0.0 + qc_bl1D(k) = 0.0 + qi_bl1D(k) = 0.0 END DO ENDIF ! - cld(kte) = cld(kte-1) ql(kte) = ql(kte-1) vt(kte) = vt(kte-1) vq(kte) = vq(kte-1) qc_bl1D(kte)=0. + qi_bl1D(kte)=0. cldfra_bl1D(kte)=0. RETURN @@ -2817,23 +2836,26 @@ SUBROUTINE mynn_tendencies(kts,kte, & &u,v,th,tk,qv,qc,qi,qnc,qni, & &p,exner, & &thl,sqv,sqc,sqi,sqw, & - &qnwfa,qnifa, & + &qnwfa,qnifa,ozone, & &ust,flt,flq,flqv,flqc,wspd,qcg, & &uoce,voce, & &tsq,qsq,cov, & &tcd,qcd, & &dfm,dfh,dfq, & &Du,Dv,Dth,Dqv,Dqc,Dqi,Dqnc,Dqni, & - &Dqnwfa,Dqnifa, & + &Dqnwfa,Dqnifa,Dozone, & &vdfg1,diss_heat, & &s_aw,s_awthl,s_awqt,s_awqv,s_awqc, & &s_awu,s_awv, & &s_awqnc,s_awqni, & &s_awqnwfa,s_awqnifa, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & &FLAG_QC,FLAG_QI,FLAG_QNC,FLAG_QNI, & &FLAG_QNWFA,FLAG_QNIFA, & &cldfra_bl1d, & - &ztop_shallow,ktop_shallow, & &bl_mynn_cloudmix, & &bl_mynn_mixqt, & &bl_mynn_edmf, & @@ -2859,21 +2881,23 @@ SUBROUTINE mynn_tendencies(kts,kte, & !! grav_settling = 0 otherwise ! thl - liquid water potential temperature ! qw - total water -! dfm,dfh,dfq - as above +! dfm,dfh,dfq - diffusivities i.e., dfh(k) = elq*sh(k) / dzk ! flt - surface flux of thl ! flq - surface flux of qw +! 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 +! 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 REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,qni,qnc,& &rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd,cldfra_bl1d,diss_heat REAL, DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,sqi,& - &qnwfa,qnifa,dfm,dfh + &qnwfa,qnifa,ozone,dfm,dfh REAL, DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv,dqc,dqi,& - &dqni,dqnc,dqnwfa,dqnifa - REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,wspd,uoce,voce,qcg,& - ztop_shallow - INTEGER, INTENT(IN) :: ktop_shallow + &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,qcg,& ! &gradu_top,gradv_top,gradth_top,gradqv_top @@ -2882,8 +2906,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & REAL, DIMENSION(kts:kte) :: dtz,vt,vq,dfhc,dfmc !Kh for clouds (Pr < 2) REAL, DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqw2,qni2,qnc2, & !AFTER MIXING - qnwfa2,qnifa2 - REAL, DIMENSION(kts:kte) :: zfac,plumeKh + qnwfa2,qnifa2,ozone2 + REAL, DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv REAL, DIMENSION(kts:kte) :: a,b,c,d,x REAL, DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface & khdz, kmdz @@ -2908,28 +2932,31 @@ SUBROUTINE mynn_tendencies(kts,kte, & ENDIF !Prepare "constants" for diffusion equation. - !khdz = rho*Kh/dz - dtz(kts)=delt/dz(kts) - kh=dfh(kts)*dz(kts) - km=dfm(kts)*dz(kts) - rhoz(kts)=rho(kts) - khdz(kts)=rhoz(kts)*kh/dz(kts) - kmdz(kts)=rhoz(kts)*km/dz(kts) + !khdz = rho*Kh/dz = rho*dfh + dtz(kts) =delt/dz(kts) + rhoz(kts) =rho(kts) + rhoinv(kts)=1./rho(kts) + khdz(kts) =rhoz(kts)*dfh(kts) + kmdz(kts) =rhoz(kts)*dfm(kts) DO k=kts+1,kte - dtz(k)=delt/dz(k) - rhoz(k)=(rho(k)*dz(k-1) + rho(k-1)*dz(k))/(dz(k-1)+dz(k)) + dtz(k) =delt/dz(k) + 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) + kmdz(k) = rhoz(k)*dfm(k) + ENDDO + khdz(kte+1)=rhoz(kte+1)*dfh(kte) + kmdz(kte+1)=rhoz(kte+1)*dfm(kte) - dzk = 0.5 *( dz(k)+dz(k-1) ) - kh = dfh(k)*dzk - km = dfm(k)*dzk - khdz(k)= rhoz(k)*kh/dzk - kmdz(k)= rhoz(k)*km/dzk + !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))) + 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 - rhoz(kte+1)=rho(kte) - kh=dfh(kte)*dz(kte) - km=dfm(kte)*dz(kte) - khdz(kte+1)=rhoz(kte+1)*kh/dz(kte) - kmdz(kte+1)=rhoz(kte+1)*km/dz(kte) !!============================================ !! u @@ -2937,23 +2964,41 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - 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 +! 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 -!JOE - tend test -! a(k)=0. -! b(k)=1.+dtz(k)*dfm(k+1) - 0.5*dtz(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)*(1.-ust**2/wspd*dtz(k)) + & -! dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff +!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 + +!!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 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 + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*s_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 + & + & sub_u(k)*delt + det_u(k)*delt ENDDO !! no flux at the top @@ -2975,7 +3020,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=u(kte) ! 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 ! du(k)=(d(k-kts+1)-u(k))/delt @@ -2988,24 +3033,42 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - 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 +! 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 +! 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 -!JOE - tend test -! a(k)=0. -! b(k)=1.+dtz(k)*dfm(k+1) - 0.5*dtz(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)*(1.-ust**2/wspd*dtz(k)) + & -! dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff +!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 + +!!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 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 + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*s_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 + & + & sub_v(k)*delt + det_v(k)*delt ENDDO !! no flux at the top @@ -3027,7 +3090,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=v(kte) ! 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 ! dv(k)=(d(k-kts+1)-v(k))/delt @@ -3040,18 +3103,37 @@ SUBROUTINE mynn_tendencies(kts,kte, & !!============================================ k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt & - & -dtz(k)*s_awthl(kts+1) + diss_heat(k)*delt*dheat_opt +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt & +! & -dtz(k)*s_awthl(kts+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)*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(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 +! 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)=thl(k) + dtz(k)*flt + tcd(k)*delt - dtz(k)*s_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)*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(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) & - & + diss_heat(k)*delt*dheat_opt + 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)=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 ENDDO !! no flux at the top @@ -3074,7 +3156,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=thl(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) +! CALL tridiag2(kte,a,b,c,d,x) + CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte !thl(k)=d(k-kts+1) @@ -3091,19 +3174,30 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - - !rhs= qcd(k) !+ (gfluxp - gfluxm)/dz(k)& +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! !rhs= qcd(k) !+ (gfluxp - gfluxm)/dz(k)& +! d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) +! +! 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(k)=sqw(k) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) +! ENDDO - d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) +!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) 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) - + 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)=sqw(k) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) ENDDO @@ -3125,7 +3219,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=sqw(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,sqw2) +! CALL tridiag2(kte,a,b,c,d,sqw2) + CALL tridiag3(kte,a,b,c,d,sqw2) ! DO k=kts,kte ! sqw2(k)=d(k-kts+1) @@ -3143,18 +3238,34 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt - & +! dtz(k)*s_awqc(k+1) + det_sqc(k)*delt +! +! 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(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + & +! det_sqc(k)*delt +! ENDDO - d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt -dtz(k)*s_awqc(k+1) +!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) + & + & det_sqc(k)*delt 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(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + 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)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + & + & det_sqc(k)*delt ENDDO ! prescribed value @@ -3164,7 +3275,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=sqc(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,sqc2) +! CALL tridiag2(kte,a,b,c,d,sqc2) + CALL tridiag3(kte,a,b,c,d,sqc2) ! DO k=kts,kte ! sqc2(k)=d(k-kts+1) @@ -3183,16 +3295,34 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) - d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) +! d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) + & +! & sub_sqv(k)*delt + det_sqv(k)*delt +! +! 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(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + & +! & sub_sqv(k)*delt + det_sqv(k)*delt +! 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)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) + & + & sub_sqv(k)*delt + det_sqv(k)*delt 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(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + 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)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + & + & sub_sqv(k)*delt + det_sqv(k)*delt ENDDO ! no flux at the top @@ -3215,7 +3345,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=sqv(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,sqv2) +! CALL tridiag2(kte,a,b,c,d,sqv2) + CALL tridiag3(kte,a,b,c,d,sqv2) ! DO k=kts,kte ! sqv2(k)=d(k-kts+1) @@ -3231,16 +3362,29 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)=0. - b(k)=1.+dtz(k)*dfh(k+1) - c(k)= -dtz(k)*dfh(k+1) - d(k)=sqi(k) !+ qcd(k)*delt !should we have qcd for ice? +! a(k)=0. +! b(k)=1.+dtz(k)*dfh(k+1) +! c(k)= -dtz(k)*dfh(k+1) +! d(k)=sqi(k) !+ qcd(k)*delt !should we have qcd for ice? +! +! DO k=kts+1,kte-1 +! a(k)= -dtz(k)*dfh(k) +! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) +! c(k)= -dtz(k)*dfh(k+1) +! d(k)=sqi(k) !+ qcd(k)*delt +! ENDDO + +!rho-weighted: + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) + d(k)=sqi(k) DO k=kts+1,kte-1 - a(k)= -dtz(k)*dfh(k) - b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) - c(k)= -dtz(k)*dfh(k+1) - d(k)=sqi(k) !+ qcd(k)*delt + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) + d(k)=sqi(k) ENDDO !! no flux at the top @@ -3263,7 +3407,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & d(kte)=sqi(kte) ! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,sqi2) +! CALL tridiag2(kte,a,b,c,d,sqi2) + CALL tridiag3(kte,a,b,c,d,sqi2) ! DO k=kts,kte ! sqi2(k)=d(k-kts+1) @@ -3280,16 +3425,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + 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)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qni(k) - dtz(k)*s_awqni(k+1)*nonloc DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qni(k) + dtz(k)*(s_awqni(k)-s_awqni(k+1))*nonloc ENDDO @@ -3321,16 +3466,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + 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)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnc(k) - dtz(k)*s_awqnc(k+1)*nonloc DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnc(k) + dtz(k)*(s_awqnc(k)-s_awqnc(k+1))*nonloc ENDDO @@ -3361,17 +3506,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))/rho(k) - & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) - & & 0.5*dtz(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnwfa(k) - dtz(k)*s_awqnwfa(k+1)*nonloc DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnwfa(k) + dtz(k)*(s_awqnwfa(k)-s_awqnwfa(k+1))*nonloc ENDDO @@ -3403,17 +3548,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))/rho(k) - & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) - & & 0.5*dtz(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnifa(k) - dtz(k)*s_awqnifa(k+1)*nonloc DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))/rho(k) + & + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) + & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*nonloc d(k)=qnifa(k) + dtz(k)*(s_awqnifa(k)-s_awqnifa(k+1))*nonloc ENDDO @@ -3437,6 +3582,39 @@ SUBROUTINE mynn_tendencies(kts,kte, & qnifa2=qnifa ENDIF +!============================================ +! Ozone - local mixing only +!============================================ + + k=kts + +!rho-weighted: + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) + d(k)=ozone(k) + + DO k=kts+1,kte-1 + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) + d(k)=ozone(k) + ENDDO + +! prescribed value + a(kte)=0. + b(kte)=1. + c(kte)=0. + d(kte)=ozone(kte) + +! 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 + !ozone2(k)=d(k-kts+1) + dozone(k)=(x(k)-ozone(k))/delt + ENDDO !!============================================ !! Compute tendencies and convert to mixing ratios for WRF. @@ -3476,7 +3654,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! WATER VAPOR TENDENCY !===================== DO k=kts,kte - Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt + !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) ENDDO @@ -3489,10 +3668,11 @@ SUBROUTINE mynn_tendencies(kts,kte, & !print*,"FLAG_QC:",FLAG_QC IF (FLAG_QC) THEN DO k=kts,kte - Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt - IF(Dqc(k)*delt + qc(k) < 0.) THEN + !Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt !mixing ratio + Dqc(k)=(sqc2(k) - sqc(k))/delt !spec humidity + IF(Dqc(k)*delt + sqc(k) < 0.) THEN !print*,' neg qc:',qsl,sqw2(k),sqi2(k),sqc2(k),qc(k),tk(k) - Dqc(k)=-qc(k)/delt + Dqc(k)=-sqc(k)/delt ENDIF ENDDO ELSE @@ -3521,10 +3701,11 @@ SUBROUTINE mynn_tendencies(kts,kte, & !=================== IF (FLAG_QI) THEN DO k=kts,kte - Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt - IF(Dqi(k)*delt + qi(k) < 0.) THEN + !Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt !mixing ratio + Dqi(k)=(sqi2(k) - sqi(k))/delt !spec humidity + IF(Dqi(k)*delt + sqi(k) < 0.) THEN ! !print*,' neg qi;',qsl,sqw2(k),sqi2(k),sqc2(k),qi(k),tk(k) - Dqi(k)=-qi(k)/delt + Dqi(k)=-sqi(k)/delt ENDIF ENDDO ELSE @@ -3566,16 +3747,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & & - th(k))/delt !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy: - !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc2(k) & - ! & + xlscp/MAX(tk(k),TKmin)*sqi2(k)) & + !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc(k) & + ! & + xlscp/MAX(tk(k),TKmin)*sqi(k)) & ! & - th(k))/delt ENDDO ELSE DO k=kts,kte - Dth(k)=(thl(k)+xlvcp/exner(k)*sqc2(k) - th(k))/delt + Dth(k)=(thl(k)+xlvcp/exner(k)*sqc(k) - th(k))/delt !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. - !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc2(k)) & + !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc(k)) & !& - th(k))/delt ENDDO ENDIF @@ -3845,16 +4026,18 @@ end subroutine tridiag3 !!\section gen_mynn_bl_driver GSD mynn_bl_driver General Algorithm !> @{ SUBROUTINE mynn_bl_driver( & - &initflag,restart,grav_settling, & + &initflag,restart,cycling, & + &grav_settling, & &delt,dz,dx,znt, & - &u,v,w,th,qv,qc,qi,qnc,qni, & - &qnwfa,qnifa, & + &u,v,w,th,sqv3D,sqc3D,sqi3D, & + &qnc,qni, & + &qnwfa,qnifa,ozone, & &p,exner,rho,T3D, & &xland,ts,qsfc,qcg,ps, & &ust,ch,hfx,qfx,rmol,wspd, & &uoce,voce, & !ocean current &vdfg, & !Katata-added for fog dep - &Qke,tke_pbl, & + &Qke, & !TKE_PBL, & &qke_adv,bl_mynn_tkeadvect, & !ACF for QKE advection #if (WRF_CHEM == 1) chem3d, vd3d, nchem, & ! WA 7/29/15 For WRF-Chem @@ -3864,7 +4047,7 @@ SUBROUTINE mynn_bl_driver( & &RUBLTEN,RVBLTEN,RTHBLTEN, & &RQVBLTEN,RQCBLTEN,RQIBLTEN, & &RQNCBLTEN,RQNIBLTEN, & - &RQNWFABLTEN,RQNIFABLTEN, & + &RQNWFABLTEN,RQNIFABLTEN,DOZONE, & &exch_h,exch_m, & &Pblh,kpbl, & &el_pbl, & @@ -3873,14 +4056,17 @@ SUBROUTINE mynn_bl_driver( & &bl_mynn_tkebudget, & &bl_mynn_cloudpdf,Sh3D, & &bl_mynn_mixlength, & - &icloud_bl,qc_bl,cldfra_bl, & + &icloud_bl,qc_bl,qi_bl,cldfra_bl,& &levflag,bl_mynn_edmf, & &bl_mynn_edmf_mom,bl_mynn_edmf_tke, & &bl_mynn_mixscalars, & + &bl_mynn_output, & &bl_mynn_cloudmix,bl_mynn_mixqt, & &edmf_a,edmf_w,edmf_qt, & &edmf_thl,edmf_ent,edmf_qc, & - &nupdraft,maxMF,ktop_shallow, & + &sub_thl3D,sub_sqv3D, & + &det_thl3D,det_sqv3D, & + &nupdraft,maxMF,ktop_plume, & &spp_pbl,pattern_spp_pbl, & &RTHRATEN, & &FLAG_QC,FLAG_QI,FLAG_QNC, & @@ -3892,26 +4078,27 @@ SUBROUTINE mynn_bl_driver( & !------------------------------------------------------------------- INTEGER, INTENT(in) :: initflag - LOGICAL, INTENT(IN) :: restart !INPUT NAMELIST OPTIONS: + LOGICAL, INTENT(in) :: restart,cycling INTEGER, INTENT(in) :: levflag INTEGER, INTENT(in) :: grav_settling INTEGER, INTENT(in) :: bl_mynn_tkebudget INTEGER, INTENT(in) :: bl_mynn_cloudpdf INTEGER, INTENT(in) :: bl_mynn_mixlength INTEGER, INTENT(in) :: bl_mynn_edmf - LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect + LOGICAL, INTENT(in) :: bl_mynn_tkeadvect INTEGER, INTENT(in) :: bl_mynn_edmf_mom INTEGER, INTENT(in) :: bl_mynn_edmf_tke INTEGER, INTENT(in) :: bl_mynn_mixscalars + INTEGER, INTENT(in) :: bl_mynn_output INTEGER, INTENT(in) :: bl_mynn_cloudmix INTEGER, INTENT(in) :: bl_mynn_mixqt INTEGER, INTENT(in) :: icloud_bl - LOGICAL, INTENT(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& + LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& FLAG_QNWFA,FLAG_QNIFA - INTEGER,INTENT(IN) :: & + INTEGER,INTENT(in) :: & & IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & &,ITS,ITE,JTS,JTE,KTS,KTE @@ -3936,21 +4123,23 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(in) :: dx !END FV3 REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(in) :: dz,& - &u,v,w,th,qv,p,exner,rho,T3D + &u,v,w,th,sqv3D,p,exner,rho,T3D REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), OPTIONAL, INTENT(in)::& - &qc,qi,qni,qnc,qnwfa,qnifa + &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,rmol,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) + !&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) :: & &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 @@ -3958,8 +4147,10 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(out) :: & &exch_h,exch_m - REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), OPTIONAL, INTENT(inout) :: & - & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc + !These 10 arrays are only allocated when bl_mynn_output > 0 + REAL, DIMENSION(:,:), OPTIONAL, INTENT(inout) :: & + & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & + & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(inout) :: & &Pblh,wstar,delta !JOE-added for GRIMS @@ -3968,7 +4159,7 @@ SUBROUTINE mynn_bl_driver( & &Psig_bl,Psig_shcu INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: & - &KPBL,nupdraft,ktop_shallow + &KPBL,nupdraft,ktop_plume REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: & &maxmf @@ -3985,9 +4176,9 @@ SUBROUTINE mynn_bl_driver( & REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: Sh3D REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(inout) :: & - &qc_bl,cldfra_bl - REAL, DIMENSION(KTS:KTE) :: qc_bl1D,cldfra_bl1D,& - qc_bl1D_old,cldfra_bl1D_old + &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 ! WA 7/29/15 Mix chemical arrays #if (WRF_CHEM == 1) @@ -4003,25 +4194,28 @@ SUBROUTINE mynn_bl_driver( & !local vars INTEGER :: ITF,JTF,KTF, IMD,JMD INTEGER :: i,j,k - REAL, DIMENSION(KTS:KTE) :: thl,thvl,tl,sqv,sqc,sqi,sqw,& + 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,& - & qke1,tsq1,qsq1,cov1,qv1,qi1,qc1,du1,dv1,dth1,dqv1,dqc1,dqi1, & - & k_m1,k_h1,qni1,dqni1,qnc1,dqnc1,qnwfa1,qnifa1,dqnwfa1,dqnifa1 + & 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 !JOE: mass-flux variables 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) :: 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) :: zw - REAL :: cpm,sqcg,flt,flq,flqv,flqc,pmz,phh,exnerg,zet,& - &afk,abk,ts_decay,th_sfc,ztop_shallow,sqc9,sqi9 + REAL :: cpm,sqcg,flt,flq,flqv,flqc,pmz,phh,exnerg,zet,& + & 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 @@ -4040,7 +4234,9 @@ SUBROUTINE mynn_bl_driver( & logical :: cloudflg !JOE-end top down -! INTEGER, SAVE :: levflag +!for WRF INTEGER, SAVE :: levflag + + LOGICAL :: INITIALIZE_QKE ! Stochastic fields INTEGER, INTENT(IN) ::spp_pbl @@ -4073,13 +4269,19 @@ SUBROUTINE mynn_bl_driver( & ! setup random seed !call init_random_seed - edmf_a(its:ite,kts:kte,jts:jte)=0. - edmf_w(its:ite,kts:kte,jts:jte)=0. - edmf_qt(its:ite,kts:kte,jts:jte)=0. - edmf_thl(its:ite,kts:kte,jts:jte)=0. - edmf_ent(its:ite,kts:kte,jts:jte)=0. - edmf_qc(its:ite,kts:kte,jts:jte)=0. - ktop_shallow(its:ite,jts:jte)=0 !int + IF (bl_mynn_output > 0) THEN !research mode + edmf_a(its:ite,kts:kte)=0. + edmf_w(its:ite,kts:kte)=0. + edmf_qt(its:ite,kts:kte)=0. + edmf_thl(its:ite,kts:kte)=0. + edmf_ent(its:ite,kts:kte)=0. + edmf_qc(its:ite,kts:kte)=0. + sub_thl3D(its:ite,kts:kte)=0. + sub_sqv3D(its:ite,kts:kte)=0. + 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. ENDIF @@ -4090,9 +4292,23 @@ SUBROUTINE mynn_bl_driver( & !! If true, a three-dimensional initialization loop is entered. Within this loop, !! several arrays are initialized and k-oriented (vertical) subroutines are called !! at every i and j point, corresponding to the x- and y- directions, respectively. - IF (initflag > 0) THEN + IF (initflag > 0 .and. .not.restart) THEN + + !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 + INITIALIZE_QKE = .TRUE. + !print*,"QKE is too small, must initialize" + ELSE + INITIALIZE_QKE = .FALSE. + !print*,"Using background QKE, will not initialize" + ENDIF + ELSE ! not cycling or restarting: + INITIALIZE_QKE = .TRUE. + !print*,"not restart nor cycling, must initialize QKE" + ENDIF - if (.not.restart) THEN + 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. @@ -4101,6 +4317,10 @@ SUBROUTINE mynn_bl_driver( & 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. + else + qc_bl1D(kts:kte)=0.0 + qi_bl1D(kts:kte)=0.0 + cldfra_bl1D(kts:kte)=0.0 end if dqc1(kts:kte)=0.0 dqi1(kts:kte)=0.0 @@ -4108,8 +4328,7 @@ SUBROUTINE mynn_bl_driver( & dqnc1(kts:kte)=0.0 dqnwfa1(kts:kte)=0.0 dqnifa1(kts:kte)=0.0 - qc_bl1D(kts:kte)=0.0 - cldfra_bl1D(kts:kte)=0.0 + dozone1(kts:kte)=0.0 qc_bl1D_old(kts:kte)=0.0 cldfra_bl1D_old(kts:kte)=0.0 edmf_a1(kts:kte)=0.0 @@ -4152,11 +4371,16 @@ SUBROUTINE mynn_bl_driver( & th1(k)=th(i,k,j) tk1(k)=T3D(i,k,j) rho1(k)=rho(i,k,j) - sqc(k)=qc(i,k,j)/(1.+qv(i,k,j)) - sqv(k)=qv(i,k,j)/(1.+qv(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)) - IF (PRESENT(qi) .AND. FLAG_QI ) THEN - sqi(k)=qi(i,k,j)/(1.+qv(i,k,j)) + 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) + ENDIF + IF (PRESENT(sqi3D) .AND. FLAG_QI ) THEN + sqi(k)=sqi3D(i,k,j) !/(1.+qv(i,k,j)) 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) @@ -4165,9 +4389,9 @@ SUBROUTINE mynn_bl_driver( & !thl(k)=th(i,k,j)*(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_BL(i,k,j)>0.001)THEN - sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) - sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN + sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) + sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) ELSE sqc9=sqc(k) sqi9=sqi(k) @@ -4182,9 +4406,9 @@ SUBROUTINE mynn_bl_driver( & !suggested min temperature to improve accuracy. !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL(i,k,j)>0.001)THEN - sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) - sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN + sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) + sqi9=0.0 ELSE sqc9=sqc(k) sqi9=0.0 @@ -4199,11 +4423,14 @@ SUBROUTINE mynn_bl_driver( & ELSE zw(k)=zw(k-1)+dz(i,k-1,j) ENDIF - if (restart) then - qke1(k) = qke(i,k,j) - else - qke1(k)=0.1-MIN(zw(k)*0.001, 0.0) !for initial PBLH calc only - end if + 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) + ELSE + qke1(k)=qke(i,k,j) + ENDIF el(k)=el_pbl(i,k,j) sh(k)=Sh3D(i,k,j) tsq1(k)=tsq(i,k,j) @@ -4240,13 +4467,15 @@ SUBROUTINE mynn_bl_driver( & !! within mym_initialize(): mym_level2() and mym_length(). CALL mym_initialize ( & &kts,kte, & - &dz1, zw, u1, v1, thl, sqv, & + &dz1, dx(i,j), zw, & + &u1, v1, thl, sqv, & &PBLH(i,j), th1, sh, & &ust(i,j), rmol(i,j), & &el, Qke1, Tsq1, Qsq1, Cov1, & &Psig_bl(i,j), cldfra_bl1D, & &bl_mynn_mixlength, & &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf,& + &INITIALIZE_QKE, & &spp_pbl,rstoch_col ) IF (.not.restart) THEN @@ -4295,6 +4524,14 @@ SUBROUTINE mynn_bl_driver( & IF ( bl_mynn_tkebudget == 1) THEN dqke(i,k,j)=qke(i,k,j) 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) + ENDIF dz1(k)= dz(i,k,j) u1(k) = u(i,k,j) v1(k) = v(i,k,j) @@ -4302,21 +4539,20 @@ SUBROUTINE mynn_bl_driver( & th1(k)= th(i,k,j) tk1(k)=T3D(i,k,j) rho1(k)=rho(i,k,j) - qv1(k)= qv(i,k,j) - qc1(k)= qc(i,k,j) - sqv(k)= qv(i,k,j)/(1.+qv(i,k,j)) - sqc(k)= qc(i,k,j)/(1.+qv(i,k,j)) - IF(icloud_bl > 0)cldfra_bl1D_old(k)=cldfra_bl(i,k,j) - IF(icloud_bl > 0)qc_bl1D_old(k)=qc_bl(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)) dqc1(k)=0.0 dqi1(k)=0.0 dqni1(k)=0.0 dqnc1(k)=0.0 dqnwfa1(k)=0.0 dqnifa1(k)=0.0 - IF(PRESENT(qi) .AND. FLAG_QI)THEN - qi1(k)= qi(i,k,j) - sqi(k)= qi(i,k,j)/(1.+qv(i,k,j)) + 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)) 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) @@ -4325,9 +4561,9 @@ SUBROUTINE mynn_bl_driver( & !thl(k)=th(i,k,j)*(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_BL(i,k,j)>0.001)THEN - sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) - sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN + sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) + sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) ELSE sqc9=sqc(k) sqi9=sqi(k) @@ -4343,16 +4579,16 @@ SUBROUTINE mynn_bl_driver( & !suggested min temperature to improve accuracy. !thl(k)=th(i,k,j)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL(i,k,j)>0.001)THEN - sqc9=QC_BL(i,k,j)*(MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) - sqi9=QC_BL(i,k,j)*(1. - MIN(1., MAX(0., (tk1(k)-254.)/15.)))*CLDFRA_BL(i,k,j) + IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN + sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) + sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) ELSE 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 - ENDIF + & - 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)) @@ -4376,6 +4612,11 @@ SUBROUTINE mynn_bl_driver( & ELSE qnifa1(k)=0.0 ENDIF + IF (PRESENT(ozone)) THEN + ozone1(k)=ozone(i,k) + 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) @@ -4407,6 +4648,15 @@ SUBROUTINE mynn_bl_driver( & s_awqni1(k)=0. s_awqnwfa1(k)=0. s_awqnifa1(k)=0. + sub_thl(k)=0. + sub_sqv(k)=0. + sub_u(k)=0. + sub_v(k)=0. + det_thl(k)=0. + det_sqv(k)=0. + det_sqc(k)=0. + det_u(k)=0. + det_v(k)=0. #if (WRF_CHEM == 1) IF (bl_mynn_mixchem == 1) THEN @@ -4480,7 +4730,7 @@ SUBROUTINE mynn_bl_driver( & ENDIF sqcg= 0.0 !JOE, it was: qcg(i,j)/(1.+qcg(i,j)) - cpm=cp*(1.+0.84*qv(i,kts,j)) + cpm=cp*(1.+0.84*qv1(kts)) exnerg=(ps(i,j)/p1000mb)**rcp !----------------------------------------------------- @@ -4531,10 +4781,10 @@ 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,p1,ex1, & - &tsq1, qsq1, cov1, & + &dx(i,j),dz1,zw,thl,sqw,sqv,sqc,sqi,& + &p1,ex1,tsq1,qsq1,cov1, & &Sh,el,bl_mynn_cloudpdf, & - &qc_bl1D,cldfra_bl1D, & + &qc_bl1D,qi_bl1D,cldfra_bl1D, & &PBLH(i,j),HFX(i,j), & &Vt, Vq, th1, sgm, rmol(i,j), & &spp_pbl, rstoch_col ) @@ -4591,11 +4841,17 @@ SUBROUTINE mynn_bl_driver( & 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 - radsum=MIN(radsum,60.0) + + !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 - bfx0 = max(radsum/rho1(k)/cp - max(sflux,0.0),0.) - !bfx0 = max(radsum/rho1(k)/cp,0.) wm3 = g/thetav(k)*bfx0*MIN(pblh(i,j),1500.) ! this is wstar3(i) wm2 = wm2 + wm3**h2 bfxpbl = - ent_eff * bfx0 @@ -4631,12 +4887,9 @@ SUBROUTINE mynn_bl_driver( & TKEprodTD(kts:kte)=0.0 ENDIF !end top-down check -!> - Call dmp_mf() to calculate the nonlocal turbulent transport from -!! the dynamic multiplume mass-flux scheme as well as the shallow-cumulus -!! component of the subgrid clouds. - IF (bl_mynn_edmf == 1) THEN + IF (bl_mynn_edmf > 0) THEN !PRINT*,"Calling DMP Mass-Flux: i= ",i," j=",j - CALL DMP_mf( & + CALL DMP_mf( & &kts,kte,delt,zw,dz1,p1, & &bl_mynn_edmf_mom, & &bl_mynn_edmf_tke, & @@ -4646,7 +4899,7 @@ SUBROUTINE mynn_bl_driver( & &qnc1,qni1,qnwfa1,qnifa1, & &ex1,Vt,Vq,sgm, & &ust(i,j),flt,flq,flqv,flqc, & - &PBLH(i,j),KPBL(i,j),DX(i,j), & + &PBLH(i,j),KPBL(i,j),DX(i,j), & &xland(i,j),th_sfc, & ! now outputs - tendencies ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & @@ -4659,16 +4912,21 @@ SUBROUTINE mynn_bl_driver( & & s_awu1,s_awv1,s_awqke1, & & s_awqnc1,s_awqni1, & & s_awqnwfa1,s_awqnifa1, & + & sub_thl,sub_sqv, & + & sub_u,sub_v, & + & det_thl,det_sqv,det_sqc, & + & det_u,det_v, & #if (WRF_CHEM == 1) & nchem,chem1,s_awchem1, & #endif & qc_bl1D,cldfra_bl1D, & + & qc_bl1D_old,cldfra_bl1D_old, & & FLAG_QC,FLAG_QI, & & FLAG_QNC,FLAG_QNI, & & FLAG_QNWFA,FLAG_QNIFA, & & Psig_shcu(i,j), & - & nupdraft(i,j),ktop_shallow(i,j), & - & maxmf(i,j),ztop_shallow, & + & nupdraft(i,j),ktop_plume(i,j), & + & maxmf(i,j),ztop_plume, & & spp_pbl,rstoch_col & ) @@ -4678,7 +4936,8 @@ SUBROUTINE mynn_bl_driver( & !! to carry out successive claculations. CALL mym_turbulence ( & &kts,kte,levflag, & - &dz1, zw, u1, v1, thl, sqc, sqw, & + &dz1, DX(i,j), zw, & + &u1, v1, thl, sqc, sqw, & &qke1, tsq1, qsq1, cov1, & &vt, vq, & &rmol(i,j), flt, flq, & @@ -4707,7 +4966,7 @@ SUBROUTINE mynn_bl_driver( & DO k=kts,kte-1 ! Set max dissipative heating rate close to 0.1 K per hour (=0.000027...) - diss_heat(k) = MIN(MAX(0.5*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.00002) + 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) ENDDO diss_heat(kte) = 0. @@ -4719,7 +4978,7 @@ SUBROUTINE mynn_bl_driver( & &u1, v1, th1, tk1, qv1, & &qc1, qi1, qnc1, qni1, & &p1, ex1, thl, sqv, sqc, sqi, sqw,& - &qnwfa1, qnifa1, & + &qnwfa1, qnifa1, ozone1, & &ust(i,j),flt,flq,flqv,flqc, & &wspd(i,j),qcg(i,j), & &uoce(i,j),voce(i,j), & @@ -4728,17 +4987,20 @@ SUBROUTINE mynn_bl_driver( & &dfm, dfh, dfq, & &Du1, Dv1, Dth1, Dqv1, & &Dqc1, Dqi1, Dqnc1, Dqni1, & - &Dqnwfa1, Dqnifa1, & + &Dqnwfa1, Dqnifa1, Dozone1, & &vdfg(i,j), diss_heat, & ! mass flux components &s_aw1,s_awthl1,s_awqt1, & &s_awqv1,s_awqc1,s_awu1,s_awv1, & &s_awqnc1,s_awqni1, & &s_awqnwfa1,s_awqnifa1, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & &FLAG_QC,FLAG_QI,FLAG_QNC, & &FLAG_QNI,FLAG_QNWFA,FLAG_QNIFA, & &cldfra_bl1d, & - &ztop_shallow,ktop_shallow(i,j), & &bl_mynn_cloudmix, & &bl_mynn_mixqt, & &bl_mynn_edmf, & @@ -4781,11 +5043,11 @@ SUBROUTINE mynn_bl_driver( & RTHBLTEN(i,k,j)=dth1(k) RQVBLTEN(i,k,j)=dqv1(k) IF(bl_mynn_cloudmix > 0)THEN - IF (PRESENT(qc) .AND. FLAG_QC) RQCBLTEN(i,k,j)=dqc1(k) - IF (PRESENT(qi) .AND. FLAG_QI) RQIBLTEN(i,k,j)=dqi1(k) + IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k,j)=dqc1(k) + IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k,j)=dqi1(k) ELSE - IF (PRESENT(qc) .AND. FLAG_QC) RQCBLTEN(i,k,j)=0. - IF (PRESENT(qi) .AND. FLAG_QI) RQIBLTEN(i,k,j)=0. + IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k,j)=0. + IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k,j)=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) @@ -4798,37 +5060,34 @@ SUBROUTINE mynn_bl_driver( & IF (PRESENT(qnwfa) .AND. FLAG_QNWFA) RQNWFABLTEN(i,k,j)=0. IF (PRESENT(qnifa) .AND. FLAG_QNIFA) RQNIFABLTEN(i,k,j)=0. ENDIF + DOZONE(i,k)=DOZONE1(k) IF(icloud_bl > 0)THEN - !make BL clouds scale aware - may already be done in mym_condensation - qc_bl(i,k,j)=qc_bl1D(k) !*Psig_shcu(i,j) - cldfra_bl(i,k,j)=cldfra_bl1D(k) !*Psig_shcu(i,j) - !DIAGNOSTIC-DECAY FOR SUBGRID-SCALE CLOUDS -!> - Compute the temporal decay of diagnostic subgrid cloud. This allows the diagnostic -!! sugrid clouds to persist for an eddy turnover time scale. - IF (CLDFRA_BL(i,k,j) < cldfra_bl1D_old(k)) THEN + IF (CLDFRA_BL1D(k) < cldfra_bl1D_old(k)) THEN !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. + !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)) - IF (cldfra_bl(i,k,j) < 0.005) THEN - CLDFRA_BL(i,k,j)= 0. - QC_BL(i,k,j) = 0. + ! 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. 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) ENDIF - - !Reapply checks on cldfra_bl and qc_bl to avoid FPEs in radiation driver - ! when these two quantities are multiplied by eachother (they may have changed - ! in the MF scheme: - !IF (icloud_bl > 0) THEN - IF ( zw(k) < 3000.0 ) THEN - IF (QC_BL(i,k,j) < 5E-6 .AND. CLDFRA_BL(i,k,j) > 0.005) QC_BL(i,k,j)= 5E-6 - ELSE - IF (QC_BL(i,k,j) < 1E-8 .AND. CLDFRA_BL(i,k,j) > 0.005) QC_BL(i,k,j)= 1E-8 - ENDIF ENDIF el_pbl(i,k,j)=el(k) @@ -4838,26 +5097,37 @@ SUBROUTINE mynn_bl_driver( & cov(i,k,j)=cov1(k) sh3d(i,k,j)=sh(k) - IF ( bl_mynn_tkebudget == 1) THEN + 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 - ENDIF + ENDDO + ENDIF - !update updraft properties - IF (bl_mynn_edmf > 0) THEN - edmf_a(i,k,j)=edmf_a1(k) - edmf_w(i,k,j)=edmf_w1(k) - edmf_qt(i,k,j)=edmf_qt1(k) - edmf_thl(i,k,j)=edmf_thl1(k) - edmf_ent(i,k,j)=edmf_ent1(k) - edmf_qc(i,k,j)=edmf_qc1(k) - ENDIF + !update updraft properties + IF (bl_mynn_output > 0) THEN !research mode == 1 + DO k = kts,kte + edmf_a(i,k)=edmf_a1(k) + edmf_w(i,k)=edmf_w1(k) + edmf_qt(i,k)=edmf_qt1(k) + edmf_thl(i,k)=edmf_thl1(k) + edmf_ent(i,k)=edmf_ent1(k) + edmf_qc(i,k)=edmf_qc1(k) + sub_thl3D(i,k)=sub_thl(k) + sub_sqv3D(i,k)=sub_sqv(k) + det_thl3D(i,k)=det_thl(k) + det_sqv3D(i,k)=det_sqv(k) + ENDDO + ENDIF - !*** Begin debug prints - IF ( debug_code ) THEN + !*** Begin debug prints + IF ( debug_code ) THEN + DO k = kts,kte IF ( sh(k) < 0. .OR. sh(k)> 200.)print*,& "SUSPICIOUS VALUES AT: i,j,k=",i,j,k," sh=",sh(k) IF ( qke(i,k,j) < -1. .OR. qke(i,k,j)> 200.)print*,& @@ -4881,30 +5151,27 @@ SUBROUTINE mynn_bl_driver( & PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k,j)," qc_bl=",QC_BL(i,k,j) ENDIF ENDIF - ENDIF - !*** End debug prints - ENDDO + + !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) + !ENDIF + ENDDO !end-k + ENDIF + !*** End debug prints !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) - 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) - ENDDO - -!*** Begin debugging -! IF(I==IMD .AND. J==JMD)THEN -! k=kdebug -! PRINT*,"MYNN DRIVER END: k=",1," sh=",sh(k) -! PRINT*," sqw=",sqw(k)," thl=",thl(k)," k_m=",k_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) -! ENDIF -!*** End debugging + !tke_pbl(i,kts,j) = 0.5*MAX(qke(i,kts,j),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) + !ENDDO ENDDO ENDDO @@ -4927,9 +5194,10 @@ END SUBROUTINE mynn_bl_driver !>\ingroup gsd_mynn_edmf SUBROUTINE mynn_bl_init_driver( & &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & - &RQCBLTEN,RQIBLTEN & !,RQNIBLTEN,RQNCBLTEN & - &,QKE,TKE_PBL,EXCH_H & -! &,icloud_bl,qc_bl,cldfra_bl & !JOE-subgrid bl clouds + &RQCBLTEN,RQIBLTEN & !,RQNIBLTEN,RQNCBLTEN & + &,QKE, & + &EXCH_H & + !&,icloud_bl,qc_bl,cldfra_bl & &,RESTART,ALLOWED_TO_READ,LEVEL & &,IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & @@ -4947,7 +5215,7 @@ SUBROUTINE mynn_bl_init_driver( & REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: & &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & &RQCBLTEN,RQIBLTEN,& !RQNIBLTEN,RQNCBLTEN & - &QKE,TKE_PBL,EXCH_H + &QKE,EXCH_H ! REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: & ! &qc_bl,cldfra_bl @@ -4971,7 +5239,6 @@ SUBROUTINE mynn_bl_init_driver( & !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. - TKE_PBL(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. @@ -5036,15 +5303,13 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) REAL, DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D !LOCAL VARS REAL :: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv - REAL :: delt_thv !< delta theta-v; dependent on land/sea point - REAL, PARAMETER :: sbl_lim = 200. !< upper limit of stable BL height (m). - REAL, PARAMETER :: sbl_damp = 400. !< transition length for blending (m). - INTEGER :: I,J,K,kthv,ktke,kzi,kzi2 + REAL :: delt_thv !delta theta-v; dependent on land/sea point + REAL, PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). + REAL, PARAMETER :: sbl_damp = 400. !transition length for blending (m). + INTEGER :: I,J,K,kthv,ktke,kzi - !ADD KPBL (kzi) - !KZI2 is the TKE-based part of the hybrid KPBL + !Initialize KPBL (kzi) kzi = 2 - kzi2= 2 !> - FIND MIN THETAV IN THE LOWEST 200 M AGL k = kts+1 @@ -5076,11 +5341,9 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) ! DO WHILE (zi .EQ. 0.) DO k=kts+1,kte-1 IF (thetav1D(k) .GE. (minthv + delt_thv))THEN - !kzi = MAX(k-1,1) zi = zw1D(k) - dz1D(k-1)* & & MIN((thetav1D(k)-(minthv + delt_thv))/ & & MAX(thetav1D(k)-thetav1D(k-1),1E-6),1.0) - kzi= MAX(k-1,1) + NINT((zi-zw1D(k-1))/dz1D(k-1)) ENDIF !k = k+1 IF (k .EQ. kte-1) zi = zw1D(kts+1) !EXIT SAFEGUARD @@ -5107,12 +5370,10 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) qtke =MAX(Qke1D(k)/2.,0.) ! maximum TKE qtkem1=MAX(Qke1D(k-1)/2.,0.) IF (qtke .LE. TKEeps) THEN - !kzi2 = MAX(k-1,1) PBLH_TKE = zw1D(k) - dz1D(k-1)* & & 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)) - kzi2 = MAX(k-1,1) + NINT((PBLH_TKE-zw1D(k-1))/dz1D(k-1)) !print *,"PBLH_TKE:",i,j,PBLH_TKE, Qke1D(k)/2., zw1D(kts+1) ENDIF !k = k+1 @@ -5137,8 +5398,13 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) zi=PBLH_TKE*(1.-wt) + zi*wt ENDIF - !ADD KPBL (kzi) for coupling to some Cu schemes - kzi = MAX(INT(kzi2*(1.-wt) + kzi*wt),1) + !Compute KPBL (kzi) + DO k=kts+1,kte-1 + IF ( zw1D(k) >= zi) THEN + kzi = k-1 + exit + ENDIF + ENDDO #ifdef HARDCODE_VERTICAL # undef kts @@ -5188,11 +5454,16 @@ SUBROUTINE DMP_mf( & & s_awu,s_awv,s_awqke, & & s_awqnc,s_awqni, & & s_awqnwfa,s_awqnifa, & + & sub_thl,sub_sqv, & + & sub_u,sub_v, & + & det_thl,det_sqv,det_sqc, & + & det_u,det_v, & #if (WRF_CHEM == 1) & nchem,chem,s_awchem, & #endif ! in/outputs - subgrid scale clouds - & qc_bl1d,cldfra_bl1d, & + & qc_bl1d,cldfra_bl1d, & + & qc_bl1D_old,cldfra_bl1D_old, & ! inputs - flags for moist arrays & F_QC,F_QI, & F_QNC,F_QNI, & @@ -5244,7 +5515,8 @@ SUBROUTINE DMP_mf( & s_awv, & s_awqke, s_aw2 - REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: qc_bl1d,cldfra_bl1d + REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: qc_bl1d,cldfra_bl1d, & + qc_bl1d_old,cldfra_bl1d_old INTEGER, PARAMETER :: NUP=10, debug_mf=0 @@ -5260,7 +5532,7 @@ SUBROUTINE DMP_mf( & ! internal variables INTEGER :: K,I,k50 REAL :: fltv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,wtv,Psig_w,maxw,maxqc,wpbl + pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl REAL :: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn,QNWFAn,QNIFAn, & Wn2,Wn,EntEXP,EntW,BCOEFF,THVkm1,THVk,Pk @@ -5304,24 +5576,42 @@ SUBROUTINE DMP_mf( & ! VARIABLES FOR CHABOUREAU-BECHTOLD CLOUD FRACTION REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm REAL :: sigq,xl,tlk,qsat_tl,rsl,cpm,a,qmq,mf_cf,Q1,diffqt,& - Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid + Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & + Ac_mf,Ac_strat,qc_mf ! Variables for plume interpolation/saturation check REAL,DIMENSION(KTS:KTE) :: exneri,dzi - REAL :: THp, QTp, QCp, esat, qsl + REAL :: THp, QTp, QCp, QCs, esat, qsl ! WA TEST 11/9/15 for consistent reduction of updraft params - REAL :: csigma,acfac,EntThrottle + REAL :: csigma,acfac !JOE- plume overshoot INTEGER :: overshoot - REAL :: bvf, Frz + REAL :: bvf, Frz, dzp !Flux limiter: not let mass-flux of heat between k=1&2 exceed (fluxportion)*(surface heat flux). !This limiter makes adjustments to the entire column. REAL :: adjustment, flx1 REAL, PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact ! over land (decrease maxMF by 10-20%), but no impact over water. + + !Subsidence + REAL,DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence + det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment + envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & + 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. + 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 + !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme + !is compensated by "gentle" environmental subsidence. + REAL, PARAMETER :: Csub=0.25 + ! check the inputs ! print *,'dt',dt ! print *,'dz',dz @@ -5385,7 +5675,16 @@ SUBROUTINE DMP_mf( & s_awchem(kts:kte+1,1:nchem) = 0.0 ENDIF #endif - +! Initialize explicit tendencies for subsidence & detrainment + sub_thl = 0. + sub_sqv = 0. + sub_u = 0. + sub_v = 0. + det_thl = 0. + det_sqv = 0. + det_sqc = 0. + det_u = 0. + det_v = 0. ! Taper off MF scheme when significant resolved-scale motions ! are present This function needs to be asymetric... @@ -5411,8 +5710,8 @@ SUBROUTINE DMP_mf( & !k = k + 1 ENDDO !print*," maxw before manipulation=", maxw - maxw = MAX(0.,maxw - 0.5) ! do nothing for small w, but - Psig_w = MAX(0.0, 1.0 - maxw/0.5) ! linearly taper off for w > 0.5 m/s + maxw = MAX(0.,maxw - 1.0) ! do nothing for small w (< 1 m/s), but + Psig_w = MAX(0.0, 1.0 - maxw) ! linearly taper off for w > 1.0 m/s Psig_w = MIN(Psig_w, Psig_shcu) !print*," maxw=", maxw," Psig_w=",Psig_w," Psig_shcu=",Psig_shcu @@ -5431,7 +5730,7 @@ SUBROUTINE DMP_mf( & ELSE hux = -0.005 ! LAND ! dT/dz must be < - 0.5 K per 100 m. ENDIF - DO k=1,MAX(1,k50-1) + DO k=1,MAX(1,k50-1) !use "-1" because k50 used interface heights (zw). IF (k == 1) then IF ((th(k)-ts)/(0.5*dz(k)) < hux) THEN superadiabatic = .true. @@ -5453,23 +5752,25 @@ SUBROUTINE DMP_mf( & ! Some of these criteria may be a little redundant but useful for bullet-proofing. ! (1) largest plume = 1.0 * dx. ! (2) Apply a scale-break, assuming no plumes with diameter larger than PBLH can exist. - ! (3) max plume size beneath clouds deck approx = height of cloud_base. - ! (4) add shear-dependent limit, when plume model breaks down. (taken out) + ! (3) max plume size beneath clouds deck approx = 0.5 * cloud_base. + ! (4) add wspd-dependent limit, when plume model breaks down. (hurricanes) ! (5) land-only limit to reduce plume sizes in weakly forced conditions ! Criteria (1) NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) - ! Criteria (2) and (4) - !wspd_pbl=SQRT(MAX(u(kpbl)**2 + v(kpbl)**2, 0.01)) - maxwidth = 1.2*PBLH !- MIN(15.*MAX(wspd_pbl - 7.5, 0.), 0.3*PBLH) + !Criteria (2) + maxwidth = 1.2*PBLH ! Criteria (3) - maxwidth = MIN(maxwidth,cloud_base) + maxwidth = MIN(maxwidth,0.75*cloud_base) + ! Criteria (4) + wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) + !Note: area fraction (acfac) is modified below ! Criteria (5) IF((landsea-1.5).LT.0)THEN width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) maxwidth = MIN(maxwidth,width_flx) ENDIF ! Convert maxwidth to number of plumes - NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) + NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) !Initialize values: ktop = 0 @@ -5499,7 +5800,12 @@ SUBROUTINE DMP_mf( & UPA(1,I) = N*l*l/(dx*dx) * dl ! fractional area of plume n ! Make updraft area (UPA) a function of the buoyancy flux ! acfac = .5*tanh((fltv - 0.03)/0.09) + .5 - acfac = .5*tanh((fltv - 0.02)/0.09) + .5 +! acfac = .5*tanh((fltv - 0.02)/0.09) + .5 + acfac = .5*tanh((fltv - 0.01)/0.09) + .5 + + !add a windspeed-dependent adjustment to acfac that tapers off + !the mass-flux scheme linearly above sfc wind speeds of 20 m/s: + acfac = acfac*(1. - MIN(MAX(wspd_pbl - 20.0, 0.0), 10.0)/10.) UPA(1,I)=UPA(1,I)*acfac An2 = An2 + UPA(1,I) ! total fractional area of all plumes @@ -5520,12 +5826,22 @@ SUBROUTINE DMP_mf( & ELSE csigma = 1.34 ! LAND ENDIF + + IF (env_subs) THEN + exc_fac = 0.0 + ELSE + exc_fac = 0.58 + ENDIF + + !Note: sigmaW is typically about 0.5*wstar sigmaW =1.34*wstar*(z0/pblh)**(1./3.)*(1 - 0.8*z0/pblh) sigmaQT=csigma*qstar*(z0/pblh)**(-1./3.) sigmaTH=csigma*thstar*(z0/pblh)**(-1./3.) - wmin=MIN(sigmaW*pwmin,0.1) - wmax=MIN(sigmaW*pwmax,0.333) + !Note: Given the pwmin & pwmax set above, these max/mins are + ! rarely exceeded. + wmin=MIN(sigmaW*pwmin,0.05) + wmax=MIN(sigmaW*pwmax,0.4) !recompute acfac for plume excess acfac = .5*tanh((fltv - 0.03)/0.07) + .5 @@ -5534,44 +5850,49 @@ SUBROUTINE DMP_mf( & DO I=1,NUP !NUP2 IF(I > NUP2) exit wlv=wmin+(wmax-wmin)/NUP2*(i-1) - wtv=wmin+(wmax-wmin)/NUP2*i !SURFACE UPDRAFT VERTICAL VELOCITY - !UPW(1,I)=0.5*(wlv+wtv) UPW(1,I)=wmin + REAL(i)/REAL(NUP)*(wmax-wmin) !IF (UPW(1,I) > 0.5*ZW(2)/dt) UPW(1,I) = 0.5*ZW(2)/dt - !SURFACE UPDRAFT AREA - !UPA(1,I)=0.5*ERF(wtv/(sqrt(2.)*sigmaW)) - 0.5*ERF(wlv/(sqrt(2.)*sigmaW)) - !UPA(1,I)=0.25*ERF(wtv/(sqrt(2.)*sigmaW)) - 0.25*ERF(wlv/(sqrt(2.)*sigmaW)) !12.0 - UPU(1,I)=(U(KTS)*DZ(KTS+1)+U(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPV(1,I)=(V(KTS)*DZ(KTS+1)+V(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQC(1,I)=0 !UPQC(1,I)=(QC(KTS)*DZ(KTS+1)+QC(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQT(1,I)=(QT(KTS)*DZ(KTS+1)+QT(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1))& - & +0.58*UPW(1,I)*sigmaQT/sigmaW + & +exc_fac*UPW(1,I)*sigmaQT/sigmaW UPTHV(1,I)=(THV(KTS)*DZ(KTS+1)+THV(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & - & +0.58*UPW(1,I)*sigmaTH/sigmaW + & +exc_fac*UPW(1,I)*sigmaTH/sigmaW !was UPTHL(1,I)= UPTHV(1,I)/(1.+svp1*UPQT(1,I)) !assume no saturated parcel at surface UPTHL(1,I)=(THL(KTS)*DZ(KTS+1)+THL(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & - & +0.58*UPW(1,I)*sigmaTH/sigmaW + & +exc_fac*UPW(1,I)*sigmaTH/sigmaW UPQKE(1,I)=(QKE(KTS)*DZ(KTS+1)+QKE(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNC(1,I)=(QNC(KTS)*DZ(KTS+1)+QNC(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNI(1,I)=(QNI(KTS)*DZ(KTS+1)+QNI(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNWFA(1,I)=(QNWFA(KTS)*DZ(KTS+1)+QNWFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNIFA(1,I)=(QNIFA(KTS)*DZ(KTS+1)+QNIFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + ENDDO + #if (WRF_CHEM == 1) IF (bl_mynn_mixchem == 1) THEN - do ic = 1,nchem - UPCHEM(1,I,ic)= (CHEM(KTS,ic)*DZ(KTS+1)+CHEM(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - enddo + DO I=1,NUP !NUP2 + IF(I > NUP2) exit + do ic = 1,nchem + UPCHEM(1,I,ic)=(CHEM(KTS,ic)*DZ(KTS+1)+CHEM(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + enddo + ENDDO ENDIF #endif + !Initialize environmental variables which can be modified by detrainment + DO k=kts,kte + envm_thl(k)=THL(k) + envm_sqv(k)=QV(k) + envm_sqc(k)=QC(k) + envm_u(k)=U(k) + envm_v(k)=V(k) ENDDO - EntThrottle = 0.001 !MAX(0.02/MAX((flt*1.25*1004.)-25.,5.),0.0002) !QCn = 0. ! do integration updraft DO I=1,NUP !NUP2 @@ -5581,19 +5902,18 @@ SUBROUTINE DMP_mf( & l = dl*I ! diameter of plume DO k=KTS+1,KTE-1 !w-dependency for entrainment a la Tian and Kuang (2016) - !ENT(k,i) = 0.5/(MIN(MAX(UPW(K-1,I),0.75),1.5)*l) - !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.5)*l) - ENT(k,i) = 0.33/(MIN(MAX(UPW(K-1,I),0.666),2.0)*l) + !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.9)*l) + wmin = 0.3 + l*0.0005 !* MAX(pblh-ZW(k+1), 0.0)/pblh + ENT(k,i) = 0.33/(MIN(MAX(UPW(K-1,I),wmin),1.9)*l) !Entrainment from Negggers (2015, JAMES) !ENT(k,i) = 0.02*l**-0.35 - 0.0009 - !JOE - implement minimum background entrainment + !Minimum background entrainment ENT(k,i) = max(ENT(k,i),0.0003) !ENT(k,i) = max(ENT(k,i),0.05/ZW(k)) !not needed for Tian and Kuang !JOE - increase entrainment for plumes extending very high. - IF(ZW(k) >= MIN(pblh+1500., 3500.))THEN - ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,3500.))*5.0E-6 + IF(ZW(k) >= MIN(pblh+1500., 4000.))THEN + ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,4000.))*5.0E-6 ENDIF - !IF(UPW(K-1,I) > 2.0) ENT(k,i) = ENT(k,i) + EntThrottle*(UPW(K-1,I) - 2.0) !SPP ENT(k,i) = ENT(k,i) * (1.0 - rstoch_col(k)) @@ -5612,6 +5932,12 @@ SUBROUTINE DMP_mf( & QNWFAn=UPQNWFA(k-1,I)*(1.-EntExp) + QNWFA(k)*EntExp QNIFAn=UPQNIFA(k-1,I)*(1.-EntExp) + QNIFA(k)*EntExp + !capture the updated qc, qt & thl modified by entranment alone, + !since they will be modified later if condensation occurs. + qc_ent = QCn + qt_ent = QTn + thl_ent = THLn + ! Exponential Entrainment: !EntExp= exp(-ENT(K,I)*(ZW(k)-ZW(k-1))) !QTn =QT(K) *(1-EntExp)+UPQT(K-1,I)*EntExp @@ -5671,6 +5997,12 @@ 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) + !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 + NUP2=0 + exit + ENDIF IF (debug_mf == 1) THEN IF (Wn .GE. 3.0) THEN @@ -5683,31 +6015,57 @@ SUBROUTINE DMP_mf( & ENDIF !Allow strongly forced plumes to overshoot if KE is sufficient - IF (fltv > 0.05 .AND. Wn <= 0 .AND. overshoot == 0) THEN + !IF (fltv > 0.05 .AND. Wn <= 0 .AND. overshoot == 0) THEN + IF (Wn <= 0.0 .AND. overshoot == 0) THEN overshoot = 1 IF ( THVk-THVkm1 .GT. 0.0 ) THEN bvf = SQRT( gtr*(THVk-THVkm1)/dz(k) ) !vertical Froude number Frz = UPW(K-1,I)/(bvf*dz(k)) - IF ( Frz >= 0.5 ) Wn = MIN(Frz,1.0)*UPW(K-1,I) + !IF ( Frz >= 0.5 ) Wn = MIN(Frz,1.0)*UPW(K-1,I) + dzp = dz(k)*MAX(MIN(Frz,1.0),0.0) ! portion of highest layer the plume penetrates ENDIF - ELSEIF (fltv > 0.05 .AND. overshoot == 1) THEN - !Do not let overshooting parcel go more than 1 layer up - Wn = 0.0 + !ELSEIF (fltv > 0.05 .AND. overshoot == 1) THEN + ELSE + dzp = dz(k) + ! !Do not let overshooting parcel go more than 1 layer up + ! Wn = 0.0 ENDIF !Limit very tall plumes ! Wn2=Wn2*EXP(-MAX(ZW(k)-(pblh+2000.),0.0)/1000.) ! IF(ZW(k) >= pblh+3000.)Wn2=0. - Wn=Wn*EXP(-MAX(ZW(k+1)-MIN(pblh+2000.,3000.),0.0)/1000.) - IF(ZW(k+1) >= MIN(pblh+3000.,4500.))Wn=0. + Wn=Wn*EXP(-MAX(ZW(k+1)-MIN(pblh+2000.,3500.),0.0)/1000.) !JOE- minimize the plume penetratration in stratocu-topped PBL ! IF (fltv < 0.06) THEN ! IF(ZW(k+1) >= pblh-200. .AND. qc(k) > 1e-5 .AND. I > 4) Wn=0. ! ENDIF + !Modify environment variables (representative of the model layer - envm*) + !following the updraft dynamical detrainment of Asai and Kasahara (1967, JAS). + !Reminder: w is limited to be non-negative (above) + aratio = MIN(UPA(K-1,I)/(1.-UPA(K-1,I)), 0.5) !limit should never get hit + detturb = 0.00008 + oow = -0.060/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate + detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0002) ! dynamical detrainment rate (m^-1) + detrateUV= MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0001) ! dynamical detrainment rate (m^-1) + envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*MIN(dzp,dzpmax) + qv_ent = 0.5*(MAX(qt_ent-qc_ent,0.) + MAX(UPQT(K-1,I)-UPQC(K-1,I),0.)) + envm_sqv(k)=envm_sqv(k) + (qv_ent-QV(K))*detrate*aratio*MIN(dzp,dzpmax) + IF (UPQC(K-1,I) > 1E-8) THEN + IF (QC(K) > 1E-6) THEN + qc_grid = QC(K) + ELSE + qc_grid = cldfra_bl1d(k)*qc_bl1d(K) + ENDIF + envm_sqc(k)=envm_sqc(k) + MAX(UPA(K-1,I)*0.5*(QCn + UPQC(K-1,I)) - qc_grid, 0.0)*detrate*aratio*MIN(dzp,dzpmax) + ENDIF + envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*MIN(dzp,dzpmax) + envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*MIN(dzp,dzpmax) + IF (Wn > 0.) THEN + !Update plume variables at current k index UPW(K,I)=Wn !Wn !sqrt(Wn2) UPTHV(K,I)=THVn UPTHL(K,I)=THLn @@ -5761,12 +6119,13 @@ SUBROUTINE DMP_mf( & IF (ktop == 0) THEN ztop = 0.0 ELSE - ztop=zw(ktop+1) + ztop=zw(ktop) ENDIF IF(nup2 > 0) THEN !Calculate the fluxes for each variable + !All s_aw* variable are == 0 at k=1 DO k=KTS,KTE IF(k > KTOP) exit DO i=1,NUP !NUP2 @@ -5782,16 +6141,23 @@ SUBROUTINE DMP_mf( & IF (tke_opt > 0) THEN s_awqke(k+1)= s_awqke(k+1) + UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w ENDIF + ENDDO + s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) + ENDDO #if (WRF_CHEM == 1) IF (bl_mynn_mixchem == 1) THEN - do ic = 1,nchem - s_awchem(k+1,ic) = s_awchem(k+1,ic) + UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w - enddo + DO k=KTS,KTE + IF(k > KTOP) exit + DO i=1,NUP !NUP2 + IF(I > NUP2) exit + do ic = 1,nchem + s_awchem(k+1,ic) = s_awchem(k+1,ic) + UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w + enddo + ENDDO + ENDDO ENDIF #endif - ENDDO - s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) - ENDDO + IF (scalar_opt > 0) THEN DO k=KTS,KTE IF(k > KTOP) exit @@ -5805,24 +6171,22 @@ SUBROUTINE DMP_mf( & ENDDO ENDIF - !Flux limiter: Check for too large heat flux at top of first model layer - ! Given that the temperature profile is calculated as: - ! d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt & - ! & -dtz(k)*s_awthl(kts+1) + diss_heat(k)*delt*dheat_opt - ! So, s_awthl(kts+1) must be less than flt + !Flux limiter: Check ratio of heat flux at top of first model layer + !and at the surface. Make sure estimated flux out of the top of the + !layer is < fluxportion*surface_heat_flux IF (s_aw(kts+1) /= 0.) THEN - THVk = (THL(kts)*DZ(kts+1)+THL(kts+1)*DZ(kts))/(DZ(kts+1)+DZ(kts)) - flx1 = MAX(s_aw(kts+1)*(s_awthl(kts+1)/s_aw(kts+1) - THVk),0.0) + dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) !dz centered at model interface + flx1 = MAX(s_aw(kts+1)*(TH(kts)-TH(kts+1))/dzi(kts),1.0e-5) ELSE flx1 = 0.0 + !print*,"ERROR: s_aw(kts+1) == 0, NUP=",NUP," NUP2=",NUP2,& + ! " superadiabatic=",superadiabatic," KTOP=",KTOP ENDIF - !flx1 = -dt/dz(kts)*s_awthl(kts+1) - !flx1 = (s_awthl(kts+1)-s_awthl(kts))!/(0.5*(dz(k)+dz(k-1))) adjustment=1.0 - !Print*,"Flux limiter in MYNN-EDMF:" - !Print*,"flx1=",flx1," s_awthl(kts+1)=",s_awthl(kts+1)," s_awthl(kts)=",s_awthl(kts) - IF (flx1 > fluxportion*flt .AND. flx1>0.0) THEN - adjustment= fluxportion*flt/flx1 + !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 + !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) + IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN + adjustment= fluxportion*flt/dz(kts)/flx1 s_aw = s_aw*adjustment s_awthl= s_awthl*adjustment s_awqt = s_awqt*adjustment @@ -5849,6 +6213,7 @@ SUBROUTINE DMP_mf( & !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt !Calculate mean updraft properties for output: + !all edmf_* variables at k=1 correspond to the interface at top of first model layer DO k=KTS,KTE-1 IF(k > KTOP) exit DO I=1,NUP !NUP2 @@ -5868,6 +6233,8 @@ SUBROUTINE DMP_mf( & #endif ENDDO + !Note that only edmf_a is multiplied by Psig_w. This takes care of the + !scale-awareness of the subsidence below: IF (edmf_a(k)>0.) THEN edmf_w(k)=edmf_w(k)/edmf_a(k) edmf_qt(k)=edmf_qt(k)/edmf_a(k) @@ -5888,9 +6255,78 @@ SUBROUTINE DMP_mf( & ENDIF ENDDO + !Calculate the effects environmental subsidence. + !All envi_*variables are valid at the interfaces, like the edmf_* variables + IF (env_subs) THEN + DO k=KTS+1,KTE-1 + !First, smooth the profiles of w & a, since sharp vertical gradients + !in plume variables are not likely extended to env variables + !Note1: w is treated as negative further below + !Note2: both w & a will be transformed into env variables further below + envi_w(k) = onethird*(edmf_w(K-1)+edmf_w(K)+edmf_w(K+1)) + envi_a(k) = onethird*(edmf_a(k-1)+edmf_a(k)+edmf_a(k+1))*adjustment + ENDDO + !define env variables at k=1 (top of first model layer) + envi_w(kts) = edmf_w(kts) + envi_a(kts) = edmf_a(kts) + !define env variables at k=kte + envi_w(kte) = 0.0 + envi_a(kte) = edmf_a(kte) + !define env variables at k=kte+1 + envi_w(kte+1) = 0.0 + envi_a(kte+1) = edmf_a(kte) + !Add limiter for very long time steps (i.e. dt > 300 s) + !Note that this is not a robust check - only for violations in + ! the first model level. + IF (envi_w(kts) > 0.9*DZ(kts)/dt) THEN + sublim = 0.9*DZ(kts)/dt/envi_w(kts) + ELSE + sublim = 1.0 + ENDIF + !Transform w & a into env variables + DO k=KTS,KTE + temp=envi_a(k) + envi_a(k)=1.0-temp + envi_w(k)=csub*sublim*envi_w(k)*temp/(1.-temp) + ENDDO + !calculate tendencies from subsidence and detrainment valid at the middle of + !each model layer + dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) + sub_thl(kts)=0.5*envi_w(kts)*envi_a(kts)*(thl(kts+1)-thl(kts))/dzi(kts) + sub_sqv(kts)=0.5*envi_w(kts)*envi_a(kts)*(qv(kts+1)-qv(kts))/dzi(kts) + DO k=KTS+1,KTE-1 + dzi(k) = 0.5*(DZ(k)+DZ(k+1)) + sub_thl(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (thl(k+1)-thl(k))/dzi(k) + sub_sqv(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (qv(k+1)-qv(k))/dzi(k) + ENDDO + + DO k=KTS,KTE-1 + det_thl(k)=Cdet*(envm_thl(k)-thl(k))*envi_a(k)*Psig_w + 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) + DO k=KTS+1,KTE-1 + sub_u(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (u(k+1)-u(k))/dzi(k) + sub_v(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (v(k+1)-v(k))/dzi(k) + ENDDO + + DO k=KTS,KTE-1 + det_u(k) = Cdet*(envm_u(k)-u(k))*envi_a(k)*Psig_w + det_v(k) = Cdet*(envm_v(k)-v(k))*envi_a(k)*Psig_w + ENDDO + ENDIF + ENDIF !end subsidence/env detranment + !First, compute exner, plume theta, and dz centered at interface !Here, k=1 is the top of the first model layer. These values do not - !need to be defined at k=kte (unused level). + !need to be defined at k=kte (unused level). DO K=KTS,KTE-1 exneri(k) = (exner(k)*DZ(k+1)+exner(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) edmf_th(k)= edmf_thl(k) + xlvcp/exneri(k)*edmf_qc(K) @@ -5957,6 +6393,7 @@ SUBROUTINE DMP_mf( & else f = 1.0 endif + 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) @@ -5968,19 +6405,43 @@ SUBROUTINE DMP_mf( & IF ( debug_code ) THEN print*,"In MYNN, StEM edmf" print*," CB: env qt=",qt(k)," qsat=",qsat_tl - print*," satdef=",QTp - qsat_tl + print*," k=",k," satdef=",QTp - qsat_tl," sgm=",sgm(k) print*," CB: sigq=",sigq," qmq=",qmq," tlk=",tlk print*," CB: mf_cf=",mf_cf," cldfra_bl=",cldfra_bl1d(k)," edmf_a=",edmf_a(k) ENDIF + ! Update cloud fractions and specific humidities in grid cells + ! where the mass-flux scheme is active. Now, we also use the + ! stratus component of the SGS clouds as well. The stratus cloud + ! fractions (Ac_strat) are reduced slightly to give way to the + ! mass-flux SGS cloud fractions (Ac_mf). IF (cldfra_bl1d(k) < 0.5) THEN IF (mf_cf > 0.5*(edmf_a(k)+edmf_a(k-1))) THEN - cldfra_bl1d(k) = mf_cf - qc_bl1d(k) = QCp*0.5*(edmf_a(k)+edmf_a(k-1))/mf_cf + !cldfra_bl1d(k) = mf_cf + !qc_bl1d(k) = QCp*0.5*(edmf_a(k)+edmf_a(k-1))/mf_cf + Ac_mf = mf_cf + Ac_strat = cldfra_bl1d(k)*(1.0-mf_cf) + cldfra_bl1d(k) = Ac_mf + Ac_strat + !dillute Qc from updraft area to larger cloud area + qc_mf = QCp*0.5*(edmf_a(k)+edmf_a(k-1))/mf_cf + !The mixing ratios from the stratus component are not well + !estimated in shallow-cumulus regimes. Ensure stratus clouds + !have mixing ratio similar to cumulus + QCs = MIN(MAX(qc_bl1d(k), 0.5*qc_mf), 5E-4) + qc_bl1d(k) = (qc_mf*Ac_mf + QCs*Ac_strat)/cldfra_bl1d(k) ELSE - cldfra_bl1d(k)=0.5*(edmf_a(k)+edmf_a(k-1)) - qc_bl1d(k) = QCp + !cldfra_bl1d(k)=0.5*(edmf_a(k)+edmf_a(k-1)) + !qc_bl1d(k) = QCp + Ac_mf = 0.5*(edmf_a(k)+edmf_a(k-1)) + Ac_strat = cldfra_bl1d(k)*(1.0-Ac_mf) + cldfra_bl1d(k)=Ac_mf + Ac_strat + qc_mf = QCp + !Ensure stratus clouds have mixing ratio similar to cumulus + QCs = MIN(MAX(qc_bl1d(k), 0.5*qc_mf), 5E-4) + qc_bl1d(k) = (QCp*Ac_mf + QCs*Ac_strat)/cldfra_bl1d(k) ENDIF + ELSE + Ac_mf = mf_cf ENDIF !Now recalculate the terms for the buoyancy flux for mass-flux clouds: @@ -5993,16 +6454,16 @@ SUBROUTINE DMP_mf( & Q1=MAX(Q1,-5.0) IF (Q1 .GE. 1.0) THEN Fng = 1.0 - ELSEIF (Q1 .GE. -1.7 .AND. Q1 < 1.0) THEN + ELSEIF (Q1 .GE. -1.7 .AND. Q1 .LT. 1.0) THEN Fng = EXP(-0.4*(Q1-1.0)) - ELSEIF (Q1 .GE. -2.5 .AND. Q1 .LE. -1.7) THEN + ELSEIF (Q1 .GE. -2.5 .AND. Q1 .LT. -1.7) THEN Fng = 3.0 + EXP(-3.8*(Q1+1.7)) ELSE Fng = MIN(23.9 + EXP(-1.6*(Q1+2.5)), 60.) ENDIF - vt(k) = qww - MIN(0.4,cldfra_bl1D(k))*beta*bb*Fng - 1. - vq(k) = alpha + MIN(0.4,cldfra_bl1D(k))*beta*a*Fng - tv0 + 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 @@ -6014,8 +6475,8 @@ SUBROUTINE DMP_mf( & maxqc = maxval(edmf_qc(1:ktop)) IF ( maxqc < 1.E-8) maxmf = -1.0*maxmf ENDIF - -! + +! ! debugging ! IF (edmf_w(1) > 4.0) THEN @@ -6093,14 +6554,14 @@ subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) EXN=(P/p1000mb)**rcp !QC=0. !better first guess QC is incoming from lower level, do not set to zero do i=1,NITER - T=EXN*THL + xlv/cp*QC + T=EXN*THL + xlvcp*QC QS=qsat_blend(T,P) QCOLD=QC QC=0.5*QC + 0.5*MAX((QT-QS),0.) if (abs(QC-QCOLD) 0.0) THEN ! PRINT*,"EDMF SAT, p:",p," iterations:",i @@ -6147,7 +6608,7 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) Psig_bl=1.0 Psig_shcu=1.0 - dxdh=MAX(dx,10.)/MIN(PBL1,3000.) + dxdh=MAX(2.5*dx,10.)/MIN(PBL1,3000.) ! Honnert et al. 2011, TKE in PBL *** original form used until 201605 !Psig_bl= ((dxdh**2) + 0.07*(dxdh**0.667))/((dxdh**2) + & ! (3./21.)*(dxdh**0.67) + (3./42.)) @@ -6158,7 +6619,7 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) Psig_bl= ((dxdh**2) + 0.106*(dxdh**0.667))/((dxdh**2) +0.066*(dxdh**0.667) + 0.071) !assume a 500 m cloud depth for shallow-cu clods - dxdh=MAX(dx,10.)/MIN(PBL1+500.,3500.) + dxdh=MAX(2.5*dx,10.)/MIN(PBL1+500.,3500.) ! Honnert et al. 2011, TKE in entrainment layer *** original form used until 201605 !Psig_shcu= ((dxdh**2) + (4./21.)*(dxdh**0.667))/((dxdh**2) + & ! (3./20.)*(dxdh**0.67) + (7./21.)) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 8a8755495..304afc6d5 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1,6 +1,12 @@ !>\file module_mp_thompson.F90 !! This file contains the entity of GSD Thompson MP scheme. +! DH* 2020-06-05 +! Use the following preprocessor directive to roll back +! to the WRFv3.8.1, used in RAPv5/HRRRv4 for more reasonable +! representation of mesoscale storms and reflectivity values +!#define WRF381 + !>\ingroup aathompson !! This module computes the moisture tendencies of water vapor, @@ -43,9 +49,16 @@ !!\author Greg Thompson, NCAR-RAL, gthompsn@ucar.edu, 303-497-2805 !! !! - Last modified: 24 Jan 2018 Aerosol additions to v3.5.1 code 9/2013 -!! Cloud fraction additions 11/2014 part of pre-v3.7 +!! Cloud fraction additions 11/2014 part of pre-v3.7 !! - Imported in CCPP by: Dom Heinzeller, NOAA/ESRL/GSD, dom.heinzeller@noaa.gov !! - Last modified: 6 Aug 2018 Update of initial import to WRFV4.0 +!! - Last modified: 13 Mar 2020 Add logic to turtn on/off the calculation +!! of melting layer in radar reflectivity routine +!! - Last modified: 2 Jun 2020 Add option to rollback to version 3.8.1 +!! used in RAPv5/HRRRv4, include stochastic physics +!! perturbations to the graupel intercept parameter, +!! the cloud water shape parameter, and the number +!! concentration of nucleated aerosols. MODULE module_mp_thompson USE machine, only : kind_phys @@ -80,7 +93,7 @@ MODULE module_mp_thompson !.. scheme. In 2-moment cloud water, Nt_c represents a maximum of !.. droplet concentration and nu_c is also variable depending on local !.. droplet number concentration. - REAL, PARAMETER, PRIVATE:: Nt_c = 100.E6 + REAL, PARAMETER :: Nt_c = 100.E6 REAL, PARAMETER, PRIVATE:: Nt_c_max = 1999.E6 !..Declaration of constants for assumed CCN/IN aerosols when none in @@ -410,23 +423,16 @@ MODULE module_mp_thompson !! lookup tables in Thomspson scheme. !>\section gen_thompson_init thompson_init General Algorithm !> @{ - SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, & - mpicomm, mpirank, mpiroot, & - threads, errmsg, errflg) + SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & + mpicomm, mpirank, mpiroot, & + threads, errmsg, errflg) IMPLICIT NONE - INTEGER, INTENT(IN):: ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte - !..OPTIONAL variables that control application of aerosol-aware scheme - REAL, DIMENSION(ims:ime,kms:kme,jms:jme), OPTIONAL, INTENT(IN) :: nwfa, nifa - REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d + REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: nwfa, nifa + REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot INTEGER, INTENT(IN) :: threads CHARACTER(len=*), INTENT(INOUT) :: errmsg @@ -457,6 +463,13 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & if (.NOT. ALLOCATED(tcg_racg) ) then ALLOCATE(tcg_racg(ntb_g1,ntb_g,ntb_r1,ntb_r)) micro_init = .TRUE. + if (mpirank==mpiroot) then +#ifdef WRF381 + write(0,*) "Using Thompson MP from WRFv3.8.1 (RAPv5/HRRRv4)" +#else + write(0,*) "Using Thompson MP from WRFv4.0+" +#endif + endif endif if (.NOT. ALLOCATED(tmr_racg)) ALLOCATE(tmr_racg(ntb_g1,ntb_g,ntb_r1,ntb_r)) @@ -968,14 +981,6 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & end if precomputed_tables_2 - ! DH* TEMPORARY GUARD 20181203 - if (minval(tnccn_act)==maxval(tnccn_act)) then - write(0,*) "TEMPORARY GUARD: abort model because table_ccnact seems to be faulty." - call sleep(5) - stop - end if - ! *DH - endif if_not_iiwarm if (mpirank==mpiroot) write(0,*) ' ... DONE microphysical lookup tables' @@ -1004,6 +1009,9 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & vt_dbz_wt, first_time_step, & re_cloud, re_ice, re_snow, & has_reqc, has_reqi, has_reqs, & + rand_perturb_on, & + kme_stoch, & + rand_pert, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims @@ -1026,6 +1034,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN):: nwfa2d, nifa2d REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT):: & re_cloud, re_ice, re_snow + INTEGER, INTENT(IN) :: rand_perturb_on, kme_stoch + REAL, DIMENSION(ims:ime,kms:kme_stoch,jms:jme), INTENT(IN), OPTIONAL:: & + rand_pert + INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs #if ( WRF_CHEM == 1 ) REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & @@ -1061,7 +1073,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL:: dt, pptrain, pptsnow, pptgraul, pptice REAL:: qc_max, qr_max, qs_max, qi_max, qg_max, ni_max, nr_max REAL:: nwfa1 - INTEGER:: i, j, k + REAL:: rand1, rand2, rand3, min_rand + INTEGER:: i, j, k, m INTEGER:: imax_qc,imax_qr,imax_qi,imax_qs,imax_qg,imax_ni,imax_nr INTEGER:: jmax_qc,jmax_qr,jmax_qi,jmax_qs,jmax_qg,jmax_ni,jmax_nr INTEGER:: kmax_qc,kmax_qr,kmax_qi,kmax_qs,kmax_qg,kmax_ni,kmax_nr @@ -1078,6 +1091,24 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & if (present(errmsg)) errmsg = '' if (present(errflg)) errflg = 0 + ! DH* 2020-06-05: The stochastic perturbations code was retrofitted + ! from a newer version of the Thompson MP scheme, but it has not been + ! tested yet. + if (rand_perturb_on .ne. 0) then + errmsg = 'Logic error in mp_gt_driver: the stochastic perturbations code ' // & + 'has not been tested yet with this version of the Thompson scheme' + errflg = 1 + return + end if + ! Activate this code when removing the guard above + !if (rand_perturb_on .ne. 0 .and. .not. present(rand_pert)) then + ! errmsg = 'Logic error in mp_gt_driver: random perturbations are on, ' // & + ! 'but optional argument rand_pert is not present' + ! errflg = 1 + ! return + !end if + ! *DH 2020-06-05 + if ( (present(tt) .and. (present(th) .or. present(pii))) .or. & (.not.present(tt) .and. .not.(present(th) .and. present(pii))) ) then if (present(errmsg)) then @@ -1167,6 +1198,32 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & j_loop: do j = j_start, j_end i_loop: do i = i_start, i_end +!+---+-----------------------------------------------------------------+ +!..Introduce stochastic parameter perturbations by creating as many scalar rand1, rand2, ... +!.. variables as needed to perturb different pieces of microphysics. gthompsn 21Mar2018 +! Setting spp_mp to 1 gives graupel Y-intercept pertubations (2^0) +! 2 gives cloud water distribution gamma shape parameter perturbations (2^1) +! 4 gives CCN & IN activation perturbations (2^2) +! 3 gives both 1+2 +! 5 gives both 1+4 +! 6 gives both 2+4 +! 7 gives all 1+2+4 +! For now (22Mar2018), standard deviation should be only 0.25 and cut-off at 1.5 +! in order to constrain the various perturbations from being too extreme. +!+---+-----------------------------------------------------------------+ + rand1 = 0.0 + rand2 = 0.0 + rand3 = 0.0 + if (rand_perturb_on .ne. 0) then + if (MOD(rand_perturb_on,2) .ne. 0) rand1 = rand_pert(i,1,j) + m = RSHIFT(ABS(rand_perturb_on),1) + if (MOD(m,2) .ne. 0) rand2 = rand_pert(i,1,j)*2. + m = RSHIFT(ABS(rand_perturb_on),2) + if (MOD(m,2) .ne. 0) rand3 = 0.1*(rand_pert(i,1,j)+ABS(min_rand)) + m = RSHIFT(ABS(rand_perturb_on),3) + endif +!+---+-----------------------------------------------------------------+ + pptrain = 0. pptsnow = 0. pptgraul = 0. @@ -1225,6 +1282,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & #if ( WRF_CHEM == 1 ) rainprod1d, evapprod1d, & #endif + rand1, rand2, rand3, & kts, kte, dt, i, j) pcp_ra(i,j) = pptrain @@ -1377,13 +1435,13 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & endif ! if (present(vt_dbz_wt) .and. present(first_time_step)) then - call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j, & - melti, vt_dbz_wt(i,:,j), & + call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & + t1d, p1d, dBZ, rand1, kts, kte, i, j, & + melti, vt_dbz_wt(i,:,j), & first_time_step) else - call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j, & + call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & + t1d, p1d, dBZ, rand1, kts, kte, i, j, & melti) end if do k = kts, kte @@ -1492,6 +1550,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & #if ( WRF_CHEM == 1 ) rainprod, evapprod, & #endif + rand1, rand2, rand3, & kts, kte, dt, ii, jj) #ifdef MPI use mpi @@ -1506,6 +1565,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, DIMENSION(kts:kte), INTENT(IN):: p1d, w1d, dzq REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice REAL, INTENT(IN):: dt + REAL, INTENT(IN):: rand1, rand2, rand3 + #if ( WRF_CHEM == 1 ) REAL, DIMENSION(kts:kte), INTENT(INOUT):: & rainprod, evapprod @@ -1742,7 +1803,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rc(k) = qc1d(k)*rho(k) nc(k) = MAX(2., MIN(nc1d(k)*rho(k), Nt_c_max)) L_qc(k) = .true. - nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + if (rand2 .eq. 0.0) then + nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + else + nu_c = NINT(1000.E6/nc(k)) + 2 + nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) + endif lamc = (nc(k)*am_r*ccg(2,nu_c)*ocg1(nu_c)/rc(k))**obmr xDc = (bm_r + nu_c + 1.) / lamc if (xDc.lt. D0c) then @@ -1991,7 +2057,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xslw1 = 0.01 endif ygra1 = 4.31 + alog10(max(5.E-5, rg(k))) - zans1 = 3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1)) + zans1 = (3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1))) + rand1 + if (rand1 .ne. 0.0) then + zans1 = MAX(2., MIN(zans1, 7.)) + endif N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) N0_min = MIN(N0_exp, N0_min) @@ -2032,7 +2101,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & mvd_c(k) = D0c if (L_qc(k)) then - nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + if (rand2 .eq. 0.0) then + nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + else + nu_c = NINT(1000.E6/nc(k)) + 2 + nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) + endif xDc = MAX(D0c*1.E6, ((rc(k)/(am_r*nc(k)))**obmr) * 1.E6) lamc = (nc(k)*am_r* ccg(2,nu_c) * ocg1(nu_c) / rc(k))**obmr mvd_c(k) = (3.0+nu_c+0.672) / lamc @@ -2434,6 +2508,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & .and. temp(k).lt.253.15) ) then if (dustyIce .AND. is_aerosol_aware) then xnc = iceDeMott(tempc,qv(k),qvs(k),qvsi(k),rho(k),nifa(k)) + xnc = xnc*(1.0 + 3.*rand3) else xnc = MIN(250.E3, TNO*EXP(ATO*(T_0-temp(k)))) endif @@ -2640,7 +2715,13 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !! supersat again. sump = pri_inu(k) + pri_ide(k) + prs_ide(k) & + prs_sde(k) + prg_gde(k) + pri_iha(k) +! DH* 2020-06-02 I believe that the WRF381 version +! is wrong, because the units do not match. +#ifdef WRF381 + rate_max = (qv(k)-qvsi(k))*odts*0.999 +#else rate_max = (qv(k)-qvsi(k))*rho(k)*odts*0.999 +#endif if ( (sump.gt. eps .and. sump.gt. rate_max) .or. & (sump.lt. -eps .and. sump.lt. rate_max) ) then ratio = rate_max/sump @@ -2772,7 +2853,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xrc=MAX(R1, (qc1d(k) + qcten(k)*dtsave)*rho(k)) xnc=MAX(2., (nc1d(k) + ncten(k)*dtsave)*rho(k)) if (xrc .gt. R1) then - nu_c = MIN(15, NINT(1000.E6/xnc) + 2) + if (rand2 .eq. 0.0) then + nu_c = MIN(15, NINT(1000.E6/xnc) + 2) + else + nu_c = NINT(1000.E6/xnc) + 2 + nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) + endif lamc = (xnc*am_r*ccg(2,nu_c)*ocg1(nu_c)/rc(k))**obmr xDc = (bm_r + nu_c + 1.) / lamc if (xDc.lt. D0c) then @@ -3062,7 +3148,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xslw1 = 0.01 endif ygra1 = 4.31 + alog10(max(5.E-5, rg(k))) - zans1 = 3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1)) + zans1 = (3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1))) + rand1 + if (rand1 .ne. 0.0) then + zans1 = MAX(2., MIN(zans1, 7.)) + endif N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) N0_min = MIN(N0_exp, N0_min) @@ -3110,7 +3199,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ ! DROPLET NUCLEATION if (clap .gt. eps) then if (is_aerosol_aware) then - xnc = MAX(2., activ_ncloud(temp(k), w1d(k), nwfa(k))) + xnc = MAX(2., activ_ncloud(temp(k), w1d(k)+rand3, nwfa(k))) else xnc = Nt_c endif @@ -3349,7 +3438,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & do k = ksed1(5), kts, -1 vtc = 0. if (rc(k) .gt. R1 .and. w1d(k) .lt. 1.E-1) then - nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + if (rand2 .eq. 0.0) then + nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + else + nu_c = NINT(1000.E6/nc(k)) + 2 + nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) + endif lamc = (nc(k)*am_r*ccg(2,nu_c)*ocg1(nu_c)/rc(k))**obmr ilamc = 1./lamc vtc = rhof(k)*av_c*ccg(5,nu_c)*ocg2(nu_c) * ilamc**bv_c @@ -3415,7 +3509,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & vts = rhof(k)*av_s * (t1_vts+t2_vts)/(t3_vts+t4_vts) if (temp(k).gt. (T_0+0.1)) then vtsk(k) = MAX(vts*vts_boost(k), & - & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) + & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) ! +! DH* The version below is supposed to be a better formulation, +! but gave worse results in RAPv5/HRRRv4 than the line above. + ! this formulation for RAPv5/HRRRv4, reverted 20 Feb 2020 + ! SR = rs(k)/(rs(k)+rr(k)) ! bug fix from G. Thompson, 10 May 2019 + ! vtsk(k) = vts*SR + (1.-SR)*vtrk(k) else vtsk(k) = vts*vts_boost(k) endif @@ -3466,6 +3565,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Sedimentation of mixing ratio is the integral of v(D)*m(D)*N(D)*dD, !! whereas neglect m(D) term for number concentration. Therefore, !! cloud ice has proper differential sedimentation. +!.. New in v3.0+ is computing separate for rain, ice, snow, and +!.. graupel species thus making code faster with credit to J. Schmidt. +!.. Bug fix, 2013Nov01 to tendencies using rho(k+1) correction thanks to +!.. Eric Skyllingstad. !+---+-----------------------------------------------------------------+ if (ANY(L_qr .eqv. .true.)) then @@ -3495,7 +3598,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(1)) enddo +#ifdef WRF381 + if (rr(kts).gt.R1*10.) & +#else if (rr(kts).gt.R1*1000.) & +#endif pptrain = pptrain + sed_r(kts)*DT*onstep(1) enddo endif @@ -3546,7 +3653,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(2)) enddo +#ifdef WRF381 + if (ri(kts).gt.R1*10.) & +#else if (ri(kts).gt.R1*1000.) & +#endif pptice = pptice + sed_i(kts)*DT*onstep(2) enddo endif @@ -3573,7 +3684,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(3)) enddo +#ifdef WRF381 + if (rs(kts).gt.R1*10.) & +#else if (rs(kts).gt.R1*1000.) & +#endif pptsnow = pptsnow + sed_s(kts)*DT*onstep(3) enddo endif @@ -3600,7 +3715,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(4)) enddo +#ifdef WRF381 + if (rg(kts).gt.R1*10.) & +#else if (rg(kts).gt.R1*1000.) & +#endif pptgraul = pptgraul + sed_g(kts)*DT*onstep(4) enddo endif @@ -3641,16 +3760,31 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qv1d(k) = MAX(1.E-10, qv1d(k) + qvten(k)*DT) qc1d(k) = qc1d(k) + qcten(k)*DT nc1d(k) = MAX(2./rho(k), MIN(nc1d(k) + ncten(k)*DT, Nt_c_max)) +! DH* 2020-06-05 I believe WRF381 is wrong in terms of units; +! dividing by rho turns number concentration per volume into +! number concentration per mass. +#ifdef WRF381 + nwfa1d(k) = MAX(11.1E6/rho(k), MIN(9999.E6/rho(k), & + (nwfa1d(k)+nwfaten(k)*DT))) + nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6/rho(k), & + (nifa1d(k)+nifaten(k)*DT))) +#else nwfa1d(k) = MAX(11.1E6, MIN(9999.E6, & (nwfa1d(k)+nwfaten(k)*DT))) nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6, & (nifa1d(k)+nifaten(k)*DT))) +#endif if (qc1d(k) .le. R1) then qc1d(k) = 0.0 nc1d(k) = 0.0 else - nu_c = MIN(15, NINT(1000.E6/(nc1d(k)*rho(k))) + 2) + if (rand2 .eq. 0.0) then + nu_c = MIN(15, NINT(1000.E6/(nc1d(k)*rho(k))) + 2) + else + nu_c = NINT(1000.E6/(nc1d(k)*rho(k))) + 2 + nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) + endif lamc = (am_r*ccg(2,nu_c)*ocg1(nu_c)*nc1d(k)/qc1d(k))**obmr xDc = (bm_r + nu_c + 1.) / lamc if (xDc.lt. D0c) then @@ -5112,7 +5246,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & INTEGER, INTENT(IN):: kts, kte REAL, DIMENSION(kts:kte), INTENT(IN):: & & t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: re_qc1d, re_qi1d, re_qs1d + REAL, DIMENSION(kts:kte), INTENT(OUT):: re_qc1d, re_qi1d, re_qs1d !..Local variables INTEGER:: k REAL, DIMENSION(kts:kte):: rho, rc, nc, ri, ni, rs @@ -5128,10 +5262,44 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & has_qi = .false. has_qs = .false. +! DH* 2020-06-08 Moved the initial values and bounds from +! the calling routines into calc_effectRad (to prevent +! multiple definitions that may be inconsistent). The +! initial values and bounds from the calling routines were +! +! re_cloud(i,k) = MAX(2.49, MIN(re_cloud(i,k)*1.e6, 50.)) +! re_ice(i,k) = MAX(4.99, MIN(re_ice(i,k)*1.e6, 125.)) +! re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) +! +! independent of the version of Thompson MP. These values +! are consistent with the WRFv3.8.1 settings, but inconsistent +! with the WRFv4+ settings. In order to apply the same bounds +! as before this change, use the WRF v3.8.1 settings throughout. +#if 1 +!ifdef WRF381 + re_qc1d(:) = 2.49E-6 + re_qi1d(:) = 4.99E-6 + re_qs1d(:) = 9.99E-6 +#else + re_qc1d(:) = 2.49E-6 + re_qi1d(:) = 2.49E-6 + re_qs1d(:) = 4.99E-6 +#endif + do k = kts, kte rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) rc(k) = MAX(R1, qc1d(k)*rho(k)) +#ifdef WRF381 + nc(k) = MAX(R2, MIN(nc1d(k)*rho(k), Nt_c_max)) +#else + ! DH* 2020-06-05 is using 2.0 instead of R2 + ! a bug in the WRFv4.0+ version of Thompson? + ! For ni(k) a few lines below, it is still R2. + ! Note that R2 is defined as R2 = 1.E-6, and is + ! used in other parts of Thompson MP for ni/nr + ! calculations (but not for nc calculations) nc(k) = MAX(2., MIN(nc1d(k)*rho(k), Nt_c_max)) +#endif if (.NOT. is_aerosol_aware) nc(k) = Nt_c if (rc(k).gt.R1 .and. nc(k).gt.R2) has_qc = .true. ri(k) = MAX(R1, qi1d(k)*rho(k)) @@ -5143,7 +5311,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qc) then do k = kts, kte - re_qc1d(k) = 2.49E-6 if (rc(k).le.R1 .or. nc(k).le.R2) CYCLE if (nc(k).lt.100) then inu_c = 15 @@ -5159,16 +5326,19 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qi) then do k = kts, kte - re_qi1d(k) = 2.49E-6 if (ri(k).le.R1 .or. ni(k).le.R2) CYCLE lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi +#if 1 +!ifdef WRF381 + re_qi1d(k) = MAX(5.01E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) +#else re_qi1d(k) = MAX(2.51E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) +#endif enddo endif if (has_qs) then do k = kts, kte - re_qs1d(k) = 4.99E-6 if (rs(k).le.R1) CYCLE tc0 = MIN(-0.1, t1d(k)-273.15) smob = rs(k)*oams @@ -5203,7 +5373,12 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & & + sb(7)*tc0*tc0*cse(1) + sb(8)*tc0*cse(1)*cse(1) & & + sb(9)*tc0*tc0*tc0 + sb(10)*cse(1)*cse(1)*cse(1) smoc = a_ * smo2**b_ +#if 1 +!ifdef WRF381 + re_qs1d(k) = MAX(10.E-6, MIN(0.5*(smoc/smob), 999.E-6)) +#else re_qs1d(k) = MAX(5.01E-6, MIN(0.5*(smoc/smob), 999.E-6)) +#endif enddo endif @@ -5218,13 +5393,14 @@ end subroutine calc_effectRad !! of frozen species remaining from what initially existed at the !! melting level interface. subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, ii, jj, melti, vt_dBZ, & - first_time_step) + t1d, p1d, dBZ, rand1, kts, kte, ii, jj, melti, & + vt_dBZ, first_time_step) IMPLICIT NONE !..Sub arguments INTEGER, INTENT(IN):: kts, kte, ii, jj + REAL, INTENT(IN):: rand1 REAL, DIMENSION(kts:kte), INTENT(IN):: & qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, t1d, p1d REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ @@ -5390,7 +5566,10 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & xslw1 = 0.01 endif ygra1 = 4.31 + alog10(max(5.E-5, rg(k))) - zans1 = 3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1)) + zans1 = (3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1))) + rand1 + if (rand1 .ne. 0.0) then + zans1 = MAX(2., MIN(zans1, 7.)) + endif N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) N0_min = MIN(N0_exp, N0_min) diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 70b98363d..94b118521 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -8,59 +8,65 @@ MODULE module_sf_mynn !------------------------------------------------------------------- !Modifications implemented by Joseph Olson NOAA/GSD/AMB - CU/CIRES -!for WRFv3.4, v3.4.1, v3.5.1, v3.6, v3.7.1, and v3.9: +!The following overviews the current state of this scheme:: ! ! BOTH LAND AND WATER: !1) Calculation of stability parameter (z/L) taken from Li et al. (2010 BLM) -! for first iteration of first time step; afterwards, exact calculation. -!2) Fixed isfflx=0 option to turn off scalar fluxes, but keep momentum +! for first iteration of first time step; afterwards, exact calculation +! using basically the same iterative technique in the module_sf_sfclayrev.F, +! which leverages Pedro Jimenez's code, and is adapted for MYNN. +!2) Fixed isflux=0 option to turn off scalar fluxes, but keep momentum ! fluxes for idealized studies (credit: Anna Fitch). -!3) Kinematic viscosity now varies with temperature -!4) Uses Monin-Obukhov flux-profile relationships more consistent with -! those used in the MYNN PBL code. -!5) Allows negative QFX, similar to MYJ scheme +!3) Kinematic viscosity varies with temperature according to Andreas (1989). +!4) Uses the blended Monin-Obukhov flux-profile relationships COARE (Fairall +! et al 2003) for the unstable regime (a blended mix of Dyer-Hicks 1974 and +! Grachev et al (2000). Uses Cheng and Brutsaert (2005) for stable conditions. +!5) The following overviews the namelist variables that control the +! aerodynamic roughness lengths (over water) and the thermal and moisture +! roughness lengths (defaults are recommended): ! ! LAND only: -!1) iz0tlnd option is now available with the following options: -! (default) =0: Zilitinkevich (1995) +! "iz0tlnd" namelist option is used to select the following momentum options: +! (default) =0: Zilitinkevich (1995); Czil now set to 0.085 ! =1: Czil_new (modified according to Chen & Zhang 2008) ! =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (original form; Garratt 1992) -! =4: Pan et al. (1994) with RUC mods for z_q, zili for z_t -!2) Relaxed u* minimum from 0.1 to 0.01 +! =4: GFS - taken from sfc_diff.f, for comparison/testing ! ! WATER only: -!1) isftcflx option is now available with the following options: +! "isftcflx" namelist option is used to select the following scalar options: ! (default) =0: z0, zt, and zq from the COARE algorithm. Set COARE_OPT (below) to ! 3.0 (Fairall et al. 2003, default) ! 3.5 (Edson et al 2013) ! =1: z0 from Davis et al (2008), zt & zq from COARE 3.0/3.5 ! =2: z0 from Davis et al (2008), zt & zq from Garratt (1992) ! =3: z0 from Taylor and Yelland (2004), zt and zq from COARE 3.0/3.5 -! =4: z0 from Zilitinkevich (2001), zt & zq from COARE 3.0/3.5 +! =4: GFS - taken from sfc_diff.f, for comparison/testing ! ! SNOW/ICE only: -!1) Added Andreas (2002) snow/ice parameterization for thermal and -! moisture roughness to help reduce the cool/moist bias in the arctic -! region. Also added a z0 mod for snow (Andreas et al. 2005, BLM), which +! Andreas (2002) snow/ice parameterization for thermal and +! moisture roughness is used over all gridpoints with snow deeper than +! 0.1 m. This algorithm calculates a z0 for snow (Andreas et al. 2005, BLM), +! which is only used as part of the thermal and moisture roughness +! length calculation, not to directly impact the surface winds. ! ! Misc: -! 2) added a more elaborate diagnostic for u10 & V10 for high vertical resolution -! model configurations. +!1) Added a more elaborate diagnostic for u10 & V10 for high vertical resolution +! model configurations but for most model configurations with depth of +! the lowest half-model level near 10 m, a neutral-log diagnostic is used. ! -! New for v3.9: -! - option for stochastic parameter perturbations (SPP) +!2) Option to activate stochastic parameter perturbations (SPP), which +! perturb z0, zt, and zq, along with many other parameters in the MYNN- +! EDMF scheme. ! !NOTE: This code was primarily tested in combination with the RUC LSM. ! Performance with the Noah (or other) LSM is relatively unknown. !------------------------------------------------------------------- !For WRF ! USE module_model_constants, only: & -! &g, p1000mb, cp, xlv, ep_2, r_d, r_v, rcp, cpv +! & p1000mb, ep_2 ! - USE module_bl_mynn, only: tv0, b1, b2, p608, ev, rd, & !, mym_condensation - &esat_blend, xl_blend, qsat_blend - +!For non-WRF use physcons, only : cp => con_cp, & & g => con_g, & & r_d => con_rd, & @@ -74,6 +80,9 @@ MODULE module_sf_mynn & EP_1 => con_fvirt, & & EP_2 => con_eps +!use subroutines from sfc_diff: +! USE sfc_diff, only: znot_t_v6, znot_t_v7, znot_m_v6, znot_m_v7 + !------------------------------------------------------------------- IMPLICIT NONE !------------------------------------------------------------------- @@ -89,52 +98,87 @@ MODULE module_sf_mynn REAL , PARAMETER :: p1000mb = 100000. ! REAL , PARAMETER :: EP_2 = r_d/r_v - - REAL, PARAMETER :: xlvcp=xlv/cp, ep_3=1.-ep_2 REAL, PARAMETER :: wmin=0.1 ! Minimum wind speed REAL, PARAMETER :: VCONVC=1.25 + REAL, PARAMETER :: onethird = 1./3. + REAL, PARAMETER :: sqrt3 = 1.7320508075688773 + REAL, PARAMETER :: atan1 = 0.785398163397 !in radians + REAL, PARAMETER :: log01=log(0.01), log05=log(0.05), log07=log(0.07) REAL, PARAMETER :: SNOWZ0=0.011 REAL, PARAMETER :: COARE_OPT=3.0 ! 3.0 or 3.5 !For debugging purposes: - LOGICAL, PARAMETER :: debug_code = .false. + INTEGER, PARAMETER :: debug_code = 0 !0: no extra ouput + !1: some step-by-step output + !2: everything - heavy I/O + LOGICAL, PARAMETER :: compute_diag = .false. + LOGICAL, PARAMETER :: compute_flux = .false. !shouldn't need compute + ! these in FV3. They will be written over anyway. + ! Computing the fluxes here is leftover from the WRF world. + + REAL, DIMENSION(0:1000 ),SAVE :: psim_stab,psim_unstab, & + psih_stab,psih_unstab CONTAINS !------------------------------------------------------------------- !>\ingroup module_sf_mynn_mod -!> Fill the PSIM and PSIH tables. The subroutine "sfclayinit". -!! can be found in module_sf_sfclay.F. This subroutine returns -!! the forms from Dyer and Hicks (1974). +!> Fill the PSIM and PSIH tables. The subroutine "psi_init" was leveraged from +!! module_sf_sfclayrev.F, leveraging the work from Pedro Jimenez. +!! This subroutine returns a blended form from Dyer and Hicks (1974) +!! and Grachev et al (2000) for unstable conditions and the form +!! from Cheng and Brutsaert (2005) for stable conditions. + SUBROUTINE mynn_sf_init_driver(allowed_to_read) LOGICAL, INTENT(in) :: allowed_to_read -! CALL sfclayinit(allowed_to_read) + CALL psi_init END SUBROUTINE mynn_sf_init_driver !------------------------------------------------------------------- !>\ingroup module_sf_mynn_mod !! This subroutine - SUBROUTINE SFCLAY_mynn( & - U3D,V3D,T3D,QV3D,P3D,dz8w, & - CP,G,ROVCP,R,XLV,PSFCPA,CHS,CHS2,CQS2, & - ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME, & - PSIM,PSIH,PSIX,PSIX10,PSIT,PSIT2, & - XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QSFC,RMOL, & - U10,V10,TH2,T2,Q2,SNOWH, & - GZ1OZ0,WSPD,BR,ISFFLX,DX, & - SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & - KARMAN,itimestep,ch,th3d,pi3d,qc3d,rho3d, & - tsq,qsq,cov,sh3d,el_pbl,qcg,wstar, & - icloud_bl,qc_bl,cldfra_bl, & - spp_pbl,pattern_spp_pbl, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, & - ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, & - bl_mynn_cloudpdf) + SUBROUTINE SFCLAY_mynn( & + U3D,V3D,T3D,QV3D,P3D,dz8w, & !in + th3d,pi3d,qc3d, & !in + PSFCPA,PBLH,MAVAIL,XLAND,DX, & !in + CP,G,ROVCP,R,XLV, & !in + SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, & !in + ISFFLX,isftcflx,lsm,iz0tlnd, & !in + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & z0pert,ztpert, & !intent(in) + & redrag,sfc_z0_type, & !intent(in) + itimestep,iter, & !in + wet, dry, icy, & !intent(in) + tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) + tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) + qsfc_ocn, qsfc_lnd, qsfc_ice, & !intent(in) + snowh_ocn, snowh_lnd, snowh_ice, & !intent(in) + ZNT_ocn, ZNT_lnd, ZNT_ice, & !intent(inout) + UST_ocn, UST_lnd, UST_ice, & !intent(inout) + cm_ocn, cm_lnd, cm_ice, & !intent(inout) + ch_ocn, ch_lnd, ch_ice, & !intent(inout) + rb_ocn, rb_lnd, rb_ice, & !intent(inout) + stress_ocn,stress_lnd,stress_ice, & !intent(inout) + fm_ocn, fm_lnd, fm_ice, & !intent(inout) + fh_ocn, fh_lnd, fh_ice, & !intent(inout) + fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) + fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) + HFLX_ocn, HFLX_lnd, HFLX_ice, & + QFLX_ocn, QFLX_lnd, QFLX_ice, & + CH,CHS,CHS2,CQS2,CPM, & + ZNT,USTM,ZOL,MOL,RMOL, & + PSIM,PSIH, & + HFLX,HFX,QFLX,QFX,LH,FLHC,FLQC, & + QGH,QSFC,QSFC_RUC, & + U10,V10,TH2,T2,Q2, & + GZ1OZ0,WSPD,WSTAR, & + spp_pbl,pattern_spp_pbl, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) !------------------------------------------------------------------- IMPLICIT NONE !------------------------------------------------------------------- @@ -143,7 +187,6 @@ SUBROUTINE SFCLAY_mynn( & !-- T3D 3D temperature (K) !-- QV3D 3D water vapor mixing ratio (Kg/Kg) !-- P3D 3D pressure (Pa) -!-- RHO3D 3D density (kg/m3) !-- dz8w 3D dz between full levels (m) !-- CP heat capacity at constant pressure for dry air (J/kg/K) !-- G acceleration due to gravity (m/s^2) @@ -166,7 +209,11 @@ SUBROUTINE SFCLAY_mynn( & !-- PSIH similarity stability function for heat !-- XLAND land mask (1 for land, 2 for water) !-- HFX upward heat flux at the surface (W/m^2) +! HFX = HFLX * rho * cp +!-- HFLX upward temperature flux at the surface (K m s^-1) !-- QFX upward moisture flux at the surface (kg/m^2/s) +! QFX = QFLX * rho +!-- QFLX upward moisture flux at the surface (kg kg-1 m s-1) !-- LH net upward latent heat flux at surface (W/m^2) !-- TSK surface temperature (K) !-- FLHC exchange coefficient for heat (W/m^2/K) @@ -202,22 +249,10 @@ SUBROUTINE SFCLAY_mynn( & ! (water =1: z0 from Davis et al (2008), zt & zq from COARE3.0/3.5 ! only) =2: z0 from Davis et al (2008), zt & zq from Garratt (1992) ! =3: z0 from Taylor and Yelland (2004), zt and zq from COARE 3.0/3.5 -! =4: z0 from Zilitinkevich (2001), zt & zq from COARE 3.0/3.5 -!-- iz0tlnd =0: Zilitinkevich (1995) with Czil=0.10, +!-- iz0tlnd =0: Zilitinkevich (1995) with Czil=0.085, ! (land =1: Czil_new (modified according to Chen & Zhang 2008) ! only) =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (Garratt 1992) -! =4: Pan et al (1994) for zq; ZIlitintevich for zt -!-- bl_mynn_cloudpdf =0: Mellor & Yamada -! =1: Kuwano et al. -!-- el_pbl = mixing length from PBL scheme (meters) -!-- Sh3d = Stability finction for heat (unitless) -!-- cov = T'q' from PBL scheme -!-- tsq = T'T' from PBL scheme -!-- qsq = q'q' from PBL scheme -!-- icloud_bl = namelist option for subgrid scale cloud/radiation feedback -!-- qc_bl = subgrid scale (bloundary layer) clouds -!-- cldfra_bl = subgridscale cloud fraction ! !-- ids start index for i in domain !-- ide end index for i in domain @@ -243,17 +278,22 @@ SUBROUTINE SFCLAY_mynn( & INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte - INTEGER, INTENT(IN) :: itimestep + INTEGER, INTENT(IN) :: itimestep,iter REAL, INTENT(IN) :: SVP1,SVP2,SVP3,SVPT0 REAL, INTENT(IN) :: EP1,EP2,KARMAN REAL, INTENT(IN) :: CP,G,ROVCP,R,XLV !,DX -!NAMELIST OPTIONS: - INTEGER, INTENT(IN) :: ISFFLX - INTEGER, OPTIONAL, INTENT(IN) :: ISFTCFLX, IZ0TLND,& - bl_mynn_cloudpdf,& - icloud_bl - INTEGER, INTENT(IN),OPTIONAL :: spp_pbl - +!NAMELIST/CONFIGURATION OPTIONS: + INTEGER, INTENT(IN) :: ISFFLX, LSM + INTEGER, OPTIONAL, INTENT(IN) :: ISFTCFLX, IZ0TLND + INTEGER, OPTIONAL, INTENT(IN) :: spp_pbl + integer, intent(in) :: ivegsrc + integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) + +!Input data + integer, dimension(ims:ime), intent(in) :: vegtype + real, dimension(ims:ime), intent(in) :: & + & sigmaf,shdmax,z0pert,ztpert !=================================== ! 3D VARIABLES !=================================== @@ -264,11 +304,10 @@ SUBROUTINE SFCLAY_mynn( & T3D, & QC3D, & U3D,V3D, & - RHO3D,th3d,pi3d,tsq,qsq,cov,sh3d,el_pbl + th3d,pi3d - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: qc_bl, & - cldfra_bl - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN),OPTIONAL ::pattern_spp_pbl + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL, & + INTENT(IN) :: pattern_spp_pbl !=================================== ! 2D VARIABLES !=================================== @@ -276,85 +315,86 @@ SUBROUTINE SFCLAY_mynn( & INTENT(IN ) :: MAVAIL, & PBLH, & XLAND, & - TSK, & - QCG, & PSFCPA, & - SNOWH, & DX REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(OUT ) :: U10,V10, & TH2,T2,Q2 - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , & - INTENT(OUT) :: ck,cka,cd,cda,ustm -! + REAL, DIMENSION( ims:ime, jms:jme ) , & - INTENT(INOUT) :: REGIME, & - HFX, & - QFX, & + INTENT(INOUT) :: HFLX,HFX, & + QFLX,QFX, & LH, & MOL,RMOL, & QSFC, & + QGH, & ZNT, & ZOL, & - UST, & + USTM, & + CPM, & CHS2, & CQS2, & CHS, & CH, & FLHC,FLQC, & - GZ1OZ0,WSPD,BR, & + GZ1OZ0,WSPD, & PSIM,PSIH, & - WSTAR, & - PSIX,PSIX10,PSIT,PSIT2 + WSTAR + + LOGICAL, DIMENSION( ims:ime ), INTENT(IN) :: & + & wet, dry, icy + + REAL, DIMENSION( ims:ime ), INTENT(IN) :: & + & tskin_ocn, tskin_lnd, tskin_ice, & + & tsurf_ocn, tsurf_lnd, tsurf_ice, & + & snowh_ocn, snowh_lnd, snowh_ice + + REAL, DIMENSION( ims:ime), INTENT(INOUT) :: & + & ZNT_ocn, ZNT_lnd, ZNT_ice, & + & UST_ocn, UST_lnd, UST_ice, & + & cm_ocn, cm_lnd, cm_ice, & + & ch_ocn, ch_lnd, ch_ice, & + & rb_ocn, rb_lnd, rb_ice, & + & stress_ocn,stress_lnd,stress_ice, & + & fm_ocn, fm_lnd, fm_ice, & + & fh_ocn, fh_lnd, fh_ice, & + & fm10_ocn, fm10_lnd, fm10_ice, & + & fh2_ocn, fh2_lnd, fh2_ice, & + & HFLX_ocn, HFLX_lnd, HFLX_ice, & + & QFLX_ocn, QFLX_lnd, QFLX_ice, & + & qsfc_ocn, qsfc_lnd, qsfc_ice, & + & qsfc_ruc !ADDITIONAL OUTPUT !JOE-begin - REAL, DIMENSION( ims:ime, jms:jme ) :: z0zt_ratio, & - BulkRi,qstar,resist,logres -!JOE-end + REAL, DIMENSION( ims:ime, jms:jme ) :: qstar +!JOE-end !=================================== ! 1D LOCAL ARRAYS !=================================== - REAL, DIMENSION( its:ite ) :: U1D, & - V1D, & + REAL, DIMENSION( its:ite ) :: U1D,V1D, & !level1 winds U1D2,V1D2, & !level2 winds QV1D, & P1D, & T1D,QC1D, & - RHO1D, & dz8w1d, & !level 1 height dz2w1d !level 2 height REAL, DIMENSION( its:ite ) :: rstoch1D - ! VARIABLE FOR PASSING TO MYM_CONDENSATION - REAL, DIMENSION(kts:kts+1 ) :: dummy1,dummy2,dummy3,dummy4, & - dummy5,dummy6,dummy7,dummy8, & - dummy9,dummy10,dummy11, & - dummy12,dummy13,dummy14 - - REAL, DIMENSION( its:ite ) :: vt1,vq1 - REAL, DIMENSION(kts:kts+1) :: thl, qw, vt, vq - REAL :: ql - INTEGER :: I,J,K,itf,jtf,ktf !----------------------------------------------------------- -!joe -test printing of constants: -! print*,"cp=", cp -! print*,"g=", g -! print*,"Rd=", r_d -! print*,"Rv=", r_v -! print*,"cpc=", cpv -! print*,"cliq=", cliq -! print*,"cice=", Cice -! print*,"rcp=", rcp -! print*,"xlv=", XLV -! print*,"xlf=", XLF -! print*,"ep1=", EP_1 -! print*,"ep2=", EP_2 + IF (debug_code >= 1) THEN + write(*,*)"======= printing of constants:" + write(*,*)"cp=", cp," g=", g + write(*,*)"Rd=", r_d," Rv=", r_v, " cpc=", cpv + write(*,*)"cliq=", cliq," cice=", Cice," rcp=", rcp + write(*,*)"xlv=", XLV," xlf=", XLF + write(*,*)"ep1=", EP_1, " ep2=", EP_2 + ENDIF itf=ite !MIN0(ite,ide-1) jtf=jte !MIN0(jte,jde-1) @@ -373,7 +413,6 @@ SUBROUTINE SFCLAY_mynn( & QC1D(i)=QC3D(i,kts,j) P1D(i) =P3D(i,kts,j) T1D(i) =T3D(i,kts,j) - RHO1D(i)=RHO3D(i,kts,j) if (spp_pbl==1) then rstoch1D(i)=pattern_spp_pbl(i,kts,j) else @@ -381,104 +420,75 @@ SUBROUTINE SFCLAY_mynn( & endif ENDDO - IF (itimestep==1) THEN + IF (itimestep==1 .AND. iter==1) THEN DO i=its,ite - vt1(i)=0. - vq1(i)=0. - UST(i,j)=MAX(0.025*SQRT(U1D(i)*U1D(i) + V1D(i)*V1D(i)),0.001) + !Everything here is used before calculated + UST_OCN(i)=MAX(0.04*SQRT(U1D(i)*U1D(i) + V1D(i)*V1D(i)),0.001) + UST_LND(i)=MAX(0.04*SQRT(U1D(i)*U1D(i) + V1D(i)*V1D(i)),0.001) + UST_ICE(i)=MAX(0.04*SQRT(U1D(i)*U1D(i) + V1D(i)*V1D(i)),0.001) MOL(i,j)=0. ! Tstar QSFC(i,j)=QV3D(i,kts,j)/(1.+QV3D(i,kts,j)) + QSFC_OCN(i)=QSFC(i,j) + QSFC_LND(i)=QSFC(i,j) + QSFC_ICE(i)=QSFC(i,j) qstar(i,j)=0.0 + QFX(i,j)=0. + HFX(i,j)=0. + QFLX(i,j)=0. + HFLX(i,j)=0. ENDDO ELSE - DO i=its,ite - DO k = kts,kts+1 - ql = qc3d(i,k,j)/(1.+qc3d(i,k,j)) - qw(k) = qv3d(i,k,j)/(1.+qv3d(i,k,j)) + ql - thl(k) = th3d(i,k,j)-xlvcp*ql/pi3d(i,k,j) - dummy1(k)=dz8w(i,k,j) - dummy2(k)=thl(k) - dummy3(k)=qw(k) - dummy4(k)=p3d(i,k,j) - dummy5(k)=pi3d(i,k,j) - dummy6(k)=tsq(i,k,j) - dummy7(k)=qsq(i,k,j) - dummy8(k)=cov(i,k,j) - dummy9(k)=Sh3d(i,k,j) - dummy10(k)=el_pbl(i,k,j) - dummy14(k)=th3d(i,k,j) - if(icloud_bl > 0) then - dummy11(k)=qc_bl(i,k,j) - dummy12(k)=cldfra_bl(i,k,j) - else - dummy11(k)=0.0 - dummy12(k)=0.0 - endif - dummy13(k)=0.0 !sgm + IF (LSM == 3) THEN + DO i=its,ite + QSFC_LND(i)=QSFC_RUC(i) ENDDO - - ! NOTE: The last grid number is kts+1 instead of kte. - CALL mym_condensation (kts,kts+1, dx(i,j),& - & dummy1,dummy2,dummy3, & - & dummy4,dummy5,dummy6, & - & dummy7,dummy8,dummy9, & - & dummy10,bl_mynn_cloudpdf,& - & dummy11,dummy12, & - & PBLH(i,j),HFX(i,j), & - & vt(kts:kts+1), vq(kts:kts+1), & - & dummy14,dummy13) - -! ! NOTE: The last grid number is kts+1 instead of kte. -! CALL mym_condensation (kts,kts+1, dx, & -! & dz8w(i,kts:kts+1,j), & -! & thl(kts:kts+1), & -! & qw(kts:kts+1), & -! & p3d(i,kts:kts+1,j), & -! & pi3d(i,kts:kts+1,j), & -! & tsq(i,kts:kts+1,j), & -! & qsq(i,kts:kts+1,j), & -! & cov(i,kts:kts+1,j), & -! & Sh3d(i,kts:kts+1,j), & !JOE - cloud PDF testing -! & el_pbl(i,kts:kts+1,j), & !JOE - cloud PDF testing -! & bl_mynn_cloudpdf, & !JOE - cloud PDF testing -! & qc_bl2D(i,kts:kts+1), & !JOE-subgrid BL clouds -! & cldfra_bl2D(i,kts:kts+1),& !JOE-subgrid BL clouds -! & PBLH(i,j),HFX(i,j), & !JOE-subgrid BL clouds -! & vt(kts:kts+1), vq(kts:kts+1), & - ! & th,sgm) - vt1(i) = vt(kts) - vq1(i) = vq(kts) - ENDDO + ENDIF ENDIF - CALL SFCLAY1D_mynn( & - J,U1D,V1D,T1D,QV1D,P1D,dz8w1d,rho1d, & - U1D2,V1D2,dz2w1d, & - CP,G,ROVCP,R,XLV,PSFCPA(ims,j),CHS(ims,j),CHS2(ims,j),& - CQS2(ims,j), PBLH(ims,j), RMOL(ims,j), & - ZNT(ims,j),UST(ims,j),MAVAIL(ims,j),ZOL(ims,j), & - MOL(ims,j),REGIME(ims,j),PSIM(ims,j),PSIH(ims,j), & - PSIX(ims,j),PSIX10(ims,j),PSIT(ims,j),PSIT2(ims,j),& - XLAND(ims,j),HFX(ims,j),QFX(ims,j),TSK(ims,j), & - U10(ims,j),V10(ims,j),TH2(ims,j),T2(ims,j), & - Q2(ims,j),FLHC(ims,j),FLQC(ims,j),SNOWH(ims,j), & - QSFC(ims,j),LH(ims,j), & - GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX(ims,j),& - SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, & - ch(ims,j),vt1,vq1,qc1d,qcg(ims,j), & - itimestep, & -!JOE-begin additional output - z0zt_ratio(ims,j),wstar(ims,j), & - qstar(ims,j),resist(ims,j),logres(ims,j), & -!JOE-end - spp_pbl,rstoch1D, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte & - ,isftcflx,iz0tlnd, & - USTM(ims,j),CK(ims,j),CKA(ims,j), & - CD(ims,j),CDA(ims,j) & - ) + CALL SFCLAY1D_mynn( & + J,U1D,V1D,T1D,QV1D,P1D,dz8w1d, & + U1D2,V1D2,dz2w1d, & + PSFCPA(ims,j),PBLH(ims,j),MAVAIL(ims,j), & + XLAND(ims,j),DX(ims,j), & + CP,G,ROVCP,R,XLV,SVP1,SVP2,SVP3,SVPT0, & + EP1,EP2,KARMAN, & + ISFFLX,isftcflx,iz0tlnd, & + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & z0pert,ztpert, & !intent(in) + & redrag,sfc_z0_type, & !intent(in) + itimestep,iter, & + wet, dry, icy, & !intent(in) + tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) + tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) + qsfc_ocn, qsfc_lnd, qsfc_ice, & !intent(in) + snowh_ocn, snowh_lnd, snowh_ice, & !intent(in) + ZNT_ocn, ZNT_lnd, ZNT_ice, & !intent(inout) + UST_ocn, UST_lnd, UST_ice, & !intent(inout) + cm_ocn, cm_lnd, cm_ice, & !intent(inout) + ch_ocn, ch_lnd, ch_ice, & !intent(inout) + rb_ocn, rb_lnd, rb_ice, & !intent(inout) + stress_ocn, stress_lnd, stress_ice, & !intent(inout) + fm_ocn, fm_lnd, fm_ice, & !intent(inout) + fh_ocn, fh_lnd, fh_ice, & !intent(inout) + fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) + fh2_ocn, fh2_lnd, fh2_ice, & + HFLX_ocn, HFLX_lnd, HFLX_ice, & + QFLX_ocn, QFLX_lnd, QFLX_ice, & + ch(ims,j),CHS(ims,j),CHS2(ims,j),CQS2(ims,j), & + CPM(ims,j), & + ZNT(ims,j),USTM(ims,j),ZOL(ims,j), & + MOL(ims,j),RMOL(ims,j), & + PSIM(ims,j),PSIH(ims,j), & + HFLX(ims,j),HFX(ims,j),QFLX(ims,j),QFX(ims,j), & + LH(ims,j),FLHC(ims,j),FLQC(ims,j), & + QGH(ims,j),QSFC(ims,j), & + U10(ims,j),V10(ims,j),TH2(ims,j),T2(ims,j),Q2(ims,j),& + GZ1OZ0(ims,j),WSPD(ims,j),wstar(ims,j), & + spp_pbl,rstoch1D, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte & + ) ENDDO @@ -486,29 +496,49 @@ END SUBROUTINE SFCLAY_MYNN !------------------------------------------------------------------- !>\ingroup module_sf_mynn_mod -!! This subroutine calculates - SUBROUTINE SFCLAY1D_mynn( & - J,U1D,V1D,T1D,QV1D,P1D,dz8w1d,rho1d, & - U1D2,V1D2,dz2w1d, & - CP,G,ROVCP,R,XLV,PSFCPA,CHS,CHS2,CQS2, & - PBLH,RMOL,ZNT,UST,MAVAIL,ZOL,MOL,REGIME, & - PSIM,PSIH,PSIX,PSIX10,PSIT,PSIT2, & - XLAND,HFX,QFX,TSK, & - U10,V10,TH2,T2,Q2,FLHC,FLQC,SNOWH, & - QSFC,LH,GZ1OZ0,WSPD,BR,ISFFLX,DX, & - SVP1,SVP2,SVP3,SVPT0,EP1,EP2, & - KARMAN,ch,vt1,vq1,qc1d,qcg, & - itimestep, & -!JOE-additional output - zratio,wstar,qstar,resist,logres, & -!JOE-end - spp_pbl,rstoch1D, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte & - ,isftcflx, iz0tlnd, & - ustm,ck,cka,cd,cda & - ) +!! This subroutine calculates u*, z/L, and the exchange coefficients +!! which are passed to subsequent scheme to calculate the fluxes. +!! This scheme has options to calculate the fluxes and near-surface +!! diagnostics, as was needed in WRF, but these are skipped for FV3. + SUBROUTINE SFCLAY1D_mynn( & + J,U1D,V1D,T1D,QV1D,P1D,dz8w1d,U1D2,V1D2,dz2w1d, & + PSFCPA,PBLH,MAVAIL,XLAND,DX, & + CP,G,ROVCP,R,XLV,SVP1,SVP2,SVP3,SVPT0, & + EP1,EP2,KARMAN, & + ISFFLX,isftcflx,iz0tlnd, & + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & z0pert,ztpert, & !intent(in) + & redrag,sfc_z0_type, & !intent(in) + itimestep,iter, & + wet, dry, icy, & !intent(in) + tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) + tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) + qsfc_ocn, qsfc_lnd, qsfc_ice, & !intent(in) + snowh_ocn, snowh_lnd, snowh_ice, & !intent(in) + ZNT_ocn, ZNT_lnd, ZNT_ice, & !intent(inout) + UST_ocn, UST_lnd, UST_ice, & !intent(inout) + cm_ocn, cm_lnd, cm_ice, & !intent(inout) + ch_ocn, ch_lnd, ch_ice, & !intent(inout) + rb_ocn, rb_lnd, rb_ice, & !intent(inout) + stress_ocn, stress_lnd, stress_ice, & !intent(inout) + psix_ocn, psix_lnd, psix_ice, & !=fm, intent(inout) + psit_ocn, psit_lnd, psit_ice, & !=fh, intent(inout) + psix10_ocn, psix10_lnd, psix10_ice, & !=fm10, intent(inout) + psit2_ocn, psit2_lnd, psit2_ice, & !=fh2, intent(inout) + HFLX_ocn, HFLX_lnd, HFLX_ice, & + QFLX_ocn, QFLX_lnd, QFLX_ice, & + ch,CHS,CHS2,CQS2,CPM, & + ZNT,USTM,ZOL,MOL,RMOL, & + PSIM,PSIH, & + HFLX,HFX,QFLX,QFX,LH,FLHC,FLQC, & + QGH,QSFC, & + U10,V10,TH2,T2,Q2, & + GZ1OZ0,WSPD,wstar, & + spp_pbl,rstoch1D, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte & + ) !------------------------------------------------------------------- IMPLICIT NONE @@ -518,7 +548,7 @@ SUBROUTINE SFCLAY1D_mynn( & INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & - J, itimestep + J, itimestep, iter REAL, PARAMETER :: XKA=2.4E-5 !molecular diffusivity REAL, PARAMETER :: PRT=1. !prandlt number @@ -531,6 +561,14 @@ SUBROUTINE SFCLAY1D_mynn( & INTEGER, INTENT(IN) :: ISFFLX INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX, IZ0TLND INTEGER, INTENT(IN) :: spp_pbl + integer, intent(in) :: ivegsrc + integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) + +!Input data + integer, dimension(ims:ime), intent(in) :: vegtype + real, dimension(ims:ime), intent(in) :: & + & sigmaf,shdmax,z0pert,ztpert !----------------------------- ! 1D ARRAYS @@ -538,34 +576,54 @@ SUBROUTINE SFCLAY1D_mynn( & REAL, DIMENSION( ims:ime ), INTENT(IN) :: MAVAIL, & PBLH, & XLAND, & - TSK, & PSFCPA, & - QCG, & - SNOWH, DX + DX REAL, DIMENSION( its:ite ), INTENT(IN) :: U1D,V1D, & U1D2,V1D2, & QV1D,P1D, & - T1D,QC1d, & - dz8w1d,dz2w1d, & - RHO1D, & - vt1,vq1 + T1D, & + dz8w1d, & + dz2w1d - REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: REGIME, & - HFX,QFX,LH, & + REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: HFLX,HFX, & + QFLX,QFX,LH, & MOL,RMOL, & - QSFC, & + QGH,QSFC, & ZNT, & ZOL, & - UST, & + CPM, & CHS2,CQS2, & CHS,CH, & FLHC,FLQC, & GZ1OZ0, & WSPD, & - BR, & - PSIM,PSIH, & - PSIX,PSIX10,PSIT,PSIT2 + PSIM, & + PSIH, & + USTM + + LOGICAL, DIMENSION( ims:ime ), INTENT(IN) :: & + & wet, dry, icy + + REAL, DIMENSION( ims:ime ), INTENT(in) :: & + & tskin_ocn, tskin_lnd, tskin_ice, & + & tsurf_ocn, tsurf_lnd, tsurf_ice, & + & snowh_ocn, snowh_lnd, snowh_ice + + REAL, DIMENSION( ims:ime ), INTENT(inout) :: & + & ZNT_ocn, ZNT_lnd, ZNT_ice, & + & UST_ocn, UST_lnd, UST_ice, & + & cm_ocn, cm_lnd, cm_ice, & + & ch_ocn, ch_lnd, ch_ice, & + & rb_ocn, rb_lnd, rb_ice, & + & stress_ocn,stress_lnd,stress_ice, & + & psix_ocn, psix_lnd, psix_ice, & + & psit_ocn, psit_lnd, psit_ice, & + & psix10_ocn,psix10_lnd,psix10_ice, & + & psit2_ocn, psit2_lnd, psit2_ice, & + & HFLX_ocn, HFLX_lnd, HFLX_ice, & + & QFLX_ocn, QFLX_lnd, QFLX_ice, & + & qsfc_ocn, qsfc_lnd, qsfc_ice REAL, DIMENSION( its:ite ), INTENT(IN) :: rstoch1D @@ -573,18 +631,13 @@ SUBROUTINE SFCLAY1D_mynn( & REAL, DIMENSION( ims:ime ), INTENT(OUT) :: U10,V10, & TH2,T2,Q2 - REAL, OPTIONAL, DIMENSION( ims:ime ) , & - INTENT(OUT) :: ck,cka,cd,cda,ustm !-------------------------------------------- !JOE-additinal output - REAL, DIMENSION( ims:ime ) :: zratio,wstar,qstar, & - resist,logres + REAL, DIMENSION( ims:ime ) :: wstar,qstar !JOE-end !---------------------------------------------------------------- ! LOCAL VARS !---------------------------------------------------------------- - REAL :: thl1,sqv1,sqc1,exner1,sqvg,sqcg,vv,ww - REAL, DIMENSION(its:ite) :: & ZA, & !Height of lowest 1/2 sigma level(m) ZA2, & !Height of 2nd lowest 1/2 sigma level(m) @@ -592,146 +645,349 @@ SUBROUTINE SFCLAY1D_mynn( & TH1D, & !Theta at lowest 1/2 sigma (K) TC1D, & !T at lowest 1/2 sigma (Celsius) TV1D, & !Tv at lowest 1/2 sigma (K) + RHO1D, & !density at lowest 1/2 sigma level QVSH, & !qv at lowest 1/2 sigma (spec humidity) - PSIH2,PSIM2, & !M-O stability functions at z=2 m - PSIH10,PSIM10, & !M-O stability functions at z=10 m - WSPDI, & - CPM, & - z_t,z_q, & !thermal & moisture roughness lengths - ZNTstoch, & + PSIH2, & !M-O stability functions at z=2 m + PSIM10, & !M-O stability functions at z=10 m + PSIH10, & !M-O stability functions at z=10 m + WSPDI, & GOVRTH, & !g/theta - THGB, & !theta at ground - THVGB, & !theta-v at ground PSFC, & !press at surface (Pa/1000) QSFCMR, & !qv at surface (mixing ratio, kg/kg) - GZ2OZ0, & !LOG((2.0+ZNT(I))/ZNT(I)) - GZ10OZ0, & !LOG((10.+ZNT(I))/ZNT(I)) - GZ2OZt, & !LOG((2.0+z_t(i))/z_t(i)) - GZ10OZt, & !LOG((10.+z_t(i))/z_t(i)) - GZ1OZt !LOG((ZA(I)+z_t(i))/z_t(i)) - - INTEGER :: N,I,K,L,NZOL,NK,NZOL2,NZOL10, ITER, yesno - INTEGER, PARAMETER :: ITMAX=1 - - REAL :: PL,THCON,TVCON,E1 - REAL :: DTHVDZ,DTHVM,VCONV,RZOL,RZOL2,RZOL10,ZOL2,ZOL10 - REAL :: DTG,DTTHX,DTHDZ,PSIT10,PSIQ,PSIQ2,PSIQ10 + THCON, & !conversion from temp to theta + zratio_lnd, zratio_ice, zratio_ocn, & !z0/zt + TSK_lnd, TSK_ice, TSK_ocn, & !absolute temperature + THSK_lnd, THSK_ice, THSK_ocn, & !theta + THVSK_lnd, THVSK_ice, THVSK_ocn, & !theta-v + GZ1OZ0_lnd, GZ1OZ0_ice, GZ1OZ0_ocn, & !LOG((ZA(I)+ZNT(i))/ZNT(i)) + GZ1OZt_lnd, GZ1OZt_ice, GZ1OZt_ocn, & !LOG((ZA(I)+ZT(i))/ZT(i)) + GZ2OZ0_lnd, GZ2OZ0_ice, GZ2OZ0_ocn, & !LOG((2.0+ZNT(I))/ZNT(I)) + GZ2OZt_lnd, GZ2OZt_ice, GZ2OZt_ocn, & !LOG((2.0+ZT(I))/ZT(I)) + GZ10OZ0_lnd, GZ10OZ0_ice, GZ10OZ0_ocn, & !LOG((10.+ZNT(I))/ZNT(I)) + GZ10OZt_lnd, GZ10OZt_ice, GZ10OZt_ocn, & !LOG((10.+ZT(I))/ZT(I)) + ZNTstoch_lnd, ZNTstoch_ice, ZNTstoch_ocn, & + ZT_lnd, ZT_ice, ZT_ocn, & + ZQ_lnd, ZQ_ice, ZQ_ocn, & + PSIQ_lnd, PSIQ_ice, PSIQ_ocn, & + PSIQ2_lnd, PSIQ2_ice, PSIQ2_ocn, & + QSFCMR_lnd, QSFCMR_ice, QSFCMR_ocn + + INTEGER :: N,I,K,L,yesno + + REAL :: PL,E1,TABS + REAL :: WSPD_lnd, WSPD_ice, WSPD_ocn + REAL :: DTHVDZ,DTHVM,VCONV,ZOL2,ZOL10,ZOLZA,ZOLZ0 + REAL :: DTG,DTTHX,PSIQ,PSIQ2,PSIQ10,PSIT10 REAL :: FLUXC,VSGD REAL :: restar,VISC,DQG,OLDUST,OLDTST - REAL, PARAMETER :: psilim = -10. ! ONLY AFFECTS z/L > 2.0 + !------------------------------------------------------------------- + IF (debug_code >= 1) THEN + write(0,*)"ITIMESTEP=",ITIMESTEP," iter=",iter + DO I=its,ite + write(0,*)"=== imortant input to mynnsfclayer, i:", i + IF (dry(i)) THEN + write(0,*)"dry=",dry(i)," pblh=",pblh(i)," tsk=", tskin_lnd(i),& + " tsurf=", tsurf_lnd(i)," qsfc=", qsfc_lnd(i)," znt=", znt_lnd(i),& + " ust=", ust_lnd(i)," snowh=", snowh_lnd(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + IF (icy(i)) THEN + write(0,*)"icy=",icy(i)," pblh=",pblh(i)," tsk=", tskin_ice(i),& + " tsurf=", tsurf_ice(i)," qsfc=", qsfc_ice(i)," znt=", znt_ice(i),& + " ust=", ust_ice(i)," snowh=", snowh_ice(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + IF (wet(i)) THEN + write(0,*)"wet=",wet(i)," pblh=",pblh(i)," tsk=", tskin_ocn(i),& + " tsurf=", tsurf_ocn(i)," qsfc=", qsfc_ocn(i)," znt=", znt_ocn(i),& + " ust=", ust_ocn(i)," snowh=", snowh_ocn(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + ENDDO + ENDIF DO I=its,ite - ! CONVERT GROUND & LOWEST LAYER TEMPERATURE TO POTENTIAL TEMPERATURE: - ! PSFC cmb + ! PSFC ( in cmb) is used later in saturation checks PSFC(I)=PSFCPA(I)/1000. - THGB(I)=TSK(I)*(100./PSFC(I))**ROVCP !(K) - ! PL cmb - PL=P1D(I)/1000. - THCON=(100./PL)**ROVCP - TH1D(I)=T1D(I)*THCON !(Theta, K) + ! DEFINE SKIN TEMPERATURES FOR LAND/WATER/ICE + TSK_lnd(I) = 0.5 * (tsurf_lnd(i)+tskin_lnd(i)) + TSK_ice(I) = 0.5 * (tsurf_ice(i)+tskin_ice(i)) + TSK_ocn(I) = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) + QVSH(I)=QV1D(I)/(1.+QV1D(I)) !CONVERT TO SPEC HUM (kg/kg) + THCON(I)=(100000./PSFCPA(I))**ROVCP + ENDDO + + DO I=its,ite + ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: + THSK_lnd(I) = TSK_lnd(I)*THCON(I) !(K) + THSK_ice(I) = TSK_ice(I)*THCON(I) !(K) + THSK_ocn(I) = TSK_ocn(I)*THCON(I) !(K) + ENDDO + + DO I=its,ite + ! CONVERT SKIN POTENTIAL TEMPERATURES TO VIRTUAL POTENTIAL TEMPERATURE: + THVSK_lnd(I) = THSK_lnd(I)*(1.+EP1*QVSH(I)) !(K) + THVSK_ice(I) = THSK_ice(I)*(1.+EP1*QVSH(I)) !(K) + THVSK_ocn(I) = THSK_ocn(I)*(1.+EP1*QVSH(I)) !(K) + ENDDO + + DO I=its,ite + ! CONVERT LOWEST LAYER TEMPERATURE TO POTENTIAL TEMPERATURE: + TH1D(I)=T1D(I)*THCON(I) !(Theta, K) TC1D(I)=T1D(I)-273.15 !(T, Celsius) + ENDDO + DO I=its,ite ! CONVERT TO VIRTUAL TEMPERATURE - QVSH(I)=QV1D(I)/(1.+QV1D(I)) !CONVERT TO SPEC HUM (kg/kg) - TVCON=(1.+EP1*QVSH(I)) - THV1D(I)=TH1D(I)*TVCON !(K) - TV1D(I)=T1D(I)*TVCON !(K) + THV1D(I)=TH1D(I)*(1.+EP1*QVSH(I)) !(K) + TV1D(I)=T1D(I)*(1.+EP1*QVSH(I)) !(K) + ENDDO - !RHO1D(I)=PSFCPA(I)/(R*TV1D(I)) !now using value calculated in sfc driver + DO I=its,ite + RHO1D(I)=PSFCPA(I)/(R*TV1D(I)) !now using value calculated in sfc driver ZA(I)=0.5*dz8w1d(I) !height of first half-sigma level ZA2(I)=dz8w1d(I) + 0.5*dz2w1d(I) !height of 2nd half-sigma level GOVRTH(I)=G/TH1D(I) ENDDO DO I=its,ite - IF (TSK(I) .LT. 273.15) THEN - !SATURATION VAPOR PRESSURE WRT ICE (SVP1=.6112; 10*mb) - E1=SVP1*EXP(4648*(1./273.15 - 1./TSK(I)) - & - & 11.64*LOG(273.15/TSK(I)) + 0.02265*(273.15 - TSK(I))) + QFX(i)=QFLX(i)*RHO1D(I) + HFX(i)=HFLX(i)*RHO1D(I)*cp + ENDDO + + IF (debug_code ==2) THEN + !write(*,*)"ITIMESTEP=",ITIMESTEP + DO I=its,ite + write(*,*)"=== derived quantities in mynn sfc layer, i:", i + write(*,*)" land, ice, water" + write(*,*)"dry=",dry(i)," icy=",icy(i)," wet=",wet(i) + write(*,*)"tsk=", tsk_lnd(i),tsk_ice(i),tsk_ocn(i) + write(*,*)"thvsk=", thvsk_lnd(i),thvsk_ice(i),thvsk_ocn(i) + write(*,*)"THV1D=", THV1D(i)," TV1D=",TV1D(i) + write(*,*)"RHO1D=", RHO1D(i)," GOVRTH=",GOVRTH(i) + ENDDO + ENDIF + + DO I=its,ite + + IF (ITIMESTEP == 1) THEN + IF (wet(i)) THEN + IF (TSK_ocn(I) .LT. 273.15) THEN + !SATURATION VAPOR PRESSURE WRT ICE (SVP1=.6112; 10*mb) + E1=SVP1*EXP(4648*(1./273.15 - 1./TSK_ocn(I)) - & + & 11.64*LOG(273.15/TSK_ocn(I)) + 0.02265*(273.15 - TSK_ocn(I))) + ELSE + !SATURATION VAPOR PRESSURE WRT WATER (Bolton 1980) + E1=SVP1*EXP(SVP2*(TSK_ocn(I)-SVPT0)/(TSK_ocn(i)-SVP3)) + ENDIF + QSFC_ocn(I)=EP2*E1/(PSFC(I)-ep_3*E1) !specific humidity + QSFCMR_ocn(I)=EP2*E1/(PSFC(I)-E1) !mixing ratio + ENDIF + IF (dry(i)) THEN + TABS = 0.5*(TSK_lnd(I) + T1D(I)) + IF (TABS .LT. 273.15) THEN + !SATURATION VAPOR PRESSURE WRT ICE (SVP1=.6112; 10*mb) + E1=SVP1*EXP(4648*(1./273.15 - 1./TABS) - & + & 11.64*LOG(273.15/TABS) + 0.02265*(273.15 - TABS)) + ELSE + !SATURATION VAPOR PRESSURE WRT WATER (Bolton 1980) + E1=SVP1*EXP(SVP2*(TABS-SVPT0)/(TABS-SVP3)) + ENDIF + QSFC_lnd(I)=EP2*E1/(PSFC(I)-ep_3*E1) !specific humidity + QSFC_lnd(I)=0.5*(QSFC_lnd(I) + QSFC(I)) + QSFCMR_lnd(I)=QSFC_lnd(I)/(1.-QSFC_lnd(I)) !mixing ratio + ENDIF + IF (icy(i)) THEN + IF (TSK_ice(I) .LT. 273.15) THEN + !SATURATION VAPOR PRESSURE WRT ICE (SVP1=.6112; 10*mb) + E1=SVP1*EXP(4648*(1./273.15 - 1./TSK_ice(I)) - & + & 11.64*LOG(273.15/TSK_ice(I)) + 0.02265*(273.15 - TSK_ice(I))) + ELSE + !SATURATION VAPOR PRESSURE WRT WATER (Bolton 1980) + E1=SVP1*EXP(SVP2*(TSK_ice(I)-SVPT0)/(TSK_ice(i)-SVP3)) + ENDIF + QSFC_ice(I)=EP2*E1/(PSFC(I)-ep_3*E1) !specific humidity + QSFCMR_ice(I)=EP2*E1/(PSFC(I)-E1) !mixing ratio + ENDIF + ELSE - !SATURATION VAPOR PRESSURE WRT WATER (Bolton 1980) - E1=SVP1*EXP(SVP2*(TSK(I)-SVPT0)/(TSK(I)-SVP3)) - ENDIF - !FOR LAND POINTS, QSFC can come from LSM, ONLY RECOMPUTE OVER WATER - IF (xland(i).gt.1.5 .or. QSFC(i).le.0.0) THEN !WATER - QSFC(I)=EP2*E1/(PSFC(I)-ep_3*E1) !specific humidity - QSFCMR(I)=EP2*E1/(PSFC(I)-E1) !mixing ratio - ELSE !LAND - QSFCMR(I)=QSFC(I)/(1.-QSFC(I)) + + ! Use what comes out of the LSM, NST, and CICE + IF (wet(i)) QSFCMR_ocn(I)=QSFC_ocn(I)/(1.-QSFC_ocn(I)) + IF (dry(i)) QSFCMR_lnd(I)=QSFC_lnd(I)/(1.-QSFC_lnd(I)) + IF (icy(i)) QSFCMR_ice(I)=QSFC_ice(I)/(1.-QSFC_ice(I)) + ENDIF - IF (TSK(I) .LT. 273.15) THEN + ! QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP + ! Q2SAT = QGH IN LSM + IF (T1D(I) .LT. 273.15) THEN !SATURATION VAPOR PRESSURE WRT ICE - E1=SVP1*EXP(4648*(1./273.15 - 1./T1D(I)) - & + E1=SVP1*EXP(4648.*(1./273.15 - 1./T1D(I)) - & & 11.64*LOG(273.15/T1D(I)) + 0.02265*(273.15 - T1D(I))) ELSE !SATURATION VAPOR PRESSURE WRT WATER (Bolton 1980) E1=SVP1*EXP(SVP2*(T1D(I)-SVPT0)/(T1D(I)-SVP3)) ENDIF PL=P1D(I)/1000. + !QGH(I)=EP2*E1/(PL-ep_3*E1) !specific humidity + QGH(I)=EP2*E1/(PL-E1) !mixing ratio CPM(I)=CP*(1.+0.84*QV1D(I)) ENDDO + IF (debug_code == 2) THEN + write(*,*)"ITIMESTEP=",ITIMESTEP + DO I=its,ite + if (wet(i)) then + write(*,*)"==== q-bombs, i:",i," wet" + write(*,*)"QSFC_ocn=", QSFC_ocn(I)," QSFCMR_ocn=", QSFCMR_ocn(I)," QGH=",QGH(I) + endif + if(dry(i)) then + write(*,*)"==== q-bombs, i:",i," dry" + write(*,*)"QSFC_lnd=", QSFC_lnd(I)," QSFCMR_lnd=", QSFCMR_lnd(I)," QGH=",QGH(I) + endif + if(icy(i)) then + write(*,*)"==== q-bombs, i:",i," ice" + write(*,*)"QSFC_ice=", QSFC_ice(I)," QSFCMR_ice=", QSFCMR_ice(I)," QGH=",QGH(I) + endif + ENDDO + ENDIF + DO I=its,ite - WSPD(I)=SQRT(U1D(I)*U1D(I)+V1D(I)*V1D(I)) - - !account for partial condensation - exner1=(p1d(I)/p1000mb)**ROVCP - sqc1=qc1d(I)/(1.+qc1d(I)) !lowest mod level cloud water spec hum - sqv1=QVSH(I) !lowest mod level water vapor spec hum - thl1=TH1D(I)-xlvcp/exner1*sqc1 - sqvg=qsfc(I) !sfc water vapor spec hum - sqcg=qcg(I)/(1.+qcg(I)) !sfc cloud water spec hum - - vv = thl1-THGB(I) - !TGS:ww = mavail(I)*(sqv1-sqvg) + (sqc1-sqcg) - ww = (sqv1-sqvg) + (sqc1-sqcg) - - !TGS:THVGB(I)=THGB(I)*(1.+EP1*QSFC(I)*MAVAIL(I)) - THVGB(I)=THGB(I)*(1.+EP1*QSFC(I)) - - DTHDZ=(TH1D(I)-THGB(I)) - DTHVDZ=(THV1D(I)-THVGB(I)) - !DTHVDZ= (vt1(i) + 1.0)*vv + (vq1(i) + tv0)*ww - - !-------------------------------------------------------- - ! Calculate the convective velocity scale (WSTAR) and - ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) - ! and Mahrt and Sun (1995, MWR), respectively - !------------------------------------------------------- - ! Use Beljaars over land and water - fluxc = max(hfx(i)/RHO1D(i)/cp & - & + ep1*THVGB(I)*qfx(i)/RHO1D(i),0.) - WSTAR(I) = vconvc*(g/TSK(i)*pblh(i)*fluxc)**.33 - - !-------------------------------------------------------- - ! Mahrt and Sun low-res correction - ! (for 13 km ~ 0.37 m/s; for 3 km == 0 m/s) - !-------------------------------------------------------- - VSGD = 0.32 * (max(dx(i)/5000.-1.,0.))**.33 - WSPD(I)=SQRT(WSPD(I)*WSPD(I)+WSTAR(I)*WSTAR(I)+vsgd*vsgd) - WSPD(I)=MAX(WSPD(I),wmin) - - !-------------------------------------------------------- - ! CALCULATE THE BULK RICHARDSON NUMBER OF SURFACE LAYER, - ! ACCORDING TO AKB(1976), EQ(12). - !-------------------------------------------------------- - BR(I)=GOVRTH(I)*ZA(I)*DTHVDZ/(WSPD(I)*WSPD(I)) - !SET LIMITS ACCORDING TO Li et al. (2010) Boundary-Layer Meteorol (p.158) - BR(I)=MAX(BR(I),-20.0) - BR(I)=MIN(BR(I),2.0) - + ! DH* 20200401 - note. A weird bug in Intel 18 on hera prevents using the + ! normal -O2 optimization in REPRO and PROD mode for this file. Not reproducible + ! by every user, the bug manifests itself in the resulting wind speed WSPD(I) + ! being -99.0 despite the assignments in lines 932 and 933. *DH + WSPD(I)=SQRT(U1D(I)*U1D(I)+V1D(I)*V1D(I)) + WSPD_ocn = -99. + WSPD_ice = -99. + WSPD_lnd = -99. + + IF (wet(i)) THEN + DTHVDZ=(THV1D(I)-THVSK_ocn(I)) + !-------------------------------------------------------- + ! Calculate the convective velocity scale (WSTAR) and + ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) + ! and Mahrt and Sun (1995, MWR), respectively + !------------------------------------------------------- + fluxc = max(hfx(i)/RHO1D(i)/cp & + & + ep1*THVSK_ocn(I)*qfx(i)/RHO1D(i),0.) + !WSTAR(I) = vconvc*(g/TSK(i)*pblh(i)*fluxc)**onethird + WSTAR(I) = vconvc*(g/TSK_ocn(i)*pblh(i)*fluxc)**onethird + !-------------------------------------------------------- + ! Mahrt and Sun low-res correction - modified for water points (halved) + ! (for 13 km ~ 0.18 m/s; for 3 km == 0 m/s) + !-------------------------------------------------------- + VSGD = MIN( 0.25 * (max(dx(i)/5000.-1.,0.))**onethird , 0.5) + WSPD_ocn=SQRT(WSPD(I)*WSPD(I)+WSTAR(I)*WSTAR(I)+vsgd*vsgd) + WSPD_ocn=MAX(WSPD_ocn,wmin) + !-------------------------------------------------------- + ! CALCULATE THE BULK RICHARDSON NUMBER OF SURFACE LAYER, + ! ACCORDING TO AKB(1976), EQ(12). + !-------------------------------------------------------- + rb_ocn(I)=GOVRTH(I)*ZA(I)*DTHVDZ/(WSPD_ocn*WSPD_ocn) + IF (ITIMESTEP == 1) THEN + rb_ocn(I)=MAX(rb_ocn(I),-2.0) + rb_ocn(I)=MIN(rb_ocn(I), 2.0) + ELSE + rb_ocn(I)=MAX(rb_ocn(I),-50.0) + rb_ocn(I)=MIN(rb_ocn(I), 50.0) + ENDIF + ENDIF ! end water point + + IF (dry(i)) THEN + DTHVDZ=(THV1D(I)-THVSK_lnd(I)) + !-------------------------------------------------------- + ! Calculate the convective velocity scale (WSTAR) and + ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) + ! and Mahrt and Sun (1995, MWR), respectively + !------------------------------------------------------- + fluxc = max(hfx(i)/RHO1D(i)/cp & + & + ep1*THVSK_lnd(I)*qfx(i)/RHO1D(i),0.) + !WSTAR(I) = vconvc*(g/TSK(i)*pblh(i)*fluxc)**onethird + !increase height scale, assuming that the non-local transoport + !from the mass-flux (plume) mixing exceedsd the PBLH. + WSTAR(I) = vconvc*(g/TSK_lnd(i)*MIN(1.5*pblh(i),4000.)*fluxc)**onethird + !-------------------------------------------------------- + ! Mahrt and Sun low-res correction + ! (for 13 km ~ 0.37 m/s; for 3 km == 0 m/s) + !-------------------------------------------------------- + VSGD = MIN( 0.32 * (max(dx(i)/5000.-1.,0.))**onethird , 0.5) + WSPD_lnd=SQRT(WSPD(I)*WSPD(I)+WSTAR(I)*WSTAR(I)+vsgd*vsgd) + WSPD_lnd=MAX(WSPD_lnd,wmin) + !-------------------------------------------------------- + ! CALCULATE THE BULK RICHARDSON NUMBER OF SURFACE LAYER, + ! ACCORDING TO AKB(1976), EQ(12). + !-------------------------------------------------------- + rb_lnd(I)=GOVRTH(I)*ZA(I)*DTHVDZ/(WSPD_lnd*WSPD_lnd) + !From Tilden Meyers: + !IF (rb_lnd(I) .GE 0.0) THEN + ! ust_lnd(i)=WSPD_lnd*0.1/(1.0 + 10.0*rb_lnd(I)) + !ELSE + ! ust_lnd(i)=WSPD_lnd*0.1*(1.0 - 10.0*rb_lnd(I))**onethird + !ENDIF + IF (ITIMESTEP == 1) THEN + rb_lnd(I)=MAX(rb_lnd(I),-2.0) + rb_lnd(I)=MIN(rb_lnd(I), 2.0) + ELSE + rb_lnd(I)=MAX(rb_lnd(I),-50.0) + rb_lnd(I)=MIN(rb_lnd(I), 50.0) + ENDIF + ENDIF ! end land point + + IF (icy(i)) THEN + DTHVDZ=(THV1D(I)-THVSK_ice(I)) + !-------------------------------------------------------- + ! Calculate the convective velocity scale (WSTAR) and + ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) + ! and Mahrt and Sun (1995, MWR), respectively + !------------------------------------------------------- + fluxc = max(hfx(i)/RHO1D(i)/cp & + & + ep1*THVSK_ice(I)*qfx(i)/RHO1D(i),0.) + !WSTAR(I) = vconvc*(g/TSK(i)*pblh(i)*fluxc)**onethird + !increase height scale, assuming that the non-local transport + !from the mass-flux (plume) mixing exceedsd the PBLH. + WSTAR(I) = vconvc*(g/TSK_ice(i)*MIN(1.5*pblh(i),4000.)*fluxc)**onethird + !-------------------------------------------------------- + ! Mahrt and Sun low-res correction + ! (for 13 km ~ 0.37 m/s; for 3 km == 0 m/s) + !-------------------------------------------------------- + VSGD = MIN( 0.32 * (max(dx(i)/5000.-1.,0.))**onethird , 0.5) + WSPD_ice=SQRT(WSPD(I)*WSPD(I)+WSTAR(I)*WSTAR(I)+vsgd*vsgd) + WSPD_ice=MAX(WSPD_ice,wmin) + !-------------------------------------------------------- + ! CALCULATE THE BULK RICHARDSON NUMBER OF SURFACE LAYER, + ! ACCORDING TO AKB(1976), EQ(12). + !-------------------------------------------------------- + rb_ice(I)=GOVRTH(I)*ZA(I)*DTHVDZ/(WSPD_ice*WSPD_ice) + IF (ITIMESTEP == 1) THEN + rb_ice(I)=MAX(rb_ice(I),-2.0) + rb_ice(I)=MIN(rb_ice(I), 2.0) + ELSE + rb_ice(I)=MAX(rb_ice(I),-50.0) + rb_ice(I)=MIN(rb_ice(I), 50.0) + ENDIF + ENDIF ! end ice point + + !NOW CONDENSE THE POSSIBLE WSPD VALUES BY TAKING THE MAXIMUM + WSPD(I) = MAX(WSPD_ice,WSPD_ocn) + WSPD(I) = MAX(WSPD_lnd,WSPD(I)) + + IF (debug_code >= 1) THEN + write(*,*)"===== After rb calc in mynn sfc layer:" + write(*,*)"ITIMESTEP=",ITIMESTEP + write(*,*)"WSPD=", WSPD(I)," WSTAR=", WSTAR(I)," vsgd=",vsgd + IF (icy(i))write(*,*)"rb_ice=", rb_ice(I)," DTHVDZ=",DTHVDZ + IF (wet(i))write(*,*)"rb_ocn=", rb_ocn(I)," DTHVDZ=",DTHVDZ + IF (dry(i))write(*,*)"rb_lnd=", rb_lnd(I)," DTHVDZ=",DTHVDZ + ENDIF + ! IF PREVIOUSLY UNSTABLE, DO NOT LET INTO REGIMES 1 AND 2 (STABLE) !if (itimestep .GT. 1) THEN ! IF(MOL(I).LT.0.)BR(I)=MIN(BR(I),0.0) !ENDIF - !IF(I .eq. 2)THEN - ! write(*,1006)"BR:",BR(I)," fluxc:",fluxc," vt1:",vt1(i)," vq1:",vq1(i) - ! write(*,1007)"XLAND:",XLAND(I)," WSPD:",WSPD(I)," DTHVDZ:",DTHVDZ," WSTAR:",WSTAR(I) - !ENDIF - ENDDO 1006 format(A,F7.3,A,f9.4,A,f9.5,A,f9.4) @@ -739,626 +995,1146 @@ SUBROUTINE SFCLAY1D_mynn( & !-------------------------------------------------------------------- !-------------------------------------------------------------------- -!--- BEGIN ITERATION LOOP (ITMAX=5); USUALLY CONVERGES IN TWO PASSES +!--- BEGIN I-LOOP !-------------------------------------------------------------------- !-------------------------------------------------------------------- DO I=its,ite - ITER = 1 - DO WHILE (ITER .LE. ITMAX) - - !COMPUTE KINEMATIC VISCOSITY (m2/s) Andreas (1989) CRREL Rep. 89-11 - !valid between -173 and 277 degrees C. - VISC=1.326e-5*(1. + 6.542e-3*TC1D(I) + 8.301e-6*TC1D(I)*TC1D(I) & - - 4.84e-9*TC1D(I)*TC1D(I)*TC1D(I)) + !COMPUTE KINEMATIC VISCOSITY (m2/s) Andreas (1989) CRREL Rep. 89-11 + !valid between -173 and 277 degrees C. + VISC=1.326e-5*(1. + 6.542e-3*TC1D(I) + 8.301e-6*TC1D(I)*TC1D(I) & + - 4.84e-9*TC1D(I)*TC1D(I)*TC1D(I)) - IF((XLAND(I)-1.5).GE.0)THEN - !-------------------------------------- - ! WATER - !-------------------------------------- + IF (wet(i)) THEN + !-------------------------------------- + ! WATER + !-------------------------------------- + if (sfc_z0_type >= 0) then ! Avoid calculation is using wave model ! CALCULATE z0 (znt) !-------------------------------------- + IF (debug_code >= 1) THEN + write(*,*)"=============Input to ZNT over water:" + write(*,*)"u*:",UST_ocn(i)," wspd=",WSPD(i)," visc=",visc," za=",ZA(I) + ENDIF IF ( PRESENT(ISFTCFLX) ) THEN IF ( ISFTCFLX .EQ. 0 ) THEN IF (COARE_OPT .EQ. 3.0) THEN - !COARE 3.0 (MISLEADING SUBROUTINE NAME) - CALL charnock_1955(ZNT(i),UST(i),WSPD(i),visc,ZA(I)) + !COARE 3.0 (MISLEADING SUBROUTINE NAME) + CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ELSE - !COARE 3.5 - CALL edson_etal_2013(ZNT(i),UST(i),WSPD(i),visc,ZA(I)) + !COARE 3.5 + CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ENDIF ELSEIF ( ISFTCFLX .EQ. 1 .OR. ISFTCFLX .EQ. 2 ) THEN - CALL davis_etal_2008(ZNT(i),UST(i)) + CALL davis_etal_2008(ZNT_ocn(i),UST_ocn(i)) ELSEIF ( ISFTCFLX .EQ. 3 ) THEN - CALL Taylor_Yelland_2001(ZNT(i),UST(i),WSPD(i)) + CALL Taylor_Yelland_2001(ZNT_ocn(i),UST_ocn(i),WSPD(i)) ELSEIF ( ISFTCFLX .EQ. 4 ) THEN - IF (COARE_OPT .EQ. 3.0) THEN - !COARE 3.0 (MISLEADING SUBROUTINE NAME) - CALL charnock_1955(ZNT(i),UST(i),WSPD(i),visc,ZA(I)) - ELSE - !COARE 3.5 - CALL edson_etal_2013(ZNT(i),UST(i),WSPD(i),visc,ZA(I)) - ENDIF + !GFS surface layer scheme + CALL GFS_z0_ocn(ZNT_ocn(i),UST_ocn(i),WSPD(i),ZA(I),sfc_z0_type,redrag) ENDIF ELSE !DEFAULT TO COARE 3.0/3.5 IF (COARE_OPT .EQ. 3.0) THEN !COARE 3.0 - CALL charnock_1955(ZNT(i),UST(i),WSPD(i),visc,ZA(I)) + CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ELSE !COARE 3.5 - CALL edson_etal_2013(ZNT(i),UST(i),WSPD(i),visc,ZA(I)) + CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ENDIF ENDIF + endif !-end wave model check + + ! add stochastic perturbation of ZNT + if (spp_pbl==1) then + ZNTstoch_ocn(I) = MAX(ZNT_ocn(I) + ZNT_ocn(I)*1.0*rstoch1D(i), 1e-6) + else + ZNTstoch_ocn(I) = ZNT_ocn(I) + endif + + IF (debug_code >= 1) THEN + write(*,*)"==========Output ZNT over water:" + write(*,*)"ZNT:",ZNTstoch_ocn(i) + ENDIF - ! add stochastic perturbaction of ZNT - if (spp_pbl==1) then - ZNTstoch(I) = MAX(ZNT(I) + 1.5 * ZNT(I) * rstoch1D(i), 1e-6) - else - ZNTstoch(I) = ZNT(I) - endif - - !COMPUTE ROUGHNESS REYNOLDS NUMBER (restar) USING NEW ZNT - ! AHW: Garrattt formula: Calculate roughness Reynolds number - ! Kinematic viscosity of air (linear approx to - ! temp dependence at sea level) - restar=MAX(ust(i)*ZNTstoch(i)/visc, 0.1) + !COMPUTE ROUGHNESS REYNOLDS NUMBER (restar) USING NEW ZNT + ! AHW: Garrattt formula: Calculate roughness Reynolds number + ! Kinematic viscosity of air (linear approx to + ! temp dependence at sea level) + restar=MAX(ust_ocn(i)*ZNTstoch_ocn(i)/visc, 0.1) + + !-------------------------------------- + !CALCULATE z_t and z_q + !-------------------------------------- + IF (debug_code >= 1) THEN + write(*,*)"=============Input to ZT over water:" + write(*,*)"u*:",UST_ocn(i)," restar=",restar," visc=",visc + ENDIF - !-------------------------------------- - !CALCULATE z_t and z_q - !-------------------------------------- - IF ( PRESENT(ISFTCFLX) ) THEN - IF ( ISFTCFLX .EQ. 0 ) THEN - IF (COARE_OPT .EQ. 3.0) THEN - CALL fairall_etal_2003(z_t(i),z_q(i),restar,UST(i),visc) - ELSE - !presumably, this will be published soon, but hasn't yet - CALL fairall_etal_2014(z_t(i),z_q(i),restar,UST(i),visc,rstoch1D(i),spp_pbl) - ENDIF - ELSEIF ( ISFTCFLX .EQ. 1 ) THEN - IF (COARE_OPT .EQ. 3.0) THEN - CALL fairall_etal_2003(z_t(i),z_q(i),restar,UST(i),visc) - ELSE - CALL fairall_etal_2014(z_t(i),z_q(i),restar,UST(i),visc,rstoch1D(i),spp_pbl) - ENDIF - ELSEIF ( ISFTCFLX .EQ. 2 ) THEN - CALL garratt_1992(z_t(i),z_q(i),ZNTstoch(i),restar,XLAND(I)) - ELSEIF ( ISFTCFLX .EQ. 3 ) THEN - IF (COARE_OPT .EQ. 3.0) THEN - CALL fairall_etal_2003(z_t(i),z_q(i),restar,UST(i),visc) - ELSE - CALL fairall_etal_2014(z_t(i),z_q(i),restar,UST(i),visc,rstoch1D(i),spp_pbl) - ENDIF - ELSEIF ( ISFTCFLX .EQ. 4 ) THEN - CALL zilitinkevich_1995(ZNTstoch(i),z_t(i),z_q(i),restar,& - UST(I),KARMAN,XLAND(I),IZ0TLND,spp_pbl,rstoch1D(i)) + IF ( PRESENT(ISFTCFLX) ) THEN + IF ( ISFTCFLX .EQ. 0 ) THEN + IF (COARE_OPT .EQ. 3.0) THEN + CALL fairall_etal_2003(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& + rstoch1D(i),spp_pbl) + ELSE + !presumably, this will be published soon, but hasn't yet + CALL fairall_etal_2014(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& + rstoch1D(i),spp_pbl) ENDIF - ELSE - !DEFAULT TO COARE 3.0/3.5 + ELSEIF ( ISFTCFLX .EQ. 1 ) THEN IF (COARE_OPT .EQ. 3.0) THEN - CALL fairall_etal_2003(z_t(i),z_q(i),restar,UST(i),visc) + CALL fairall_etal_2003(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& + rstoch1D(i),spp_pbl) ELSE - CALL fairall_etal_2014(z_t(i),z_q(i),restar,UST(i),visc,rstoch1D(i),spp_pbl) + CALL fairall_etal_2014(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& + rstoch1D(i),spp_pbl) ENDIF + ELSEIF ( ISFTCFLX .EQ. 2 ) THEN + CALL garratt_1992(ZT_ocn(i),ZQ_ocn(i),ZNTstoch_ocn(i),restar,2.0) + ELSEIF ( ISFTCFLX .EQ. 3 ) THEN + IF (COARE_OPT .EQ. 3.0) THEN + CALL fairall_etal_2003(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& + rstoch1D(i),spp_pbl) + ELSE + CALL fairall_etal_2014(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& + rstoch1D(i),spp_pbl) + ENDIF + ELSEIF ( ISFTCFLX .EQ. 4 ) THEN + !GFS zt formulation + CALL GFS_zt_ocn(ZT_ocn(i),ZNTstoch_ocn(i),restar,WSPD(i),ZA(i),sfc_z0_type) + ZQ_ocn(i)=ZT_ocn(i) ENDIF - ELSE + !DEFAULT TO COARE 3.0/3.5 + IF (COARE_OPT .EQ. 3.0) THEN + CALL fairall_etal_2003(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& + rstoch1D(i),spp_pbl) + ELSE + CALL fairall_etal_2014(ZT_ocn(i),ZQ_ocn(i),restar,UST_ocn(i),visc,& + rstoch1D(i),spp_pbl) + ENDIF + ENDIF + IF (debug_code >= 1) THEN + write(*,*)"=============Output ZT & ZQ over water:" + write(*,*)"ZT:",ZT_ocn(i)," ZQ:",ZQ_ocn(i) + ENDIF - ! add stochastic perturbaction of ZNT - if (spp_pbl==1) then - ZNTstoch(I) = MAX(ZNT(I) + 1.5 * ZNT(I) * rstoch1D(i), 1e-6) - else - ZNTstoch(I) = ZNT(I) - endif + GZ1OZ0_ocn(I)= LOG((ZA(I)+ZNTstoch_ocn(I))/ZNTstoch_ocn(I)) + GZ1OZt_ocn(I)= LOG((ZA(I)+ZT_ocn(i))/ZT_ocn(i)) + GZ2OZ0_ocn(I)= LOG((2.0+ZNTstoch_ocn(I))/ZNTstoch_ocn(I)) + GZ2OZt_ocn(I)= LOG((2.0+ZT_ocn(i))/ZT_ocn(i)) + GZ10OZ0_ocn(I)=LOG((10.+ZNTstoch_ocn(I))/ZNTstoch_ocn(I)) + GZ10OZt_ocn(I)=LOG((10.+ZT_ocn(i))/ZT_ocn(i)) + zratio_ocn(i)=ZNTstoch_ocn(I)/ZT_ocn(I) !need estimate for Li et al. + + ENDIF !end water point + + IF (dry(I)) THEN + + if ( IZ0TLND .EQ. 4 ) then + CALL GFS_z0_lnd(ZNT_lnd(i),shdmax(i),ZA(i),vegtype(i),ivegsrc,z0pert(i)) + endif + + ! add stochastic perturbaction of ZNT + if (spp_pbl==1) then + ZNTstoch_lnd(I) = MAX(ZNT_lnd(I) + ZNT_lnd(I)*1.0*rstoch1D(i), 1e-6) + else + ZNTstoch_lnd(I) = ZNT_lnd(I) + endif + + !-------------------------------------- + ! LAND + !-------------------------------------- + !COMPUTE ROUGHNESS REYNOLDS NUMBER (restar) USING DEFAULT ZNT + restar=MAX(ust_lnd(i)*ZNTstoch_lnd(i)/visc, 0.1) + + !-------------------------------------- + !GET z_t and z_q + !-------------------------------------- + IF (snowh_lnd(i) > 50.) THEN ! (mm) Treat as snow cover - use Andreas + CALL Andreas_2002(ZNTstoch_lnd(i),visc,ust_lnd(i),ZT_lnd(i),ZQ_lnd(i)) + ELSE + IF ( PRESENT(IZ0TLND) ) THEN + IF ( IZ0TLND .LE. 1 ) THEN + CALL zilitinkevich_1995(ZNTstoch_lnd(i),ZT_lnd(i),ZQ_lnd(i),restar,& + UST_lnd(I),KARMAN,1.0,IZ0TLND,spp_pbl,rstoch1D(i)) + ELSEIF ( IZ0TLND .EQ. 2 ) THEN + CALL Yang_2008(ZNTSTOCH_lnd(i),ZT_lnd(i),ZQ_lnd(i),UST_lnd(i),MOL(I),& + qstar(I),restar,visc) + ELSEIF ( IZ0TLND .EQ. 3 ) THEN + !Original MYNN in WRF-ARW used this form: + CALL garratt_1992(ZT_lnd(i),ZQ_lnd(i),ZNTSTOCH_lnd(i),restar,1.0) + ELSEIF ( IZ0TLND .EQ. 4 ) THEN + !GFS: + CALL GFS_zt_lnd(ZT_lnd(i),ZNTSTOCH_lnd(i),sigmaf(i),ztpert(i),UST_lnd(i)) + ZQ_lnd(i)=ZT_lnd(i) + ENDIF + ELSE + !DEFAULT TO ZILITINKEVICH + CALL zilitinkevich_1995(ZNTSTOCH_lnd(i),ZT_lnd(i),ZQ_lnd(i),restar,& + UST_lnd(I),KARMAN,1.0,0,spp_pbl,rstoch1D(i)) + ENDIF + ENDIF - !-------------------------------------- - ! LAND - !-------------------------------------- - !COMPUTE ROUGHNESS REYNOLDS NUMBER (restar) USING DEFAULT ZNT - restar=MAX(ust(i)*ZNTstoch(i)/visc, 0.1) + GZ1OZ0_lnd(I)= LOG((ZA(I)+ZNTstoch_lnd(I))/ZNTstoch_lnd(I)) + GZ1OZt_lnd(I)= LOG((ZA(I)+ZT_lnd(i))/ZT_lnd(i)) + GZ2OZ0_lnd(I)= LOG((2.0+ZNTstoch_lnd(I))/ZNTstoch_lnd(I)) + GZ2OZt_lnd(I)= LOG((2.0+ZT_lnd(i))/ZT_lnd(i)) + GZ10OZ0_lnd(I)=LOG((10.+ZNTstoch_lnd(I))/ZNTstoch_lnd(I)) + GZ10OZt_lnd(I)=LOG((10.+ZT_lnd(i))/ZT_lnd(i)) + zratio_lnd(i)=ZNTstoch_lnd(I)/ZT_lnd(I) !need estimate for Li et al. + + ENDIF !end land point + + IF (icy(I) .OR. snowh_lnd(i) > 50.) THEN + + ! add stochastic perturbaction of ZNT + if (spp_pbl==1) then + ZNTstoch_ice(I) = MAX(ZNT_ice(I) + ZNT_ice(I)*1.0*rstoch1D(i), 1e-6) + else + ZNTstoch_ice(I) = ZNT_ice(I) + endif + + !-------------------------------------- + ! ICE + !-------------------------------------- + !COMPUTE ROUGHNESS REYNOLDS NUMBER (restar) USING DEFAULT ZNT + restar=MAX(ust_ice(i)*ZNTstoch_ice(i)/visc, 0.1) + !-------------------------------------- + !GET z_t and z_q + !-------------------------------------- + CALL Andreas_2002(ZNTstoch_ice(i),visc,ust_ice(i),ZT_ice(i),ZQ_ice(i)) + + GZ1OZ0_ice(I)= LOG((ZA(I)+ZNTstoch_ice(I))/ZNTstoch_ice(I)) + GZ1OZt_ice(I)= LOG((ZA(I)+ZT_ice(i))/ZT_ice(i)) + GZ2OZ0_ice(I)= LOG((2.0+ZNTstoch_ice(I))/ZNTstoch_ice(I)) + GZ2OZt_ice(I)= LOG((2.0+ZT_ice(i))/ZT_ice(i)) + GZ10OZ0_ice(I)=LOG((10.+ZNTstoch_ice(I))/ZNTstoch_ice(I)) + GZ10OZt_ice(I)=LOG((10.+ZT_ice(i))/ZT_ice(i)) + zratio_ice(i)=ZNTstoch_ice(I)/ZT_ice(I) !need estimate for Li et al. + + ENDIF !end ice point + + !Capture a representative ZNT + IF (dry(i)) THEN + ZNT(i)=ZNTstoch_lnd(I) + ELSEIF (wet(i)) THEN + ZNT(i)=ZNTstoch_ocn(I) + ELSEIF (icy(i)) THEN + ZNT(i)=ZNTstoch_ice(I) + ENDIF + + !-------------------------------------------------------------------- + !--- DIAGNOSE STABILITY FUNCTIONS FOR THE APPROPRIATE STABILITY CLASS: + ! THE STABILITY CLASSES ARE DETERMINED BY THE BULK RICHARDSON NUMBER. + !-------------------------------------------------------------------- + + IF (wet(i)) THEN + IF (rb_ocn(I) .GT. 0.0) THEN + + !COMPUTE z/L first guess: + IF (itimestep .LE. 1) THEN + CALL Li_etal_2010(ZOL(I),rb_ocn(I),ZA(I)/ZNTstoch_ocn(I),zratio_ocn(I)) + ELSE + ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST_ocn(I)*UST_ocn(I),0.0001)) + ZOL(I)=MAX(ZOL(I),0.0) + ZOL(I)=MIN(ZOL(I),50.) + ENDIF - !-------------------------------------- - !GET z_t and z_q - !-------------------------------------- - !CHECK FOR SNOW/ICE POINTS OVER LAND - !IF ( ZNTSTOCH(i) .LE. SNOWZ0 .AND. TSK(I) .LE. 273.15 ) THEN - IF ( SNOWH(i) .GE. 0.1) THEN - CALL Andreas_2002(ZNTSTOCH(i),visc,ust(i),z_t(i),z_q(i)) + IF (debug_code >= 1) THEN + IF (ZNTstoch_ocn(i) < 1E-8 .OR. Zt_ocn(i) < 1E-10) THEN + write(0,*)"===(wet) capture bad input in mynn sfc layer, i=:",i + write(0,*)"rb=", rb_ocn(I)," ZNT=", ZNTstoch_ocn(i)," ZT=",Zt_ocn(i) + write(0,*)" tsk=", tskin_ocn(i)," prev z/L=",ZOL(I),& + " tsurf=", tsurf_ocn(i)," qsfc=", qsfc_ocn(i)," znt=", znt_ocn(i),& + " ust=", ust_ocn(i)," snowh=", snowh_ocn(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + ENDIF + !Use Pedros iterative function to find z/L + zol(I)=zolri(rb_ocn(I),ZA(I),ZNTstoch_ocn(I),ZT_ocn(I),ZOL(I)) + ZOL(I)=MAX(ZOL(I),0.0) + ZOL(I)=MIN(ZOL(I),50.) + + zolz0 = zol(I)*ZNTstoch_ocn(I)/ZA(I) ! z0/L + zolza = zol(I)*(za(I)+ZNTstoch_ocn(I))/za(I) ! (z+z0/L + zol10 = zol(I)*(10.+ZNTstoch_ocn(I))/za(I) ! (10+z0)/L + zol2 = zol(I)*(2.+ZNTstoch_ocn(I))/za(I) ! (2+z0)/L + + !COMPUTE PSIM and PSIH + !CALL PSI_Suselj_Sood_2010(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_Beljaars_Holtslag_1991(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),ZT_ocn(I),ZNTstoch_ocn(I),ZA(I)) + !CALL PSI_CB2005(PSIM(I),PSIH(I),zolza,zolz0) + ! or use tables + psim(I)=psim_stable(zolza)-psim_stable(zolz0) + psih(I)=psih_stable(zolza)-psih_stable(zolz0) + psim10(I)=psim_stable(zol10)-psim_stable(zolz0) + psih10(I)=psih_stable(zol10)-psih_stable(zolz0) + psih2(I)=psih_stable(zol2)-psih_stable(zolz0) + + ! 1.0 over Monin-Obukhov length + RMOL(I)= ZOL(I)/ZA(I) + + ELSEIF(rb_ocn(I) .EQ. 0.) THEN + !========================================================= + !-----CLASS 3; FORCED CONVECTION/NEUTRAL: + !========================================================= + + PSIM(I)=0.0 + PSIH(I)=PSIM(I) + PSIM10(I)=0. + PSIH10(I)=0. + PSIH2(I)=0. + + ZOL(I) =0. + RMOL(I) =0. + + ELSEIF(rb_ocn(I) .LT. 0.)THEN + !========================================================== + !-----CLASS 4; FREE CONVECTION: + !========================================================== + + !COMPUTE z/L first guess: + IF (itimestep .LE. 1) THEN + CALL Li_etal_2010(ZOL(I),rb_ocn(I),ZA(I)/ZNTstoch_ocn(I),zratio_ocn(I)) ELSE - IF ( PRESENT(IZ0TLND) ) THEN - IF ( IZ0TLND .LE. 1 .OR. IZ0TLND .EQ. 4) THEN - !IF IZ0TLND==4, THEN PSIQ WILL BE RECALCULATED USING - !PAN ET AL (1994), but PSIT FROM ZILI WILL BE USED. - CALL zilitinkevich_1995(ZNTSTOCH(i),z_t(i),z_q(i),restar,& - UST(I),KARMAN,XLAND(I),IZ0TLND,spp_pbl,rstoch1D(i)) - ELSEIF ( IZ0TLND .EQ. 2 ) THEN - CALL Yang_2008(ZNTSTOCH(i),z_t(i),z_q(i),UST(i),MOL(I),& - qstar(I),restar,visc,XLAND(I)) - ELSEIF ( IZ0TLND .EQ. 3 ) THEN - !Original MYNN in WRF-ARW used this form: - CALL garratt_1992(z_t(i),z_q(i),ZNTSTOCH(i),restar,XLAND(I)) - ENDIF - ELSE - !DEFAULT TO ZILITINKEVICH - CALL zilitinkevich_1995(ZNTSTOCH(i),z_t(i),z_q(i),restar,& - UST(I),KARMAN,XLAND(I),0,spp_pbl,rstoch1D(i)) - ENDIF + ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST_ocn(I)*UST_ocn(I),0.001)) + ZOL(I)=MAX(ZOL(I),-50.0) + ZOL(I)=MIN(ZOL(I),0.0) ENDIF + IF (debug_code >= 1) THEN + IF (ZNTstoch_ocn(i) < 1E-8 .OR. Zt_ocn(i) < 1E-10) THEN + write(0,*)"===(wet) capture bad input in mynn sfc layer, i=:",i + write(0,*)"rb=", rb_ocn(I)," ZNT=", ZNTstoch_ocn(i)," ZT=",Zt_ocn(i) + write(0,*)" tsk=", tskin_ocn(i)," wstar=",wstar(i)," prev z/L=",ZOL(I),& + " tsurf=", tsurf_ocn(i)," qsfc=", qsfc_ocn(i)," znt=", znt_ocn(i),& + " ust=", ust_ocn(i)," snowh=", snowh_ocn(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + ENDIF + !Use Pedros iterative function to find z/L + zol(I)=zolri(rb_ocn(I),ZA(I),ZNTstoch_ocn(I),ZT_ocn(I),ZOL(I)) + ZOL(I)=MAX(ZOL(I),-50.0) + ZOL(I)=MIN(ZOL(I),0.0) + + zolz0 = zol(I)*ZNTstoch_ocn(I)/ZA(I) ! z0/L + zolza = zol(I)*(za(I)+ZNTstoch_ocn(I))/za(I) ! (z+z0/L + zol10 = zol(I)*(10.+ZNTstoch_ocn(I))/za(I) ! (10+z0)/L + zol2 = zol(I)*(2.+ZNTstoch_ocn(I))/za(I) ! (2+z0)/L + + !COMPUTE PSIM and PSIH + !CALL PSI_Suselj_Sood_2010(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_Hogstrom_1996(PSIM(I),PSIH(I),ZOL(I), ZT_ocn(I), ZNTstoch_ocn(I), ZA(I)) + !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),ZT_ocn(I),ZNTstoch_ocn(I),ZA(I)) + ! use tables + psim(I)=psim_unstable(zolza)-psim_unstable(zolz0) + psih(I)=psih_unstable(zolza)-psih_unstable(zolz0) + psim10(I)=psim_unstable(zol10)-psim_unstable(zolz0) + psih10(I)=psih_unstable(zol10)-psih_unstable(zolz0) + psih2(I)=psih_unstable(zol2)-psih_unstable(zolz0) + + !---LIMIT PSIH AND PSIM IN THE CASE OF THIN LAYERS AND + !---HIGH ROUGHNESS. THIS PREVENTS DENOMINATOR IN FLUXES + !---FROM GETTING TOO SMALL + PSIH(I)=MIN(PSIH(I),0.9*GZ1OZt_ocn(I)) + PSIM(I)=MIN(PSIM(I),0.9*GZ1OZ0_ocn(I)) + PSIH2(I)=MIN(PSIH2(I),0.9*GZ2OZt_ocn(I)) + PSIM10(I)=MIN(PSIM10(I),0.9*GZ10OZ0_ocn(I)) + PSIH10(I)=MIN(PSIH10(I),0.9*GZ10OZt_ocn(I)) + + RMOL(I) = ZOL(I)/ZA(I) + ENDIF - zratio(i)=zntstoch(i)/z_t(i) - - !ADD RESISTANCE (SOMEWHAT FOLLOWING JIMENEZ ET AL. (2012)) TO PROTECT AGAINST - !EXCESSIVE FLUXES WHEN USING A LOW FIRST MODEL LEVEL (ZA < 10 m). - !Formerly: GZ1OZ0(I)= LOG(ZA(I)/ZNTstoch(I)) - GZ1OZ0(I)= LOG((ZA(I)+ZNTstoch(I))/ZNTstoch(I)) - GZ1OZt(I)= LOG((ZA(I)+z_t(i))/z_t(i)) - GZ2OZ0(I)= LOG((2.0+ZNTstoch(I))/ZNTstoch(I)) - GZ2OZt(I)= LOG((2.0+z_t(i))/z_t(i)) - GZ10OZ0(I)=LOG((10.+ZNTstoch(I))/ZNTstoch(I)) - GZ10OZt(I)=LOG((10.+z_t(i))/z_t(i)) - - !-------------------------------------------------------------------- - !--- DIAGNOSE BASIC PARAMETERS FOR THE APPROPRIATE STABILITY CLASS: - ! - ! THE STABILITY CLASSES ARE DETERMINED BY BR (BULK RICHARDSON NO.). - ! - ! CRITERIA FOR THE CLASSES ARE AS FOLLOWS: - ! - ! 1. BR .GE. 0.2; - ! REPRESENTS NIGHTTIME STABLE CONDITIONS (REGIME=1), - ! - ! 2. BR .LT. 0.2 .AND. BR .GT. 0.0; - ! REPRESENTS DAMPED MECHANICAL TURBULENT CONDITIONS - ! (REGIME=2), - ! - ! 3. BR .EQ. 0.0 - ! REPRESENTS FORCED CONVECTION CONDITIONS (REGIME=3), - ! - ! 4. BR .LT. 0.0 - ! REPRESENTS FREE CONVECTION CONDITIONS (REGIME=4). - ! - !-------------------------------------------------------------------- - IF (BR(I) .GT. 0.0) THEN - IF (BR(I) .GT. 0.2) THEN - !---CLASS 1; STABLE (NIGHTTIME) CONDITIONS: - REGIME(I)=1. - ELSE - !---CLASS 2; DAMPED MECHANICAL TURBULENCE: - REGIME(I)=2. - ENDIF - !COMPUTE z/L - !CALL Li_etal_2010(ZOL(I),BR(I),ZA(I)/ZNTstoch(I),zratio(I)) -! IF (ITER .EQ. 1 .AND. itimestep .LE. 1) THEN - CALL Li_etal_2010(ZOL(I),BR(I),ZA(I)/ZNTstoch(I),zratio(I)) -! ELSE -! ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST(I)*UST(I),0.0001)) -! ZOL(I)=MAX(ZOL(I),0.0) -! ZOL(I)=MIN(ZOL(I),2.) -! ENDIF - - !COMPUTE PSIM and PSIH - IF((XLAND(I)-1.5).GE.0)THEN - ! WATER - !CALL PSI_Suselj_Sood_2010(PSIM(I),PSIH(I),ZOL(I)) - !CALL PSI_Beljaars_Holtslag_1991(PSIM(I),PSIH(I),ZOL(I)) - !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) - CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),z_t(I),ZNTstoch(I),ZA(I)) - ELSE - ! LAND - !CALL PSI_Beljaars_Holtslag_1991(PSIM(I),PSIH(I),ZOL(I)) - !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) - !CALL PSI_Zilitinkevich_Esau_2007(PSIM(I),PSIH(I),ZOL(I)) - CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),z_t(I),ZNTstoch(I),ZA(I)) - ENDIF - - ! LOWER LIMIT ON PSI IN STABLE CONDITIONS - PSIM(I)=MAX(PSIM(I),psilim) - PSIH(I)=MAX(PSIH(I),psilim) - PSIM10(I)=MAX(10./ZA(I)*PSIM(I), psilim) - PSIH10(I)=MAX(10./ZA(I)*PSIH(I), psilim) - PSIM2(I)=MAX(2./ZA(I)*PSIM(I), psilim) - PSIH2(I)=MAX(2./ZA(I)*PSIH(I), psilim) - ! 1.0 over Monin-Obukhov length - RMOL(I)= ZOL(I)/ZA(I) - - ELSEIF(BR(I) .EQ. 0.) THEN - !========================================================= - !-----CLASS 3; FORCED CONVECTION/NEUTRAL: - !========================================================= - REGIME(I)=3. - - PSIM(I)=0.0 - PSIH(I)=PSIM(I) - PSIM10(I)=0. - PSIH10(I)=PSIM10(I) - PSIM2(I)=0. - PSIH2(I)=PSIM2(I) - - !ZOL(I)=0. - IF(UST(I) .LT. 0.01)THEN - ZOL(I)=BR(I)*GZ1OZ0(I) - ELSE - ZOL(I)=KARMAN*GOVRTH(I)*ZA(I)*MOL(I)/(MAX(UST(I)*UST(I),0.001)) - ENDIF - RMOL(I) = ZOL(I)/ZA(I) - - ELSEIF(BR(I) .LT. 0.)THEN - !========================================================== - !-----CLASS 4; FREE CONVECTION: - !========================================================== - REGIME(I)=4. - - !COMPUTE z/L - !CALL Li_etal_2010(ZOL(I),BR(I),ZA(I)/ZNTstoch(I),zratio(I)) - !IF (ITER .EQ. 1 .AND. itimestep .LE. 1) THEN - CALL Li_etal_2010(ZOL(I),BR(I),ZA(I)/ZNTstoch(I),zratio(I)) - !ELSE - ! ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST(I)*UST(I),0.001)) - ! ZOL(I)=MAX(ZOL(I),-19.999) - ! ZOL(I)=MIN(ZOL(I),0.0) - !ENDIF - - ZOL10=10./ZA(I)*ZOL(I) - ZOL2=2./ZA(I)*ZOL(I) - ZOL(I)=MIN(ZOL(I),0.) - ZOL(I)=MAX(ZOL(I),-19.9999) - ZOL10=MIN(ZOL10,0.) - ZOL10=MAX(ZOL10,-19.9999) - ZOL2=MIN(ZOL2,0.) - ZOL2=MAX(ZOL2,-19.9999) - NZOL=INT(-ZOL(I)*100.) - RZOL=-ZOL(I)*100.-NZOL - NZOL10=INT(-ZOL10*100.) - RZOL10=-ZOL10*100.-NZOL10 - NZOL2=INT(-ZOL2*100.) - RZOL2=-ZOL2*100.-NZOL2 - - !COMPUTE PSIM and PSIH - IF((XLAND(I)-1.5).GE.0)THEN - ! WATER - !CALL PSI_Suselj_Sood_2010(PSIM(I),PSIH(I),ZOL(I)) - !CALL PSI_Hogstrom_1996(PSIM(I),PSIH(I),ZOL(I), z_t(I), ZNTstoch(I), ZA(I)) - !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) - CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),z_t(I),ZNTstoch(I),ZA(I)) - ELSE - ! LAND - !CALL PSI_Hogstrom_1996(PSIM(I),PSIH(I),ZOL(I), z_t(I), ZNTstoch(I), ZA(I)) - !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) - CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),z_t(I),ZNTstoch(I),ZA(I)) - ENDIF - - PSIM10(I)=10./ZA(I)*PSIM(I) - PSIH10(I)=10./ZA(I)*PSIH(I) - PSIM2(I)=2./ZA(I)*PSIM(I) - PSIH2(I)=2./ZA(I)*PSIH(I) - - !---LIMIT PSIH AND PSIM IN THE CASE OF THIN LAYERS AND - !---HIGH ROUGHNESS. THIS PREVENTS DENOMINATOR IN FLUXES - !---FROM GETTING TOO SMALL - !PSIH(I)=MIN(PSIH(I),0.9*GZ1OZt(I)) !JOE: less restricitive over forest/urban. - PSIH(I)=MIN(PSIH(I),0.9*GZ1OZ0(I)) - PSIM(I)=MIN(PSIM(I),0.9*GZ1OZ0(I)) - !PSIH2(I)=MIN(PSIH2(I),0.9*GZ2OZt(I)) !JOE: less restricitive over forest/urban. - PSIH2(I)=MIN(PSIH2(I),0.9*GZ2OZ0(I)) - PSIM2(I)=MIN(PSIM2(I),0.9*GZ2OZ0(I)) - PSIM10(I)=MIN(PSIM10(I),0.9*GZ10OZ0(I)) - PSIH10(I)=MIN(PSIH10(I),0.9*GZ10OZ0(I)) - - RMOL(I) = ZOL(I)/ZA(I) - - ENDIF - - !------------------------------------------------------------ - !-----COMPUTE THE FRICTIONAL VELOCITY: - !------------------------------------------------------------ - ! ZA(1982) EQS(2.60),(2.61). - PSIX(I)=GZ1OZ0(I)-PSIM(I) - PSIX10(I)=GZ10OZ0(I)-PSIM10(I) - ! TO PREVENT OSCILLATIONS AVERAGE WITH OLD VALUE - OLDUST = UST(I) - UST(I)=0.5*UST(I)+0.5*KARMAN*WSPD(I)/PSIX(I) - !NON-AVERAGED: UST(I)=KARMAN*WSPD(I)/PSIX(I) - - ! Compute u* without vconv for use in HFX calc when isftcflx > 0 - WSPDI(I)=MAX(SQRT(U1D(I)*U1D(I)+V1D(I)*V1D(I)), wmin) - IF ( PRESENT(USTM) ) THEN - USTM(I)=0.5*USTM(I)+0.5*KARMAN*WSPDI(I)/PSIX(I) - ENDIF + ! CALCULATE THE RESISTANCE: + PSIX_ocn(I) =MAX(GZ1OZ0_ocn(I)-PSIM(I) , 1.0) ! = fm + PSIX10_ocn(I)=MAX(GZ10OZ0_ocn(I)-PSIM10(I), 1.0) ! = fm10 + PSIT_ocn(I) =MAX(GZ1OZt_ocn(I)-PSIH(I) , 1.0) ! = fh + PSIT2_ocn(I) =MAX(GZ2OZt_ocn(I)-PSIH2(I) , 1.0) ! = fh2 + PSIQ_ocn(I) =MAX(LOG((ZA(I)+ZQ_ocn(i))/ZQ_ocn(I))-PSIH(I) ,1.0) + PSIQ2_ocn(I) =MAX(LOG((2.0+ZQ_ocn(i))/ZQ_ocn(I))-PSIH2(I) ,1.0) - IF ((XLAND(I)-1.5).LT.0.) THEN !LAND - UST(I)=MAX(UST(I),0.005) !Further relaxing this limit - no need to go lower - !Keep ustm = ust over land. - IF ( PRESENT(USTM) ) USTM(I)=UST(I) - ENDIF + ENDIF ! end water points - !------------------------------------------------------------ - !-----COMPUTE THE THERMAL AND MOISTURE RESISTANCE (PSIQ AND PSIT): - !------------------------------------------------------------ - ! LOWER LIMIT ADDED TO PREVENT LARGE FLHC IN SOIL MODEL - ! ACTIVATES IN UNSTABLE CONDITIONS WITH THIN LAYERS OR HIGH Z0 - GZ1OZt(I)= LOG((ZA(I)+z_t(i))/z_t(i)) - GZ2OZt(I)= LOG((2.0+z_t(i))/z_t(i)) - - PSIT(I) =MAX(GZ1OZt(I)-PSIH(I) ,1.) - PSIT2(I)=MAX(GZ2OZt(I)-PSIH2(I),1.) - resist(I)=PSIT(I) - logres(I)=GZ1OZt(I) - - PSIQ=MAX(LOG((ZA(I)+z_q(i))/z_q(I))-PSIH(I) ,1.0) - PSIQ2=MAX(LOG((2.0+z_q(i))/z_q(I))-PSIH2(I) ,1.0) - - IF((XLAND(I)-1.5).LT.0)THEN !Land only - IF ( IZ0TLND .EQ. 4 ) THEN - CALL Pan_etal_1994(PSIQ,PSIQ2,UST(I),PSIH(I),PSIH2(I),& - & KARMAN,ZA(I)) - ENDIF - ENDIF + IF (dry(i)) THEN + IF (rb_lnd(I) .GT. 0.0) THEN - !---------------------------------------------------- - !COMPUTE THE TEMPERATURE SCALE (or FRICTION TEMPERATURE, T*) - !---------------------------------------------------- - !DTG=TH1D(I)-THGB(I) !SWITCH TO THETA-V - DTG=THV1D(I)-THVGB(I) - OLDTST=MOL(I) - MOL(I)=KARMAN*DTG/PSIT(I)/PRT - !t_star(I) = -HFX(I)/(UST(I)*CPM(I)*RHO1D(I)) - !t_star(I) = MOL(I) - !---------------------------------------------------- - !COMPUTE THE MOISTURE SCALE (or q*) - DQG=(QVSH(i)-qsfc(i))*1000. !(kg/kg -> g/kg) - qstar(I)=KARMAN*DQG/PSIQ/PRT - - !CHECK FOR CONVERGENCE - IF (ITER .GE. 2) THEN - !IF (ABS(OLDUST-UST(I)) .lt. 0.01) THEN - IF (ABS(OLDTST-MOL(I)) .lt. 0.01) THEN - ITER = ITER+ITMAX - ENDIF + !COMPUTE z/L first guess: + IF (itimestep .LE. 1) THEN + CALL Li_etal_2010(ZOL(I),rb_lnd(I),ZA(I)/ZNTstoch_lnd(I),zratio_lnd(I)) + ELSE + ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST_lnd(I)*UST_lnd(I),0.0001)) + ZOL(I)=MAX(ZOL(I),0.0) + ZOL(I)=MIN(ZOL(I),50.) + ENDIF - !IF () THEN - ! print*,"ITER:",ITER - ! write(*,1001)"REGIME:",REGIME(I)," z/L:",ZOL(I)," U*:",UST(I)," Tstar:",MOL(I) - ! write(*,1002)"PSIM:",PSIM(I)," PSIH:",PSIH(I)," W*:",WSTAR(I)," DTHV:",THV1D(I)-THVGB(I) - ! write(*,1003)"CPM:",CPM(I)," RHO1D:",RHO1D(I)," L:",ZOL(I)/ZA(I)," DTH:",TH1D(I)-THGB(I) - ! write(*,1004)"Z0/Zt:",zratio(I)," Z0:",ZNTstoch(I)," Zt:",z_t(I)," za:",za(I) - ! write(*,1005)"Re:",restar," MAVAIL:",MAVAIL(I)," QSFC(I):",QSFC(I)," QVSH(I):",QVSH(I) - ! print*,"VISC=",VISC," Z0:",ZNTstoch(I)," T1D(i):",T1D(i) - ! write(*,*)"=============================================" - !ENDIF - ENDIF + IF (debug_code >= 1) THEN + IF (ZNTstoch_lnd(i) < 1E-8 .OR. Zt_lnd(i) < 1E-10) THEN + write(0,*)"===(land) capture bad input in mynn sfc layer, i=:",i + write(0,*)"rb=", rb_lnd(I)," ZNT=", ZNTstoch_lnd(i)," ZT=",Zt_lnd(i) + write(0,*)" tsk=", tskin_lnd(i)," prev z/L=",ZOL(I),& + " tsurf=", tsurf_lnd(i)," qsfc=", qsfc_lnd(i)," znt=", znt_lnd(i),& + " ust=", ust_lnd(i)," snowh=", snowh_lnd(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + ENDIF + !Use Pedros iterative function to find z/L + zol(I)=zolri(rb_lnd(I),ZA(I),ZNTstoch_lnd(I),ZT_lnd(I),ZOL(I)) + ZOL(I)=MAX(ZOL(I),0.0) + ZOL(I)=MIN(ZOL(I),50.) + + zolz0 = zol(I)*ZNTstoch_lnd(I)/ZA(I) ! z0/L + zolza = zol(I)*(za(I)+ZNTstoch_lnd(I))/za(I) ! (z+z0/L + zol10 = zol(I)*(10.+ZNTstoch_lnd(I))/za(I) ! (10+z0)/L + zol2 = zol(I)*(2.+ZNTstoch_lnd(I))/za(I) ! (2+z0)/L + + !COMPUTE PSIM and PSIH + !CALL PSI_Beljaars_Holtslag_1991(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_Zilitinkevich_Esau_2007(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),ZT_lnd(I),ZNTstoch_lnd(I),ZA(I)) + !CALL PSI_CB2005(PSIM(I),PSIH(I),zolza,zolz0) + psim(I)=psim_stable(zolza)-psim_stable(zolz0) + psih(I)=psih_stable(zolza)-psih_stable(zolz0) + psim10(I)=psim_stable(zol10)-psim_stable(zolz0) + psih10(I)=psih_stable(zol10)-psih_stable(zolz0) + psih2(I)=psih_stable(zol2)-psih_stable(zolz0) + + ! 1.0 over Monin-Obukhov length + RMOL(I)= ZOL(I)/ZA(I) + + ELSEIF(rb_lnd(I) .EQ. 0.) THEN + !========================================================= + !-----CLASS 3; FORCED CONVECTION/NEUTRAL: + !========================================================= + + PSIM(I)=0.0 + PSIH(I)=PSIM(I) + PSIM10(I)=0. + PSIH10(I)=0. + PSIH2(I)=0. + + ZOL(I) =0. + RMOL(I) =0. + + ELSEIF(rb_lnd(I) .LT. 0.)THEN + !========================================================== + !-----CLASS 4; FREE CONVECTION: + !========================================================== + + !COMPUTE z/L first guess: + IF (itimestep .LE. 1) THEN + CALL Li_etal_2010(ZOL(I),rb_lnd(I),ZA(I)/ZNTstoch_lnd(I),zratio_lnd(I)) + ELSE + ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST_lnd(I)*UST_lnd(I),0.001)) + ZOL(I)=MAX(ZOL(I),-50.0) + ZOL(I)=MIN(ZOL(I),0.0) + ENDIF - ITER = ITER + 1 + IF (debug_code >= 1) THEN + IF (ZNTstoch_lnd(i) < 1E-8 .OR. Zt_lnd(i) < 1E-10) THEN + write(0,*)"===(land) capture bad input in mynn sfc layer, i=:",i + write(0,*)"rb=", rb_lnd(I)," ZNT=", ZNTstoch_lnd(i)," ZT=",Zt_lnd(i) + write(0,*)" tsk=", tskin_lnd(i)," wstar=",wstar(i)," prev z/L=",ZOL(I),& + " tsurf=", tsurf_lnd(i)," qsfc=", qsfc_lnd(i)," znt=", znt_lnd(i),& + " ust=", ust_lnd(i)," snowh=", snowh_lnd(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + ENDIF + !Use Pedros iterative function to find z/L + zol(I)=zolri(rb_lnd(I),ZA(I),ZNTstoch_lnd(I),ZT_lnd(I),ZOL(I)) + ZOL(I)=MAX(ZOL(I),-50.0) + ZOL(I)=MIN(ZOL(I),0.0) + + zolz0 = zol(I)*ZNTstoch_lnd(I)/ZA(I) ! z0/L + zolza = zol(I)*(za(I)+ZNTstoch_lnd(I))/za(I) ! (z+z0/L + zol10 = zol(I)*(10.+ZNTstoch_lnd(I))/za(I) ! (10+z0)/L + zol2 = zol(I)*(2.+ZNTstoch_lnd(I))/za(I) ! (2+z0)/L + + !COMPUTE PSIM and PSIH + !CALL PSI_Hogstrom_1996(PSIM(I),PSIH(I),ZOL(I), ZT_lnd(I), ZNTstoch_lnd(I), ZA(I)) + !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),ZT_lnd(I),ZNTstoch_lnd(I),ZA(I)) + ! use tables + psim(I)=psim_unstable(zolza)-psim_unstable(zolz0) + psih(I)=psih_unstable(zolza)-psih_unstable(zolz0) + psim10(I)=psim_unstable(zol10)-psim_unstable(zolz0) + psih10(I)=psih_unstable(zol10)-psih_unstable(zolz0) + psih2(I)=psih_unstable(zol2)-psih_unstable(zolz0) + + !---LIMIT PSIH AND PSIM IN THE CASE OF THIN LAYERS AND + !---HIGH ROUGHNESS. THIS PREVENTS DENOMINATOR IN FLUXES + !---FROM GETTING TOO SMALL + PSIH(I)=MIN(PSIH(I),0.9*GZ1OZt_lnd(I)) + PSIM(I)=MIN(PSIM(I),0.9*GZ1OZ0_lnd(I)) + PSIH2(I)=MIN(PSIH2(I),0.9*GZ2OZt_lnd(I)) + PSIM10(I)=MIN(PSIM10(I),0.9*GZ10OZ0_lnd(I)) + PSIH10(I)=MIN(PSIH10(I),0.9*GZ10OZt_lnd(I)) + + RMOL(I) = ZOL(I)/ZA(I) - ENDDO ! end ITERATION-loop + ENDIF - ENDDO ! end i-loop + ! CALCULATE THE RESISTANCE: + PSIX_lnd(I) =MAX(GZ1OZ0_lnd(I)-PSIM(I), 1.0) + PSIX10_lnd(I)=MAX(GZ10OZ0_lnd(I)-PSIM10(I), 1.0) + PSIT_lnd(I) =MAX(GZ1OZt_lnd(I)-PSIH(I) , 1.0) + PSIT2_lnd(I) =MAX(GZ2OZt_lnd(I)-PSIH2(I), 1.0) + PSIQ_lnd(I) =MAX(LOG((ZA(I)+ZQ_lnd(i))/ZQ_lnd(I))-PSIH(I) ,1.0) + PSIQ2_lnd(I) =MAX(LOG((2.0+ZQ_lnd(i))/ZQ_lnd(I))-PSIH2(I) ,1.0) - 1000 format(A,F6.1, A,f6.1, A,f5.1, A,f7.1) - 1001 format(A,F2.0, A,f10.4,A,f5.3, A,f11.5) - 1002 format(A,f7.2, A,f7.2, A,f7.2, A,f10.3) - 1003 format(A,f7.2, A,f7.2, A,f10.3,A,f10.3) - 1004 format(A,f11.3,A,f9.7, A,f9.7, A,f6.2, A,f10.3) - 1005 format(A,f9.2,A,f6.4,A,f7.4,A,f7.4) + ENDIF ! end land points - !---------------------------------------------------------- - ! COMPUTE SURFACE HEAT AND MOISTURE FLUXES - !---------------------------------------------------------- - DO I=its,ite + IF (icy(i)) THEN + IF (rb_ice(I) .GT. 0.0) THEN - !For computing the diagnostics and fluxes (below), whether the fluxes - !are turned off or on, we need the following: - PSIX(I)=GZ1OZ0(I)-PSIM(I) - PSIX10(I)=GZ10OZ0(I)-PSIM10(I) + !COMPUTE z/L first guess: + IF (itimestep .LE. 1) THEN + CALL Li_etal_2010(ZOL(I),rb_ice(I),ZA(I)/ZNTstoch_ice(I),zratio_ice(I)) + ELSE + ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST_ice(I)*UST_ice(I),0.0001)) + ZOL(I)=MAX(ZOL(I),0.0) + ZOL(I)=MIN(ZOL(I),50.) + ENDIF - PSIT(I) =MAX(GZ1OZt(I)-PSIH(I), 1.0) - PSIT2(I)=MAX(GZ2OZt(I)-PSIH2(I),1.0) - PSIT10=MAX(GZ10OZ0(I)-PSIH10(I), 1.0) - - PSIQ=MAX(LOG((ZA(I)+z_q(i))/z_q(I))-PSIH(I) ,1.0) - PSIQ2=MAX(LOG((2.0+z_q(i))/z_q(I))-PSIH2(I) ,1.0) - PSIQ10=MAX(GZ10OZ0(I)-PSIH10(I),1.0) + IF (debug_code >= 1) THEN + IF (ZNTstoch_ice(i) < 1E-8 .OR. Zt_ice(i) < 1E-10) THEN + write(0,*)"===(ice) capture bad input in mynn sfc layer, i=:",i + write(0,*)"rb=", rb_ice(I)," ZNT=", ZNTstoch_ice(i)," ZT=",Zt_ice(i) + write(0,*)" tsk=", tskin_ice(i)," prev z/L=",ZOL(I),& + " tsurf=", tsurf_ice(i)," qsfc=", qsfc_ice(i)," znt=", znt_ice(i),& + " ust=", ust_ice(i)," snowh=", snowh_ice(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + ENDIF + !Use Pedros iterative function to find z/L + zol(I)=zolri(rb_ice(I),ZA(I),ZNTstoch_ice(I),ZT_ice(I),ZOL(I)) + ZOL(I)=MAX(ZOL(I),0.0) + ZOL(I)=MIN(ZOL(I),50.) + + zolz0 = zol(I)*ZNTstoch_ice(I)/ZA(I) ! z0/L + zolza = zol(I)*(za(I)+ZNTstoch_ice(I))/za(I) ! (z+z0/L + zol10 = zol(I)*(10.+ZNTstoch_ice(I))/za(I) ! (10+z0)/L + zol2 = zol(I)*(2.+ZNTstoch_ice(I))/za(I) ! (2+z0)/L + + !COMPUTE PSIM and PSIH + !CALL PSI_Beljaars_Holtslag_1991(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_Zilitinkevich_Esau_2007(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),ZT_ice(I),ZNTstoch_ice(I),ZA(I)) + !CALL PSI_CB2005(PSIM(I),PSIH(I),zolza,zolz0) + psim(I)=psim_stable(zolza)-psim_stable(zolz0) + psih(I)=psih_stable(zolza)-psih_stable(zolz0) + psim10(I)=psim_stable(zol10)-psim_stable(zolz0) + psih10(I)=psih_stable(zol10)-psih_stable(zolz0) + psih2(I)=psih_stable(zol2)-psih_stable(zolz0) + + ! 1.0 over Monin-Obukhov length + RMOL(I)= ZOL(I)/ZA(I) + + ELSEIF(rb_ice(I) .EQ. 0.) THEN + !========================================================= + !-----CLASS 3; FORCED CONVECTION/NEUTRAL: + !========================================================= + + PSIM(I)=0.0 + PSIH(I)=PSIM(I) + PSIM10(I)=0. + PSIH10(I)=0. + PSIH2(I)=0. + + ZOL(I) =0. + RMOL(I) =0. + + ELSEIF(rb_ice(I) .LT. 0.)THEN + !========================================================== + !-----CLASS 4; FREE CONVECTION: + !========================================================== + + !COMPUTE z/L first guess: + IF (itimestep .LE. 1) THEN + CALL Li_etal_2010(ZOL(I),rb_ice(I),ZA(I)/ZNTstoch_ice(I),zratio_ice(I)) + ELSE + ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST_ice(I)*UST_ice(I),0.001)) + ZOL(I)=MAX(ZOL(I),-50.0) + ZOL(I)=MIN(ZOL(I),0.0) + ENDIF + + IF (debug_code >= 1) THEN + IF (ZNTstoch_ice(i) < 1E-8 .OR. Zt_ice(i) < 1E-10) THEN + write(0,*)"===(ice) capture bad input in mynn sfc layer, i=:",i + write(0,*)"rb=", rb_ice(I)," ZNT=", ZNTstoch_ice(i)," ZT=",Zt_ice(i) + write(0,*)" tsk=", tskin_ice(i)," wstar=",wstar(i)," prev z/L=",ZOL(I),& + " tsurf=", tsurf_ice(i)," qsfc=", qsfc_ice(i)," znt=", znt_ice(i),& + " ust=", ust_ice(i)," snowh=", snowh_ice(i),"psfcpa=",PSFCPA(i), & + " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + ENDIF + ENDIF + !Use Pedros iterative function to find z/L + zol(I)=zolri(rb_ice(I),ZA(I),ZNTstoch_ice(I),ZT_ice(I),ZOL(I)) + ZOL(I)=MAX(ZOL(I),-50.0) + ZOL(I)=MIN(ZOL(I),0.0) + + zolz0 = zol(I)*ZNTstoch_ice(I)/ZA(I) ! z0/L + zolza = zol(I)*(za(I)+ZNTstoch_ice(I))/za(I) ! (z+z0/L + zol10 = zol(I)*(10.+ZNTstoch_ice(I))/za(I) ! (10+z0)/L + zol2 = zol(I)*(2.+ZNTstoch_ice(I))/za(I) ! (2+z0)/L + + !COMPUTE PSIM and PSIH + !CALL PSI_Hogstrom_1996(PSIM(I),PSIH(I),ZOL(I), ZT_ice(I), ZNTstoch_ice(I), ZA(I)) + !CALL PSI_Businger_1971(PSIM(I),PSIH(I),ZOL(I)) + !CALL PSI_DyerHicks(PSIM(I),PSIH(I),ZOL(I),ZT_ice(I),ZNTstoch_ice(I),ZA(I)) + ! use tables + psim(I)=psim_unstable(zolza)-psim_unstable(zolz0) + psih(I)=psih_unstable(zolza)-psih_unstable(zolz0) + psim10(I)=psim_unstable(zol10)-psim_unstable(zolz0) + psih10(I)=psih_unstable(zol10)-psih_unstable(zolz0) + psih2(I)=psih_unstable(zol2)-psih_unstable(zolz0) + + !---LIMIT PSIH AND PSIM IN THE CASE OF THIN LAYERS AND + !---HIGH ROUGHNESS. THIS PREVENTS DENOMINATOR IN FLUXES + !---FROM GETTING TOO SMALL + PSIH(I)=MIN(PSIH(I),0.9*GZ1OZt_ice(I)) + PSIM(I)=MIN(PSIM(I),0.9*GZ1OZ0_ice(I)) + PSIH2(I)=MIN(PSIH2(I),0.9*GZ2OZt_ice(I)) + PSIM10(I)=MIN(PSIM10(I),0.9*GZ10OZ0_ice(I)) + PSIH10(I)=MIN(PSIH10(I),0.9*GZ10OZt_ice(I)) + + RMOL(I) = ZOL(I)/ZA(I) + + ENDIF + + ! CALCULATE THE RESISTANCE: + PSIX_ice(I) =MAX(GZ1OZ0_ice(I)-PSIM(I) , 1.0) + PSIX10_ice(I)=MAX(GZ10OZ0_ice(I)-PSIM10(I), 1.0) + PSIT_ice(I) =MAX(GZ1OZt_ice(I)-PSIH(I) , 1.0) + PSIT2_ice(I) =MAX(GZ2OZt_ice(I)-PSIH2(I) , 1.0) + PSIQ_ice(I) =MAX(LOG((ZA(I)+ZQ_ice(i))/ZQ_ice(I))-PSIH(I) ,1.0) + PSIQ2_ice(I) =MAX(LOG((2.0+ZQ_ice(i))/ZQ_ice(I))-PSIH2(I) ,1.0) + + ENDIF ! end ice points + + !------------------------------------------------------------ + !-----COMPUTE THE FRICTIONAL VELOCITY: + !------------------------------------------------------------ + + IF (wet(I)) THEN + ! TO PREVENT OSCILLATIONS AVERAGE WITH OLD VALUE + OLDUST = UST_ocn(I) + UST_ocn(I)=0.5*UST_ocn(I)+0.5*KARMAN*WSPD(I)/PSIX_ocn(I) + !NON-AVERAGED: + !UST_ocn(I)=KARMAN*WSPD(I)/PSIX_ocn(I) + stress_ocn(i)=ust_ocn(i)**2 + + ! Compute u* without vconv for use in HFX calc when isftcflx > 0 + WSPDI(I)=MAX(SQRT(U1D(I)*U1D(I)+V1D(I)*V1D(I)), wmin) + USTM(I)=0.5*USTM(I)+0.5*KARMAN*WSPDI(I)/PSIX_ocn(I) + + ENDIF ! end water points + + IF (dry(I)) THEN + ! TO PREVENT OSCILLATIONS AVERAGE WITH OLD VALUE + OLDUST = UST_lnd(I) + UST_lnd(I)=0.5*UST_lnd(I)+0.5*KARMAN*WSPD(I)/PSIX_lnd(I) + !NON-AVERAGED: + !UST_lnd(I)=KARMAN*WSPD(I)/PSIX_lnd(I) + !From Tilden Meyers: + !IF (rb_lnd(I) .GE 0.0) THEN + ! ust_lnd(i)=WSPD_lnd*0.1/(1.0 + 10.0*rb_lnd(I)) + !ELSE + ! ust_lnd(i)=WSPD_lnd*0.1*(1.0 - 10.0*rb_lnd(I))**onethird + !ENDIF + UST_lnd(I)=MAX(UST_lnd(I),0.005) + stress_lnd(i)=ust_lnd(i)**2 + + !set ustm = ust over land. + USTM(I)=UST_lnd(I) + ENDIF ! end water points + + IF (icy(I)) THEN + ! TO PREVENT OSCILLATIONS AVERAGE WITH OLD VALUE + OLDUST = UST_ice(I) + UST_ice(I)=0.5*UST_ice(I)+0.5*KARMAN*WSPD(I)/PSIX_ice(I) + !NON-AVERAGED: + !UST_ice(I)=KARMAN*WSPD(I)/PSIX_ice(I) + UST_ice(I)=MAX(UST_ice(I),0.005) + stress_ice(i)=ust_ice(i)**2 + + !Set ustm = ust over ice. + USTM(I)=UST_ice(I) + ENDIF ! end ice points + + !---------------------------------------------------- + !----COMPUTE THE TEMPERATURE SCALE (a.k.a. FRICTION TEMPERATURE, T*, or MOL) + !----AND COMPUTE THE MOISTURE SCALE (or q*) + !---------------------------------------------------- + + IF (wet(I)) THEN + DTG=THV1D(I)-THVSK_ocn(I) + OLDTST=MOL(I) + MOL(I)=KARMAN*DTG/PSIT_ocn(I)/PRT + !t_star(I) = -HFX(I)/(UST(I)*CPM(I)*RHO1D(I)) + !t_star(I) = MOL(I) + !---------------------------------------------------- + DQG=(QVSH(i)-qsfc_ocn(i))*1000. !(kg/kg -> g/kg) + qstar(I)=KARMAN*DQG/PSIQ_ocn(I)/PRT + ENDIF + + IF (dry(I)) THEN + DTG=THV1D(I)-THVSK_lnd(I) + OLDTST=MOL(I) + MOL(I)=KARMAN*DTG/PSIT_lnd(I)/PRT + !t_star(I) = -HFX(I)/(UST(I)*CPM(I)*RHO1D(I)) + !t_star(I) = MOL(I) + !---------------------------------------------------- + DQG=(QVSH(i)-qsfc_lnd(i))*1000. !(kg/kg -> g/kg) + qstar(I)=KARMAN*DQG/PSIQ_lnd(I)/PRT + ENDIF + + IF (icy(I)) THEN + DTG=THV1D(I)-THVSK_ice(I) + OLDTST=MOL(I) + MOL(I)=KARMAN*DTG/PSIT_ice(I)/PRT + !t_star(I) = -HFX(I)/(UST(I)*CPM(I)*RHO1D(I)) + !t_star(I) = MOL(I) + !---------------------------------------------------- + DQG=(QVSH(i)-qsfc_ice(i))*1000. !(kg/kg -> g/kg) + qstar(I)=KARMAN*DQG/PSIQ_ice(I)/PRT + ENDIF + + ENDDO ! end i-loop + + IF (debug_code == 2) THEN + DO I=its,ite + IF(wet(i))write(*,*)"==== AT END OF MAIN LOOP, i=",i, "(wet)" + IF(dry(i))write(*,*)"==== AT END OF MAIN LOOP, i=",i, "(land)" + IF(icy(i))write(*,*)"==== AT END OF MAIN LOOP, i=",i, "(ice)" + write(*,*)"z/L:",ZOL(I)," wspd:",wspd(I)," Tstar:",MOL(I) + IF(wet(i))write(*,*)"PSIM:",PSIM(I)," PSIH:",PSIH(I)," W*:",WSTAR(I),& + " DTHV:",THV1D(I)-THVSK_ocn(I) + IF(dry(i))write(*,*)"PSIM:",PSIM(I)," PSIH:",PSIH(I)," W*:",WSTAR(I),& + " DTHV:",THV1D(I)-THVSK_lnd(I) + IF(icy(i))write(*,*)"PSIM:",PSIM(I)," PSIH:",PSIH(I)," W*:",WSTAR(I),& + " DTHV:",THV1D(I)-THVSK_ice(i) + write(*,*)"CPM:",CPM(I)," RHO1D:",RHO1D(I)," q*:",qstar(I)," T*:",MOL(I) + IF(wet(i))write(*,*)"U*:",UST_ocn(I)," Z0:",ZNTstoch_ocn(I)," Zt:",zt_ocn(I) + IF(dry(i))write(*,*)"U*:",UST_lnd(I)," Z0:",ZNTstoch_lnd(I)," Zt:",zt_lnd(I) + IF(icy(i))write(*,*)"U*:",UST_ice(I)," Z0:",ZNTstoch_ice(I)," Zt:",zt_ice(I) + write(*,*)"hfx:",HFX(I)," MAVAIL:",MAVAIL(I)," QVSH(I):",QVSH(I) + write(*,*)"=============================================" + ENDDO ! end i-loop + ENDIF + + !---------------------------------------------------------- + ! COMPUTE SURFACE HEAT AND MOISTURE FLUXES + !---------------------------------------------------------- + DO I=its,ite - IF (ISFFLX .LT. 1) THEN + IF (ISFFLX .LT. 1) THEN QFX(i) = 0. - HFX(i) = 0. + HFX(i) = 0. + HFLX(i) = 0. FLHC(I) = 0. FLQC(I) = 0. LH(I) = 0. CHS(I) = 0. CH(I) = 0. CHS2(i) = 0. - CQS2(i) = 0. - IF(PRESENT(ck) .and. PRESENT(cd) .and. & - &PRESENT(cka) .and. PRESENT(cda)) THEN - Ck(I) = 0. - Cd(I) = 0. - Cka(I)= 0. - Cda(I)= 0. - ENDIF + CQS2(i) = 0. + ch_ocn(I)= 0. + cm_ocn(I)= 0. + ch_lnd(I)= 0. + cm_lnd(I)= 0. + ch_ice(I)= 0. + cm_ice(I)= 0. + ELSE - IF((XLAND(I)-1.5).LT.0)THEN !LAND Only - IF ( IZ0TLND .EQ. 4 ) THEN - CALL Pan_etal_1994(PSIQ,PSIQ2,UST(I),PSIH(I),PSIH2(I),& - & KARMAN,ZA(I)) + IF (dry(i)) THEN + + !------------------------------------------ + ! CALCULATE THE EXCHANGE COEFFICIENTS FOR HEAT (FLHC) + ! AND MOISTURE (FLQC) + !------------------------------------------ + FLQC(I)=RHO1D(I)*MAVAIL(I)*UST_lnd(I)*KARMAN/PSIQ_lnd(i) + FLHC(I)=RHO1D(I)*CPM(I)*UST_lnd(I)*KARMAN/PSIT_lnd(I) + + IF (compute_flux) THEN + !---------------------------------- + ! COMPUTE SURFACE MOISTURE FLUX: + !---------------------------------- + !QFX(I)=FLQC(I)*(QSFCMR_lnd(I)-QV1D(I)) + QFX(I)=FLQC(I)*(QSFC_lnd(I)-QV1D(I)) + QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX + LH(i)=XLV*QFX(i) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + QFLX_lnd(i)=QFX(i)/RHO1D(i) + QFLX(i)=QFLX_lnd(i) + + !---------------------------------- + ! COMPUTE SURFACE HEAT FLUX: + !---------------------------------- + HFX(I)=FLHC(I)*(THSK_lnd(I)-TH1D(I)) + HFX(I)=MAX(HFX(I),-250.) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + HFLX_lnd(I)=HFX(I)/(RHO1D(I)*cpm(I)) + HFLX(I)=HFLX_lnd(I) ENDIF - ENDIF - !------------------------------------------ - ! CALCULATE THE EXCHANGE COEFFICIENTS FOR HEAT (FLHC) - ! AND MOISTURE (FLQC) - !------------------------------------------ - FLQC(I)=RHO1D(I)*MAVAIL(I)*UST(I)*KARMAN/PSIQ - FLHC(I)=RHO1D(I)*CPM(I)*UST(I)*KARMAN/PSIT(I) - !OLD WAY: - !DTTHX=ABS(TH1D(I)-THGB(I)) - !IF(DTTHX.GT.1.E-5)THEN - ! FLHC(I)=CPM(I)*RHO1D(I)*UST(I)*MOL(I)/(TH1D(I)-THGB(I)) - !ELSE - ! FLHC(I)=0. - !ENDIF - - !---------------------------------- - ! COMPUTE SURFACE MOISTURE FLUX: - !---------------------------------- - QFX(I)=FLQC(I)*(QSFCMR(I)-QV1D(I)) - !JOE: QFX(I)=MAX(QFX(I),0.) !originally did not allow neg QFX - QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX, like MYJ - LH(I)=XLV*QFX(I) - - !---------------------------------- - ! COMPUTE SURFACE HEAT FLUX: - !---------------------------------- - IF(XLAND(I)-1.5.GT.0.)THEN !WATER - HFX(I)=FLHC(I)*(THGB(I)-TH1D(I)) - IF ( PRESENT(ISFTCFLX) ) THEN - IF ( ISFTCFLX.NE.0 ) THEN - ! AHW: add dissipative heating term - HFX(I)=HFX(I)+RHO1D(I)*USTM(I)*USTM(I)*WSPDI(I) + !TRANSFER COEFF FOR SOME LSMs: + !CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) & + ! /XKA+ZA(I)/ZL)-PSIH(I)) + CHS(I)=UST_lnd(I)*KARMAN/PSIT_lnd(I) + + !THESE ARE USED FOR 2-M DIAGNOSTICS ONLY + CQS2(I)=UST_lnd(I)*KARMAN/PSIQ2_lnd(i) + CHS2(I)=UST_lnd(I)*KARMAN/PSIT2_lnd(I) + + QSFC(I)=QSFC_lnd(I) + + ELSEIF (wet(i)) THEN + + !------------------------------------------ + ! CALCULATE THE EXCHANGE COEFFICIENTS FOR HEAT (FLHC) + ! AND MOISTURE (FLQC) + !------------------------------------------ + FLQC(I)=RHO1D(I)*MAVAIL(I)*UST_ocn(I)*KARMAN/PSIQ_ocn(i) + FLHC(I)=RHO1D(I)*CPM(I)*UST_ocn(I)*KARMAN/PSIT_ocn(I) + + IF (compute_flux) THEN + !---------------------------------- + ! COMPUTE SURFACE MOISTURE FLUX: + !---------------------------------- + !QFX(I)=FLQC(I)*(QSFCMR_ocn(I)-QV1D(I)) + QFX(I)=FLQC(I)*(QSFC_ocn(I)-QV1D(I)) + QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX + LH(I)=XLV*QFX(I) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + QFLX_ocn(i)=QFX(i)/RHO1D(i) + QFLX(i)=QFLX_ocn(i) + + !---------------------------------- + ! COMPUTE SURFACE HEAT FLUX: + !---------------------------------- + HFX(I)=FLHC(I)*(THSK_ocn(I)-TH1D(I)) + IF ( PRESENT(ISFTCFLX) ) THEN + IF ( ISFTCFLX.NE.0 ) THEN + ! AHW: add dissipative heating term + HFX(I)=HFX(I)+RHO1D(I)*USTM(I)*USTM(I)*WSPDI(I) + ENDIF ENDIF + ! BWG, 2020-06-17: Mod next 2 lines for fractional + HFLX_ocn(I)=HFX(I)/(RHO1D(I)*cpm(I)) + HFLX(I)=HFLX_ocn(I) ENDIF - ELSEIF(XLAND(I)-1.5.LT.0.)THEN !LAND - HFX(I)=FLHC(I)*(THGB(I)-TH1D(I)) - HFX(I)=MAX(HFX(I),-250.) - ENDIF - !CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) & - ! /XKA+ZA(I)/ZL)-PSIH(I)) + !TRANSFER COEFF FOR SOME LSMs: + !CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) & + ! /XKA+ZA(I)/ZL)-PSIH(I)) + CHS(I)=UST_ocn(I)*KARMAN/PSIT_ocn(I) + + !THESE ARE USED FOR 2-M DIAGNOSTICS ONLY + CQS2(I)=UST_ocn(I)*KARMAN/PSIQ2_ocn(i) + CHS2(I)=UST_ocn(I)*KARMAN/PSIT2_ocn(I) + + QSFC(I)=QSFC_ocn(I) + + ELSEIF (icy(i)) THEN + + !------------------------------------------ + ! CALCULATE THE EXCHANGE COEFFICIENTS FOR HEAT (FLHC) + ! AND MOISTURE (FLQC) + !------------------------------------------ + FLQC(I)=RHO1D(I)*MAVAIL(I)*UST_ice(I)*KARMAN/PSIQ_ice(i) + FLHC(I)=RHO1D(I)*CPM(I)*UST_ice(I)*KARMAN/PSIT_ice(I) + + IF (compute_flux) THEN + !---------------------------------- + ! COMPUTE SURFACE MOISTURE FLUX: + !---------------------------------- + !QFX(I)=FLQC(I)*(QSFCMR_ice(I)-QV1D(I)) + QFX(I)=FLQC(I)*(QSFC_ice(I)-QV1D(I)) + QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX + LH(I)=XLF*QFX(I) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + QFLX_ice(i)=QFX(i)/RHO1D(i) + QFLX(i)=QFLX_ice(i) + + !---------------------------------- + ! COMPUTE SURFACE HEAT FLUX: + !---------------------------------- + HFX(I)=FLHC(I)*(THSK_ice(I)-TH1D(I)) + HFX(I)=MAX(HFX(I),-250.) + ! BWG, 2020-06-17: Mod next 2 lines for fractional + HFLX_ice(I)=HFX(I)/(RHO1D(I)*cpm(I)) + HFLX(I)=HFLX_ice(I) + ENDIF - CHS(I)=UST(I)*KARMAN/PSIT(I) + !TRANSFER COEFF FOR SOME LSMs: + !CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) & + ! /XKA+ZA(I)/ZL)-PSIH(I)) + CHS(I)=UST_ice(I)*KARMAN/PSIT_ice(I) - ! The exchange coefficient for cloud water is assumed to be the - ! same as that for heat. CH is multiplied by WSPD. + !THESE ARE USED FOR 2-M DIAGNOSTICS ONLY + CQS2(I)=UST_ice(I)*KARMAN/PSIQ2_ice(i) + CHS2(I)=UST_ice(I)*KARMAN/PSIT2_ice(I) - !ch(i)=chs(i) - ch(i)=flhc(i)/( cpm(i)*RHO1D(i) ) + QSFC(I)=QSFC_ice(I) - !THESE ARE USED FOR 2-M DIAGNOSTICS ONLY - CQS2(I)=UST(I)*KARMAN/PSIQ2 - CHS2(I)=UST(I)*KARMAN/PSIT2(I) + ENDIF - IF(PRESENT(ck) .and. PRESENT(cd) .and. & - &PRESENT(cka) .and. PRESENT(cda)) THEN - Ck(I)=(karman/psix10(I))*(karman/psiq10) - Cd(I)=(karman/psix10(I))*(karman/psix10(I)) - Cka(I)=(karman/psix(I))*(karman/psiq) - Cda(I)=(karman/psix(I))*(karman/psix(I)) + IF (debug_code >= 1) THEN + write(*,*)"QFX=",QFX(I),"FLQC=",FLQC(I) + if(icy(i))write(*,*)"ice, MAVAIL:",MAVAIL(I)," u*=",UST_ice(I)," psiq=",PSIQ_ice(i) + if(dry(i))write(*,*)"lnd, MAVAIL:",MAVAIL(I)," u*=",UST_lnd(I)," psiq=",PSIQ_lnd(i) + if(wet(i))write(*,*)"ocn, MAVAIL:",MAVAIL(I)," u*=",UST_ocn(I)," psiq=",PSIQ_ocn(i) ENDIF - ENDIF !end ISFFLX option + ! The exchange coefficient for cloud water is assumed to be the + ! same as that for heat. CH is multiplied by WSPD. + ch(i)=flhc(i)/( cpm(i)*RHO1D(i) ) + + !----------------------------------------- + !--- COMPUTE EXCHANGE COEFFICIENTS FOR FV3 + !----------------------------------------- + IF (wet(i)) THEN + ch_ocn(I)=(karman/psix_ocn(I))*(karman/psit_ocn(i)) + cm_ocn(I)=(karman/psix_ocn(I))*(karman/psix_ocn(I)) + ENDIF + IF (dry(i)) THEN + ch_lnd(I)=(karman/psix_lnd(I))*(karman/psit_lnd(i)) + cm_lnd(I)=(karman/psix_lnd(I))*(karman/psix_lnd(I)) + ENDIF + IF (icy(i)) THEN + ch_ice(I)=(karman/psix_ice(I))*(karman/psit_ice(i)) + cm_ice(I)=(karman/psix_ice(I))*(karman/psix_ice(I)) + ENDIF - !----------------------------------------------------- - !COMPUTE DIAGNOSTICS - !----------------------------------------------------- - !COMPUTE 10 M WNDS - !----------------------------------------------------- - ! If the lowest model level is close to 10-m, use it - ! instead of the flux-based diagnostic formula. - if (ZA(i) .le. 7.0) then - ! high vertical resolution - if(ZA2(i) .gt. 7.0 .and. ZA2(i) .lt. 13.0) then - !use 2nd model level - U10(I)=U1D2(I) - V10(I)=V1D2(I) + ENDIF !end ISFFLX option +ENDDO ! end i-loop + +IF (compute_diag) then + DO I=its,ite + !----------------------------------------------------- + !COMPUTE DIAGNOSTICS + !----------------------------------------------------- + !COMPUTE 10 M WNDS + !----------------------------------------------------- + ! If the lowest model level is close to 10-m, use it + ! instead of the flux-based diagnostic formula. + if (ZA(i) .le. 7.0) then + ! high vertical resolution + if(ZA2(i) .gt. 7.0 .and. ZA2(i) .lt. 13.0) then + !use 2nd model level + U10(I)=U1D2(I) + V10(I)=V1D2(I) + else + IF (dry(i)) THEN + !U10(I)=U1D(I)*PSIX10_lnd(I)/PSIX_lnd(I) + !V10(I)=V1D(I)*PSIX10_lnd(I)/PSIX_lnd(I) + !use neutral-log: + U10(I)=U1D(I)*log(10./ZNTstoch_lnd(I))/log(ZA(I)/ZNTstoch_lnd(I)) + V10(I)=V1D(I)*log(10./ZNTstoch_lnd(I))/log(ZA(I)/ZNTstoch_lnd(I)) + ELSEIF (wet(i)) THEN + U10(I)=U1D(I)*log(10./ZNTstoch_ocn(I))/log(ZA(I)/ZNTstoch_ocn(I)) + V10(I)=V1D(I)*log(10./ZNTstoch_ocn(I))/log(ZA(I)/ZNTstoch_ocn(I)) + ELSEIF (icy(i)) THEN + U10(I)=U1D(I)*log(10./ZNTstoch_ice(I))/log(ZA(I)/ZNTstoch_ice(I)) + V10(I)=V1D(I)*log(10./ZNTstoch_ice(I))/log(ZA(I)/ZNTstoch_ice(I)) + ENDIF + endif + elseif (ZA(i) .gt. 7.0 .and. ZA(i) .lt. 13.0) then + !moderate vertical resolution + IF (dry(i)) THEN + !U10(I)=U1D(I)*PSIX10_lnd(I)/PSIX_lnd(I) + !V10(I)=V1D(I)*PSIX10_lnd(I)/PSIX_lnd(I) + !use neutral-log: + U10(I)=U1D(I)*log(10./ZNTstoch_lnd(I))/log(ZA(I)/ZNTstoch_lnd(I)) + V10(I)=V1D(I)*log(10./ZNTstoch_lnd(I))/log(ZA(I)/ZNTstoch_lnd(I)) + ELSEIF (wet(i)) THEN + U10(I)=U1D(I)*log(10./ZNTstoch_ocn(I))/log(ZA(I)/ZNTstoch_ocn(I)) + V10(I)=V1D(I)*log(10./ZNTstoch_ocn(I))/log(ZA(I)/ZNTstoch_ocn(I)) + ELSEIF (icy(i)) THEN + U10(I)=U1D(I)*log(10./ZNTstoch_ice(I))/log(ZA(I)/ZNTstoch_ice(I)) + V10(I)=V1D(I)*log(10./ZNTstoch_ice(I))/log(ZA(I)/ZNTstoch_ice(I)) + ENDIF else - U10(I)=U1D(I)*log(10./ZNTstoch(I))/log(ZA(I)/ZNTstoch(I)) - V10(I)=V1D(I)*log(10./ZNTstoch(I))/log(ZA(I)/ZNTstoch(I)) + ! very coarse vertical resolution + IF (dry(i)) THEN + U10(I)=U1D(I)*PSIX10_lnd(I)/PSIX_lnd(I) + V10(I)=V1D(I)*PSIX10_lnd(I)/PSIX_lnd(I) + ELSEIF (wet(i)) THEN + U10(I)=U1D(I)*PSIX10_ocn(I)/PSIX_ocn(I) + V10(I)=V1D(I)*PSIX10_ocn(I)/PSIX_ocn(I) + ELSEIF (icy(i)) THEN + U10(I)=U1D(I)*PSIX10_ice(I)/PSIX_ice(I) + V10(I)=V1D(I)*PSIX10_ice(I)/PSIX_ice(I) + ENDIF endif - elseif(ZA(i) .gt. 7.0 .and. ZA(i) .lt. 13.0) then - !moderate vertical resolution - !U10(I)=U1D(I)*PSIX10(I)/PSIX(I) - !V10(I)=V1D(I)*PSIX10(I)/PSIX(I) - !use neutral-log: - U10(I)=U1D(I)*log(10./ZNTstoch(I))/log(ZA(I)/ZNTstoch(I)) - V10(I)=V1D(I)*log(10./ZNTstoch(I))/log(ZA(I)/ZNTstoch(I)) - else - ! very coarse vertical resolution - U10(I)=U1D(I)*PSIX10(I)/PSIX(I) - V10(I)=V1D(I)*PSIX10(I)/PSIX(I) - endif - - !----------------------------------------------------- - !COMPUTE 2m T, TH, AND Q - !THESE WILL BE OVERWRITTEN FOR LAND POINTS IN THE LSM - !----------------------------------------------------- - DTG=TH1D(I)-THGB(I) - TH2(I)=THGB(I)+DTG*PSIT2(I)/PSIT(I) - !*** BE CERTAIN THAT THE 2-M THETA IS BRACKETED BY - !*** THE VALUES AT THE SURFACE AND LOWEST MODEL LEVEL. - IF ((TH1D(I)>THGB(I) .AND. (TH2(I)TH1D(I))) .OR. & - (TH1D(I)THGB(I) .OR. TH2(I)QSFCMR(I) .AND. (Q2(I)QV1D(I))) .OR. & - (QV1D(I)QSFCMR(I) .OR. Q2(I)THSK_lnd(I) .AND. (TH2(I)TH1D(I))) .OR. & + (TH1D(I)THSK_lnd(I) .OR. TH2(I)THSK_ocn(I) .AND. (TH2(I)TH1D(I))) .OR. & + (TH1D(I)THSK_ocn(I) .OR. TH2(I)THSK_ice(I) .AND. (TH2(I)TH1D(I))) .OR. & + (TH1D(I)THSK_ice(I) .OR. TH2(I) 1200. .OR. HFX(I) < -700.)THEN + IF (compute_flux) THEN + IF (HFX(I) > 1200. .OR. HFX(I) < -700.)THEN + print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& + I,J, "HFX: ",HFX(I) + yesno = 1 + ENDIF + IF (LH(I) > 1200. .OR. LH(I) < -700.)THEN print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& - ITER-ITMAX," ITERATIONS",I,J, "HFX: ",HFX(I) + I,J, "LH: ",LH(I) yesno = 1 + ENDIF ENDIF - IF (LH(I) > 1200. .OR. LH(I) < -700.)THEN + IF (wet(i)) THEN + IF (UST_ocn(I) < 0.0 .OR. UST_ocn(I) > 4.0 )THEN print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& - ITER-ITMAX," ITERATIONS",I,J, "LH: ",LH(I) + I,J, "UST_ocn: ",UST_ocn(I) yesno = 1 + ENDIF ENDIF - IF (UST(I) < 0.0 .OR. UST(I) > 4.0 )THEN - print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& - ITER-ITMAX," ITERATIONS",I,J, "UST: ",UST(I) + IF (dry(i)) THEN + IF (UST_lnd(I) < 0.0 .OR. UST_lnd(I) > 4.0 )THEN + print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& + I,J, "UST_lnd: ",UST_lnd(I) yesno = 1 + ENDIF + ENDIF + IF (icy(i)) THEN + IF (UST_ice(I) < 0.0 .OR. UST_ice(I) > 4.0 )THEN + print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& + I,J, "UST_ice: ",UST_ice(I) + yesno = 1 + ENDIF ENDIF IF (WSTAR(I)<0.0 .OR. WSTAR(I) > 6.0)THEN print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& - ITER-ITMAX," ITERATIONS",I,J, "WSTAR: ",WSTAR(I) + I,J, "WSTAR: ",WSTAR(I) yesno = 1 ENDIF IF (RHO1D(I)<0.0 .OR. RHO1D(I) > 1.6 )THEN print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& - ITER-ITMAX," ITERATIONS",I,J, "rho: ",RHO1D(I) + I,J, "rho: ",RHO1D(I) yesno = 1 ENDIF - IF (QSFC(I)*1000. <0.0 .OR. QSFC(I)*1000. >40.)THEN + IF (dry(i)) THEN + IF (QSFC_lnd(I)*1000. <0.0 .OR. QSFC_lnd(I)*1000. >40.)THEN print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& - ITER-ITMAX," ITERATIONS",I,J, "QSFC: ",QSFC(I) + I,J, "QSFC_lnd: ",QSFC_lnd(I) yesno = 1 + ENDIF ENDIF IF (PBLH(I)<0. .OR. PBLH(I)>6000.)THEN - print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& - ITER-ITMAX," ITERATIONS",I,J, "PBLH: ",PBLH(I) + print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& + I,J, "PBLH: ",PBLH(I) yesno = 1 ENDIF IF (yesno == 1) THEN - print*," OTHER INFO:" - write(*,1001)"REGIME:",REGIME(I)," z/L:",ZOL(I)," U*:",UST(I),& + IF (wet(i)) THEN + print*," OTHER INFO over water:" + print*,"z/L:",ZOL(I)," U*:",UST_ocn(I)," Tstar:",MOL(I) + print*,"PSIM:",PSIM(I)," PSIH:",PSIH(I)," W*:",WSTAR(I),& + " DTHV:",THV1D(I)-THVSK_ocn(I) + print*,"CPM:",CPM(I)," RHO1D:",RHO1D(I)," L:",& + ZOL(I)/ZA(I)," DTH:",TH1D(I)-THSK_ocn(I) + print*," Z0:",ZNTstoch_ocn(I)," Zt:",ZT_ocn(I)," za:",za(I) + print*,"MAVAIL:",MAVAIL(I)," QSFC_ocn(I):",& + QSFC_ocn(I)," QVSH(I):",QVSH(I) + print*,"PSIX=",PSIX_ocn(I)," T1D(i):",T1D(i) + write(*,*)"=============================================" + ENDIF + IF (dry(i)) THEN + print*," OTHER INFO over land:" + print*,"z/L:",ZOL(I)," U*:",UST_lnd(I),& + " Tstar:",MOL(I) + print*,"PSIM:",PSIM(I)," PSIH:",PSIH(I)," W*:",WSTAR(I),& + " DTHV:",THV1D(I)-THVSK_lnd(I) + print*,"CPM:",CPM(I)," RHO1D:",RHO1D(I)," L:",& + ZOL(I)/ZA(I)," DTH:",TH1D(I)-THSK_lnd(I) + print*," Z0:",ZNTstoch_lnd(I)," Zt:",ZT_lnd(I)," za:",za(I) + print*," MAVAIL:",MAVAIL(I)," QSFC_lnd(I):",& + QSFC_lnd(I)," QVSH(I):",QVSH(I) + print*,"PSIX=",PSIX_lnd(I)," T1D(i):",T1D(i) + write(*,*)"=============================================" + ENDIF + IF (icy(i)) THEN + print*," OTHER INFO:" + print*,"z/L:",ZOL(I)," U*:",UST_ice(I),& " Tstar:",MOL(I) - write(*,1002)"PSIM:",PSIM(I)," PSIH:",PSIH(I)," W*:",WSTAR(I),& - " DTHV:",THV1D(I)-THVGB(I) - write(*,1003)"CPM:",CPM(I)," RHO1D:",RHO1D(I)," L:",& - ZOL(I)/ZA(I)," DTH:",TH1D(I)-THGB(I) - write(*,1004)"Z0/Zt:",zratio(I)," Z0:",ZNTstoch(I)," Zt:",z_t(I),& - " za:",za(I) - write(*,1005)"Re:",restar," MAVAIL:",MAVAIL(I)," QSFC(I):",& - QSFC(I)," QVSH(I):",QVSH(I) - print*,"PSIX=",PSIX(I)," Z0:",ZNTstoch(I)," T1D(i):",T1D(i) - write(*,*)"=============================================" + print*,"PSIM:",PSIM(I)," PSIH:",PSIH(I)," W*:",WSTAR(I),& + " DTHV:",THV1D(I)-THVSK_ice(I) + print*,"CPM:",CPM(I)," RHO1D:",RHO1D(I)," L:",& + ZOL(I)/ZA(I)," DTH:",TH1D(I)-THSK_ice(I) + print*," Z0:",ZNTstoch_ice(I)," Zt:",ZT_ice(I)," za:",za(I) + print*," MAVAIL:",MAVAIL(I)," QSFC_ice(I):",& + QSFC_ice(I)," QVSH(I):",QVSH(I) + print*,"PSIX=",PSIX_ice(I)," T1D(i):",T1D(i) + write(*,*)"=============================================" + ENDIF ENDIF - ENDIF - - ENDDO !end i-loop + ENDDO ! end i-loop + ENDIF ! end debug option END SUBROUTINE SFCLAY1D_mynn !------------------------------------------------------------------- @@ -1411,23 +2187,20 @@ SUBROUTINE zilitinkevich_1995(Z_0,Zt,Zq,restar,ustar,KARMAN,& IF ( IZ0TLND2 .EQ. 1 ) THEN CZIL = 10.0 ** ( -0.40 * ( Z_0 / 0.07 ) ) ELSE - CZIL = 0.075 !0.10 + CZIL = 0.085 !0.075 !0.10 END IF Zt = Z_0*EXP(-KARMAN*CZIL*SQRT(restar)) - Zt = MIN( Zt, Z_0/2.) + Zt = MIN( Zt, 0.75*Z_0) Zq = Z_0*EXP(-KARMAN*CZIL*SQRT(restar)) - Zq = MIN( Zq, Z_0/2.) + Zq = MIN( Zq, 0.75*Z_0) -! perturb thermal and moisture roughness lenth by +/-50% -! uses same perturbation pattern for perturbing cloud fraction -! and turbulent mixing length (module_sf_mynn.F), but -! twice the amplitude; -! multiplication with -1.0 anticorrelates patterns +! stochastically perturb thermal and moisture roughness length. +! currently set to half the amplitude: if (spp_pbl==1) then - Zt = Zt + Zt * 2.0 * rstoch - Zt = MAX(Zt, 0.001) + Zt = Zt + Zt * 0.5 * rstoch + Zt = MAX(Zt, 0.0001) Zq = Zt endif @@ -1437,60 +2210,26 @@ SUBROUTINE zilitinkevich_1995(Z_0,Zt,Zq,restar,ustar,KARMAN,& END SUBROUTINE zilitinkevich_1995 !-------------------------------------------------------------------- -!>\ingroup module_sf_mynn_mod -!! This subroutine returns the resistance (PSIQ) for moisture -!! exchange. This is a modified form originating from Pan et al.. -!! (1994) but modified according to tests in both the RUC model. -!! and WRF-ARW. Note that it is very similar to Carlson and -!! Boland (1978) model (include below in comments) but has an -!! extra molecular layer (a third layer) instead of two layers. - SUBROUTINE Pan_etal_1994(PSIQ,PSIQ2,ustar,psih,psih2,KARMAN,Z1) - - IMPLICIT NONE - REAL, INTENT(IN) :: Z1,ustar,KARMAN,psih,psih2 - REAL, INTENT(OUT) :: psiq,psiq2 - REAL, PARAMETER :: Cpan=1.0 !was 20.8 in Pan et al 1994 - REAL, PARAMETER :: ZL=0.01 - REAL, PARAMETER :: ZMUs=0.2E-3 - REAL, PARAMETER :: XKA = 2.4E-5 - - !PAN et al. (1994): 3-layer model, as in paper: - !ZMU = Cpan*XKA/(KARMAN*UST(I)) - !PSIQ =MAX(KARMAN*ustar*ZMU/XKA + LOG((KARMAN*ustar*ZL + XKA)/XKA + & - ! & Z1/ZL) - PSIH,2.0) - !PSIQ2=MAX(KARMAN*ustar*ZMU/XKA + LOG((KARMAN*ustar*ZL + XKA)/XKA + & - ! & 2./ZL) - PSIH2,2.0) - !MODIFIED FORM: - PSIQ =MAX(KARMAN*ustar*ZMUs/XKA + LOG((KARMAN*ustar*Z1)/XKA + & - & Z1/ZL) - PSIH,2.0) - PSIQ2=MAX(KARMAN*ustar*ZMUs/XKA + LOG((KARMAN*ustar*2.0)/XKA + & - & 2./ZL) - PSIH2,2.0) - - !CARLSON AND BOLAND (1978): 2-layer model - !PSIQ =MAX(LOG(KARMAN*ustar*Z1/XKA + Z1/ZL)-PSIH ,2.0) - !PSIQ2=MAX(LOG(KARMAN*ustar*2./XKA + 2./ZL)-PSIH2 ,2.0) - - END SUBROUTINE Pan_etal_1994 -!-------------------------------------------------------------- -!>\ingroup module_sf_mynn_mod -!! This formulation for roughness length was designed to match. -!! the labratory experiments of Donelan et al. (2004). -!! This is an update version from Davis et al. 2008, which -!! corrects a small-bias in Z_0 (AHW real-time 2012). SUBROUTINE davis_etal_2008(Z_0,ustar) + !a.k.a. : Donelan et al. (2004) + !This formulation for roughness length was designed to match + !the labratory experiments of Donelan et al. (2004). + !This is an update version from Davis et al. 2008, which + !corrects a small-bias in Z_0 (AHW real-time 2012). + IMPLICIT NONE REAL, INTENT(IN) :: ustar REAL, INTENT(OUT) :: Z_0 REAL :: ZW, ZN1, ZN2 REAL, PARAMETER :: G=9.81, OZO=1.59E-5 - !OLD FORM: Z_0 = 10.*EXP(-10./(ustar**(1./3.))) + !OLD FORM: Z_0 = 10.*EXP(-10./(ustar**onethird)) !NEW FORM: ZW = MIN((ustar/1.06)**(0.3),1.0) ZN1 = 0.011*ustar*ustar/G + OZO - ZN2 = 10.*exp(-9.5*ustar**(-.3333)) + & + ZN2 = 10.*exp(-9.5*ustar**(-onethird)) + & 0.11*1.5E-5/AMAX1(ustar,0.01) Z_0 = (1.0-ZW) * ZN1 + ZW * ZN2 @@ -1623,11 +2362,12 @@ END SUBROUTINE garratt_1992 !!(1992, p. 102), is available for flows with Ren < 2. !! !!This is for use over water only. - SUBROUTINE fairall_etal_2003(Zt,Zq,Ren,ustar,visc) + SUBROUTINE fairall_etal_2003(Zt,Zq,Ren,ustar,visc,rstoch,spp_pbl) IMPLICIT NONE - REAL, INTENT(IN) :: Ren,ustar,visc - REAL, INTENT(OUT) :: Zt,Zq + REAL, INTENT(IN) :: Ren,ustar,visc,rstoch + INTEGER, INTENT(IN):: spp_pbl + REAL, INTENT(OUT) :: Zt,Zq IF (Ren .le. 2.) then @@ -1645,6 +2385,11 @@ SUBROUTINE fairall_etal_2003(Zt,Zq,Ren,ustar,visc) ENDIF + if (spp_pbl==1) then + Zt = Zt + Zt * 0.5 * rstoch + Zq = Zt + endif + Zt = MIN(Zt,1.0e-4) Zt = MAX(Zt,2.0e-9) @@ -1673,8 +2418,8 @@ SUBROUTINE fairall_etal_2014(Zt,Zq,Ren,ustar,visc,rstoch,spp_pbl) Zq = Zt IF (spp_pbl ==1) THEN - Zt = MAX(Zt + Zt*2.0*rstoch,2.0e-9) - Zq = MAX(Zt + Zt*2.0*rstoch,2.0e-9) + Zt = MAX(Zt + Zt*0.5*rstoch,2.0e-9) + Zq = MAX(Zt + Zt*0.5*rstoch,2.0e-9) ELSE Zt = MAX(Zt,2.0e-9) Zq = MAX(Zt,2.0e-9) @@ -1708,10 +2453,10 @@ END SUBROUTINE fairall_etal_2014 !!Zt was reduced too much for low-moderate positive heat fluxes. !! !!This should only be used over land! - SUBROUTINE Yang_2008(Z_0,Zt,Zq,ustar,tstar,qst,Ren,visc,landsea) + SUBROUTINE Yang_2008(Z_0,Zt,Zq,ustar,tstar,qst,Ren,visc) IMPLICIT NONE - REAL, INTENT(IN) :: Z_0, Ren, ustar, tstar, qst, visc, landsea + REAL, INTENT(IN) :: Z_0, Ren, ustar, tstar, qst, visc REAL :: ht, &! roughness height at critical Reynolds number tstar2, &! bounded T*, forced to be non-positive qstar2, &! bounded q*, forced to be non-positive @@ -1741,6 +2486,414 @@ SUBROUTINE Yang_2008(Z_0,Zt,Zq,ustar,tstar,qst,Ren,visc,landsea) END SUBROUTINE Yang_2008 !-------------------------------------------------------------------- +! Taken from the GFS (sfc_diff.f) for comparison + SUBROUTINE GFS_z0_lnd(z0max,shdmax,z1,vegtype,ivegsrc,z0pert) + + REAL, INTENT(OUT) :: z0max + REAL, INTENT(IN) :: shdmax,z1,z0pert + INTEGER, INTENT(IN):: vegtype,ivegsrc + REAL :: tem1, tem2 + +! z0max = max(1.0e-6, min(0.01 * z0max, z1)) +!already converted into meters in the wrapper + z0max = max(1.0e-6, min(z0max, z1)) +!** xubin's new z0 over land + tem1 = 1.0 - shdmax + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 + + if( ivegsrc == 1 ) then + + if (vegtype == 10) then + z0max = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype == 6) then + z0max = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype == 7) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + elseif (vegtype == 16) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + else + z0max = exp( tem2*log01 + tem1*log(z0max) ) + endif + + elseif (ivegsrc == 2 ) then + + if (vegtype == 7) then + z0max = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype == 8) then + z0max = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype == 9) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + elseif (vegtype == 11) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max = 0.01 + else + z0max = exp( tem2*log01 + tem1*log(z0max) ) + endif + + endif + +! mg, sfc-perts: add surface perturbations to z0max over land + if (z0pert /= 0.0 ) then + z0max = z0max * (10.**z0pert) + endif + + z0max = max(z0max, 1.0e-6) + + END SUBROUTINE GFS_z0_lnd +!-------------------------------------------------------------------- +! Taken from the GFS (sfc_diff.f) for comparison + SUBROUTINE GFS_zt_lnd(ztmax,z0max,sigmaf,ztpert,ustar_lnd) + + REAL, INTENT(OUT) :: ztmax + REAL, INTENT(IN) :: z0max,sigmaf,ztpert,ustar_lnd + REAL :: czilc, tem1, tem2 + REAL, PARAMETER :: ca = 0.4 + +! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil + czilc = 0.8 + + tem1 = 1.0 - sigmaf + ztmax = z0max*exp( - tem1*tem1 & + & * czilc*ca*sqrt(ustar_lnd*(0.01/1.5e-05))) +! +! czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) +! ztmax = z0max * exp( - czilc * ca & +! & * 258.2 * sqrt(ustar_lnd*z0max) ) + + +! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land + if (ztpert /= 0.0) then + ztmax = ztmax * (10.**ztpert) + endif + ztmax = max(ztmax, 1.0e-6) + + END SUBROUTINE GFS_zt_lnd +!-------------------------------------------------------------------- + SUBROUTINE GFS_z0_ocn(z0rl_ocn,ustar_ocn,WSPD,z1,sfc_z0_type,redrag) + + REAL, INTENT(OUT) :: z0rl_ocn + REAL, INTENT(INOUT):: ustar_ocn + REAL, INTENT(IN) :: wspd,z1 + LOGICAL, INTENT(IN):: redrag + INTEGER, INTENT(IN):: sfc_z0_type + REAL :: z0,z0max,wind10m + REAL, PARAMETER :: charnock = 0.014, z0s_max=.317e-2 + +! z0 = 0.01 * z0rl_ocn +!Already converted to meters in the wrapper + z0 = z0rl_ocn + z0max = max(1.0e-6, min(z0,z1)) + ustar_ocn = sqrt(g * z0 / charnock) + wind10m = wspd*log(10./1e-4)/log(z1/1e-4) + !wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) +! + if (sfc_z0_type >= 0) then + if (sfc_z0_type == 0) then + z0 = (charnock / g) * ustar_ocn * ustar_ocn + +! mbek -- toga-coare flux algorithm +! z0 = (charnock / g) * ustar(i)*ustar(i) + arnu/ustar(i) +! new implementation of z0 +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = g * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + !z0rl_ocn = 100.0 * max(min(z0, z0s_max), 1.e-7) + z0rl_ocn = max(min(z0, z0s_max), 1.e-7) + else + !z0rl_ocn = 100.0 * max(min(z0,.1), 1.e-7) + z0rl_ocn = max(min(z0,.1), 1.e-7) + endif + + elseif (sfc_z0_type == 6) then ! wang + call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m + !z0rl_ocn = 100.0 * z0 ! cm + elseif (sfc_z0_type == 7) then ! wang + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + !z0rl_ocn = 100.0 * z0 ! cm + else + z0rl_ocn = 1.0e-6 + endif + + endif + + END SUBROUTINE GFS_z0_ocn +!-------------------------------------------------------------------- + SUBROUTINE GFS_zt_ocn(ztmax,z0rl_ocn,restar,WSPD,z1,sfc_z0_type) + + REAL, INTENT(OUT) :: ztmax + REAL, INTENT(IN) :: wspd,z1,z0rl_ocn,restar + INTEGER, INTENT(IN):: sfc_z0_type + REAL :: z0,z0max,wind10m,rat,ustar_ocn + REAL, PARAMETER :: charnock = 0.014, z0s_max=.317e-2 + +! z0 = 0.01 * z0rl_ocn +!Already converted to meters in the wrapper + z0 = z0rl_ocn + z0max = max(1.0e-6, min(z0,z1)) + ustar_ocn = sqrt(g * z0 / charnock) + wind10m = wspd*log(10./1e-4)/log(z1/1e-4) + +!** test xubin's new z0 + +! ztmax = z0max + +!input restar = max(ustar_ocn(i)*z0max*visi, 0.000001) + +! restar = log(restar) +! restar = min(restar,5.) +! restar = max(restar,-5.) +! rat = aa1 + (bb1 + cc1*restar) * restar +! rat = rat / (1. + (bb2 + cc2*restar) * restar)) +! rat taken from zeng, zhao and dickinson 1997 + + rat = min(7.0, 2.67 * sqrt(sqrt(restar)) - 2.57) + ztmax = max(z0max * exp(-rat), 1.0e-6) +! + if (sfc_z0_type == 6) then + call znot_t_v6(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) + else if (sfc_z0_type == 7) then + call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) + else if (sfc_z0_type > 0) then + write(0,*)'no option for sfc_z0_type=',sfc_z0_type + stop + endif + + END SUBROUTINE GFS_zt_ocn +!-------------------------------------------------------------------- +!! add fitted z0,zt curves for hurricane application (used in HWRF/HMON) +!! Weiguo Wang, 2019-0425 + + SUBROUTINE znot_m_v6(uref, znotm) + use machine , only : kind_phys + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! +! Bin Liu, NOAA/NCEP/EMC 2017 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL(kind=kind_phys), INTENT(IN) :: uref + REAL(kind=kind_phys), INTENT(OUT):: znotm + real(kind=kind_phys), parameter :: p13 = -1.296521881682694e-02,& + & p12 = 2.855780863283819e-01, p11 = -1.597898515251717e+00,& + & p10 = -8.396975715683501e+00, & + + & p25 = 3.790846746036765e-10, p24 = 3.281964357650687e-09,& + & p23 = 1.962282433562894e-07, p22 = -1.240239171056262e-06,& + & p21 = 1.739759082358234e-07, p20 = 2.147264020369413e-05,& + + & p35 = 1.840430200185075e-07, p34 = -2.793849676757154e-05,& + & p33 = 1.735308193700643e-03, p32 = -6.139315534216305e-02,& + & p31 = 1.255457892775006e+00, p30 = -1.663993561652530e+01,& + + & p40 = 4.579369142033410e-04 + + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp(p10 + uref * (p11 + uref * (p12 + uref*p13))) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + & + uref * (p24 + uref * p25)))) + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p30 + uref * (p31 + uref * (p32 + uref * (p33 & + & + uref * (p34 + uref * p35))))) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v6 +!-------------------------------------------------------------------- + SUBROUTINE znot_t_v6(uref, znott) + + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! +! Bin Liu, NOAA/NCEP/EMC 2017 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + real, parameter :: p00 = 1.100000000000000e-04,& + & p15 = -9.144581627678278e-10, p14 = 7.020346616456421e-08,& + & p13 = -2.155602086883837e-06, p12 = 3.333848806567684e-05,& + & p11 = -2.628501274963990e-04, p10 = 8.634221567969181e-04,& + + & p25 = -8.654513012535990e-12, p24 = 1.232380050058077e-09,& + & p23 = -6.837922749505057e-08, p22 = 1.871407733439947e-06,& + & p21 = -2.552246987137160e-05, p20 = 1.428968311457630e-04,& + + & p35 = 3.207515102100162e-12, p34 = -2.945761895342535e-10,& + & p33 = 8.788972147364181e-09, p32 = -3.814457439412957e-08,& + & p31 = -2.448983648874671e-06, p30 = 3.436721779020359e-05,& + + & p45 = -3.530687797132211e-11, p44 = 3.939867958963747e-09,& + & p43 = -1.227668406985956e-08, p42 = -1.367469811838390e-05,& + & p41 = 5.988240863928883e-04, p40 = -7.746288511324971e-03,& + + & p56 = -1.187982453329086e-13, p55 = 4.801984186231693e-11,& + & p54 = -8.049200462388188e-09, p53 = 7.169872601310186e-07,& + & p52 = -3.581694433758150e-05, p51 = 9.503919224192534e-04,& + & p50 = -1.036679430885215e-02, & + + & p60 = 4.751256171799112e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p10 + uref * (p11 + uref * (p12 + uref * (p13 & + & + uref * (p14 + uref * p15)))) + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + & + uref * (p24 + uref * p25)))) + elseif (uref > 21.6 .and. uref <= 42.2) then + znott = p30 + uref * (p31 + uref * (p32 + uref * (p33 & + & + uref * (p34 + uref * p35)))) + elseif ( uref > 42.2 .and. uref <= 53.3) then + znott = p40 + uref * (p41 + uref * (p42 + uref * (p43 & + & + uref * (p44 + uref * p45)))) + elseif ( uref > 53.3 .and. uref <= 80.0) then + znott = p50 + uref * (p51 + uref * (p52 + uref * (p53 & + & + uref * (p54 + uref * (p55 + uref * p56))))) + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v6 + +!------------------------------------------------------------------- + + SUBROUTINE znot_m_v7(uref, znotm) + + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! Comparing to znot_t_v6, slightly decrease Cd for higher wind speed +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znotm + + real, parameter :: p13 = -1.296521881682694e-02,& + & p12 = 2.855780863283819e-01, p11 = -1.597898515251717e+00,& + & p10 = -8.396975715683501e+00,& + + & p25 = 3.790846746036765e-10, p24 = 3.281964357650687e-09,& + & p23 = 1.962282433562894e-07, p22 = -1.240239171056262e-06,& + & p21 = 1.739759082358234e-07, p20 = 2.147264020369413e-05,& + + & p35 = 1.897534489606422e-07, p34 = -3.019495980684978e-05,& + & p33 = 1.931392924987349e-03, p32 = -6.797293095862357e-02,& + & p31 = 1.346757797103756e+00, p30 = -1.707846930193362e+01,& + + & p40 = 3.371427455376717e-04 + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp( p10 + uref * (p11 + uref * (p12 + uref * p13))) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + & + uref * (p24 + uref * p25)))) + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p30 + uref * (p31 + uref * (p32 + uref * (p33 & + & + uref * (p34 + uref * p35))))) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v7 +!-------------------------------------------------------------------- + SUBROUTINE znot_t_v7(uref, znott) + + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! To be compatible with the slightly decreased Cd for higher wind speed +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + + real, parameter :: p00 = 1.100000000000000e-04, & + + & p15 = -9.193764479895316e-10, p14 = 7.052217518653943e-08,& + & p13 = -2.163419217747114e-06, p12 = 3.342963077911962e-05,& + & p11 = -2.633566691328004e-04, p10 = 8.644979973037803e-04,& + + & p25 = -9.402722450219142e-12, p24 = 1.325396583616614e-09,& + & p23 = -7.299148051141852e-08, p22 = 1.982901461144764e-06,& + & p21 = -2.680293455916390e-05, p20 = 1.484341646128200e-04,& + + & p35 = 7.921446674311864e-12, p34 = -1.019028029546602e-09,& + & p33 = 5.251986927351103e-08, p32 = -1.337841892062716e-06,& + & p31 = 1.659454106237737e-05, p30 = -7.558911792344770e-05,& + + & p45 = -2.694370426850801e-10, p44 = 5.817362913967911e-08,& + & p43 = -5.000813324746342e-06, p42 = 2.143803523428029e-04,& + & p41 = -4.588070983722060e-03, p40 = 3.924356617245624e-02,& + + & p56 = -1.663918773476178e-13, p55 = 6.724854483077447e-11,& + & p54 = -1.127030176632823e-08, p53 = 1.003683177025925e-06,& + & p52 = -5.012618091180904e-05, p51 = 1.329762020689302e-03,& + & p50 = -1.450062148367566e-02, p60 = 6.840803042788488e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p10 + uref * (p11 + uref * (p12 + uref * (p13 & + & + uref * (p14 + uref * p15)))) + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + & + uref * (p24 + uref * p25)))) + elseif (uref > 21.6 .and. uref <= 42.6) then + znott = p30 + uref * (p31 + uref * (p32 + uref * (p33 & + & + uref * (p34 + uref * p35)))) + elseif ( uref > 42.6 .and. uref <= 53.0) then + znott = p40 + uref * (p41 + uref * (p42 + uref * (p43 & + & + uref * (p44 + uref * p45)))) + elseif ( uref > 53.0 .and. uref <= 80.0) then + znott = p50 + uref * (p51 + uref * (p52 + uref * (p53 & + & + uref * (p54 + uref * (p55 + uref * p56))))) + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v7 + +!-------------------------------------------------------------------- !>\ingroup module_sf_mynn_mod !> This is taken from Andreas (2002; J. of Hydromet) and !! Andreas et al. (2005; BLM). @@ -1994,12 +3147,31 @@ SUBROUTINE PSI_Suselj_Sood_2010(psi_m, psi_h, zL) END SUBROUTINE PSI_Suselj_Sood_2010 !-------------------------------------------------------------------- -!>\ingroup module_sf_mynn_mod -!>This subroutine returns a more robust z/L that best matches -!! the z/L from Hogstrom (1996) for unstable conditions and Beljaars -!! and Holtslag (1991) for stable conditions. + SUBROUTINE PSI_CB2005(psim1,psih1,zL,z0L) + + ! This subroutine returns the stability functions based off + ! of Cheng and Brutseart (2005, BLM), for use in stable conditions only. + ! The returned values are the combination of psi((za+zo)/L) - psi(z0/L) + + IMPLICIT NONE + REAL, INTENT(IN) :: zL,z0L + REAL, INTENT(OUT) :: psim1,psih1 + + psim1 = -6.1*LOG(zL + (1.+ zL**2.5)**0.4) & + -6.1*LOG(z0L + (1.+ z0L**2.5)**0.4) + psih1 = -5.5*log(zL + (1.+ zL**1.1)**0.90909090909) & + -5.5*log(z0L + (1.+ z0L**1.1)**0.90909090909) + + return + + END SUBROUTINE PSI_CB2005 +!-------------------------------------------------------------------- SUBROUTINE Li_etal_2010(zL, Rib, zaz0, z0zt) + !This subroutine returns a more robust z/L that best matches + !the z/L from Hogstrom (1996) for unstable conditions and Beljaars + !and Holtslag (1991) for stable conditions. + IMPLICIT NONE REAL, INTENT(OUT) :: zL REAL, INTENT(IN) :: Rib, zaz0, z0zt @@ -2054,393 +3226,235 @@ SUBROUTINE Li_etal_2010(zL, Rib, zaz0, z0zt) return END SUBROUTINE Li_etal_2010 - !------------------------------------------------------------------- -!>\ingroup module_sf_mynn_mod -!! This subroutine adds pbl modules so they can be optimized in pbl code - SUBROUTINE mym_condensation (kts,kte, & - & dx, dz, & - & thl, qw, & - & p,exner, & - & tsq, qsq, cov, & - & Sh, el, bl_mynn_cloudpdf,& - & qc_bl1D, cldfra_bl1D, & - & PBLH1,HFX1, & - & Vt, Vq, th, sgm) + REAL function zolri(ri,za,z0,zt,zol1) -!------------------------------------------------------------------- + ! This iterative algorithm was taken from the revised surface layer + ! scheme in WRF-ARW, written by Pedro Jimenez and Jimy Dudhia and + ! summarized in Jimenez et al. (2012, MWR). This function was adapted + ! to input the thermal roughness length, zt, (as well as z0) because + ! zt is necessary input for the Dyer-Hicks functions used in MYNN. - INTEGER, INTENT(IN) :: kts,kte, bl_mynn_cloudpdf - REAL, INTENT(IN) :: dx,PBLH1,HFX1 - REAL, DIMENSION(kts:kte), INTENT(IN) :: dz - REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner, thl, qw, & - &tsq, qsq, cov, th - - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm - - REAL, DIMENSION(kts:kte) :: qmq,alp,a,bet,b,ql,q1,cld,RH - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,cldfra_bl1D - DOUBLE PRECISION :: t3sq, r3sq, c3sq - - REAL :: qsl,esat,qsat,tlk,qsat_tl,dqsl,cld0,q1k,eq1,qll,& - &q2p,pt,rac,qt,t,xl,rsl,cpm,cdhdz,Fng,qww,alpha,beta,bb,ls_min,ls,wt - INTEGER :: i,j,k - - REAL :: erf - - !JOE: NEW VARIABLES FOR ALTERNATE SIGMA - REAL::dth,dtl,dqw,dzk - REAL, DIMENSION(kts:kte), INTENT(IN) :: Sh,el - - !JOE: variables for BL clouds - REAL::zagl,cld9,damp,edown,RHcrit,RHmean,RHsum,RHnum,Hshcu,PBLH2,ql_limit - REAL, PARAMETER :: Hfac = 3.0 !cloud depth factor for HFX (m^3/W) - REAL, PARAMETER :: HFXmin = 50.0 !min W/m^2 for BL clouds - REAL :: RH_00L, RH_00O, phi_dz, lfac - REAL, PARAMETER :: cdz = 2.0 - REAL, PARAMETER :: mdz = 1.5 - - !JAYMES: variables for tropopause-height estimation - REAL :: theta1, theta2, ht1, ht2 - INTEGER :: k_tropo - - REAL, PARAMETER :: rr2=0.7071068, rrp=0.3989423 - - k_tropo=5 - - zagl = 0. - - SELECT CASE(bl_mynn_cloudpdf) - - CASE (0) ! ORIGINAL MYNN PARTIAL-CONDENSATION SCHEME - - 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) - !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) - - !NOTE: negative bl_mynn_cloudpdf will zero-out the stratus subgrid clouds - ! at the end of this subroutine. - !Sommeria and Deardorff (1977) scheme, as implemented - !in Nakanishi and Niino (2009), Appendix B - t3sq = MAX( tsq(k), 0.0 ) - r3sq = MAX( qsq(k), 0.0 ) - c3sq = cov(k) - c3sq = SIGN( MIN( ABS(c3sq), SQRT(t3sq*r3sq) ), c3sq ) - r3sq = r3sq +bet(k)**2*t3sq -2.0*bet(k)*c3sq - !DEFICIT/EXCESS WATER CONTENT - qmq(k) = qw(k) -qsl - !ORIGINAL STANDARD DEVIATION: limit e-6 produces ~10% more BL clouds - !than e-10 - sgm(k) = SQRT( MAX( r3sq, 1.0d-10 )) - !NORMALIZED DEPARTURE FROM SATURATION - q1(k) = qmq(k) / sgm(k) - !CLOUD FRACTION. rr2 = 1/SQRT(2) = 0.707 - cld(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) - - END DO - - CASE (1, -1) !ALTERNATIVE FORM (Nakanishi & Niino 2004 BLM, eq. B6, and - !Kuwano-Yoshida et al. 2010 QJRMS, eq. 7): - 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) - !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) - - if (k .eq. kts) then - dzk = 0.5*dz(k) - else - dzk = 0.5*( dz(k) + dz(k-1) ) - end if - dth = 0.5*(thl(k+1)+thl(k)) - 0.5*(thl(k)+thl(MAX(k-1,kts))) - dqw = 0.5*(qw(k+1) + qw(k)) - 0.5*(qw(k) + qw(MAX(k-1,kts))) - sgm(k) = SQRT( MAX( (alp(k)**2 * MAX(el(k)**2,0.1) * & - b2 * MAX(Sh(k),0.03))/4. * & - (dqw/dzk - bet(k)*(dth/dzk ))**2 , 1.0e-10) ) - qmq(k) = qw(k) -qsl - q1(k) = qmq(k) / sgm(k) - cld(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) - END DO - - CASE (2, -2) - !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS - !JAYMES- this added 27 Apr 2015 - 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) - !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" - - qmq(k) = a(k) * (qw(k) - qsat_tl) ! saturation deficit/excess; - ! the numerator of Q1 - - 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))) - - if (k .eq. kts) then - dzk = 0.5*dz(k) - else - dzk = 0.5*( dz(k) + dz(k-1) ) - end if - - cdhdz = dtl/dzk + (g/cpm)*(1.+qw(k)) ! expression below Eq. 9 - ! in CB02 - zagl = zagl + dz(k) - ls_min = MIN(MAX(zagl,25.),300.) ! Let this be the minimum possible length scale: - ! 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),900.),ls_min) ! Bounded: ls_min < ls < 900 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 - - cld(k) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 - - END DO - END SELECT - - zagl = 0. - RHsum=0. - RHnum=0. - RHmean=0.1 !initialize with small value for small PBLH cases - damp =0 - PBLH2=MAX(10.,PBLH1) - - SELECT CASE(bl_mynn_cloudpdf) - - CASE (-1 : 1) ! ORIGINAL MYNN PARTIAL-CONDENSATION SCHEME - ! OR KUWANO ET AL. - DO k = kts,kte-1 - t = th(k)*exner(k) - q1k = q1(k) - zagl = zagl + dz(k) - !q1=0. - !cld(k)=0. - - !COMPUTE MEAN RH IN PBL (NOT PRESSURE WEIGHTED). - IF (zagl < PBLH2 .AND. PBLH2 > 400.) THEN - RHsum=RHsum+RH(k) - RHnum=RHnum+1.0 - RHmean=RHsum/RHnum - ENDIF - RHcrit = 1. - 0.35*(1.0 - (MAX(250.- MAX(HFX1,HFXmin),0.0)/200.)**2) - if (HFX1 > HFXmin) then - cld9=MIN(MAX(0., (rh(k)-RHcrit)/(1.1-RHcrit)), 1.)**2 - else - cld9=0.0 - endif + IMPLICIT NONE + REAL, INTENT(IN) :: ri,za,z0,zt,zol1 + REAL :: x1,x2,fx1,fx2 + INTEGER :: n - edown=PBLH2*.1 - !Vary BL cloud depth (Hshcu) by mean RH in PBL and HFX - !(somewhat following results from Zhang and Klein (2013, JAS)) - Hshcu=200. + (RHmean+0.5)**1.5*MAX(HFX1,0.)*Hfac - if (zagl < PBLH2-edown) then - damp=MIN(1.0,exp(-ABS(((PBLH2-edown)-zagl)/edown))) - elseif(zagl >= PBLH2-edown .AND. zagl < PBLH2+Hshcu)then - damp=1. - elseif (zagl >= PBLH2+Hshcu)then - damp=MIN(1.0,exp(-ABS((zagl-(PBLH2+Hshcu))/500.))) - endif - cldfra_bl1D(k)=cld9*damp - !cldfra_bl1D(k)=cld(k) ! JAYMES: use this form to retain the Sommeria-Deardorff value - - !use alternate cloud fraction to estimate qc for use in BL clouds-radiation - eq1 = rrp*EXP( -0.5*q1k*q1k ) - qll = MAX( cldfra_bl1D(k)*q1k + eq1, 0.0 ) - !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) - ql (k) = alp(k)*sgm(k)*qll - if(cldfra_bl1D(k)>0.01 .and. ql(k)<1.E-6)ql(k)=1.E-6 - qc_bl1D(k)=ql(k)*damp - !now recompute estimated lwc for PBL scheme's use - !qll IS THE NORMALIZED LIQUID WATER CONTENT (Sommeria and - !Deardorff (1977, eq 29a). rrp = 1/(sqrt(2*pi)) = 0.3989 - eq1 = rrp*EXP( -0.5*q1k*q1k ) - qll = MAX( cld(k)*q1k + eq1, 0.0 ) - !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) - ql (k) = alp(k)*sgm(k)*qll - - q2p = xlvcp/exner(k) - pt = thl(k) +q2p*ql(k) ! potential temp - - !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) - qt = 1.0 +p608*qw(k) -(1.+p608)*ql(k) - rac = alp(k)*( cld(k)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) - - !BUOYANCY FACTORS: wherever vt and vq are used, there is a - !"+1" and "+tv0", respectively, so these are subtracted out here. - !vt is unitless and vq has units of K. - vt(k) = qt-1.0 -rac*bet(k) - vq(k) = p608*pt-tv0 +rac - - !To avoid FPE in radiation driver, when these two quantities are multiplied by eachother, - ! add limit to qc_bl and cldfra_bl: - IF (QC_BL1D(k) < 1E-6 .AND. ABS(CLDFRA_BL1D(k)) > 0.01) QC_BL1D(k)= 1E-6 - IF (CLDFRA_BL1D(k) < 1E-2)THEN - CLDFRA_BL1D(k)=0. - QC_BL1D(k)=0. - ENDIF + if (ri.lt.0.)then + x1=zol1 - 0.02 !-5. + x2=0. + else + x1=0. + x2=zol1 + 0.02 !5. + endif - END DO - CASE ( 2, -2) - ! 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 - ! water flux; these formulations are from Cuijpers and Bechtold - ! (1995), Eq. 7. CB95 also draws from Bechtold et al. 1995, - ! hereafter BCMT95 - DO k = kts,kte-1 - t = th(k)*exner(k) - q1k = q1(k) - zagl = zagl + dz(k) - IF (q1k < 0.) THEN - ql (k) = sgm(k)*EXP(1.2*q1k-1) - ELSE IF (q1k > 2.) THEN - ql (k) = sgm(k)*q1k - ELSE - ql (k) = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ENDIF + n=0 + fx1=zolri2(x1,ri,za,z0,zt) + fx2=zolri2(x2,ri,za,z0,zt) + Do While (abs(x1 - x2) > 0.01 .and. n < 5) + if(abs(fx2).lt.abs(fx1))then + x1=x1-fx1/(fx2-fx1)*(x2-x1) + fx1=zolri2(x1,ri,za,z0,zt) + zolri=x1 + else + x2=x2-fx2/(fx2-fx1)*(x2-x1) + fx2=zolri2(x2,ri,za,z0,zt) + zolri=x2 + endif + n=n+1 + !print*," n=",n," x1=",x1," x2=",x2 + enddo + + if (n==5 .and. abs(x1 - x2) >= 0.01) then + !print*,"iter FAIL, n=",n," Ri=",ri," z/L=",zolri + !Tests results: fails convergence ~ 0.07 % of the time + !set approximate values: + if (ri.lt.0.)then + zolri=ri*5. + else + zolri=ri*8. + endif + !else + ! print*,"iter OK, n=",n," Ri=",ri," z/L=",zolri + endif - !Next, adjust our initial estimates of cldfra and ql based - !on tropopause-height and PBLH considerations - !JAYMES: added 4 Nov 2016 - if ((cld(k) .gt. 0.) .or. (ql(k) .gt. 0.)) then - if (k .le. k_tropo) then - !At and below tropopause: impose an upper limit on ql; assume that - !a maximum of 0.5 percent supersaturation in water vapor can be - !available for cloud production - ql_limit = 0.005 * qsat_blend( th(k)*exner(k), p(k) ) - ql(k) = MIN( ql(k), ql_limit ) - else - !Above tropopause: eliminate subgrid clouds from CB scheme - cld(k) = 0. - ql(k) = 0. - endif - endif + return + end function +!------------------------------------------------------------------- + REAL function zolri2(zol2,ri2,za,z0,zt) - !Buoyancy-flux-related calculations follow... - ! "Fng" represents the non-Gaussian transport factor - ! (non-dimensional) from from Bechtold et al. 1995 - ! (hereafter BCMT95), section 3(c). Their suggested - ! forms for Fng (from their Eq. 20) are: - ! For purposes of the buoyancy flux in stratus, we will use Fng = 1 - Fng = 1. - - xl = xl_blend(t) - bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from - ! "b" in CB02 (i.e., b(k) above) by a factor - ! of T/theta. Strictly, b(k) above is formulated in - ! terms of sat. mixing ratio, but bb in BCMT95 is - ! cast in terms of sat. specific humidity. The - ! conversion is neglected here. - qww = 1.+0.61*qw(k) - alpha = 0.61*th(k) - beta = (th(k)/t)*(xl/cp) - 1.61*th(k) - - vt(k) = qww - cld(k)*beta*bb*Fng - 1. - vq(k) = alpha + cld(k)*beta*a(k)*Fng - tv0 - ! vt and vq correspond to beta-theta and beta-q, respectively, - ! in NN09, Eq. B8. They also correspond to the bracketed - ! expressions in BCMT95, Eq. 15, since (s*ql/sigma^2) = cldfra*Fng - ! The "-1" and "-tv0" terms are included for consistency with - ! the legacy vt and vq formulations (above). - - ! increase the cloud fraction estimate below PBLH+1km - if (zagl .lt. PBLH2+1000.) cld(k) = MIN( 1., 1.8*cld(k) ) - ! return a cloud condensate and cloud fraction for icloud_bl option: - cldfra_bl1D(k) = cld(k) - qc_bl1D(k) = ql(k) - - !To avoid FPE in radiation driver, when these two quantities are multiplied by eachother, - ! add limit to qc_bl and cldfra_bl: - IF (QC_BL1D(k) < 1E-6 .AND. ABS(CLDFRA_BL1D(k)) > 0.01) QC_BL1D(k)= 1E-6 - IF (CLDFRA_BL1D(k) < 1E-2)THEN - CLDFRA_BL1D(k)=0. - QC_BL1D(k)=0. - ENDIF + ! INPUT: ================================= + ! zol2 - estimated z/L + ! ri2 - calculated bulk Richardson number + ! za - 1/2 depth of first model layer + ! z0 - aerodynamic roughness length + ! zt - thermal roughness length + ! OUTPUT: ================================ + ! zolri2 - updated estimate of z/L - END DO + IMPLICIT NONE + REAL, INTENT(IN) :: ri2,za,z0,zt + REAL, INTENT(INOUT) :: zol2 + REAL :: zol20,zol3,psim1,psih1,psix2,psit2 - END SELECT !end cloudPDF option + if(zol2*ri2 .lt. 0.)zol2=0. ! limit zol2 - must be same sign as ri2 - !FOR TESTING PURPOSES ONLY, ISOLATE ON THE MASS-CLOUDS. - IF (bl_mynn_cloudpdf .LT. 0) THEN - DO k = kts,kte-1 - cldfra_bl1D(k) = 0.0 - qc_bl1D(k) = 0.0 - END DO - ENDIF + zol20=zol2*z0/za ! z0/L + zol3=zol2+zol20 ! (z+z0)/L - cld(kte) = cld(kte-1) - ql(kte) = ql(kte-1) - vt(kte) = vt(kte-1) - vq(kte) = vq(kte-1) - qc_bl1D(kte)=0. - cldfra_bl1D(kte)=0. + if (ri2.lt.0) then + !CALL PSI_DyerHicks(psim1,psih1,zol3,zt,z0,za) + psix2=log((za+z0)/z0)-(psim_unstable(zol3)-psim_unstable(zol20)) + psit2=log((za+zt)/zt)-(psih_unstable(zol3)-psih_unstable(zol20)) + !psix2=log((za+z0)/z0)-psim1 + !psit2=log((za+zt)/zt)-psih1 + else + !CALL PSI_DyerHicks(psim1,psih1,zol2,zt,z0,za) + !CALL PSI_CB2005(psim1,psih1,zol3,zol20) + psix2=log((za+z0)/z0)-(psim_stable(zol3)-psim_stable(zol20)) + psit2=log((za+zt)/zt)-(psih_stable(zol3)-psih_stable(zol20)) + !psix2=log((za+z0)/z0)-psim1 + !psit2=log((za+zt)/zt)-psih1 + endif + + zolri2=zol2*psit2/psix2**2 - ri2 - RETURN + return + end function +!==================================================================== + SUBROUTINE psi_init - END SUBROUTINE mym_condensation + INTEGER :: N + REAL :: zolf + DO N=0,1000 + ! stable function tables + zolf = float(n)*0.01 + psim_stab(n)=psim_stable_full(zolf) + psih_stab(n)=psih_stable_full(zolf) + + ! unstable function tables + zolf = -float(n)*0.01 + psim_unstab(n)=psim_unstable_full(zolf) + psih_unstab(n)=psih_unstable_full(zolf) + ENDDO + + END SUBROUTINE psi_init ! ================================================================== +! ... integrated similarity functions ... +! + REAL function psim_stable_full(zolf) + REAL :: zolf + + !psim_stable_full=-6.1*log(zolf+(1+zolf**2.5)**(1./2.5)) + psim_stable_full=-6.1*log(zolf+(1+zolf**2.5)**0.4) + + return + end function + + REAL function psih_stable_full(zolf) + REAL :: zolf + + !psih_stable_full=-5.3*log(zolf+(1+zolf**1.1)**(1./1.1)) + psih_stable_full=-5.3*log(zolf+(1+zolf**1.1)**0.9090909090909090909) + + return + end function + + REAL function psim_unstable_full(zolf) + REAL :: zolf,x,ym,psimc,psimk + x=(1.-16.*zolf)**.25 + !psimk=2*ALOG(0.5*(1+X))+ALOG(0.5*(1+X*X))-2.*ATAN(X)+2.*ATAN(1.) + psimk=2.*ALOG(0.5*(1+X))+ALOG(0.5*(1+X*X))-2.*ATAN(X)+2.*atan1 + + ym=(1.-10.*zolf)**onethird + !psimc=(3./2.)*log((ym**2.+ym+1.)/3.)-sqrt(3.)*ATAN((2.*ym+1)/sqrt(3.))+4.*ATAN(1.)/sqrt(3.) + psimc=1.5*log((ym**2 + ym+1.)*onethird)-sqrt3*ATAN((2.*ym+1)/sqrt3)+4.*atan1/sqrt3 + + psim_unstable_full=(psimk+zolf**2*(psimc))/(1+zolf**2.) + + return + end function + + REAL function psih_unstable_full(zolf) + REAL :: zolf,y,yh,psihc,psihk + + y=(1.-16.*zolf)**.5 + !psihk=2.*log((1+y)/2.) + psihk=2.*log((1+y)*0.5) + + yh=(1.-34.*zolf)**onethird + !psihc=(3./2.)*log((yh**2.+yh+1.)/3.)-sqrt(3.)*ATAN((2.*yh+1)/sqrt(3.))+4.*ATAN(1.)/sqrt(3.) + psihc=1.5*log((yh**2.+yh+1.)*onethird)-sqrt3*ATAN((2.*yh+1)/sqrt3)+4.*atan1/sqrt3 + + psih_unstable_full=(psihk+zolf**2*(psihc))/(1+zolf**2) + + return + end function +!================================================================= +! look-up table functions +!================================================================= + REAL function psim_stable(zolf) + integer :: nzol + real :: rzol,zolf + + nzol = int(zolf*100.) + rzol = zolf*100. - nzol + if(nzol+1 .le. 1000)then + psim_stable = psim_stab(nzol) + rzol*(psim_stab(nzol+1)-psim_stab(nzol)) + else + psim_stable = psim_stable_full(zolf) + endif + + return + end function + + REAL function psih_stable(zolf) + integer :: nzol + real :: rzol,zolf + + nzol = int(zolf*100.) + rzol = zolf*100. - nzol + if(nzol+1 .le. 1000)then + psih_stable = psih_stab(nzol) + rzol*(psih_stab(nzol+1)-psih_stab(nzol)) + else + psih_stable = psih_stable_full(zolf) + endif + + return + end function + + REAL function psim_unstable(zolf) + integer :: nzol + real :: rzol,zolf + + nzol = int(-zolf*100.) + rzol = -zolf*100. - nzol + if(nzol+1 .le. 1000)then + psim_unstable = psim_unstab(nzol) + rzol*(psim_unstab(nzol+1)-psim_unstab(nzol)) + else + psim_unstable = psim_unstable_full(zolf) + endif + + return + end function + + REAL function psih_unstable(zolf) + integer :: nzol + real :: rzol,zolf + + nzol = int(-zolf*100.) + rzol = -zolf*100. - nzol + if(nzol+1 .le. 1000)then + psih_unstable = psih_unstab(nzol) + rzol*(psih_unstab(nzol+1)-psih_unstab(nzol)) + else + psih_unstable = psih_unstable_full(zolf) + endif + + return + end function +!======================================================================== END MODULE module_sf_mynn diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 1084aa426..63edc3486 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -57,14 +57,16 @@ end subroutine hedmf_finalize !! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. !! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm !! @{ - subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & u1,v1,t1,q1,swh,hlw,xmu, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & - & xkzminv,moninq_fac,errmsg,errflg) + & xkzminv,moninq_fac,lssav,ldiag3d,qdiag3d,lsidea,ntoz, & + & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL,do3dt_PBL, & + & flag_for_pbl_generic_tend, errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -74,9 +76,10 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ! arguments ! - logical, intent(in) :: lprnt + logical, intent(in) :: lprnt,lssav,ldiag3d,qdiag3d,lsidea + logical, intent(in) :: flag_for_pbl_generic_tend integer, intent(in) :: ipr - integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) + integer, intent(in) :: im, km, ntrac, ntcw, kinver(im), ntoz integer, intent(out) :: kpbl(im) ! @@ -84,10 +87,13 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac 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 real(kind=kind_phys), intent(in) :: & - & u1(ix,km), v1(ix,km), & - & t1(ix,km), q1(ix,km,ntrac), & - & swh(ix,km), hlw(ix,km), & + & u1(im,km), v1(im,km), & + & t1(im,km), q1(im,km,ntrac), & + & swh(im,km), hlw(im,km), & & xmu(im), psk(im), & & rbsoil(im), zorl(im), & & u10m(im), v10m(im), & @@ -96,9 +102,9 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & heat(im), evap(im), & & stress(im), spd1(im) real(kind=kind_phys), intent(in) :: & - & prsi(ix,km+1), del(ix,km), & - & prsl(ix,km), prslk(ix,km), & - & phii(ix,km+1), phil(ix,km) + & 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(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -237,8 +243,6 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !> ## Compute preliminary variables from input arguments ! compute preliminary variables -! - if (ix .lt. im) stop ! ! iprt = 0 ! if(iprt.eq.1) then @@ -854,7 +858,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo !> For details of the mfpbl subroutine, step into its documentation ::mfpbl - call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, + call mfpbl(im,im,km,ntrac,dt2,pcnvflg, & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) ! @@ -1037,6 +1041,18 @@ subroutine hedmf_run (ix,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 + if(lsidea) then + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*rdt + else + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + & + & ((ttend-hlw(i,k)-swh(i,k)*xmu(i))*rdt) + endif + if(qdiag3d) then + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*rdt + endif + endif enddo enddo if(ntrac >= 2) then @@ -1049,6 +1065,17 @@ subroutine hedmf_run (ix,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))*rdt + do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend + enddo + enddo + endif endif ! ! compute tke dissipation rate @@ -1150,6 +1177,11 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & dv(i,k) = dv(i,k) + vtend dusfc(i) = dusfc(i) + conw*del(i,k)*utend dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend + if(lssav .and. ldiag3d .and. .not. & + & flag_for_pbl_generic_tend) then + du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*delt + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*delt + endif ! ! for dissipative heating for ecmwf model ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 09abe71a0..a89660cac 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -32,14 +32,6 @@ [ccpp-arg-table] name = hedmf_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -499,6 +491,89 @@ kind = kind_phys intent = in optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + 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 +[lsidea] + standard_name = flag_idealized_physics + long_name = flag for idealized physics + units = flag + dimensions = () + type = logical + intent = in +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + 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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/moninedmf_hafs.f b/physics/moninedmf_hafs.f index 5c6ff85a8..00a8dbd0b 100644 --- a/physics/moninedmf_hafs.f +++ b/physics/moninedmf_hafs.f @@ -57,7 +57,7 @@ end subroutine hedmf_hafs_finalize !! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. !! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm !! @{ - subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + subroutine hedmf_hafs_run(im,km,ntrac,ntcw,dv,du,tau,rtg, & & u1,v1,t1,q1,swh,hlw,xmu, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & @@ -76,7 +76,7 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! logical, intent(in) :: lprnt integer, intent(in) :: ipr - integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) + integer, intent(in) :: im, km, ntrac, ntcw, kinver(im) integer, intent(in) :: islimsk(1:im) integer, intent(out) :: kpbl(im) @@ -86,9 +86,9 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & & tau(im,km), rtg(im,km,ntrac) real(kind=kind_phys), intent(in) :: & - & u1(ix,km), v1(ix,km), & - & t1(ix,km), q1(ix,km,ntrac), & - & swh(ix,km), hlw(ix,km), & + & u1(im,km), v1(im,km), & + & t1(im,km), q1(im,km,ntrac), & + & swh(im,km), hlw(im,km), & & xmu(im), psk(im), & & rbsoil(im), zorl(im), & & u10m(im), v10m(im), & @@ -97,9 +97,9 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & heat(im), evap(im), & & stress(im), spd1(im) real(kind=kind_phys), intent(in) :: & - & prsi(ix,km+1), del(ix,km), & - & prsl(ix,km), prslk(ix,km), & - & phii(ix,km+1), phil(ix,km) + & 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(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -257,8 +257,6 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !> ## Compute preliminary variables from input arguments ! compute preliminary variables -! - if (ix .lt. im) stop ! ! iprt = 0 ! if(iprt.eq.1) then @@ -1107,7 +1105,7 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo !> For details of the mfpbl subroutine, step into its documentation ::mfpbl - call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, + call mfpbl(im,im,km,ntrac,dt2,pcnvflg, & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) ! diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index d600c8eac..2883e6847 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -32,14 +32,6 @@ [ccpp-arg-table] name = hedmf_hafs_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/moninshoc.f b/physics/moninshoc.f index eb6ccd7e7..86cab9643 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -24,7 +24,7 @@ end subroutine moninshoc_finalize !> \section arg_table_moninshoc_run Argument Table !! \htmlinclude moninshoc_run.html !! - subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, + subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & u1,v1,t1,q1,tkh,prnum,ntke, & psk,rbsoil,zorl,u10m,v10m,fm,fh, & tsea,heat,evap,stress,spd1,kpbl, @@ -41,7 +41,7 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! arguments ! - integer, intent(in) :: ix, im, + integer, intent(in) :: im, & km, ntrac, ntcw, ncnd, ntke integer, dimension(im), intent(in) :: kinver @@ -51,10 +51,10 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & rd, cp, hvap, fv real(kind=kind_phys), dimension(im), intent(in) :: psk, & rbsoil, zorl, u10m, v10m, fm, fh, tsea, heat, evap, stress, spd1 - real(kind=kind_phys), dimension(ix,km), intent(in) :: u1, v1, + real(kind=kind_phys), dimension(im,km), intent(in) :: u1, v1, & t1, tkh, del, prsl, phil, prslk - real(kind=kind_phys), dimension(ix,km+1), intent(in) :: prsi, phii - real(kind=kind_phys), dimension(ix,km,ntrac), intent(in) :: q1 + real(kind=kind_phys), dimension(im,km+1), intent(in) :: prsi, phii + real(kind=kind_phys), dimension(im,km,ntrac), intent(in) :: q1 real(kind=kind_phys), dimension(im,km), intent(inout) :: du, dv, & tau @@ -114,8 +114,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, !----------------------------------------------------------------------- ! ! compute preliminary variables -! - if (ix < im) stop ! dt2 = delt rdt = 1. / dt2 diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index d5fd594ab..e8da8478d 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = moninshoc_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index e3b760738..ec19945b0 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -8,7 +8,10 @@ module mp_thompson use machine, only : kind_phys - use module_mp_thompson, only : thompson_init, mp_gt_driver, thompson_finalize + use module_mp_thompson, only : thompson_init, mp_gt_driver, thompson_finalize, calc_effectRad + use module_mp_thompson, only : naIN0, naIN1, naCCN0, naCCN1, eps, Nt_c + + use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber, make_RainNumber implicit none @@ -20,40 +23,80 @@ module mp_thompson contains -!> This subroutine is a wrapper around the actual mp_gt_driver(). +!> This subroutine is a wrapper around the actual thompson_init(). !! \section arg_table_mp_thompson_init Argument Table !! \htmlinclude mp_thompson_init.html !! - subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & - nwfa2d, nifa2d, nwfa, nifa, & - mpicomm, mpirank, mpiroot, & - imp_physics, & - imp_physics_thompson, & - threads, errmsg, errflg) + subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & + imp_physics, imp_physics_thompson, & + spechum, qc, qr, qi, qs, qg, ni, nr, & + is_aerosol_aware, nc, nwfa2d, nifa2d, & + nwfa, nifa, tgrs, prsl, phil, area, & + re_cloud, re_ice, re_snow, & + mpicomm, mpirank, mpiroot, & + threads, errmsg, errflg) implicit none ! Interface variables - integer, intent(in) :: ncol - integer, intent(in) :: nlev - logical, intent(in) :: is_aerosol_aware - real(kind_phys), optional, intent(inout) :: nwfa2d(:) - real(kind_phys), optional, intent(inout) :: nifa2d(:) + integer, intent(in ) :: ncol + integer, intent(in ) :: nlev + real(kind_phys), intent(in ) :: con_g, con_rd + logical, intent(in ) :: restart + integer, intent(in ) :: imp_physics + integer, intent(in ) :: imp_physics_thompson + ! Hydrometeors + real(kind_phys), intent(inout) :: spechum(:,:) + real(kind_phys), intent(inout) :: qc(:,:) + real(kind_phys), intent(inout) :: qr(:,:) + real(kind_phys), intent(inout) :: qi(:,:) + real(kind_phys), intent(inout) :: qs(:,:) + real(kind_phys), intent(inout) :: qg(:,:) + real(kind_phys), intent(inout) :: ni(:,:) + real(kind_phys), intent(inout) :: nr(:,:) + ! Aerosols + logical, intent(in ) :: is_aerosol_aware + real(kind_phys), optional, intent(inout) :: nc(:,:) real(kind_phys), optional, intent(inout) :: nwfa(:,:) real(kind_phys), optional, intent(inout) :: nifa(:,:) - integer, intent(in) :: mpicomm - integer, intent(in) :: mpirank - integer, intent(in) :: mpiroot - integer, intent(in) :: threads - integer, intent(in) :: imp_physics - integer, intent(in) :: imp_physics_thompson + real(kind_phys), optional, intent(inout) :: nwfa2d(:) + real(kind_phys), optional, intent(inout) :: nifa2d(:) + ! State variables + real(kind_phys), intent(in ) :: tgrs(:,:) + real(kind_phys), intent(in ) :: prsl(:,:) + real(kind_phys), intent(in ) :: phil(:,:) + real(kind_phys), intent(in ) :: area(:) + ! Cloud effective radii + real(kind_phys), optional, intent( out) :: re_cloud(:,:) + real(kind_phys), optional, intent( out) :: re_ice(:,:) + real(kind_phys), optional, intent( out) :: re_snow(:,:) + ! MPI information + integer, intent(in ) :: mpicomm + integer, intent(in ) :: mpirank + integer, intent(in ) :: mpiroot + ! Threading/blocking information + integer, intent(in ) :: threads + ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg - ! Local variables: dimensions used in thompson_init - integer :: ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte + ! Hydrometeors + real(kind_phys) :: qv_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) + real(kind_phys) :: qc_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) + real(kind_phys) :: qr_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) + real(kind_phys) :: qi_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) + real(kind_phys) :: qs_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) + real(kind_phys) :: qg_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) + real(kind_phys) :: ni_mp(1:ncol,1:nlev) !< kg-1 + real(kind_phys) :: nr_mp(1:ncol,1:nlev) !< kg-1 + real(kind_phys) :: nc_mp(1:ncol,1:nlev) !< kg-1 + ! + real(kind_phys) :: hgt(1:ncol,1:nlev) ! m + real(kind_phys) :: rho(1:ncol,1:nlev) ! kg m-3 + real(kind_phys) :: orho(1:ncol,1:nlev) ! m3 kg-1 + ! + real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 + integer :: i, k ! Initialize the CCPP error handling variables errmsg = '' @@ -69,57 +112,240 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & end if ! *DH temporary + ! Consistency checks if (imp_physics/=imp_physics_thompson) then write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from Thompson MP" errflg = 1 return end if - ! Set internal dimensions - ids = 1 - ims = 1 - its = 1 - ide = ncol - ime = ncol - ite = ncol - jds = 1 - jms = 1 - jts = 1 - jde = 1 - jme = 1 - jte = 1 - kds = 1 - kms = 1 - kts = 1 - kde = nlev - kme = nlev - kte = nlev + ! Call Thompson init + if (is_aerosol_aware) then + call thompson_init(nwfa2d=nwfa2d, nifa2d=nifa2d, nwfa=nwfa, nifa=nifa, & + mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & + threads=threads, errmsg=errmsg, errflg=errflg) + if (errflg /= 0) return + else + call thompson_init(mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & + threads=threads, errmsg=errmsg, errflg=errflg) + if (errflg /= 0) return + end if + + ! For restart runs, the init is done here + if (restart) then + is_initialized = .true. + return + end if + + ! Fix initial values of hydrometeors + where(spechum<0) spechum = 0.0 + where(qc<0) qc = 0.0 + where(qr<0) qr = 0.0 + where(qi<0) qi = 0.0 + where(qs<0) qs = 0.0 + where(qg<0) qg = 0.0 + where(ni<0) ni = 0.0 + where(nr<0) nr = 0.0 + + if (is_aerosol_aware) then + ! Fix initial values of aerosols + where(nc<0) nc = 0.0 + where(nwfa<0) nwfa = 0.0 + where(nifa<0) nifa = 0.0 + where(nwfa2d<0) nwfa2d = 0.0 + where(nifa2d<0) nifa2d = 0.0 + end if + + ! Geopotential height in m2 s-2 to height in m + hgt = phil/con_g + + ! Density of air in kg m-3 and inverse density of air + rho = prsl/(con_rd*tgrs) + orho = 1.0/rho + + ! Prior to calling the functions: make_DropletNumber, make_IceNumber, make_RainNumber, + ! the incoming mixing ratios should be converted to units of mass/num per cubic meter + ! rather than per kg of air. So, to pass back to the model state variables, + ! they also need to be switched back to mass/number per kg of air, because + ! what is returned by the functions is in units of number per cubic meter. + ! They also need to be converted to dry mixing ratios. + + !> - Convert specific humidity/moist mixing ratios to dry mixing ratios + qv_mp = spechum/(1.0_kind_phys-spechum) + qc_mp = qc/(1.0_kind_phys-spechum) + qr_mp = qr/(1.0_kind_phys-spechum) + qi_mp = qi/(1.0_kind_phys-spechum) + qs_mp = qs/(1.0_kind_phys-spechum) + qg_mp = qg/(1.0_kind_phys-spechum) + + !> - Convert number concentrations from moist to dry + ni_mp = ni/(1.0_kind_phys-spechum) + nr_mp = nr/(1.0_kind_phys-spechum) + if (is_aerosol_aware) then + nc_mp = nc/(1.0_kind_phys-spechum) + end if + + ! If qi is in boundary conditions but ni is not, calculate ni from qi, rho and tgrs + if (maxval(qi_mp)>0.0 .and. maxval(ni_mp)==0.0) then + ni_mp = make_IceNumber(qi_mp*rho, tgrs) * orho + end if + + ! If ni is in boundary conditions but qi is not, reset ni to zero + if (maxval(ni_mp)>0.0 .and. maxval(qi_mp)==0.0) ni_mp = 0.0 + + ! If qr is in boundary conditions but nr is not, calculate nr from qr, rho and tgrs + if (maxval(qr_mp)>0.0 .and. maxval(nr_mp)==0.0) then + nr_mp = make_RainNumber(qr_mp*rho, tgrs) * orho + end if + + ! If nr is in boundary conditions but qr is not, reset nr to zero + if (maxval(nr_mp)>0.0 .and. maxval(qr_mp)==0.0) nr_mp = 0.0 + + !..Check for existing aerosol data, both CCN and IN aerosols. If missing + !.. fill in just a basic vertical profile, somewhat boundary-layer following. + if (is_aerosol_aware) then + + ! CCN + if (MAXVAL(nwfa) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosols.' + do i = 1, ncol + if (hgt(i,1).le.1000.0) then + h_01 = 0.8 + elseif (hgt(i,1).ge.2500.0) then + h_01 = 0.01 + else + h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) + endif + niCCN3 = -1.0*ALOG(naCCN1/naCCN0)/h_01 + nwfa(i,1) = naCCN1+naCCN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niCCN3) + airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg + nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) + do k = 2, nlev + nwfa(i,k) = naCCN1+naCCN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niCCN3) + enddo + enddo + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosols are present.' + if (MAXVAL(nwfa2d) .lt. eps) then +! Hard-coded switch between new (from WRFv4.0, top) and old (until WRFv3.9.1.1, bottom) surface emission rate calculations +#if 0 + !+---+-----------------------------------------------------------------+ + !..Scale the lowest level aerosol data into an emissions rate. This is + !.. very far from ideal, but need higher emissions where larger amount + !.. of (climo) existing and lesser emissions where there exists fewer to + !.. begin as a first-order simplistic approach. Later, proper connection to + !.. emission inventory would be better, but, for now, scale like this: + !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per second per grid box unit + !.. that was tested as ~(20kmx20kmx50m = 2.E10 m**-3) + !+---+-----------------------------------------------------------------+ + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' + if (mpirank==mpiroot) write(*,*) ' Use new (WRFv4+) formula to calculate CCN surface emission rates.' + do i = 1, ncol + airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg + nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) + enddo +#else + !+---+-----------------------------------------------------------------+ + !..Scale the lowest level aerosol data into an emissions rate. This is + !.. very far from ideal, but need higher emissions where larger amount + !.. of existing and lesser emissions where not already lots of aerosols + !.. for first-order simplistic approach. Later, proper connection to + !.. emission inventory would be better, but, for now, scale like this: + !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per kg per second + !.. Nwfa=500 per cc, emit 0.875E5 aerosols per kg per second + !.. Nwfa=5000 per cc, emit 0.875E6 aerosols per kg per second + !.. for a grid with 20km spacing and scale accordingly for other spacings. + !+---+-----------------------------------------------------------------+ + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' + if (mpirank==mpiroot) write(*,*) ' Use old (pre WRFv4) formula to calculate CCN surface emission rates.' + do i = 1, ncol + if (SQRT(area(i))/20000.0 .ge. 1.0) then + h_01 = 0.875 + else + h_01 = (0.875 + 0.125*((20000.-SQRT(area(i)))/16000.)) * SQRT(area(i))/20000. + endif + nwfa2d(i) = 10.0**(LOG10(nwfa(i,1)*1.E-6)-3.69897) + nwfa2d(i) = nwfa2d(i)*h_01 * 1.E6 + enddo +#endif + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosol surface emission rates are present.' + endif + endif + + ! IN + if (MAXVAL(nifa) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosols.' + do i = 1, ncol + if (hgt(i,1).le.1000.0) then + h_01 = 0.8 + elseif (hgt(i,1).ge.2500.0) then + h_01 = 0.01 + else + h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) + endif + niIN3 = -1.0*ALOG(naIN1/naIN0)/h_01 + nifa(i,1) = naIN1+naIN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niIN3) + nifa2d(i) = 0. + do k = 2, nlev + nifa(i,k) = naIN1+naIN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niIN3) + enddo + enddo + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial IN aerosols are present.' + if (MAXVAL(nifa2d) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosol surface emission rates, set to zero.' + ! calculate IN surface flux here, right now just set to zero + nifa2d = 0. + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial IN aerosol surface emission rates are present.' + endif + endif + + ! If qc is in boundary conditions but nc is not, calculate nc from qc, rho and nwfa + if (maxval(qc_mp)>0.0 .and. maxval(nc_mp)==0.0) then + nc_mp = make_DropletNumber(qc_mp*rho, nwfa) * orho + end if + + ! If nc is in boundary conditions but qc is not, reset nc to zero + if (maxval(nc_mp)>0.0 .and. maxval(qc_mp)==0.0) nc_mp = 0.0 - if (is_aerosol_aware .and. present(nwfa2d) & - .and. present(nifa2d) & - .and. present(nwfa) & - .and. present(nifa) ) then - ! Call init - call thompson_init(nwfa2d=nwfa2d, nifa2d=nifa2d, nwfa=nwfa, nifa=nifa, & - ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & - ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & - its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & - mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads, errmsg=errmsg, errflg=errflg) - if (errflg /= 0) return - else if (is_aerosol_aware) then - write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_init:', & - ' aerosol-aware microphysics require all of the following', & - ' optional arguments: nifa2d, nwfa2d, nwfa, nifa' - errflg = 1 - return else - call thompson_init(ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & - ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & - its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & - mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads, errmsg=errmsg, errflg=errflg) - if (errflg /= 0) return + + ! Constant droplet concentration for single moment cloud water as in + ! module_mp_thompson.F90, only needed for effective radii calculation + nc_mp = Nt_c/rho + + end if + + ! Calculate initial cloud effective radii if requested + if (present(re_cloud) .and. present(re_ice) .and. present(re_snow)) then + ! Effective radii [m] are now intent(out), bounds applied in calc_effectRad + do i = 1, ncol + call calc_effectRad (tgrs(i,:), prsl(i,:), qv_mp(i,:), qc_mp(i,:), & + nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & + re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, nlev) + end do + !! Convert to micron: required for bit-for-bit identical restarts; + !! otherwise entering mp_thompson_init and converting mu to m and + !! back (without updating re_*) introduces b4b differences. + !! If this code is used, change units in metadata from m to um! + !re_cloud = 1.0E6*re_cloud + !re_ice = 1.0E6*re_ice + !re_snow = 1.0E6*re_snow + else if (present(re_cloud) .or. present(re_ice) .or. present(re_snow)) then + write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_init:', & + ' all or none of the following optional', & + ' arguments are required: re_cloud, re_ice, re_snow' + errflg = 1 + return + end if + + !> - Convert number concentrations from dry to moist + ni = ni_mp/(1.0_kind_phys+qv_mp) + nr = nr_mp/(1.0_kind_phys+qv_mp) + if (is_aerosol_aware) then + nc = nc_mp/(1.0_kind_phys+qv_mp) end if is_initialized = .true. @@ -163,7 +389,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(inout) :: ni(1:ncol,1:nlev) real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev) ! Aerosols - logical, intent(in) :: is_aerosol_aware,reset + logical, intent(in) :: is_aerosol_aware, reset + ! The following arrays are not allocated if is_aerosol_aware is false real(kind_phys), optional, intent(inout) :: nc(:,:) real(kind_phys), optional, intent(inout) :: nwfa(:,:) real(kind_phys), optional, intent(inout) :: nifa(:,:) @@ -208,6 +435,10 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys) :: qi_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) real(kind_phys) :: qs_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) real(kind_phys) :: qg_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) + real(kind_phys) :: ni_mp(1:ncol,1:nlev) !< kg-1 + real(kind_phys) :: nr_mp(1:ncol,1:nlev) !< kg-1 + real(kind_phys) :: nc_mp(1:ncol,1:nlev) !< kg-1 + ! Vertical velocity and level width real(kind_phys) :: w(1:ncol,1:nlev) !< m s-1 real(kind_phys) :: dz(1:ncol,1:nlev) !< m @@ -228,6 +459,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & integer :: has_reqc integer :: has_reqi integer :: has_reqs + ! DH* 2020-06-05 hardcode these values for not using random perturbations, + ! hasn't been tested yet with this version of module_mp_thompson.F90 + integer, parameter :: rand_perturb_on = 0 + integer, parameter :: kme_stoch = 1 + !real(kind_phys) :: rand_pert(1:ncol,1:kme_stoch) + ! *DH 2020-06-05 ! Dimensions used in mp_gt_driver integer :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -244,14 +481,6 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & return end if - !> - Convert specific humidity/moist mixing ratios to dry mixing ratios - qv_mp = spechum/(1.0_kind_phys-spechum) - qc_mp = qc/(1.0_kind_phys-spechum) - qr_mp = qr/(1.0_kind_phys-spechum) - qi_mp = qi/(1.0_kind_phys-spechum) - qs_mp = qs/(1.0_kind_phys-spechum) - qg_mp = qg/(1.0_kind_phys-spechum) - if (is_aerosol_aware .and. .not. (present(nc) .and. & present(nwfa) .and. & present(nifa) .and. & @@ -265,6 +494,21 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & return end if + !> - Convert specific humidity/moist mixing ratios to dry mixing ratios + qv_mp = spechum/(1.0_kind_phys-spechum) + qc_mp = qc/(1.0_kind_phys-spechum) + qr_mp = qr/(1.0_kind_phys-spechum) + qi_mp = qi/(1.0_kind_phys-spechum) + qs_mp = qs/(1.0_kind_phys-spechum) + qg_mp = qg/(1.0_kind_phys-spechum) + + !> - Convert number concentrations from moist to dry + ni_mp = ni/(1.0_kind_phys-spechum) + nr_mp = nr/(1.0_kind_phys-spechum) + if (is_aerosol_aware) then + nc_mp = nc/(1.0_kind_phys-spechum) + end if + !> - Density of air in kg m-3 rho = prsl/(con_rd*tgrs) @@ -336,11 +580,10 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & kme = nlev kte = nlev - !> - Call mp_gt_driver() with or without aerosols if (is_aerosol_aware) then call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, & - ni=ni, nr=nr, nc=nc, & + ni=ni_mp, nr=nr_mp, nc=nc_mp, & nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & rainnc=rain_mp, rainncv=delta_rain_mp, & @@ -351,6 +594,10 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & re_cloud=re_cloud, re_ice=re_ice, re_snow=re_snow, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & + rand_perturb_on=rand_perturb_on, kme_stoch=kme_stoch, & + ! DH* 2020-06-05 not passing this optional argument, see + ! comment in module_mp_thompson.F90 / mp_gt_driver + !rand_pert=rand_pert, & ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & @@ -358,7 +605,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & else call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, & - ni=ni, nr=nr, nc=nc, & + ni=ni_mp, nr=nr_mp, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -368,6 +615,10 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & re_cloud=re_cloud, re_ice=re_ice, re_snow=re_snow, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & + rand_perturb_on=rand_perturb_on, kme_stoch=kme_stoch, & + ! DH* 2020-06-05 not passing this optional argument, see + ! comment in module_mp_thompson.F90 / mp_gt_driver + !rand_pert=rand_pert, & ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & @@ -383,6 +634,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & qs = qs_mp/(1.0_kind_phys+qv_mp) qg = qg_mp/(1.0_kind_phys+qv_mp) + !> - Convert number concentrations from dry to moist + ni = ni_mp/(1.0_kind_phys+qv_mp) + nr = nr_mp/(1.0_kind_phys+qv_mp) + if (is_aerosol_aware) then + nc = nc_mp/(1.0_kind_phys+qv_mp) + end if !> - Convert rainfall deltas from mm to m (on physics timestep); add to inout variables ! "rain" in Thompson MP refers to precipitation (total of liquid rainfall+snow+graupel+ice) @@ -395,11 +652,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & end subroutine mp_thompson_run !>@} -#if 0 !! \section arg_table_mp_thompson_finalize Argument Table !! \htmlinclude mp_thompson_finalize.html !! -#endif subroutine mp_thompson_finalize(errmsg, errflg) implicit none diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 45113cbb2..5bbd85732 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -17,6 +17,120 @@ type = integer intent = in optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[spechum] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qr] + standard_name = rain_water_mixing_ratio + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qi] + standard_name = ice_water_mixing_ratio + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qs] + standard_name = snow_water_mixing_ratio + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qg] + standard_name = graupel_mixing_ratio + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ni] + standard_name = ice_number_concentration + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nr] + standard_name = rain_number_concentration + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [is_aerosol_aware] standard_name = flag_for_aerosol_physics long_name = flag for aerosol-aware physics @@ -25,6 +139,15 @@ type = logical intent = in optional = F +[nc] + standard_name = cloud_droplet_number_concentration + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T [nwfa2d] standard_name = tendency_of_water_friendly_aerosols_at_surface long_name = instantaneous fake water-friendly surface aerosol source @@ -61,6 +184,69 @@ kind = kind_phys intent = inout optional = T +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[re_cloud] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[re_ice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[re_snow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometer + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T [mpicomm] standard_name = mpi_comm long_name = MPI communicator @@ -93,22 +279,6 @@ type = integer intent = in optional = F -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_thompson] - standard_name = flag_for_thompson_microphysics_scheme - long_name = choice of Thompson microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -422,7 +592,7 @@ type = real kind = kind_phys intent = out - optional = F + optional = T [re_ice] standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer (meter here) @@ -431,7 +601,7 @@ type = real kind = kind_phys intent = out - optional = F + optional = T [re_snow] standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometer (meter here) @@ -440,7 +610,7 @@ type = real kind = kind_phys intent = out - optional = F + optional = T [mpicomm] standard_name = mpi_comm long_name = MPI communicator diff --git a/physics/mp_thompson_post.F90 b/physics/mp_thompson_post.F90 index feb031a3e..cca74951d 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -12,21 +12,16 @@ module mp_thompson_post logical :: apply_limiter - real(kind_phys), dimension(:), allocatable :: mp_tend_lim - contains -#if 0 !! \section arg_table_mp_thompson_post_init Argument Table !! \htmlinclude mp_thompson_post_init.html !! -#endif - subroutine mp_thompson_post_init(ncol, ttendlim, errmsg, errflg) + subroutine mp_thompson_post_init(ttendlim, errmsg, errflg) implicit none ! Interface variables - integer, intent(in) :: ncol real(kind_phys), intent(in) :: ttendlim ! CCPP error handling @@ -45,28 +40,18 @@ subroutine mp_thompson_post_init(ncol, ttendlim, errmsg, errflg) if (ttendlim < 0) then apply_limiter = .false. - is_initialized = .true. - return + else + apply_limiter = .true. end if - allocate(mp_tend_lim(1:ncol)) - - do i=1,ncol - mp_tend_lim(i) = ttendlim - end do - - apply_limiter = .true. - is_initialized = .true. end subroutine mp_thompson_post_init -#if 0 !! \section arg_table_mp_thompson_post_run Argument Table !! \htmlinclude mp_thompson_post_run.html !! -#endif - subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & + subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendlim, & kdt, mpicomm, mpirank, mpiroot, errmsg, errflg) implicit none @@ -78,6 +63,7 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & real(kind_phys), dimension(1:ncol,1:nlev), intent(inout) :: tgrs real(kind_phys), dimension(1:ncol,1:nlev), intent(in) :: prslk real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in) :: ttendlim integer, intent(in) :: kdt ! MPI information integer, intent(in ) :: mpicomm @@ -90,7 +76,9 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & ! Local variables real(kind_phys), dimension(1:ncol,1:nlev) :: mp_tend integer :: i, k +#ifdef DEBUG integer :: events +#endif ! Initialize the CCPP error handling variables errmsg = '' @@ -106,37 +94,39 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & ! If limiter is deactivated, return immediately if (.not.apply_limiter) return - ! mp_tend and mp_tend_lim are expressed in potential temperature + ! mp_tend and ttendlim are expressed in potential temperature mp_tend = (tgrs - tgrs_save)/prslk +#ifdef DEBUG events = 0 +#endif do k=1,nlev do i=1,ncol - mp_tend(i,k) = max( -mp_tend_lim(i)*dtp, min( mp_tend_lim(i)*dtp, mp_tend(i,k) ) ) + mp_tend(i,k) = max( -ttendlim*dtp, min( ttendlim*dtp, mp_tend(i,k) ) ) - if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then #ifdef DEBUG + if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then write(0,'(a,3i6,3e16.7)') "mp_thompson_post_run mp_tend limiter: kdt, i, k, t_old, t_new, t_lim:", & & kdt, i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) -#endif events = events + 1 end if +#endif tgrs(i,k) = tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) end do end do +#ifdef DEBUG if (events > 0) then - write(0,'(a,i0,a,i0,a,i0)') "mp_thompson_post_run: mp_tend_lim applied ", events, "/", nlev*ncol, & + write(0,'(a,i0,a,i0,a,i0)') "mp_thompson_post_run: ttendlim applied ", events, "/", nlev*ncol, & & " times at timestep ", kdt end if +#endif end subroutine mp_thompson_post_run -#if 0 !! \section arg_table_mp_thompson_post_finalize Argument Table !! \htmlinclude mp_thompson_post_finalize.html !! -#endif subroutine mp_thompson_post_finalize(errmsg, errflg) implicit none @@ -148,12 +138,10 @@ subroutine mp_thompson_post_finalize(errmsg, errflg) ! initialize ccpp error handling variables errmsg = '' errflg = 0 - + ! Check initialization state if (.not. is_initialized) return - if (allocated(mp_tend_lim)) deallocate(mp_tend_lim) - is_initialized = .false. end subroutine mp_thompson_post_finalize diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index 0f3cc6189..eeaeeb65d 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = mp_thompson_post_init type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F [ttendlim] standard_name = limit_for_temperature_tendency_for_microphysics long_name = temperature tendency limiter per physics time step @@ -92,6 +84,15 @@ kind = kind_phys intent = in optional = F +[ttendlim] + standard_name = limit_for_temperature_tendency_for_microphysics + long_name = temperature tendency limiter per physics time step + units = K s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [kdt] standard_name = index_of_time_step long_name = current forecast iteration diff --git a/physics/mp_thompson_pre.F90 b/physics/mp_thompson_pre.F90 index 3654b6682..4087ac815 100644 --- a/physics/mp_thompson_pre.F90 +++ b/physics/mp_thompson_pre.F90 @@ -7,10 +7,6 @@ module mp_thompson_pre use machine, only : kind_phys - use module_mp_thompson, only : naIN0, naIN1, naCCN0, naCCN1, eps - - use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber, make_RainNumber - implicit none public :: mp_thompson_pre_init, mp_thompson_pre_run, mp_thompson_pre_finalize @@ -22,64 +18,23 @@ module mp_thompson_pre subroutine mp_thompson_pre_init() end subroutine mp_thompson_pre_init -#if 0 !! \section arg_table_mp_thompson_pre_run Argument Table !! \htmlinclude mp_thompson_pre_run.html !! -#endif - subroutine mp_thompson_pre_run(ncol, nlev, kdt, con_g, con_rd, & - spechum, qc, qr, qi, qs, qg, ni, nr, & - is_aerosol_aware, nc, nwfa, nifa, nwfa2d, & - nifa2d, tgrs, tgrs_save, prsl, phil, area, & - mpirank, mpiroot, blkno, errmsg, errflg) + subroutine mp_thompson_pre_run(ncol, nlev, tgrs, tgrs_save, errmsg, errflg) implicit none ! Interface variables - ! Dimensions and constants integer, intent(in ) :: ncol integer, intent(in ) :: nlev - integer, intent(in ) :: kdt - real(kind_phys), intent(in ) :: con_g - real(kind_phys), intent(in ) :: con_rd - ! Hydrometeors - real(kind_phys), intent(inout) :: spechum(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qc(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qr(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qi(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qs(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: qg(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: ni(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev) - ! Aerosols - logical, intent(in ) :: is_aerosol_aware - real(kind_phys), optional, intent(inout) :: nc(:,:) - real(kind_phys), optional, intent(inout) :: nwfa(:,:) - real(kind_phys), optional, intent(inout) :: nifa(:,:) - real(kind_phys), optional, intent(inout) :: nwfa2d(:) - real(kind_phys), optional, intent(inout) :: nifa2d(:) - ! State variables and timestep information real(kind_phys), intent(in ) :: tgrs(1:ncol,1:nlev) real(kind_phys), intent( out) :: tgrs_save(1:ncol,1:nlev) - real(kind_phys), intent(in ) :: prsl(1:ncol,1:nlev) - real(kind_phys), intent(in ) :: phil(1:ncol,1:nlev) - real(kind_phys), intent(in ) :: area(1:ncol) - ! MPI information - integer, intent(in ) :: mpirank - integer, intent(in ) :: mpiroot - ! Blocking information - integer, intent(in ) :: blkno + ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg - ! Local variables - real (kind=kind_phys) :: hgt(1:ncol,1:nlev) ! m - real (kind=kind_phys) :: rho(1:ncol,1:nlev) ! kg m-3 - real (kind=kind_phys) :: orho(1:ncol,1:nlev) ! m3 kg-1 - real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 - integer :: i, k - ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -87,182 +42,6 @@ subroutine mp_thompson_pre_run(ncol, nlev, kdt, con_g, con_rd, & ! Save current air temperature for tendency limiters in mp_thompson_post tgrs_save = tgrs - ! Return if not first timestep - if (kdt > 1) return - - ! Consistency check - if (is_aerosol_aware .and. & - (.not.present(nc) .or. & - .not.present(nwfa2d) .or. & - .not.present(nifa2d) .or. & - .not.present(nwfa) .or. & - .not.present(nifa) )) then - write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_pre_run:', & - ' aerosol-aware microphysics require all of the following', & - ' optional arguments: nc, nwfa2d, nifa2d, nwfa, nifa' - errflg = 1 - return - end if - - ! Fix initial values of hydrometeors - where(spechum<0) spechum = 0.0 - where(qc<0) qc = 0.0 - where(qr<0) qr = 0.0 - where(qi<0) qi = 0.0 - where(qs<0) qs = 0.0 - where(qg<0) qg = 0.0 - where(ni<0) ni = 0.0 - where(nr<0) nr = 0.0 - - if (is_aerosol_aware) then - ! Fix initial values of aerosols - where(nc<0) nc = 0.0 - where(nwfa<0) nwfa = 0.0 - where(nifa<0) nifa = 0.0 - where(nwfa2d<0) nwfa2d = 0.0 - where(nifa2d<0) nifa2d = 0.0 - end if - - ! Geopotential height in m2 s-2 to height in m - hgt = phil/con_g - - ! Density of air in kg m-3 and inverse density of air - rho = prsl/(con_rd*tgrs) - orho = 1.0/rho - - ! Prior to calling the functions: make_DropletNumber, make_IceNumber, make_RainNumber, - ! the incoming mixing ratios should be converted to units of mass/num per cubic meter - ! rather than per kg of air. So, to pass back to the model state variables, - ! they also need to be switched back to mass/number per kg of air, because - ! what is returned by the functions is in units of number per cubic meter. - - ! If qi is in boundary conditions but ni is not, calculate ni from qi, rho and tgrs - if (maxval(qi)>0.0 .and. maxval(ni)==0.0) then - ni = make_IceNumber(qi*rho, tgrs) * orho - end if - - ! If ni is in boundary conditions but qi is not, reset ni to zero - if (maxval(ni)>0.0 .and. maxval(qi)==0.0) ni = 0.0 - - ! If qr is in boundary conditions but nr is not, calculate nr from qr, rho and tgrs - if (maxval(qr)>0.0 .and. maxval(nr)==0.0) then - nr = make_RainNumber(qr*rho, tgrs) * orho - end if - - ! If nr is in boundary conditions but qr is not, reset nr to zero - if (maxval(nr)>0.0 .and. maxval(qr)==0.0) nr = 0.0 - - ! Return if aerosol-aware option is not used - if (.not. is_aerosol_aware) return - -!..Check for existing aerosol data, both CCN and IN aerosols. If missing -!.. fill in just a basic vertical profile, somewhat boundary-layer following. - -!.. CCN - if (MAXVAL(nwfa) .lt. eps) then - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial CCN aerosols.' - do i = 1, ncol - if (hgt(i,1).le.1000.0) then - h_01 = 0.8 - elseif (hgt(i,1).ge.2500.0) then - h_01 = 0.01 - else - h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) - endif - niCCN3 = -1.0*ALOG(naCCN1/naCCN0)/h_01 - nwfa(i,1) = naCCN1+naCCN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niCCN3) - airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg - nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) - do k = 2, nlev - nwfa(i,k) = naCCN1+naCCN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niCCN3) - enddo - enddo - else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial CCN aerosols are present.' - if (MAXVAL(nwfa2d) .lt. eps) then -! Hard-coded switch between new (from WRFv4.0, top) and old (until WRFv3.9.1.1, bottom) surface emission rate calculations -#if 0 - !+---+-----------------------------------------------------------------+ - !..Scale the lowest level aerosol data into an emissions rate. This is - !.. very far from ideal, but need higher emissions where larger amount - !.. of (climo) existing and lesser emissions where there exists fewer to - !.. begin as a first-order simplistic approach. Later, proper connection to - !.. emission inventory would be better, but, for now, scale like this: - !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per second per grid box unit - !.. that was tested as ~(20kmx20kmx50m = 2.E10 m**-3) - !+---+-----------------------------------------------------------------+ - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Use new (WRFv4+) formula to calculate CCN surface emission rates.' - do i = 1, ncol - airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg - nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) - enddo -#else - !+---+-----------------------------------------------------------------+ - !..Scale the lowest level aerosol data into an emissions rate. This is - !.. very far from ideal, but need higher emissions where larger amount - !.. of existing and lesser emissions where not already lots of aerosols - !.. for first-order simplistic approach. Later, proper connection to - !.. emission inventory would be better, but, for now, scale like this: - !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per kg per second - !.. Nwfa=500 per cc, emit 0.875E5 aerosols per kg per second - !.. Nwfa=5000 per cc, emit 0.875E6 aerosols per kg per second - !.. for a grid with 20km spacing and scale accordingly for other spacings. - !+---+-----------------------------------------------------------------+ - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Use old (pre WRFv4) formula to calculate CCN surface emission rates.' - do i = 1, ncol - if (SQRT(area(i))/20000.0 .ge. 1.0) then - h_01 = 0.875 - else - h_01 = (0.875 + 0.125*((20000.-SQRT(area(i)))/16000.)) * SQRT(area(i))/20000. - endif - nwfa2d(i) = 10.0**(LOG10(nwfa(i,1)*1.E-6)-3.69897) - nwfa2d(i) = nwfa2d(i)*h_01 * 1.E6 - enddo -#endif - else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial CCN aerosol surface emission rates are present.' - endif - endif - -!.. IN - if (MAXVAL(nifa) .lt. eps) then - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial IN aerosols.' - do i = 1, ncol - if (hgt(i,1).le.1000.0) then - h_01 = 0.8 - elseif (hgt(i,1).ge.2500.0) then - h_01 = 0.01 - else - h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) - endif - niIN3 = -1.0*ALOG(naIN1/naIN0)/h_01 - nifa(i,1) = naIN1+naIN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niIN3) - nifa2d(i) = 0. - do k = 2, nlev - nifa(i,k) = naIN1+naIN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niIN3) - enddo - enddo - else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial IN aerosols are present.' - if (MAXVAL(nifa2d) .lt. eps) then - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently there are no initial IN aerosol surface emission rates, set to zero.' - ! calculate IN surface flux here, right now just set to zero - nifa2d = 0. - else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial IN aerosol surface emission rates are present.' - endif - endif - - ! If qc is in boundary conditions but nc is not, calculate nc from qc, rho and nwfa - if (maxval(qc)>0.0 .and. maxval(nc)==0.0) then - nc = make_DropletNumber(qc*rho, nwfa) * orho - end if - - ! If nc is in boundary conditions but qc is not, reset nc to zero - if (maxval(nc)>0.0 .and. maxval(qc)==0.0) nc = 0.0 - end subroutine mp_thompson_pre_run subroutine mp_thompson_pre_finalize() diff --git a/physics/mp_thompson_pre.meta b/physics/mp_thompson_pre.meta index 0fc225fa1..5782c10f6 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/mp_thompson_pre.meta @@ -17,157 +17,6 @@ type = integer intent = in optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in - optional = F -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_rd] - standard_name = gas_constant_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[spechum] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qc] - standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = cloud water mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qr] - standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = rain water mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qi] - standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = ice water mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qs] - standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = snow water mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qg] - standard_name = graupel_mixing_ratio_updated_by_physics - long_name = graupel mixing ratio wrt dry+vapor (no condensates) - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ni] - standard_name = ice_number_concentration_updated_by_physics - long_name = ice number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[nr] - standard_name = rain_number_concentration_updated_by_physics - long_name = rain number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[is_aerosol_aware] - standard_name = flag_for_aerosol_physics - long_name = flag for aerosol-aware physics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[nc] - standard_name = cloud_droplet_number_concentration_updated_by_physics - long_name = cloud droplet number concentration - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nwfa] - standard_name = water_friendly_aerosol_number_concentration_updated_by_physics - long_name = number concentration of water-friendly aerosols - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nifa] - standard_name = ice_friendly_aerosol_number_concentration_updated_by_physics - long_name = number concentration of ice-friendly aerosols - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nwfa2d] - standard_name = tendency_of_water_friendly_aerosols_at_surface - long_name = instantaneous fake water-friendly surface aerosol source - units = kg-1 s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[nifa2d] - standard_name = tendency_of_ice_friendly_aerosols_at_surface - long_name = instantaneous fake ice-friendly surface aerosol source - units = kg-1 s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = T [tgrs] standard_name = air_temperature_updated_by_physics long_name = model layer mean temperature @@ -186,57 +35,6 @@ kind = kind_phys intent = out optional = F -[prsl] - standard_name = air_pressure - long_name = mean layer pressure - units = Pa - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[phil] - standard_name = geopotential - long_name = geopotential at model layer centers - units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[area] - standard_name = cell_area - long_name = area of the grid cell - units = m2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[mpirank] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[mpiroot] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[blkno] - standard_name = ccpp_block_number - long_name = for explicit data blocking: block number of this block - 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/multi_gases.F90 b/physics/multi_gases.F90 index c660b7dfb..4f7c53aa4 100644 --- a/physics/multi_gases.F90 +++ b/physics/multi_gases.F90 @@ -77,8 +77,8 @@ subroutine multi_gases_init(ngas, nwat, ri, cpi, is_master) ! vicv(0): cv0/cv_air !-------------------------------------------- integer, intent(in):: ngas, nwat - real, intent(in):: ri(0:ngas) - real, intent(in):: cpi(0:ngas) + real(kind=kind_dyn), intent(in):: ri(0:ngas) + real(kind=kind_dyn), intent(in):: cpi(0:ngas) logical, intent(in):: is_master ! Local: integer n @@ -121,11 +121,11 @@ subroutine multi_gases_init(ngas, nwat, ri, cpi, is_master) enddo if( is_master ) then - write(*,*) ' multi_gases_init with ind_gas=',ind_gas - write(*,*) ' multi_gases_init with num_gas=',num_gas - write(*,*) ' multi_gases_init with vir =',vir - write(*,*) ' multi_gases_init with vicp=',vicp - write(*,*) ' multi_gases_init with vicv=',vicv + write(*,*) ' ccpp multi_gases_init with ind_gas=',ind_gas + write(*,*) ' ccpp multi_gases_init with num_gas=',num_gas + write(*,*) ' ccpp multi_gases_init with vir =',vir + write(*,*) ' ccpp multi_gases_init with vicp=',vicp + write(*,*) ' ccpp multi_gases_init with vicv=',vicv endif return @@ -149,7 +149,7 @@ pure real function virq(q) ! !OUTPUT PARAMETERS ! Ouput: variable gas 1+zvir/(1-qc) !-------------------------------------------- - real, intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: q(num_gas) ! Local: integer :: n @@ -169,7 +169,7 @@ pure real function virq_nodq(q) ! !OUTPUT PARAMETERS ! Ouput: variable gas 1+zvir without dividing by 1-qv or 1-qv-qc !-------------------------------------------- - real, intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: q(num_gas) ! Local: integer :: n @@ -188,8 +188,8 @@ pure real function virq_max(q, qmin) ! !OUTPUT PARAMETERS ! Ouput: variable gas 1+zvir using max(qmin,q(sphum)) !-------------------------------------------- - real, intent(in) :: q(num_gas) - real, intent(in) :: qmin + real(kind=kind_dyn), intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: qmin ! Local: integer :: n @@ -210,8 +210,8 @@ pure real function virq_qpz(q, qpz) ! !OUTPUT PARAMETERS ! Ouput: variable gas 1+zvir/(1.-qpz): qpz in place of qv+qc from q !-------------------------------------------- - real, intent(in) :: q(num_gas) - real, intent(in) :: qpz + real(kind=kind_dyn), intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: qpz ! Local: integer :: n @@ -232,7 +232,7 @@ pure real function virqd(q) ! !OUTPUT PARAMETERS ! Ouput: variable gas 1+zvir/(1-(qv+qc)) (dry) !-------------------------------------------- - real, intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: q(num_gas) ! Local: integer :: n @@ -252,7 +252,7 @@ pure real function vicpqd(q) ! !OUTPUT PARAMETERS ! Ouput: variable gas cp (dry) !-------------------------------------------- - real, intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: q(num_gas) ! Local: integer :: n @@ -272,8 +272,8 @@ pure real function vicpqd_qpz(q, qpz) ! !OUTPUT PARAMETERS ! Ouput: variable gas cp (dry) with qpz in place of qv+qc from q !-------------------------------------------- - real, intent(in) :: q(num_gas) - real, intent(in) :: qpz + real(kind=kind_dyn), intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: qpz ! Local: integer :: n @@ -293,7 +293,7 @@ pure real function vicvqd(q) ! !OUTPUT PARAMETERS ! Ouput: variable gas cv (dry) !-------------------------------------------- - real, intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: q(num_gas) ! Local: integer :: n @@ -313,8 +313,8 @@ pure real function vicvqd_qpz(q,qpz) ! !OUTPUT PARAMETERS ! Ouput: variable gas cv (dry) with qpz in place of qv+qc from q !-------------------------------------------- - real, intent(in) :: q(num_gas) - real, intent(in) :: qpz + real(kind=kind_dyn), intent(in) :: q(num_gas) + real(kind=kind_dyn), intent(in) :: qpz ! Local: integer :: n diff --git a/physics/ozphys.f b/physics/ozphys.f index 02296ee79..f8da58760 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -50,8 +50,8 @@ end subroutine ozphys_finalize !> \section genal_ozphys GFS ozphys_run General Algorithm !> @{ subroutine ozphys_run ( & - & ix, im, levs, ko3, dt, oz, tin, po3, & - & prsl, prdout, oz_coeff, delp, ldiag3d, & + & im, levs, ko3, dt, oz, tin, po3, & + & prsl, prdout, oz_coeff, delp, ldiag3d, qdiag3d, & & ozp1, ozp2, ozp3, ozp4, con_g, me, errmsg, errflg) ! ! this code assumes that both prsl and po3 are from bottom to top @@ -61,18 +61,18 @@ subroutine ozphys_run ( & implicit none ! ! Interface variables - integer, intent(in) :: im, ix, levs, ko3, oz_coeff, me + integer, intent(in) :: im, levs, ko3, oz_coeff, me real(kind=kind_phys), intent(inout) :: & - & oz(ix,levs) + & oz(im,levs) ! These arrays may not be allocated and need assumed array sizes real(kind=kind_phys), intent(inout) :: & & ozp1(:,:), ozp2(:,:), ozp3(:,:), ozp4(:,:) real(kind=kind_phys), intent(in) :: & - & dt, po3(ko3), prdout(ix,ko3,oz_coeff), & - & prsl(ix,levs), tin(ix,levs), delp(ix,levs), & + & 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 + logical, intent(in) :: ldiag3d, qdiag3d character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -82,7 +82,7 @@ subroutine ozphys_run ( & 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), - & ozib(im), colo3(im,levs+1), ozi(ix,levs) + & ozib(im), colo3(im,levs+1), ozi(im,levs) ! ! Initialize CCPP error handling variables errmsg = '' @@ -157,12 +157,12 @@ subroutine ozphys_run ( & oz(i,l) = (ozib(i) + prod(i,1)*dt) / (1.0 + prod(i,2)*dt) enddo ! - !if (ldiag3d) 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 - !endif + 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 + endif endif !> - Calculate the 4 terms of prognostic ozone change during time \a dt: !! - ozp1(:,:) - Ozone production from production/loss ratio @@ -178,14 +178,14 @@ 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) 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)) - ! 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 - !endif + 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 + endif endif enddo ! vertical loop diff --git a/physics/ozphys.meta b/physics/ozphys.meta index 9f7a3870d..4f0e6aa9d 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -36,14 +36,6 @@ [ccpp-arg-table] name = ozphys_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -147,6 +139,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 [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 diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index 3126313dc..238a8fb21 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -54,8 +54,9 @@ 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 ( & - & ix, im, levs, ko3, dt, oz, tin, po3, & - & prsl, prdout, pl_coeff, delp, ldiag3d, & + & im, levs, ko3, dt, oz, tin, po3, & + & prsl, prdout, pl_coeff, delp, & + & ldiag3d, qdiag3d, & & ozp1,ozp2,ozp3,ozp4,con_g, & & me, errmsg, errflg) ! @@ -65,26 +66,26 @@ subroutine ozphys_2015_run ( & ! real(kind=kind_phys),intent(in) :: con_g real :: gravi - integer, intent(in) :: im, ix, levs, ko3, pl_coeff,me + integer, intent(in) :: im, levs, ko3, pl_coeff,me real(kind=kind_phys), intent(in) :: po3(ko3), & - & prsl(ix,levs), tin(ix,levs), & - & delp(ix,levs), & - & prdout(ix,ko3,pl_coeff), dt + & 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(:,:) - real(kind=kind_phys), intent(inout) :: oz(ix,levs) + real(kind=kind_phys), intent(inout) :: oz(im,levs) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer k,kmax,kmin,l,i,j - logical ldiag3d, flg(im) + logical ldiag3d, flg(im), qdiag3d real(kind=kind_phys) pmax, pmin, tem, temp real(kind=kind_phys) wk1(im), wk2(im), wk3(im),prod(im,pl_coeff), & & ozib(im), colo3(im,levs+1), coloz(im,levs+1),& - & ozi(ix,levs) + & ozi(im,levs) ! ! Initialize CCPP error handling variables errmsg = '' @@ -163,16 +164,15 @@ 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) then ! ozone change diagnostics -! do i=1,im -! ozp1(i,l) = ozp1(i,l) + (prod(i,1)-prod(i,2)*prod(i,6))*dt -!!ccpp ozp(i,l,2) = ozp(i,l,2) + (ozo(i,l) - ozib(i)) -! 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 -! endif + 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 + endif enddo ! vertical loop ! return diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 51f8e76f4..bfc010358 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -36,14 +36,6 @@ [ccpp-arg-table] name = ozphys_2015_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -147,6 +139,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 [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 diff --git a/physics/phys_tend.F90 b/physics/phys_tend.F90 new file mode 100644 index 000000000..333c22e2a --- /dev/null +++ b/physics/phys_tend.F90 @@ -0,0 +1,99 @@ +module phys_tend + + use machine, only: kind_phys + + implicit none + + private + + public phys_tend_init, phys_tend_run, phys_tend_finalize + +contains + + subroutine phys_tend_init() + end subroutine phys_tend_init + + subroutine phys_tend_finalize() + 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) + + ! 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(:,:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! 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 + + end subroutine phys_tend_run + +end module phys_tend diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta new file mode 100644 index 000000000..48c189c07 --- /dev/null +++ b/physics/phys_tend.meta @@ -0,0 +1,351 @@ +[ccpp-arg-table] + name = phys_tend_run + type = scheme +[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 +[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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,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_dimension,vertical_dimension) + type = real + kind = kind_phys + 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_dimension,vertical_dimension) + type = real + kind = kind_phys + 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_dimension,vertical_dimension) + type = real + kind = kind_phys + 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_dimension,vertical_dimension) + type = real + kind = kind_phys + 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_dimension,vertical_dimension) + type = real + kind = kind_phys + 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_dimension,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_dimension,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 + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/precpd.f b/physics/precpd.f index 5e7018314..0e330558b 100644 --- a/physics/precpd.f +++ b/physics/precpd.f @@ -45,7 +45,7 @@ end subroutine zhaocarr_precpd_init !! -# Calculate precipitation at surface (\f$rn\f$) and fraction of frozen precipitation (\f$sr\f$). !! \section Zhao-Carr_precip_detailed GFS precpd Scheme Detailed Algorithm !> @{ - subroutine zhaocarr_precpd_run (im,ix,km,dt,del,prsl,q,cwm,t,rn & + subroutine zhaocarr_precpd_run (im,km,dt,del,prsl,q,cwm,t,rn & &, sr,rainp,u00k,psautco,prautco,evpco,wminco & &, wk1,lprnt,jpr,errmsg,errflg) @@ -77,18 +77,17 @@ subroutine zhaocarr_precpd_run (im,ix,km,dt,del,prsl,q,cwm,t,rn & ! argument list: ! -------------- ! im : inner dimension over which calculation is made -! ix : maximum inner dimension ! km : number of vertical levels ! dt : time step in seconds ! del(km) : pressure layer thickness (bottom to top) ! prsl(km) : pressure values for model layers (bottom to top) -! q(ix,km) : specific humidity (updated in the code) -! cwm(ix,km) : condensate mixing ratio (updated in the code) -! t(ix,km) : temperature (updated in the code) +! q(im,km) : specific humidity (updated in the code) +! cwm(im,km) : condensate mixing ratio (updated in the code) +! t(im,km) : temperature (updated in the code) ! rn(im) : precipitation over one time-step dt (m/dt) !old sr(im) : index (=-1 snow, =0 rain/snow, =1 rain) !new sr(im) : "snow ratio", ratio of snow to total precipitation -! cll(ix,km) : cloud cover +! cll(im,km) : cloud cover !hchuang rn(im) unit in m per time step ! precipitation rate conversion 1 mm/s = 1 kg/m2/s ! @@ -101,11 +100,11 @@ subroutine zhaocarr_precpd_run (im,ix,km,dt,del,prsl,q,cwm,t,rn & ! include 'constant.h' ! ! Interface variables - integer, intent(in) :: im, ix, km, jpr + integer, intent(in) :: im, km, jpr real (kind=kind_phys), intent(in) :: dt - real (kind=kind_phys), intent(in) :: del(ix,km), prsl(ix,km) - real (kind=kind_phys), intent(inout) :: q(ix,km), t(ix,km), & - & cwm(ix,km) + real (kind=kind_phys), intent(in) :: del(im,km), prsl(im,km) + real (kind=kind_phys), intent(inout) :: q(im,km), t(im,km), & + & cwm(im,km) real (kind=kind_phys), intent(out) :: rn(im), sr(im), rainp(im,km) real (kind=kind_phys), intent(in) :: u00k(im,km) real (kind=kind_phys), intent(in) :: psautco(2), prautco(2), & diff --git a/physics/precpd.meta b/physics/precpd.meta index 37a1850ab..6df3f35af 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -14,14 +14,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 49b394fe1..5b4aa54ab 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -243,7 +243,7 @@ module module_radiation_clouds integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld4o + & cld_init, progcld5, progcld4o, gethml ! ================= diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index be3b928a8..cc6838b2c 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -228,11 +228,10 @@ end subroutine rascnv_finalize !! inputs: size !! ! !! im - integer, horiz dimension and num of used pts 1 ! -!! ix - integer, maximum horiz dimension 1 ! !! k - integer, vertical dimension 1 ! !! dt - real, time step in seconds 1 ! !! dtf - real, dynamics time step in seconds 1 ! -!! rannum - real, array holding random numbers between 0 an 1 (ix,nrcm) ! +!! rannum - real, array holding random numbers between 0 an 1 (im,nrcm) ! !! tin - real, input temperature (K) !! qin - real, input specific humidity (kg/kg) !! uin - real, input zonal wind component @@ -286,7 +285,7 @@ end subroutine rascnv_finalize !! \section arg_table_rascnv_run Argument Table !! \htmlinclude rascnv_run.html !! - subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & + subroutine rascnv_run(IM, k, ntr, dt, dtf & &, ccwf, area, dxmin, dxinv & &, psauras, prauras, wminras, dlqf, flipv & &, me, rannum, nrcm, mp_phys, mp_phys_mg & @@ -321,7 +320,7 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & ! ! input ! - integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, kdt & + integer, intent(in) :: im, k, ntr, me, nrcm, ntk, kdt & &, mp_phys, mp_phys_mg integer, dimension(im) :: kbot, ktop, kcnv, kpbl ! @@ -329,9 +328,9 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, psauras(2), prauras(2) & &, wminras(2), dlqf(2) ! - real(kind=kind_phys), dimension(ix,k) :: tin, qin, uin, vin & + real(kind=kind_phys), dimension(im,k) :: tin, qin, uin, vin & &, prsl, prslk, phil - real(kind=kind_phys), dimension(ix,k+1) :: prsi, prsik, phii + real(kind=kind_phys), dimension(im,k+1) :: prsi, prsik, phii real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, dt_mf & &, rhc, qlcn, qicn, w_upi & &, cnv_mfd & @@ -340,8 +339,8 @@ subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & &, cnv_nice, cf_upi real(kind=kind_phys), dimension(im) :: area, cdrag & &, rainc, ddvel - real(kind=kind_phys), dimension(ix,nrcm):: rannum - real(kind=kind_phys) ccin(ix,k,ntr+2) + real(kind=kind_phys), dimension(im,nrcm):: rannum + real(kind=kind_phys) ccin(im,k,ntr+2) real(kind=kind_phys) trcmin(ntr+2) real(kind=kind_phys) DT, dtf, qw0, qi0 diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 0a201e74d..c2ad6bf3f 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -196,14 +196,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [k] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index 3231a16d8..a56a85e8c 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -24,8 +24,10 @@ end subroutine rayleigh_damp_init !>\section gen_ray_damp_run GFS rayleigh_damp_runGeneral Algorithm !> @{ subroutine rayleigh_damp_run ( & - & lsidea,IM,IX,KM,A,B,C,U1,V1,DT,CP, & - & LEVR,pgr,PRSL,PRSLRD0,ral_ts,errmsg,errflg) + & lsidea,IM,KM,A,B,C,U1,V1,DT,CP, & + & LEVR,pgr,PRSL,PRSLRD0,ral_ts, & + & ldiag3d,du3dt,dv3dt,dt3dt, & + & errmsg,errflg) ! ! ******************************************************************** ! -----> I M P L E M E N T A T I O N V E R S I O N <---------- @@ -47,16 +49,16 @@ subroutine rayleigh_damp_run ( & ! IS CONVERTED INTO INTERNAL ENERGY. ! ! INPUT -! A(IX,KM) NON-LIN TENDENCY FOR V WIND COMPONENT -! B(IX,KM) NON-LIN TENDENCY FOR U WIND COMPONENT -! C(IX,KM) NON-LIN TENDENCY FOR TEMPERATURE -! U1(IX,KM) ZONAL WIND M/SEC AT T0-DT -! V1(IX,KM) MERIDIONAL WIND M/SEC AT T0-DT -! T1(IX,KM) TEMPERATURE DEG K AT T0-DT +! A(IM,KM) NON-LIN TENDENCY FOR V WIND COMPONENT +! B(IM,KM) NON-LIN TENDENCY FOR U WIND COMPONENT +! C(IM,KM) NON-LIN TENDENCY FOR TEMPERATURE +! U1(IM,KM) ZONAL WIND M/SEC AT T0-DT +! V1(IM,KM) MERIDIONAL WIND M/SEC AT T0-DT +! T1(IM,KM) TEMPERATURE DEG K AT T0-DT ! ! DT TIME STEP SECS ! pgr(im) surface pressure (Pa) -! prsl(IX,KM) PRESSURE AT MIDDLE OF LAYER (Pa) +! prsl(IM,KM) PRESSURE AT MIDDLE OF LAYER (Pa) ! prslrd0 pressure level above which to apply Rayleigh damping ! ral_ts timescale in days for Rayleigh damping ! @@ -66,12 +68,15 @@ subroutine rayleigh_damp_run ( & USE MACHINE , ONLY : kind_phys implicit none ! - logical,intent(in) :: lsidea - integer,intent(in) :: im, ix, km,levr + logical,intent(in) :: lsidea,ldiag3d + integer,intent(in) :: im, km,levr real(kind=kind_phys),intent(in) :: DT, CP, PRSLRD0, ral_ts - real(kind=kind_phys),intent(in) :: pgr(im), PRSL(IX,KM) - real(kind=kind_phys),intent(in) :: U1(IX,KM), V1(IX,KM) - real(kind=kind_phys),intent(inout) :: A(IX,KM), B(IX,KM), C(IX,KM) + 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(:,:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -79,7 +84,7 @@ subroutine rayleigh_damp_run ( & real(kind=kind_phys), parameter :: cons1=1.0, cons2=2.0, half=0.5 real(kind=kind_phys) DTAUX, DTAUY, wrk1, rtrd1, rfactrd, wrk2 &, ENG0, ENG1, tem1, tem2, dti, hfbcpdt, rtrd - real(kind=kind_phys) tx1(im) + real(kind=kind_phys) tx1(im), deltaA, deltaB, deltaC integer i, k ! ! Initialize CCPP error handling variables @@ -112,9 +117,17 @@ subroutine rayleigh_damp_run ( & tem1 = U1(I,K) + DTAUX tem2 = V1(I,K) + DTAUY ENG1 = tem1*tem1 + tem2*tem2 - A(I,K) = A(I,K) + DTAUY * dti - B(I,K) = B(I,K) + DTAUX * dti - C(I,K) = C(I,K) + max((ENG0-ENG1),0.0) * hfbcpdt + deltaA = DTAUY * dti + deltaB = DTAUX * dti + deltaC = max((ENG0-ENG1),0.0) * hfbcpdt + 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 + ENDIF ENDDO ENDDO diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index ec08802e8..554ac4139 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -22,14 +22,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = number of vertical layers @@ -145,6 +137,41 @@ kind = kind_phys 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 +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt] + standard_name = cumulative_change_in_y_wind_due_to_rayleigh_damping + long_name = cumulative change in meridional wind due to Rayleigh damping + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index e42336923..d1da08405 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -18,13 +18,21 @@ module rrtmgp_lw_cloud_sampling !! \section arg_table_rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_init.html !! - subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) + subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0, errmsg, errflg) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data ! Outputs integer, intent(out) :: & ipsdlw0 ! Initial permutation seed for McICA + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! Set initial permutation seed for McICA, initially set to number of G-points ipsdlw0 = lw_gas_props%get_ngpt() diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 547c6177c..87e785a4d 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -17,6 +17,23 @@ type = integer intent = out optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F ###################################################### [ccpp-arg-table] @@ -111,4 +128,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 0c839afb2..45d0fad67 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -18,13 +18,21 @@ module rrtmgp_sw_cloud_sampling !! \section arg_table_rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! - subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) + subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0, errmsg, errflg) ! Inputs type(ty_gas_optics_rrtmgp),intent(in) :: & sw_gas_props ! RRTMGP DDT: K-distribution data ! Outputs integer, intent(out) :: & ipsdsw0 ! Initial permutation seed for McICA + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error code + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! Set initial permutation seed for McICA, initially set to number of G-points ipsdsw0 = sw_gas_props%get_ngpt() diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 3ad9073d5..c30d4934d 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -17,6 +17,23 @@ type = integer intent = out optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F ###################################################### [ccpp-arg-table] @@ -127,4 +144,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 677a2cee1..67576af15 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -68,7 +68,7 @@ end subroutine samfdeepcnv_finalize !! !! \section samfdeep_detailed GFS samfdeepcnv Detailed Algorithm !! @{ - subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & + subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav,hwrf_samfdeep, & @@ -86,25 +86,25 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & implicit none ! - integer, intent(in) :: im, ix, km, itc, ntc, ntk, ntr, ncloud + integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(im) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, eps, epsm1, & & fv, grav, hvap, rd, rv, t0c real(kind=kind_phys), intent(in) :: delt - real(kind=kind_phys), intent(in) :: psp(im), delp(ix,km), & - & prslp(ix,km), garea(im), dot(ix,km), phil(ix,km) + real(kind=kind_phys), intent(in) :: psp(im), delp(im,km), & + & prslp(im,km), garea(im), dot(im,km), phil(im,km) real(kind=kind_phys), dimension(:), intent(in) :: fscav logical, intent(in) :: hwrf_samfdeep real(kind=kind_phys), intent(in) :: nthresh - real(kind=kind_phys), intent(in) :: ca_deep(ix) - real(kind=kind_phys), intent(out) :: rainevap(ix) + real(kind=kind_phys), intent(in) :: ca_deep(im) + real(kind=kind_phys), intent(out) :: rainevap(im) logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger integer, intent(inout) :: kcnv(im) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH - real(kind=kind_phys), intent(inout) :: qtr(ix,km,ntr+2), & - & q1(ix,km), t1(ix,km), u1(ix,km), v1(ix,km), & - & cnvw(ix,km), cnvc(ix,km) + real(kind=kind_phys), intent(inout) :: qtr(im,km,ntr+2), & + & q1(im,km), t1(im,km), u1(im,km), v1(im,km), & + & cnvw(im,km), cnvc(im,km) integer, intent(out) :: kbot(im), ktop(im) real(kind=kind_phys), intent(out) :: cldwrk(im), & @@ -172,7 +172,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & ! ! real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), real(kind=kind_phys) aa1(im), tkemean(im),clamt(im), - & ps(im), del(ix,km), prsl(ix,km), + & ps(im), del(im,km), prsl(im,km), & umean(im), tauadv(im), gdx(im), & delhbar(im), delq(im), delq2(im), & delqbar(im), delqev(im), deltbar(im), @@ -2558,7 +2558,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & !> - Transport aerosols if present if (do_aerosols) - & call samfdeepcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, + & call samfdeepcnv_aerosols(im, im, km, itc, ntc, ntr, delt, & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kbcon, ktcon, fscav, & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, & qtr, qaero) diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index d76348ca8..2a134bac7 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -19,14 +19,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index 7a6db70f0..e48962822 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -49,7 +49,7 @@ end subroutine samfshalcnv_finalize !! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. !! \section det_samfshalcnv GFS samfshalcnv Detailed Algorithm !! @{ - subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & + subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & @@ -62,23 +62,23 @@ subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & implicit none ! - integer, intent(in) :: im, ix, km, itc, ntc, ntk, ntr, ncloud + integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(im) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, & & eps, epsm1, fv, grav, hvap, rd, rv, t0c real(kind=kind_phys), intent(in) :: delt - real(kind=kind_phys), intent(in) :: psp(im), delp(ix,km), & - & prslp(ix,km), garea(im), hpbl(im), dot(ix,km), phil(ix,km) + real(kind=kind_phys), intent(in) :: psp(im), delp(im,km), & + & prslp(im,km), garea(im), hpbl(im), dot(im,km), phil(im,km) ! real(kind=kind_phys), dimension(:), intent(in) :: fscav integer, intent(inout) :: kcnv(im) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH - real(kind=kind_phys), intent(inout) :: qtr(ix,km,ntr+2), & - & q1(ix,km), t1(ix,km), u1(ix,km), v1(ix,km) + real(kind=kind_phys), intent(inout) :: qtr(im,km,ntr+2), & + & q1(im,km), t1(im,km), u1(im,km), v1(im,km) ! integer, intent(out) :: kbot(im), ktop(im) real(kind=kind_phys), intent(out) :: rn(im), & - & cnvw(ix,km), cnvc(ix,km), ud_mf(im,km), dt_mf(im,km) + & cnvw(im,km), cnvc(im,km), ud_mf(im,km), dt_mf(im,km) ! real(kind=kind_phys), intent(in) :: clam, c0s, c1, & & asolfac, pgcon @@ -120,7 +120,7 @@ subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & ! real(kind=kind_phys) aa1(im), cina(im), & tkemean(im), clamt(im), - & ps(im), del(ix,km), prsl(ix,km), + & ps(im), del(im,km), prsl(im,km), & umean(im), tauadv(im), gdx(im), & delhbar(im), delq(im), delq2(im), & delqbar(im), delqev(im), deltbar(im), @@ -1586,7 +1586,7 @@ subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & ! if (.not.hwrf_samfshal) then if (do_aerosols) - & call samfshalcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, + & call samfshalcnv_aerosols(im, im, km, itc, ntc, ntr, delt, ! & xlamde, xlamdd, cnvflg, jmin, kb, kmax, kbcon, ktcon, fscav, & cnvflg, kb, kmax, kbcon, ktcon, fscav, ! & edto, xlamd, xmb, c0t, eta, etad, zi, xlamue, xlamud, delp, diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 4e7fd3898..0fd6c2922 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -19,14 +19,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = vertical layer dimension diff --git a/physics/sascnvn.F b/physics/sascnvn.F index 79c1bdc36..ac59b9c5c 100644 --- a/physics/sascnvn.F +++ b/physics/sascnvn.F @@ -55,8 +55,7 @@ end subroutine sascnvn_finalize !! !! As in Grell (1993) \cite grell_1993 , the SAS convective scheme can be described in terms of three types of "controls": static, dynamic, and feedback. The static control component consists of the simple entraining/detraining updraft/downdraft cloud model and is used to determine the cloud properties, convective precipitation, as well as the convective cloud top height. The dynamic control is the determination of the potential energy available for convection to "consume", or how primed the large-scale environment is for convection to occur due to changes by the dyanmics of the host model. The feedback control is the determination of how the parameterized convection changes the large-scale environment (the host model state variables) given the changes to the state variables per unit cloud base mass flux calculated in the static control portion and the deduced cloud base mass flux determined from the dynamic control. !! -!! \param[in] im number of used points -!! \param[in] ix horizontal dimension +!! \param[in] im horizontal dimension !! \param[in] km vertical layer dimension !! \param[in] jcap number of spectral wave trancation !! \param[in] delt physics time step in seconds @@ -99,7 +98,7 @@ end subroutine sascnvn_finalize !! @{ subroutine sascnvn_run( & grav,cp,hvap,rv,fv,t0c,rgas,cvap,cliq,eps,epsm1, & - & im,ix,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & + & im,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & & q1,t1,u1,v1,cldwrk,rn,kbot,ktop,kcnv,islimsk, & & dot,ncloud,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & & qlcn,qicn,w_upi,cf_upi,cnv_mfd, & @@ -119,7 +118,7 @@ subroutine sascnvn_run( ! real(kind=kind_phys), intent(in) :: grav, cp, hvap, rv, fv, t0c, & & rgas, cvap, cliq, eps, epsm1 - integer, intent(in) :: im, ix, km, jcap, ncloud, & + integer, intent(in) :: im, km, jcap, ncloud, & & mp_phys, mp_phys_mg integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) integer, intent(in) :: islimsk(:) @@ -184,7 +183,7 @@ subroutine sascnvn_run( & jmin(im), lmin(im), kbmax(im), & kbm(im), kmax(im) ! - real(kind=kind_phys) ps(im), del(ix,km), prsl(ix,km) + real(kind=kind_phys) ps(im), del(im,km), prsl(im,km) ! real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), & delhbar(im), delq(im), delq2(im), diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index f330dd94d..dbc10783a 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -151,14 +151,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal_dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = number of vertical levels diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 5900349e9..f00fb3776 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -53,14 +53,16 @@ end subroutine satmedmfvdif_finalize !! (mfscu.f). !! \section detail_satmedmfvidf GFS satmedmfvdif Detailed Algorithm !> @{ - subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & + subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & & prsi,del,prsl,prslk,phii,phil,delt, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & - & kinver,xkzm_m,xkzm_h,xkzm_s,errmsg,errflg) + & kinver,xkzm_m,xkzm_h,xkzm_s, & + & dt3dt_PBL,du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL, & + & ldiag3d,qdiag3d,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -68,9 +70,13 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & implicit none ! !---------------------------------------------------------------------- - integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke + integer, intent(in) :: im, km, ntrac, ntcw, ntiw, ntke integer, intent(in) :: kinver(im) integer, intent(out) :: kpbl(im) +! + logical, intent(in) :: ldiag3d, qdiag3d + real(kind=kind_phys), intent(inout), dimension(:,:) :: & + & dt3dt_PBL,du3dt_PBL,dv3dt_PBL,dq3dt_PBL,do3dt_PBL ! real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 @@ -78,19 +84,19 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & & tdt(im,km), rtg(im,km,ntrac) real(kind=kind_phys), intent(in) :: & - & u1(ix,km), v1(ix,km), & - & t1(ix,km), q1(ix,km,ntrac), & - & swh(ix,km), hlw(ix,km), & + & u1(im,km), v1(im,km), & + & t1(im,km), q1(im,km,ntrac), & + & swh(im,km), hlw(im,km), & & xmu(im), garea(im), & - & psk(ix), rbsoil(im), & + & psk(im), rbsoil(im), & & zorl(im), tsea(im), & & u10m(im), v10m(im), & & fm(im), fh(im), & & evap(im), heat(im), & & stress(im), spd1(im), & - & prsi(ix,km+1), del(ix,km), & - & prsl(ix,km), prslk(ix,km), & - & phii(ix,km+1), phil(ix,km) + & 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(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -801,13 +807,13 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo !> - Call mfpblt(), which is an EDMF parameterization (Siebesma et al.(2007) \cite Siebesma_2007) !! to take into account nonlocal transport by large eddies. - call mfpblt(im,ix,km,kmpbl,ntcw,ntrac1,dt2, + call mfpblt(im,im,km,kmpbl,ntcw,ntrac1,dt2, & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buou,xmf, & tcko,qcko,ucko,vcko,xlamue) !> - Call mfscu(), which is a new mass-flux parameterization for !! stratocumulus-top-induced turbulence mixing. - call mfscu(im,ix,km,kmscu,ntcw,ntrac1,dt2, + call mfscu(im,im,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae,radj, & krad,mrad,radmin,buod,xmfd, @@ -1391,6 +1397,12 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & 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(ldiag3d) then + dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*delt + if(qdiag3d) then + dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*delt + endif + endif enddo enddo ! @@ -1491,6 +1503,10 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & 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(ldiag3d) then + du3dt_PBL(i,k) = du3dt_PBL(i,k) + utend*delt + dv3dt_PBL(i,k) = dv3dt_PBL(i,k) + vtend*delt + endif enddo enddo ! diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index c33e4b85f..6ff485565 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -39,14 +39,6 @@ [ccpp-arg-table] name = satmedmfvdif_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -551,6 +543,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_dimension,vertical_dimension) + type = real + kind = kind_phys +[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_dimension,vertical_dimension) + type = real + kind = kind_phys +[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_dimension,vertical_dimension) + type = real + kind = kind_phys +[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_dimension,vertical_dimension) + type = real + kind = kind_phys +[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_dimension,vertical_dimension) + type = real + kind = kind_phys +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 0f4aa5103..f192788fe 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -57,7 +57,7 @@ end subroutine satmedmfvdifq_finalize !! (mfscuq.f). !! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm !! @{ - subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & + subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea,islimsk, & & snwdph_lnd,psk,rbsoil,zorl,u10m,v10m,fm,fh, & @@ -65,6 +65,7 @@ subroutine satmedmfvdifq_run(ix,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,ldiag3d,qdiag3d, & & errmsg,errflg) ! use machine , only : kind_phys @@ -73,10 +74,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & implicit none ! !---------------------------------------------------------------------- - integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke + integer, intent(in) :: im, km, ntrac, ntcw, ntiw, ntke, ntoz integer, intent(in) :: kinver(im) integer, intent(in) :: islimsk(im) integer, intent(out) :: kpbl(im) + logical, intent(in) :: ldiag3d,qdiag3d ! real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 @@ -85,20 +87,24 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & & tdt(im,km), rtg(im,km,ntrac) real(kind=kind_phys), intent(in) :: & - & u1(ix,km), v1(ix,km), & - & t1(ix,km), q1(ix,km,ntrac), & - & swh(ix,km), hlw(ix,km), & + & u1(im,km), v1(im,km), & + & t1(im,km), q1(im,km,ntrac), & + & swh(im,km), hlw(im,km), & & xmu(im), garea(im), & & snwdph_lnd(im), & - & psk(ix), rbsoil(im), & + & psk(im), rbsoil(im), & & zorl(im), tsea(im), & & u10m(im), v10m(im), & & fm(im), fh(im), & & evap(im), heat(im), & & stress(im), spd1(im), & - & prsi(ix,km+1), del(ix,km), & - & prsl(ix,km), prslk(ix,km), & - & phii(ix,km+1), phil(ix,km) + & 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(out) :: & & dusfc(im), dvsfc(im), & & dtsfc(im), dqsfc(im), & @@ -786,13 +792,13 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo !> - Call mfpbltq(), which is an EDMF parameterization (Siebesma et al.(2007) \cite Siebesma_2007) !! to take into account nonlocal transport by large eddies. For details of the mfpbltq subroutine, step into its documentation ::mfpbltq - call mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,dt2, + call mfpbltq(im,im,km,kmpbl,ntcw,ntrac1,dt2, & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buou,xmf, & tcko,qcko,ucko,vcko,xlamue,bl_upfr) !> - Call mfscuq(), which is a new mass-flux parameterization for !! stratocumulus-top-induced turbulence mixing. For details of the mfscuq subroutine, step into its documentation ::mfscuq - call mfscuq(im,ix,km,kmscu,ntcw,ntrac1,dt2, + call mfscuq(im,im,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae, & krad,mrad,radmin,buod,xmfd, @@ -1415,6 +1421,22 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend enddo enddo + if(ldiag3d) then + do k = 1,km + do i = 1,im + ttend = (f1(i,k)-t1(i,k))*rdt + dt3dt(i,k) = dt3dt(i,k)+dspfac*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)+dspfac*qtend*delt + enddo + enddo + endif + endif ! if(ntrac1 >= 2) then do kk = 2, ntrac1 @@ -1426,19 +1448,37 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo enddo + if(ldiag3d .and. qdiag3d .and. ntoz>0) then + kk=ntoz + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (f2(i,k+is)-q1(i,k,kk))*rdt + do3dt(i,k) = do3dt(i,k)+qtend*delt + enddo + enddo + endif endif ! !> ## Add TKE dissipative heating to temperature tendency ! if(dspheat) then - do k = 1,km1 - do i = 1,im -! tem = min(diss(i,k), dspmax) -! ttend = tem / cp - ttend = diss(i,k) / cp - tdt(i,k) = tdt(i,k) + dspfac * ttend + do k = 1,km1 + do i = 1,im +! tem = min(diss(i,k), dspmax) +! ttend = tem / cp + ttend = diss(i,k) / cp + tdt(i,k) = tdt(i,k) + dspfac * ttend + enddo enddo - enddo + if(ldiag3d) 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 + endif endif c !> ## Compute tridiagonal matrix elements for momentum @@ -1515,6 +1555,16 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend enddo enddo + if(ldiag3d) 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 + endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> ## Save PBL height for diagnostic purpose diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index f8f0c1918..397d71537 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -39,14 +39,6 @@ [ccpp-arg-table] name = satmedmfvdifq_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -595,6 +587,75 @@ kind = kind_phys 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 +[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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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_dimension,vertical_dimension) + type = real + 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_dimension,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_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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_dimension,vertical_dimension) + type = real + 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 = 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 diff --git a/physics/shalcnv.F b/physics/shalcnv.F index 5c9e65203..2a8918985 100644 --- a/physics/shalcnv.F +++ b/physics/shalcnv.F @@ -58,8 +58,7 @@ end subroutine shalcnv_finalize !! !! This routine follows the \ref SAS scheme quite closely, although it can be interpreted as only having the "static" and "feedback" control portions, since the "dynamic" control is not necessary to find the cloud base mass flux. The algorithm is simplified from SAS deep convection by excluding convective downdrafts and being confined to operate below \f$p=0.7p_{sfc}\f$. Also, entrainment is both simpler and stronger in magnitude compared to the deep scheme. !! -!! \param[in] im number of used points -!! \param[in] ix horizontal dimension +!! \param[in] im horizontal dimension !! \param[in] km vertical layer dimension !! \param[in] jcap number of spectral wave trancation !! \param[in] delt physics time step in seconds @@ -101,7 +100,7 @@ end subroutine shalcnv_finalize !! @{ subroutine shalcnv_run( & & grav,cp,hvap,rv,fv,t0c,rd,cvap,cliq,eps,epsm1, & - & im,ix,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & + & im,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & & q1,t1,u1,v1,rn,kbot,ktop,kcnv,islimsk, & & dot,ncloud,hpbl,heat,evap,ud_mf,dt_mf,cnvw,cnvc, & & clam,c0,c1,pgcon,errmsg,errflg) @@ -118,7 +117,7 @@ subroutine shalcnv_run( & ! real(kind=kind_phys), intent(in) :: grav, cp, hvap, rv, fv, t0c, & & rd, cvap, cliq, eps, epsm1 - integer, intent(in) :: im, ix, km, jcap, ncloud + integer, intent(in) :: im, km, jcap, ncloud integer, intent(inout) :: kbot(:), ktop(:), kcnv(:) integer, intent(in) :: islimsk(:) real(kind=kind_phys), intent(in) :: delt, clam, c0, c1, pgcon diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index e0d806a5c..2a508cb0b 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -167,14 +167,6 @@ type = integer intent = in optional = F -[ix] - standard_name = horizontal_dimension - long_name = horizontal_dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [km] standard_name = vertical_dimension long_name = number of vertical levels diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index 8053934ac..83270a08d 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -25,7 +25,7 @@ end subroutine shinhongvdif_finalize !! \htmlinclude shinhongvdif_run.html !! !------------------------------------------------------------------------------- - subroutine shinhongvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & + subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & utnp,vtnp,ttnp,qtnp,ntrac,ndiff,ntcw,ntiw, & phii,phil,psfcpa, & zorl,stress,hpbl,psim,psih, & @@ -104,20 +104,20 @@ subroutine shinhongvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & real(kind=kind_phys),parameter :: cpent = -0.4,rigsmax = 100. real(kind=kind_phys),parameter :: entfmin = 1.0, entfmax = 5.0 ! 1D in - integer, intent(in ) :: ix,im,km,ntrac,ndiff,ntcw,ntiw + integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw real(kind=kind_phys), intent(in ) :: g,cp,rd,rv,ep1,ep2,xlv,dt ! 3D in - real(kind=kind_phys), dimension(ix, km) , & + real(kind=kind_phys), dimension(im, km) , & intent(in ) :: phil, & pi2d, & p2d, & ux, & vx, & tx - real(kind=kind_phys), dimension( ix, km, ntrac ) , & + real(kind=kind_phys), dimension( im, km, ntrac ) , & intent(in ) :: qx - real(kind=kind_phys), dimension( ix, km+1 ) , & + real(kind=kind_phys), dimension( im, km+1 ) , & intent(in ) :: p2di, & phii ! 3D in&out diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 4ce047aa2..08646d7b9 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = shinhongvdif_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index fff945774..51ed599f0 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -25,7 +25,7 @@ end subroutine ysuvdif_finalize !! \htmlinclude ysuvdif_run.html !! !------------------------------------------------------------------------------- - subroutine ysuvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & + subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & utnp,vtnp,ttnp,qtnp, & swh,hlw,xmu,ntrac,ndiff,ntcw,ntiw, & phii,phil,psfcpa, & @@ -59,16 +59,16 @@ subroutine ysuvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ! !------------------------------------------------------------------------------------- ! input variables - integer, intent(in ) :: ix,im,km,ntrac,ndiff,ntcw,ntiw + integer, intent(in ) :: im,km,ntrac,ndiff,ntcw,ntiw real(kind=kind_phys), intent(in ) :: g,cp,rd,rv,ep1,ep2,xlv,dt - real(kind=kind_phys), dimension( ix,km ), & + real(kind=kind_phys), dimension( im,km ), & intent(in) :: pi2d,p2d,phil,ux,vx,swh,hlw,tx - real(kind=kind_phys), dimension( ix,km,ntrac ) , & + real(kind=kind_phys), dimension( im,km,ntrac ) , & intent(in ) :: qx - real(kind=kind_phys), dimension( ix, km+1 ) , & + real(kind=kind_phys), dimension( im, km+1 ) , & intent(in ) :: p2di,phii real(kind=kind_phys), dimension( im ) , & diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index fe18e6f45..c040233a7 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] name = ysuvdif_run type = scheme -[ix] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent