From bf549a0227a2e53745518fc29a7883b76f746e88 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 18 Dec 2019 08:13:01 -0700 Subject: [PATCH 1/4] Apply missing code change for coupled model runs in physics/GFS_surface_generic.F90 --- physics/GFS_surface_generic.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index d8520c333..104d57f07 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -187,10 +187,11 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (cplflx) then do i=1,im - islmsk_cice(i) = int(slimskin_cpl(i)+0.5) - if(islmsk_cice(i) == 4)then - flag_cice(i) = .true. - ulwsfc_cice(i) = ulwsfcin_cpl(i) + islmsk_cice(i) = nint(slimskin_cpl(i)) + flag_cice(i) = (islmsk_cice(i) == 4) + + if (flag_cice(i)) then +! ulwsfc_cice(i) = ulwsfcin_cpl(i) dusfc_cice(i) = dusfcin_cpl(i) dvsfc_cice(i) = dvsfcin_cpl(i) dtsfc_cice(i) = dtsfcin_cpl(i) From 608b3c921a50f79212f3d40c9d3e9db33b9a35e0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 26 Dec 2019 10:30:18 -0700 Subject: [PATCH 2/4] Mirror updates to IPD physics in CCPP --- physics/GFS_DCNV_generic.F90 | 17 +++++++++----- physics/GFS_DCNV_generic.meta | 17 ++++++++++++++ physics/GFS_rrtmg_post.F90 | 42 ++++++++++++++++++++++++++--------- physics/GFS_rrtmg_post.meta | 8 +++++++ physics/sflx.f | 1 + 5 files changed, 70 insertions(+), 15 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 0acfbd19e..3778d8ed9 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -17,17 +17,17 @@ end subroutine GFS_DCNV_generic_pre_finalize !! \htmlinclude GFS_DCNV_generic_pre_run.html !! #endif - subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, & + subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm,& isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & save_u, save_v, save_t, save_qv, ca_deep, & - errmsg, errflg) + dqdti, errmsg, errflg) - use machine, only: kind_phys + use machine, only: kind_phys implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, isppt_deep + logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep 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 @@ -37,9 +37,12 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, 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 integer, intent(out) :: errflg + real(kind=kind_phys), parameter :: zero = 0.0d0 integer :: i, k ! Initialize CCPP error handling variables @@ -70,7 +73,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, enddo endif - if (ldiag3d .or. isppt_deep) then + if (ldiag3d .or. cplchm .or. isppt_deep) then do k=1,levs do i=1,im save_qv(i,k) = gq0_water_vapor(i,k) @@ -78,6 +81,10 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, enddo endif + if (cplchm) then + dqdti = zero + endif + end subroutine GFS_DCNV_generic_pre_run end module GFS_DCNV_generic_pre diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index eae53a910..5e8377133 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -41,6 +41,14 @@ type = logical intent = in optional = F +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F [isppt_deep] standard_name = flag_for_combination_of_sppt_with_isppt_deep long_name = switch for combination with isppt_deep. @@ -130,6 +138,15 @@ 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 + units = kg kg-1 s-1 + 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/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index dd9b9191e..db3de4f44 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -15,7 +15,7 @@ end subroutine GFS_rrtmg_post_init !! subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & - cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, & + cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, nday, & errmsg, errflg) use machine, only: kind_phys @@ -41,7 +41,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & type(GFS_diag_type), intent(inout) :: Diag type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(in) :: scmpsw - integer, intent(in) :: im, lm, ltp, kt, kb, kd + integer, intent(in) :: im, lm, ltp, kt, kb, kd, nday real(kind=kind_phys), intent(in) :: raddt real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: aerodp @@ -152,18 +152,40 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt) Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb) Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + enddo + enddo ! Anning adds optical depth and emissivity output - tem1 = 0. - tem2 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel - tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel + if (Model%lsswr .and. (nday > 0)) then + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel + enddo + Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 enddo - Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 - Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) enddo - enddo + endif + + if (Model%lslwr) then + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel + enddo + Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo + endif + endif endif ! end_if_lssav diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index fdd2c2b55..61e89098d 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -180,6 +180,14 @@ kind = kind_phys intent = in optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/sflx.f b/physics/sflx.f index 1654a8872..6a5914d02 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -359,6 +359,7 @@ subroutine gfssflx &! --- input runoff2 = 0.0 runoff3 = 0.0 snomlt = 0.0 + rc = 0.0 ! --- ... define local variable ice to achieve: ! sea-ice case, ice = 1 From 20ff17891f4d7a0ed1c59b585fbf6e5af5509739 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 11 Jan 2020 20:55:51 -0500 Subject: [PATCH 3/4] physics/samfdeepcnv.f, physics/satmedmfvdifq.F: GFSv16 updates copied from IPD --- physics/samfdeepcnv.f | 28 ++++++++++++++-------------- physics/satmedmfvdifq.F | 15 +++++++++------ 2 files changed, 23 insertions(+), 20 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index bb5d5deb1..83e1efb80 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -1554,22 +1554,22 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & enddo enddo do i = 1, im - betamn = betas - if(islimsk(i) == 1) betamn = betal - if(ntk > 0) then - betamx = betamn + dbeta - if(tkemean(i) > tkemx) then - beta = betamn - else if(tkemean(i) < tkemn) then - beta = betamx + if(cnvflg(i)) then + betamn = betas + if(islimsk(i) == 1) betamn = betal + if(ntk > 0) then + betamx = betamn + dbeta + if(tkemean(i) > tkemx) then + beta = betamn + else if(tkemean(i) < tkemn) then + beta = betamx + else + tem = (betamx - betamn) * (tkemean(i) - tkemn) + beta = betamx - tem / dtke + endif else - tem = (betamx - betamn) * (tkemean(i) - tkemn) - beta = betamx - tem / dtke + beta = betamn endif - else - beta = betamn - endif - if(cnvflg(i)) then dz = (sumx(i)+zi(i,1))/float(kbcon(i)) tem = 1./float(kbcon(i)) xlamd(i) = (1.-beta**tem)/dz diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 546cefca6..f5a5f1f78 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -184,7 +184,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & buop, shrp, dtn, & prnum, prmax, prmin, prtke, & prscu, pr0, ri, - & dw2, dw2min, zk, + & dw2, dw2min, zk, & elmfac, elefac, dspmax, & alp, clwt, cql, & f0, robn, crbmin, crbmax, @@ -193,7 +193,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & epsi, beta, chx, cqx, & rdt, rdz, qmin, qlmin, & rimin, rbcr, rbint, tdzmin, - & rlmn, rlmn1, rlmx, elmx, + & rlmn, rlmn1, rlmn2, + & rlmx, elmx, & ttend, utend, vtend, qtend, & zfac, zfmin, vk, spdk2, & tkmin, tkminx, xkzinv, xkgdx, @@ -205,13 +206,14 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! real(kind=kind_phys) qlcr, zstblmax ! - real(kind=kind_phys) h1 + real(kind=kind_phys) h1 !! parameter(wfac=7.0,cfac=3.0) parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) parameter(vk=0.4,rimin=-100.) parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3) - parameter(rlmn=30.,rlmn1=5.,rlmx=300.,elmx=300.) + parameter(rlmn=30.,rlmn1=5.,rlmn2=10.) + parameter(rlmx=300.,elmx=300.) parameter(prmin=0.25,prmax=4.0) parameter(pr0=1.0,prtke=1.0,prscu=0.67) parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35) @@ -751,8 +753,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! if(tem1 > 1.e-5) then tem1 = tvx(i,k+1)-tvx(i,k) if(tem1 > 0.) then - xkzo(i,k) = min(xkzo(i,k),xkzinv) - xkzmo(i,k) = min(xkzmo(i,k),xkzinv) + xkzo(i,k) = min(xkzo(i,k), xkzinv) + xkzmo(i,k) = min(xkzmo(i,k), xkzinv) + rlmnz(i,k) = min(rlmnz(i,k), rlmn2) endif enddo enddo From 4c7dcaa8ae1e5465c5358647e75c239c6dafb30c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 27 Jan 2020 10:08:39 -0700 Subject: [PATCH 4/4] Add missing updates from IPD physics commit 7ffe6471c20404091fbbf8f321fbb9ee84a4f36d --- physics/module_gfdl_cloud_microphys.F90 | 2 +- physics/module_sf_noahmp_glacier.f90 | 0 physics/module_sf_noahmplsm.f90 | 0 physics/noahmp_tables.f90 | 0 physics/sfc_noahmp_drv.f | 0 5 files changed, 1 insertion(+), 1 deletion(-) mode change 100755 => 100644 physics/module_sf_noahmp_glacier.f90 mode change 100755 => 100644 physics/module_sf_noahmplsm.f90 mode change 100755 => 100644 physics/noahmp_tables.f90 mode change 100755 => 100644 physics/sfc_noahmp_drv.f diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index 01ab4655c..5750d27fd 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -3320,7 +3320,7 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) else tc (k) = tk (k) - tice vti (k) = (3. + log10 (qi (k) * den (k))) * (tc (k) * (aa * tc (k) + bb) + cc) + dd * tc (k) + ee - vti (k) = vi0 * exp (log_10 * vti (k)) * 0.8 + vti (k) = vi0 * exp (log_10 * vti (k)) * 0.9 vti (k) = min (vi_max, max (vf_min, vti (k))) endif enddo diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 old mode 100755 new mode 100644 diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 old mode 100755 new mode 100644 diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 old mode 100755 new mode 100644 diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f old mode 100755 new mode 100644