From e563a91ee63ec82fb5c8ce3c5eb0329e3a57b9b3 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 3 Dec 2019 15:42:00 -0700 Subject: [PATCH 01/90] Update CODEOWNERS for gsd/develop --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index 0d5230f89..986cf7664 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @llpcarson @grantfirl @JulieSchramm +* @climbfuji @tanyasmirnova # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners From 73717d29583373b8b73d9eac3bb71ebfa9d60561 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 5 Dec 2019 21:05:30 -0700 Subject: [PATCH 02/90] physics/GFS_time_vary_pre.fv3.*: allow for radiation being called on physics timestep for first nhfrad timesteps --- physics/GFS_time_vary_pre.fv3.F90 | 14 ++++++++++---- physics/GFS_time_vary_pre.fv3.meta | 8 ++++++++ 2 files changed, 18 insertions(+), 4 deletions(-) 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 From e81ee3683d61d557404543f59c4a70949cdf2f45 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 12 Dec 2019 10:24:04 -0700 Subject: [PATCH 03/90] Update CODEOWNERS for move to NOAA-GSD --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index 986cf7664..b6c597371 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @tanyasmirnova +* @DomHeinzeller # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners From bdf4f8e4e9b88f1e846753e47abafa2df7eae24c Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 19 Dec 2019 20:13:30 +0000 Subject: [PATCH 04/90] add qdiag3d support --- physics/GFS_MP_generic.F90 | 31 ++++++++++++++++++++----------- physics/GFS_MP_generic.meta | 16 ++++++++++++++++ 2 files changed, 36 insertions(+), 11 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index a7afa2ee0..ea2ef6c16 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -16,13 +16,13 @@ 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_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 @@ -42,12 +42,14 @@ 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(do_aw .or. (qdiag3d .and. ldiag3d)) 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 @@ -81,7 +83,7 @@ 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, & + 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, & @@ -94,7 +96,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt integer, intent(in) :: im, ix, 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 @@ -110,8 +112,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 @@ -256,9 +259,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 3a11a9983..1ac030bc7 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 @@ -266,6 +274,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) From a48681459256779bdf2a95b6fb46916afd6df158 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 27 Dec 2019 19:03:29 +0000 Subject: [PATCH 05/90] several missing changes for qdiag3d support --- physics/GFS_PBL_generic.F90 | 19 +++++++++++++++++-- physics/GFS_PBL_generic.meta | 8 ++++++++ physics/GFS_SCNV_generic.F90 | 32 +++++++++++++++++++------------- physics/GFS_SCNV_generic.meta | 16 ++++++++++++++++ physics/rayleigh_damp.f | 25 +++++++++++++++++++------ physics/rayleigh_damp.meta | 35 +++++++++++++++++++++++++++++++++++ 6 files changed, 114 insertions(+), 21 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 4bebae589..d31dbafec 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -281,7 +281,7 @@ 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, & + ltaerosol, cplflx, cplchm, lssav, 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, & @@ -299,7 +299,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires - logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea + logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu real(kind=kind_phys), intent(in) :: dtf @@ -571,6 +571,21 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dv3dt_OGWD(i,k) = dv3dt_OGWD(i,k) - dvdt(i,k) * dtf enddo enddo + if (qdiag3d) then + do k=1,levs + do i=1,im + tem = dqdt(i,k,ntqv) * dtf + dq3dt(i,k) = dq3dt(i,k) + tem + enddo + enddo + if (ntoz > 0) then + do k=1,levs + do i=1,im + dq3dt_ozone(i,k) = dq3dt_ozone(i,k) + dqdt(i,k,ntoz) * dtf + enddo + enddo + endif + endif endif endif ! end if_lssav diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 51764e04d..ae86b0dce 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -617,6 +617,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 diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 0cb1ac06f..1cbff590e 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -14,7 +14,7 @@ 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, & + subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gt0, gq0_water_vapor, & save_t, save_qv, errmsg, errflg) use machine, only: kind_phys @@ -22,7 +22,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, gt0, gq0_water_vapor, & implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d + logical, intent(in) :: ldiag3d, qdiag3d real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t, save_qv @@ -41,14 +41,14 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, gt0, gq0_water_vapor, & 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 @@ -67,7 +67,7 @@ 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, & + subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cplchm, & frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, dt3dt, dq3dt, clw, & shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, & rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & @@ -78,7 +78,7 @@ 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 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 @@ -137,9 +137,15 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, cplchm, & 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 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 ! diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 79f4eab11..24dd7236d 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_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 [gt0] standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics @@ -115,6 +123,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 diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index 3231a16d8..814704385 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -25,7 +25,9 @@ end subroutine rayleigh_damp_init !> @{ subroutine rayleigh_damp_run ( & & lsidea,IM,IX,KM,A,B,C,U1,V1,DT,CP, & - & LEVR,pgr,PRSL,PRSLRD0,ral_ts,errmsg,errflg) + & 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 <---------- @@ -66,12 +68,15 @@ subroutine rayleigh_damp_run ( & USE MACHINE , ONLY : kind_phys implicit none ! - logical,intent(in) :: lsidea + logical,intent(in) :: lsidea,ldiag3d integer,intent(in) :: im, ix, 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(inout) :: du3dt(IX,KM) + real(kind=kind_phys),intent(inout) :: dv3dt(IX,KM) + real(kind=kind_phys),intent(inout) :: dt3dt(IX,KM) 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..2f9d81ed5 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -145,6 +145,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 From a0286b1575f41f7ee54293b6b294a998d7958fef Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Mon, 30 Dec 2019 21:34:58 +0000 Subject: [PATCH 06/90] Updating MYNN surface layer scheme --- physics/module_MYNNSFC_wrapper.F90 | 348 +-- physics/module_MYNNSFC_wrapper.meta | 502 +++-- physics/module_sf_mynn.F90 | 3064 +++++++++++++++------------ 3 files changed, 2304 insertions(+), 1610 deletions(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 5471c4825..dee855ff7 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 () @@ -19,46 +25,55 @@ end subroutine mynnsfc_wrapper_finalize !! #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( & + & ix,im,levs, & + & iter,flag_init,flag_restart, & + & 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) + & QSFC, USTM, ZOL, MOL, RMOL, & + & WSPD, ch, HFLX, evap, QFX, 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 +88,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, & @@ -133,43 +111,59 @@ SUBROUTINE mynnsfc_wrapper_run( & & 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 + & u, v, t3d, qvsh, qc + real(kind=kind_phys), dimension(im,levs) :: & - & dz, rho, th, qv, & + & dz, th, qv, & & pattern_spp_pbl + 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, & + & 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, & + & dx, pblh, slmsk, evap, qsfc, ps, & + & ustm, hflx, qfx, wspd, & & 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 ! 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 (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); @@ -189,7 +183,6 @@ SUBROUTINE mynnsfc_wrapper_run( & 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 @@ -199,95 +192,122 @@ SUBROUTINE mynnsfc_wrapper_run( & 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) + 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 + ts(i)=tskin_ocn(i)/exner(i,1) !theta mavail(i)=1.0 !???? + cpm(i)=cp 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) + 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, & - 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 ) + 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, & + iz0tlnd=iz0tlnd,itimestep=itimestep, & + 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) + 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,QFX=qfx,LH=lh,FLHC=flhc,FLQC=flqc, & + QGH=qgh,QSFC=qsfc, & + 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 - hflx(i)=hfx(i)/(rho(i,1)*cp) - !QFX(i)=evap(i) - zorl(i)=znt(i)*100. !m -> cm - stress(i) = ust(i)**2 + !* 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 + evap(i)=QFX(i) + znt_lnd(i)=znt_lnd(i)*100. !m -> cm + znt_ocn(i)=znt_ocn(i)*100. + znt_ice(i)=znt_ice(i)*100. 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* + 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 diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 2f877075c..cf481ddbf 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -139,116 +139,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 +289,339 @@ 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 +[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] - standard_name = surface_friction_velocity - long_name = boundary layer parameter +[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 +[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 = in + 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,6 +640,15 @@ kind = kind_phys intent = inout optional = F +[evap] + 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 = inout + optional = F [QFX] standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux @@ -490,49 +757,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_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 70b98363d..e2cd7f70c 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -8,59 +8,63 @@ 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 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 ! ! WATER only: -!1) isftcflx option is now available with the following options: +! "isftcflx" namelist option is used to select the following 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 ! ! 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, & @@ -89,52 +93,77 @@ 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 :: 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. + + 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,iz0tlnd,itimestep, & !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) + CH,CHS,CHS2,CQS2,CPM, & + ZNT,USTM,ZOL,MOL,RMOL, & + PSIM,PSIH, & + HFLX,HFX,QFX,LH,FLHC,FLQC, & + QGH,QSFC, & + 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 +172,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,6 +194,7 @@ 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) +!-- HFLX upward temperature flux at the surface (K m s^-1) !-- QFX upward moisture flux at the surface (kg/m^2/s) !-- LH net upward latent heat flux at surface (W/m^2) !-- TSK surface temperature (K) @@ -202,22 +231,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 @@ -249,10 +266,8 @@ SUBROUTINE SFCLAY_mynn( & 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 + INTEGER, OPTIONAL, INTENT(IN) :: ISFTCFLX, IZ0TLND + INTEGER, OPTIONAL, INTENT(IN) :: spp_pbl !=================================== ! 3D VARIABLES @@ -264,11 +279,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 +290,82 @@ 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, & + INTENT(INOUT) :: HFLX,HFX, & QFX, & LH, & MOL,RMOL, & - QSFC, & + 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, & + & qsfc_ocn, qsfc_lnd, qsfc_ice !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 +384,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 @@ -383,102 +393,56 @@ SUBROUTINE SFCLAY_mynn( & IF (itimestep==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)) qstar(i,j)=0.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 - 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) + QFX(i,j)=0. + HFX(i,j)=0. ENDDO 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,itimestep, & + 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, & + 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),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 @@ -487,28 +451,39 @@ 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 & - ) + 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,itimestep, & + 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) + ch,CHS,CHS2,CQS2,CPM, & + ZNT,USTM,ZOL,MOL,RMOL, & + PSIM,PSIH, & + HFLX,HFX,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 @@ -538,34 +513,52 @@ 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, & + 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, & + & qsfc_ocn, qsfc_lnd, qsfc_ice REAL, DIMENSION( its:ite ), INTENT(IN) :: rstoch1D @@ -573,18 +566,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,76 +580,170 @@ 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(*,*)"ITIMESTEP=",ITIMESTEP + DO I=its,ite + write(*,*)"=== input to mynnsfclayer, i:", i + write(*,*)" land, ice, water" + write(*,*)"dry=",dry(i)," icy=",icy(i)," wet=",wet(i) + write(*,*)"tsk=", tskin_lnd(i),tskin_ice(i),tskin_ocn(i) + write(*,*)"tsurf=", tsurf_lnd(i),tsurf_ice(i),tsurf_ocn(i) + write(*,*)"qsfc=", qsfc_lnd(i),qsfc_ice(i),qsfc_ocn(i) + write(*,*)"znt=", znt_lnd(i),znt_ice(i),znt_ocn(i) + write(*,*)"ust=", ust_lnd(i),ust_ice(i),ust_ocn(i) + write(*,*)"snowh=", snowh_lnd(i),snowh_ice(i),snowh_ocn(i) + write(*,*)" psfcpa=",PSFCPA(i)," dz=",dz8w1d(i) + 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 + 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 (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))) + + 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)) - & & 11.64*LOG(273.15/T1D(I)) + 0.02265*(273.15 - T1D(I))) @@ -670,68 +752,159 @@ SUBROUTINE SFCLAY1D_mynn( & 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)) + 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.16 * (max(dx(i)/5000.-1.,0.))**onethird , 0.25) + 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 - !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) - ! 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 +912,1073 @@ 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)) - - IF((XLAND(I)-1.5).GE.0)THEN - !-------------------------------------- - ! WATER - !-------------------------------------- - ! CALCULATE z0 (znt) - !-------------------------------------- - 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)) - ELSE - !COARE 3.5 - CALL edson_etal_2013(ZNT(i),UST(i),WSPD(i),visc,ZA(I)) - ENDIF - ELSEIF ( ISFTCFLX .EQ. 1 .OR. ISFTCFLX .EQ. 2 ) THEN - CALL davis_etal_2008(ZNT(i),UST(i)) - ELSEIF ( ISFTCFLX .EQ. 3 ) THEN - CALL Taylor_Yelland_2001(ZNT(i),UST(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 + !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 (wet(i)) THEN + !-------------------------------------- + ! WATER + !-------------------------------------- + ! 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_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) + ELSE + !COARE 3.5 + CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ENDIF - ELSE - !DEFAULT TO COARE 3.0/3.5 + ELSEIF ( ISFTCFLX .EQ. 1 .OR. ISFTCFLX .EQ. 2 ) THEN + CALL davis_etal_2008(ZNT_ocn(i),UST_ocn(i)) + ELSEIF ( ISFTCFLX .EQ. 3 ) THEN + 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 - 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)) + CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ENDIF ENDIF + ELSE + !DEFAULT TO COARE 3.0/3.5 + IF (COARE_OPT .EQ. 3.0) THEN + !COARE 3.0 + CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) + ELSE + !COARE 3.5 + CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) + ENDIF + 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 + ! 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 + + !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 - !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) - - !-------------------------------------- - !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(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. 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(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 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 + + ! 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) + 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) - - !-------------------------------------- - !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)) + 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)) 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 - 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.0001)) + ZOL(I)=MAX(ZOL(I),0.0) + ZOL(I)=MIN(ZOL(I),50.) ENDIF + IF (debug_code >= 1) 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) + 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 + 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 + 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) + 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 + write(0,*)"===(dry) capture bad input in mynn sfc layer, i=:",i + write(0,*)"rb=", rb_lnd(I)," ZNT=", ZNTstoch_lnd(i)," ZT=",Zt_lnd(i) + 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 + write(0,*)"===(dry) capture bad input in mynn sfc layer, i=:",i + write(0,*)"rb=", rb_lnd(I)," ZNT=", ZNTstoch_lnd(i)," ZT=",Zt_lnd(i) + 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 + 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) + 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 + 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) + 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 ITER LOOP, i=",i, "(wet)" + IF(dry(i))write(*,*)"==== AT END OF ITER LOOP, i=",i, "(land)" + IF(icy(i))write(*,*)"==== AT END OF ITER 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 - ELSE + 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. - 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 + ELSE - !------------------------------------------ - ! 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 (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) + + !---------------------------------- + ! COMPUTE SURFACE MOISTURE FLUX: + !---------------------------------- + QFX(I)=FLQC(I)*(QSFCMR_lnd(I)-QV1D(I)) + QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX + LH(I)=XLV*QFX(I) + + !---------------------------------- + ! COMPUTE SURFACE HEAT FLUX: + !---------------------------------- + HFX(I)=FLHC(I)*(THSK_lnd(I)-TH1D(I)) + HFX(I)=MAX(HFX(I),-250.) + HFLX(I)=HFX(I)/(RHO1D(I)*cpm(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) + + 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) + + !---------------------------------- + ! COMPUTE SURFACE MOISTURE FLUX: + !---------------------------------- + QFX(I)=FLQC(I)*(QSFCMR_ocn(I)-QV1D(I)) + QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX + LH(I)=XLV*QFX(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 - ELSEIF(XLAND(I)-1.5.LT.0.)THEN !LAND - HFX(I)=FLHC(I)*(THGB(I)-TH1D(I)) - HFX(I)=MAX(HFX(I),-250.) - ENDIF + HFLX(I)=HFX(I)/(RHO1D(I)*cpm(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) + + 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) + + !---------------------------------- + ! COMPUTE SURFACE MOISTURE FLUX: + !---------------------------------- + QFX(I)=FLQC(I)*(QSFCMR_ice(I)-QV1D(I)) + QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX + LH(I)=XLV*QFX(I) + + !---------------------------------- + ! COMPUTE SURFACE HEAT FLUX: + !---------------------------------- + HFX(I)=FLHC(I)*(THSK_ice(I)-TH1D(I)) + HFX(I)=MAX(HFX(I),-250.) + HFLX(I)=HFX(I)/(RHO1D(I)*cpm(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) + + !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) - !CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) & - ! /XKA+ZA(I)/ZL)-PSIH(I)) + ENDIF - CHS(I)=UST(I)*KARMAN/PSIT(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 ! The exchange coefficient for cloud water is assumed to be the ! same as that for heat. CH is multiplied by WSPD. - - !ch(i)=chs(i) ch(i)=flhc(i)/( cpm(i)*RHO1D(i) ) - !THESE ARE USED FOR 2-M DIAGNOSTICS ONLY - CQS2(I)=UST(I)*KARMAN/PSIQ2 - CHS2(I)=UST(I)*KARMAN/PSIT2(I) - - 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)) + !----------------------------------------- + !--- 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 ENDIF !end ISFFLX option - - !----------------------------------------------------- - !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) +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 print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& - ITER-ITMAX," ITERATIONS",I,J, "HFX: ",HFX(I) + 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, "LH: ",LH(I) + I,J, "LH: ",LH(I) + yesno = 1 + ENDIF + IF (wet(i)) THEN + IF (UST_ocn(I) < 0.0 .OR. UST_ocn(I) > 4.0 )THEN + print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& + I,J, "UST_ocn: ",UST_ocn(I) + yesno = 1 + ENDIF + ENDIF + 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 (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 (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) - 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_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) + 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 +2031,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 +2054,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 +2206,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 +2229,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 +2262,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 +2297,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 @@ -1994,12 +2583,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 +2662,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. + + IMPLICIT NONE + REAL, INTENT(IN) :: ri,za,z0,zt,zol1 + REAL :: x1,x2,fx1,fx2 + INTEGER :: n + if (ri.lt.0.)then + x1=zol1 - 0.02 !-5. + x2=0. + else + x1=0. + x2=zol1 + 0.02 !5. + 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 + + return + end function !------------------------------------------------------------------- + REAL function zolri2(zol2,ri2,za,z0,zt) - 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 + ! 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 - 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 - - 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 - - !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 + IMPLICIT NONE + REAL, INTENT(IN) :: ri2,za,z0,zt + REAL, INTENT(INOUT) :: zol2 + REAL :: zol20,zol3,psim1,psih1,psix2,psit2 - !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 - - END DO - - END SELECT !end cloudPDF option - - !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 + if(zol2*ri2 .lt. 0.)zol2=0. ! limit zol2 - must be same sign as ri2 + + 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 + end function +!==================================================================== + SUBROUTINE psi_init - RETURN + INTEGER :: N + REAL :: zolf - END SUBROUTINE mym_condensation + 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 From 017ae429d0e5f254df94df3baf0da09bf011cada Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 31 Dec 2019 09:10:16 -0700 Subject: [PATCH 07/90] Move Thompson MP initialization logic to mp_thompson_init, fix number concentrations, calculate effective radii before first call of radiation --- physics/module_mp_thompson.F90 | 2 +- physics/mp_thompson.F90 | 368 +++++++++++++++++++++++++++++---- physics/mp_thompson.meta | 200 ++++++++++++++++-- physics/mp_thompson_post.F90 | 6 - physics/mp_thompson_pre.F90 | 225 +------------------- physics/mp_thompson_pre.meta | 202 ------------------ 6 files changed, 512 insertions(+), 491 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b1ca6ba07..5e118c070 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -80,7 +80,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 diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 812229f98..7fd709b13 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,36 +23,60 @@ module mp_thompson contains -!> This subroutine is a wrapper around the actual mp_gt_driver(). -#if 0 +!> This subroutine is a wrapper around the actual thompson_init(). !! \section arg_table_mp_thompson_init Argument Table !! \htmlinclude mp_thompson_init.html !! -#endif - 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, & + 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, blkno, 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(1:ncol) - real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol) - real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev) + real(kind_phys), intent(in) :: con_g, con_rd + 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(:,:) + 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 - integer, intent(in) :: imp_physics - integer, intent(in) :: imp_physics_thompson + integer, intent(in) :: blkno + ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -57,6 +84,23 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & 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 = '' @@ -72,12 +116,26 @@ 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 + 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_init:', & + ' aerosol-aware microphysics require all of the following', & + ' optional arguments: nc, nwfa2d, nifa2d, nwfa, nifa' + errflg = 1 + return + end if + ! Set internal dimensions ids = 1 ims = 1 @@ -98,11 +156,8 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & kme = nlev kte = nlev - if (is_aerosol_aware .and. present(nwfa2d) & - .and. present(nifa2d) & - .and. present(nwfa) & - .and. present(nifa) ) then - ! Call init + ! Call Thompson init + if (is_aerosol_aware) then 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, & @@ -110,12 +165,6 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & 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, & @@ -125,16 +174,233 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & if (errflg /= 0) 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 = ni/(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 .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_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 + + else + + ! 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 + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = 2.49E-6 + re_ice(i,k) = 4.99E-6 + re_snow(i,k) = 9.99E-6 + end do + end do + 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,:), kts, kte) + end do + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) + re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) + re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) + end do + end do + else if (.not.present(re_cloud) .and. .not.present(re_ice) .and. .not.present(re_snow)) then + ! Do nothing + else + write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_run:', & + ' 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. end subroutine mp_thompson_init -#if 0 !> \section arg_table_mp_thompson_run Argument Table !! \htmlinclude mp_thompson_run.html !! -#endif !>\ingroup aathompson !>\section gen_thompson_hrrr Thompson MP General Algorithm !>@{ @@ -213,6 +479,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 @@ -249,14 +519,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. & @@ -270,6 +532,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) @@ -341,11 +618,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, & @@ -363,7 +639,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, & @@ -388,6 +664,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) @@ -400,11 +682,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 619053882..80e368228 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -17,6 +17,112 @@ 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 +[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 +131,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 +176,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 (meter here) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + 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) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + 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) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T [mpicomm] standard_name = mpi_comm long_name = MPI communicator @@ -93,18 +271,10 @@ 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 +[blkno] + standard_name = ccpp_block_number + long_name = for explicit data blocking: block number of this block + units = index dimensions = () type = integer intent = in @@ -414,7 +584,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) @@ -423,7 +593,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) @@ -432,7 +602,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..2452fa337 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -16,11 +16,9 @@ module mp_thompson_post 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) implicit none @@ -61,11 +59,9 @@ subroutine mp_thompson_post_init(ncol, ttendlim, errmsg, errflg) 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, & kdt, mpicomm, mpirank, mpiroot, errmsg, errflg) @@ -132,11 +128,9 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & 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 diff --git a/physics/mp_thompson_pre.F90 b/physics/mp_thompson_pre.F90 index 14ede1ec9..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(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nwfa2d(1:ncol) - real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol) - ! 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 From 92f9b6378a801974b8f1bff0c457c052e596104d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 31 Dec 2019 10:44:25 -0700 Subject: [PATCH 08/90] physics/GFS_rrtmg_pre.F90: turn off cloud effective radii initialization to default values for Thompson MP --- physics/GFS_rrtmg_pre.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index aa1ea039e..b179a74db 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -750,7 +750,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6 .or. & Model%imp_physics == 15) then - if (Model%kdt == 1) then + if (Model%kdt == 1 .and. .not.Model%imp_physics == 8) then Tbd%phy_f3d(:,:,Model%nleffr) = 10. Tbd%phy_f3d(:,:,Model%nieffr) = 50. Tbd%phy_f3d(:,:,Model%nseffr) = 250. From a77488d3801117720d947242196e824a2f6e409c Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 3 Jan 2020 15:53:12 +0000 Subject: [PATCH 09/90] Further bug fixes to tendency accumulation --- physics/GFS_DCNV_generic.F90 | 18 ++++++++---- physics/GFS_DCNV_generic.meta | 16 +++++++++++ physics/GFS_GWD_generic.F90 | 21 ++++++++------ physics/GFS_GWD_generic.meta | 40 ++++++++++++++++++++++++++ physics/cires_ugwp.F90 | 36 +++++++++++++++++++++-- physics/cires_ugwp.meta | 54 +++++++++++++++++++++++++++++++++++ physics/gwdc.f | 11 +++---- physics/ozphys.f | 32 ++++++++++----------- physics/ozphys.meta | 8 ++++++ 9 files changed, 198 insertions(+), 38 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 0acfbd19e..eb6e277d5 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -17,7 +17,7 @@ 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, qdiag3d, do_cnvgwd, do_ca, & isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & save_u, save_v, save_t, save_qv, ca_deep, & errmsg, errflg) @@ -27,7 +27,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, 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, isppt_deep, qdiag3d 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 @@ -70,7 +70,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, enddo endif - if (ldiag3d .or. isppt_deep) then + if (( ldiag3d .and. qdiag3d) .or. isppt_deep) then do k=1,levs do i=1,im save_qv(i,k) = gq0_water_vapor(i,k) @@ -95,7 +95,7 @@ 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, do_ca, & + subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cscnv, do_ca, & isppt_deep, 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, clw_ice, clw_liquid, npdf3d, num_p3d, ncnvcld3d, & rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & @@ -107,7 +107,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c implicit none integer, intent(in) :: im, levs - logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep + logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep, qdiag3d real(kind=kind_phys), intent(in) :: frain, dtf real(kind=kind_phys), dimension(im), intent(in) :: rain1, cld1d @@ -179,7 +179,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c 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 @@ -188,6 +187,13 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, ras, cscnv, do_c ! 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 eae53a910..c5c006e88 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) @@ -184,6 +192,14 @@ type = logical intent = in optional = F +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F [ras] standard_name = flag_for_ras_deep_convection long_name = flag for ras convection scheme diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 0915dd170..a90ccecb3 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -19,7 +19,8 @@ subroutine GFS_GWD_generic_pre_run( & & im, levs, nmtvr, mntvar, & & oc, oa4, clx, theta, & & sigma, gamma, elvmax, lssav, ldiag3d, & - & dtdt, dt3dt, dtf, errmsg, errflg) + & dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, & + & gwd_generic_tend, errmsg, errflg) use machine, only : kind_phys implicit none @@ -31,10 +32,10 @@ subroutine GFS_GWD_generic_pre_run( & & oc(im), oa4(im,4), clx(im,4), & & 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, 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 @@ -91,10 +92,13 @@ subroutine GFS_GWD_generic_pre_run( & endif ! end if_nmtvr if (lssav) then - if (ldiag3d) then + if (ldiag3d .and. gwd_generic_tend) then + write(0,*) 'gwd_generic_tend' 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 +129,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, gwd_generic_tend, errmsg, errflg) use machine, only : kind_phys implicit none - logical, intent(in) :: lssav, ldiag3d + logical, intent(in) :: lssav, ldiag3d, gwd_generic_tend real(kind=kind_phys), intent(in) :: dusfcg(:), dvsfcg(:) real(kind=kind_phys), intent(in) :: dudt(:,:), dvdt(:,:), dtdt(:,:) @@ -150,7 +154,8 @@ 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. gwd_generic_tend) then + write(0,*) 'gwd_generic_tend' 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..b87f398ab 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -118,6 +118,20 @@ 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 +[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 [dtdt] standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature @@ -127,6 +141,20 @@ 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 +[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 [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 +173,12 @@ kind = kind_phys intent = in optional = F +[gwd_generic_tend] + standard_name = true_if_GFS_GWD_generic_should_calculate_tendencies + 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 @@ -287,6 +321,12 @@ kind = kind_phys intent = inout optional = F +[gwd_generic_tend] + standard_name = true_if_GFS_GWD_generic_should_calculate_tendencies + 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/cires_ugwp.F90 b/physics/cires_ugwp.F90 index c15697e68..1daa10af5 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -149,7 +149,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, errmsg, errflg) implicit none @@ -172,6 +174,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(im, levs) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw + real(kind=kind_phys), intent(inout), dimension(im, levs) :: 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 @@ -263,6 +271,18 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr endif ! do_ugwp + + if(ldiag3d .and. lssav) 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 @@ -338,8 +358,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" @@ -358,6 +377,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) 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..005327005 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -850,6 +850,60 @@ 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 +[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 +[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 +[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 +[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 +[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 +[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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/gwdc.f b/physics/gwdc.f index 9909a3100..ad3aa3bf7 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -1498,13 +1498,14 @@ 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 + write(0,*) 'update gwdc tend' + du3dt(:,:) = du3dt(:,:) + gwdcu(:,:) * dtf + dv3dt(:,:) = dv3dt(:,:) + gwdcv(:,:) * dtf + endif + ! --- ... update the wind components with gwdc tendencies do k = 1, levs diff --git a/physics/ozphys.f b/physics/ozphys.f index 02296ee79..8ca13b99f 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -51,7 +51,7 @@ end subroutine ozphys_finalize !> @{ subroutine ozphys_run ( & & ix, im, levs, ko3, dt, oz, tin, po3, & - & prsl, prdout, oz_coeff, delp, ldiag3d, & + & 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 @@ -72,7 +72,7 @@ subroutine ozphys_run ( & & prsl(ix,levs), tin(ix,levs), delp(ix,levs), & & con_g real :: gravi - logical, intent(in) :: ldiag3d + logical, intent(in) :: ldiag3d, qdiag3d character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -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..8cce5c266 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -147,6 +147,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 From 6dcc757eaad3fe85a6b90e0041d305cc533d8b8e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 5 Jan 2020 20:26:24 -0700 Subject: [PATCH 10/90] physics/mp_thompson.F90: bugfix, initialize nr_mp from nr and not from ni --- physics/mp_thompson.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 7fd709b13..c01cab210 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -217,7 +217,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, & !> - Convert number concentrations from moist to dry ni_mp = ni/(1.0_kind_phys-spechum) - nr_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 From 1c6cad52ef65d4b7d01bbe9ce9fe93e71129180a Mon Sep 17 00:00:00 2001 From: hannah barnes Date: Mon, 6 Jan 2020 10:52:21 -0700 Subject: [PATCH 11/90] Number Concentrated code moved to interstitial code --- physics/GFS_DCNV_generic.F90 | 20 ++++++--- physics/GFS_DCNV_generic.meta | 25 +++++++++++ physics/GFS_suite_interstitial.F90 | 64 ++++++++++++++++++----------- physics/GFS_suite_interstitial.meta | 45 ++++++++++++++++++++ physics/cu_gf_driver.F90 | 26 ------------ physics/cu_gf_driver.meta | 59 -------------------------- 6 files changed, 125 insertions(+), 114 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 0acfbd19e..02230904c 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -17,16 +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, & - isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & - save_u, save_v, save_t, save_qv, ca_deep, & - errmsg, errflg) + subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, & + isppt_deep, imp_physics, imp_physics_thompson, & + gu0, gv0, gt0, gq0_water_vapor, & + save_u, save_v, save_t, save_tcp, save_qv, & + ca_deep, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs + integer, intent(in) :: im, levs, imp_physics, imp_physics_thompson logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, isppt_deep real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 @@ -35,6 +36,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_u real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_v real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t + real(kind=kind_phys), dimension(im,levs), intent(out), optional :: save_tcp real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv real(kind=kind_phys), dimension(im), intent(in) :: ca_deep character(len=*), intent(out) :: errmsg @@ -70,6 +72,14 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, enddo endif + if (imp_physics == imp_physics_thompson) then + do k=1,levs + do i=1,im + save_tcp(i,k) = gt0(i,k) + enddo + enddo + endif + if (ldiag3d .or. isppt_deep) then do k=1,levs do i=1,im diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index eae53a910..65c44e53b 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -49,6 +49,22 @@ 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 [gu0] standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics @@ -112,6 +128,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 = out + optional = T [save_qv] standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 1e8545e98..79b14c18e 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -662,9 +662,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, dqdti, imfdeepcnv, imfdeepcnv_gf, errmsg, errflg) + gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, imfdeepcnv, imfdeepcnv_gf, errmsg, errflg) use machine, only: kind_phys + use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber implicit none @@ -683,6 +684,11 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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(im,levs), intent(in), optional :: 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 @@ -693,10 +699,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_dryar + 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 = '' @@ -729,6 +737,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 @@ -736,25 +745,31 @@ 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) then + do k=1,levs + do i=1,im + !> - Density of air in kg m-3 + rho_dryar(i,k) = prsl(i,k)/(con_rd*save_tcp(i,k)) + + !> - Convert specific humidity/moist mixing ratios to dry mixing ratios + qv_mp(i,k) = spechum(i,k)/(1.0_kind_phys-spechum(i,k)) + qc_mp(i,k) = save_qc(i,k)/(1.0_kind_phys-spechum(i,k)) + qi_mp(i,k) = save_qi(i,k)/(1.0_kind_phys-spechum(i,k)) + + !> - Convert number concentrations from moist to dry + nc_mp(i,k) = gq0(i,k,ntlnc)/(1.0_kind_phys-spechum(i,k)) + ni_mp(i,k) = gq0(i,k,ntinc)/(1.0_kind_phys-spechum(i,k)) + + + nc_mp(i,k) = nc_mp(i,k) + max(0.0, make_DropletNumber(qc_mp(i,k) * rho_dryar(i,k), nwfa(i,k)) * (1.0/rho_dryar(i,k))) + ni_mp(i,k) = ni_mp(i,k) + max(0.0, make_IceNumber(qi_mp(i,k) * rho_dryar(i,k), save_tcp(i,k)) * (1.0/rho_dryar(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)) + gq0(i,k,ntinc) = ni_mp(i,k)/(1.0_kind_phys+qv_mp(i,k)) + enddo + enddo endif else @@ -764,6 +779,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 diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index e6e349a2a..7316bb048 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1692,6 +1692,51 @@ kind = kind_phys intent = inout 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 +[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 = in + optional = T +[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 = T +[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 long_name = instantaneous moisture tendency due to convection diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 53e26fb46..70d1ce799 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 @@ -74,7 +73,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & 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) !------------------------------------------------------------- implicit none @@ -126,12 +124,6 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & 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 @@ -826,26 +818,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) diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index d3687a352..0733b603d 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -358,65 +358,6 @@ 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 - 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 = () - type = real - kind = kind_phys - intent = in - optional = F -[gq0] - standard_name = tracer_concentration_updated_by_physics - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) - 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 - 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 From a227ad0d7e4c67e7ad6e74b770e4786f189af008 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 6 Jan 2020 19:54:18 +0000 Subject: [PATCH 12/90] fix several bugs mentioned in code review --- physics/GFS_GWD_generic.F90 | 2 -- physics/GFS_GWD_generic.meta | 5 +++++ physics/GFS_MP_generic.F90 | 16 +++++++++++++--- physics/GFS_MP_generic.meta | 9 +++++++++ physics/cires_ugwp.meta | 7 +++++++ physics/gwdc.f | 1 - 6 files changed, 34 insertions(+), 6 deletions(-) diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index a90ccecb3..f05fa508f 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -93,7 +93,6 @@ subroutine GFS_GWD_generic_pre_run( & if (lssav) then if (ldiag3d .and. gwd_generic_tend) then - write(0,*) 'gwd_generic_tend' do k=1,levs do i=1,im dt3dt(i,k) = dt3dt(i,k) - dtdt(i,k)*dtf @@ -155,7 +154,6 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf if (ldiag3d .and. gwd_generic_tend) then - write(0,*) 'gwd_generic_tend' 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 b87f398ab..782adfa59 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -125,6 +125,7 @@ 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 @@ -132,6 +133,7 @@ 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 @@ -148,6 +150,7 @@ 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 @@ -155,6 +158,7 @@ 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 @@ -179,6 +183,7 @@ 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_MP_generic.F90 b/physics/GFS_MP_generic.F90 index ea2ef6c16..521a8b6ac 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -16,7 +16,7 @@ end subroutine GFS_MP_generic_pre_init !> \section arg_table_GFS_MP_generic_pre_run Argument Table !! \htmlinclude GFS_MP_generic_pre_run.html !! - subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, ntrac, gt0, gq0, save_t, save_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 @@ -26,7 +26,7 @@ subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, real(kind=kind_phys), dimension(im, levs), intent(in) :: gt0 real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 - real(kind=kind_phys), dimension(im, levs), intent(inout) :: save_t + 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 @@ -44,7 +44,17 @@ subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, save_t(i,k) = gt0(i,k) enddo enddo - if(do_aw .or. (qdiag3d .and. ldiag3d)) then + 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) diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 1ac030bc7..3c8574f95 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -97,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 diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 005327005..32c64145f 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -857,6 +857,7 @@ 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 @@ -864,6 +865,7 @@ 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 @@ -871,6 +873,7 @@ 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 @@ -878,6 +881,7 @@ 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 @@ -885,6 +889,7 @@ 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 @@ -892,6 +897,7 @@ 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 @@ -904,6 +910,7 @@ 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/gwdc.f b/physics/gwdc.f index ad3aa3bf7..314aa4d44 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -1501,7 +1501,6 @@ subroutine gwdc_post_run( & endif ! end if_lssav if (ldiag3d) then - write(0,*) 'update gwdc tend' du3dt(:,:) = du3dt(:,:) + gwdcu(:,:) * dtf dv3dt(:,:) = dv3dt(:,:) + gwdcv(:,:) * dtf endif From ff02358faa89878ac2d9c8d934bfd0cba96fba93 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 10 Jan 2020 13:03:38 -0700 Subject: [PATCH 13/90] Bugfix for bit-for-bit identical restart runs --- physics/mp_thompson.F90 | 43 ++++++++++++++++++++++++++-------------- physics/mp_thompson.meta | 26 +++++++++++++++--------- 2 files changed, 45 insertions(+), 24 deletions(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index c01cab210..4ecbc47df 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -27,7 +27,7 @@ module mp_thompson !! \section arg_table_mp_thompson_init Argument Table !! \htmlinclude mp_thompson_init.html !! - subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, & + 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, & @@ -39,11 +39,12 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, & implicit none ! Interface variables - integer, intent(in) :: ncol - integer, intent(in) :: nlev - real(kind_phys), intent(in) :: con_g, con_rd - integer, intent(in) :: imp_physics - integer, intent(in) :: imp_physics_thompson + 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(:,:) @@ -66,16 +67,16 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, & 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(:,:) + real(kind_phys), optional, intent(inout) :: re_cloud(:,:) + real(kind_phys), optional, intent(inout) :: re_ice(:,:) + real(kind_phys), optional, intent(inout) :: re_snow(:,:) ! MPI information - integer, intent(in) :: mpicomm - integer, intent(in) :: mpirank - integer, intent(in) :: mpiroot + integer, intent(in ) :: mpicomm + integer, intent(in ) :: mpirank + integer, intent(in ) :: mpiroot ! Threading/blocking information - integer, intent(in) :: threads - integer, intent(in) :: blkno + integer, intent(in ) :: threads + integer, intent(in ) :: blkno ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -174,6 +175,12 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, & 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 @@ -361,7 +368,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, & do k = 1, nlev re_cloud(i,k) = 2.49E-6 re_ice(i,k) = 4.99E-6 - re_snow(i,k) = 9.99E-6 + re_snow(i,k) = 9.99E-6 end do end do do i = 1, ncol @@ -376,6 +383,12 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, & re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) end do 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. + re_cloud = 1.0E6*re_cloud + re_ice = 1.0E6*re_ice + re_snow = 1.0E6*re_snow else if (.not.present(re_cloud) .and. .not.present(re_ice) .and. .not.present(re_snow)) then ! Do nothing else diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 80e368228..0419a6c15 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -35,6 +35,14 @@ 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 @@ -214,30 +222,30 @@ 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 (meter here) - units = m + long_name = eff. radius of cloud liquid water particle in micrometer + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + 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 (meter here) - units = m + long_name = eff. radius of cloud ice water particle in micrometer + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + 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 (meter here) - units = m + long_name = effective radius of cloud snow particle in micrometer + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = T [mpicomm] standard_name = mpi_comm From 4367882dcf5da5e9086c19f11be35d38005cc017 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 14 Jan 2020 01:21:35 +0000 Subject: [PATCH 14/90] Move PBL tendencies into the PBL run subroutine. --- physics/GFS_PBL_generic.F90 | 5 +-- physics/GFS_PBL_generic.meta | 7 ++++ physics/moninedmf.f | 36 ++++++++++++++++--- physics/moninedmf.meta | 67 ++++++++++++++++++++++++++++++++++++ 4 files changed, 109 insertions(+), 6 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index d31dbafec..cd4a30849 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -281,7 +281,7 @@ 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, qdiag3d, lsidea, hybedmf, do_shoc, satmedmf, shinhong, do_ysu, & + ltaerosol, cplflx, cplchm, lssav, 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, & @@ -301,6 +301,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu + logical, intent(in) :: pbl_generic_tend real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap @@ -552,7 +553,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! & dtf,' kdt=',kdt,' lat=',lat ! endif - if (ldiag3d) then + if (ldiag3d .and. pbl_generic_tend) then if (lsidea) then dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf else diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index ae86b0dce..4256049dd 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -601,6 +601,13 @@ type = logical intent = in optional = F +[pbl_generic_tend] + standard_name = true_if_GFS_PBL_generic_should_calculate_tendencies + long_name = true if GFS_PBL_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in [lssav] standard_name = flag_diagnostics long_name = logical flag for storing diagnostics diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 1084aa426..2bd19580a 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -64,7 +64,9 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & 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, & + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -74,16 +76,18 @@ 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 integer, intent(in) :: ipr - integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) + integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im), ntoz integer, intent(out) :: kpbl(im) ! real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s 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) + & tau(im,km), rtg(im,km,ntrac)\ + real(kind=kind_phys), intent(inout), dimension(ix,km) :: & + & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL real(kind=kind_phys), intent(in) :: & & u1(ix,km), v1(ix,km), & & t1(ix,km), q1(ix,km,ntrac), & @@ -1037,6 +1041,17 @@ 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) 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)-hsw(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 +1064,15 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo enddo + if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d) then + is = (ntoz-1) * km + do k = 1, km + do i = 1, im + qtend = (a2(i,k+is)-q1(i,k,kk))*rdt + do3dt(i,k,kk) = do3dt(i,k,kk)+qtend + enddo + enddo + endif endif ! ! compute tke dissipation rate @@ -1150,6 +1174,10 @@ 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) 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 47875640f..2027008fc 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -499,6 +499,73 @@ 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 +[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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 2850217b2efafbda2cafa8a9b01af82348ee2cda Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 14 Jan 2020 01:26:13 +0000 Subject: [PATCH 15/90] add a missing intent(in) to physics/moninedmf.meta --- physics/moninedmf.meta | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 2027008fc..07b389219 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -526,6 +526,7 @@ units = flag dimensions = () type = logical + intent = in [ntoz] standard_name = index_for_ozone long_name = tracer index for ozone mixing ratio From d5a527841cfb07f0fe94f6fd2816264c39060655 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 16 Jan 2020 00:33:10 +0000 Subject: [PATCH 16/90] add ldiag3d and qdiag3d support to physics/module_MYNNPBL_wrapper.F90 and physics/moninedmf.f --- physics/module_MYNNPBL_wrapper.F90 | 126 ++++++++++++++++++---------- physics/module_MYNNPBL_wrapper.meta | 38 +++++++-- physics/moninedmf.f | 10 +-- physics/moninedmf.meta | 8 ++ 4 files changed, 123 insertions(+), 59 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 36c9e55de..471c99f50 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -25,7 +25,7 @@ end subroutine mynnedmf_wrapper_finalize SUBROUTINE mynnedmf_wrapper_run( & & ix,im,levs, & & flag_init,flag_restart, & - & lssav, ldiag3d, lsidea, & + & lssav, ldiag3d, qdiag3d, lsidea,& & delt,dtf,dx,zorl, & & phii,u,v,omega,t3d, & & qgrs_water_vapor, & @@ -56,7 +56,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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, & @@ -154,7 +155,7 @@ SUBROUTINE mynnedmf_wrapper_run( & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea + LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea, qdiag3d ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & lprnt, do_mynnsfclay @@ -224,8 +225,9 @@ SUBROUTINE mynnedmf_wrapper_run( & & RTHRATEN 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 @@ -285,7 +287,7 @@ SUBROUTINE mynnedmf_wrapper_run( & endif ! Assign variables for each microphysics scheme - if (imp_physics == imp_physics_wsm6) then + init_if_imp_physics: if (imp_physics == imp_physics_wsm6) then ! WSM6 FLAG_QI = .true. FLAG_QNI= .false. @@ -314,7 +316,7 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo elseif (imp_physics == imp_physics_thompson) then ! Thompson - if(ltaerosol) then + tmp_init_if_aer: if(ltaerosol) then FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. @@ -366,7 +368,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qnifa(i,k) = 0. enddo enddo - endif + endif tmp_init_if_aer elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP FLAG_QI = .true. @@ -420,7 +422,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qnifa(i,k) = 0. enddo enddo - endif + endif init_if_imp_physics if (lprnt)write(0,*)"prepping MYNN-EDMF variables..." @@ -436,7 +438,7 @@ SUBROUTINE mynnedmf_wrapper_run( & pattern_spp_pbl(i,k)=0.0 enddo enddo - do i=1,im + big_init_i_loop: 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 @@ -479,9 +481,9 @@ SUBROUTINE mynnedmf_wrapper_run( & ! qsfc(i)=qss(i) ! ps(i)=pgr(i) ! wspd(i)=wind(i) - enddo + enddo big_init_i_loop - if (lprnt) then + lprnt_before: if (lprnt) then print* write(0,*)"===CALLING mynn_bl_driver; input:" print*,"bl_mynn_tkebudget=",bl_mynn_tkebudget," bl_mynn_tkeadvect=",bl_mynn_tkeadvect @@ -518,7 +520,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"exch_h:",exch_h(1,1),exch_h(1,2),exch_h(1,levs) ! - intent(out) !print*,"exch_m:",exch_m(1,1),exch_m(1,2),exch_m(1,levs) ! - intent(out) print*,"max cf_bl:",maxval(cldfra_bl(1,:)) - endif + endif lprnt_before CALL mynn_bl_driver( & @@ -591,6 +593,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 @@ -601,7 +623,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !enddo !DO moist/scalar/tracer tendencies: - if (imp_physics == imp_physics_wsm6) then + if_imp_physics: if (imp_physics == imp_physics_wsm6) then ! WSM6 do k=1,levs do i=1,im @@ -611,6 +633,13 @@ SUBROUTINE mynnedmf_wrapper_run( & !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 @@ -622,8 +651,8 @@ SUBROUTINE mynnedmf_wrapper_run( & !enddo elseif (imp_physics == imp_physics_thompson) then ! Thompson-Aerosol - if(ltaerosol) then - do k=1,levs + thmp_if_ltaerosol: if(ltaerosol) then + thmp_aer_tend: 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)) @@ -634,7 +663,14 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) enddo - enddo + enddo thmp_aer_tend + 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,7 +685,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !enddo else !Thompson (2008) - do k=1,levs + thmp_noaer_tend: 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)) @@ -657,7 +693,14 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) !dqdt_ozone(i,k) = 0.0 enddo - enddo + enddo thmp_noaer_tend + 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 @@ -667,10 +710,10 @@ SUBROUTINE mynnedmf_wrapper_run( & ! !dqdt_ozone(i,k) = 0.0 ! enddo !enddo - endif !end thompson choice + endif thmp_if_ltaerosol !end thompson choice elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP - do k=1,levs + gfdl_mp_tend: 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)) @@ -680,7 +723,14 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_graupel(i,k) = 0.0 !dqdt_ozone(i,k) = 0.0 enddo - enddo + enddo gfdl_mp_tend + 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 @@ -702,30 +752,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 + endif if_imp_physics - if (lprnt) then + lprnt_after: if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" print*,"T:",t3d(1,1),t3d(1,2),t3d(1,levs) @@ -764,7 +800,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"ktop_shallow:",ktop_shallow(1)," maxmf:",maxmf(1) print*,"nup:",nupdraft(1) print* - endif + endif lprnt_after END SUBROUTINE mynnedmf_wrapper_run diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 61a9ccb70..68de977c5 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -57,6 +57,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 @@ -692,15 +698,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 @@ -737,6 +734,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_timestep long_name = total sky sw heating rate diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 2bd19580a..f6558a861 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -65,7 +65,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & & xkzminv,moninq_fac,lssav,ldiag3d,qdiag3d,lsidea,ntoz, & - & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL, & + & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL,do3dt_PBL, & & errmsg,errflg) ! use machine , only : kind_phys @@ -85,9 +85,9 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s 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)\ + & tau(im,km), rtg(im,km,ntrac) real(kind=kind_phys), intent(inout), dimension(ix,km) :: & - & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL + & 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), & @@ -1046,7 +1046,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + ttend*rdt else dt3dt_PBL(i,k) = dt3dt_PBL(i,k) + & - & ((ttend-hlw(i,k)-hsw(i,k)*xmu(i))*rdt) + & ((ttend-hlw(i,k)-swh(i,k)*xmu(i))*rdt) endif if(qdiag3d) then dq3dt_PBL(i,k) = dq3dt_PBL(i,k) + qtend*rdt @@ -1069,7 +1069,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & do k = 1, km do i = 1, im qtend = (a2(i,k+is)-q1(i,k,kk))*rdt - do3dt(i,k,kk) = do3dt(i,k,kk)+qtend + do3dt_PBL(i,k) = do3dt_PBL(i,k)+qtend enddo enddo endif diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 07b389219..b5a6947c3 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -567,6 +567,14 @@ 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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 8d5fe8c3765eddfba4a33e023c3b70dcc47d5966 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 23 Jan 2020 11:50:13 -0700 Subject: [PATCH 17/90] physics/module_mp_thompson.F90: bugfix, remove threaded computation/read of lookup tables --- physics/module_mp_thompson.F90 | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 5e118c070..67e0e3d9d 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -924,11 +924,6 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & call cpu_time(stime) -!$OMP parallel num_threads(threads) - -!$OMP sections - -!$OMP section !> - Call qr_acr_qg() to create rain collecting graupel & graupel collecting rain table if (mpirank==mpiroot) write(0,*) ' creating rain collecting graupel table' call cpu_time(stime) @@ -936,7 +931,6 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & call cpu_time(etime) if (mpirank==mpiroot) print '("Computing rain collecting graupel table took ",f10.3," seconds.")', etime-stime -!$OMP section !> - Call qr_acr_qs() to create rain collecting snow & snow collecting rain table if (mpirank==mpiroot) write (*,*) ' creating rain collecting snow table' call cpu_time(stime) @@ -944,10 +938,6 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & call cpu_time(etime) if (mpirank==mpiroot) print '("Computing rain collecting snow table took ",f10.3," seconds.")', etime-stime -!$OMP end sections - -!$OMP end parallel - !> - Call freezeh2o() to create cloud water and rain freezing (Bigg, 1953) table if (mpirank==mpiroot) write(0,*) ' creating freezing of water drops table' call cpu_time(stime) From 3449dd57f0f678324c4d73e5ed883a088fbb1d34 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 27 Jan 2020 10:08:39 -0700 Subject: [PATCH 18/90] 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 From c23b8d19c31b68869b15c0d0bc1367fa4e991234 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 28 Jan 2020 23:06:20 +0000 Subject: [PATCH 19/90] Add ozone tendencies to ozphys_2015 --- physics/ozphys_2015.f | 23 ++++++++++++----------- physics/ozphys_2015.meta | 8 ++++++++ 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index 3126313dc..766cfdd62 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -55,7 +55,8 @@ end subroutine ozphys_2015_finalize !!\author June 2015 - Shrinivas Moorthi subroutine ozphys_2015_run ( & & ix, im, levs, ko3, dt, oz, tin, po3, & - & prsl, prdout, pl_coeff, delp, ldiag3d, & + & prsl, prdout, pl_coeff, delp, & + & ldiag3d, qdiag3d, & & ozp1,ozp2,ozp3,ozp4,con_g, & & me, errmsg, errflg) ! @@ -80,7 +81,7 @@ subroutine ozphys_2015_run ( & 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),& @@ -163,16 +164,16 @@ 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 + 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 !!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 + 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..eedfe3ca2 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -147,6 +147,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 From 2ee8e48f45cc10c05a78ffabaae0bfdf034cc515 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 31 Jan 2020 20:35:33 +0000 Subject: [PATCH 20/90] Changes in cloud/radiation interaction in GSD physics suite that uses Thompson MP, MYNN pbl and GF convection: 1. Switch the order of calls, first MYNNrad_pre (or SGSCloud_RadPre), then rrtmg_pre. This will add sub-grid clouds from MYNN PBL (or MYNN PBL and GF) to QC and QI, and these updated hydrometeors will be used to compute cloud paths and effective radii. 2. In rrtmg_pre with the use of THompson MP: - use Thompson's subroutines make_IceNumber and make_DropletNumber to compute number concentrations for subgrid clouds. - use calc_effectRad to compute effective radii for QC and QI with sub-grid clouds. - added option (clduni) to use the same subroutine to compute water paths as with the GFDL MP. For this input.nl should set effr_in=.true. - the progcld5 is used mostly to compute Xu-Randall cloud fraction. 3. Added *SGSCloud_* modules to replace *MYNNrad* to add all subgrid clouds to QC and QI (from MYNN PBL and GF conv). 4. Added convective clouds qci_conv to GF scheme and SGSCloud_RadPre. 5. Computation of total cloud fraction in progcld5 is change not to depend on shallow/deep convection. Not needed in the current version of GSD suite. --- physics/GFS_rrtmg_pre.F90 | 306 ++++++++++++++++++++++++-- physics/GFS_rrtmg_pre.meta | 61 ++++++ physics/cu_gf_driver.F90 | 8 +- physics/cu_gf_driver.meta | 9 + physics/module_MYNNrad_pre.F90 | 7 + physics/module_SGSCloud_RadPost.F90 | 75 +++++++ physics/module_SGSCloud_RadPost.meta | 96 +++++++++ physics/module_SGSCloud_RadPre.F90 | 211 ++++++++++++++++++ physics/module_SGSCloud_RadPre.meta | 308 +++++++++++++++++++++++++++ physics/radiation_clouds.f | 63 +++--- 10 files changed, 1095 insertions(+), 49 deletions(-) create mode 100644 physics/module_SGSCloud_RadPost.F90 create mode 100644 physics/module_SGSCloud_RadPost.meta create mode 100644 physics/module_SGSCloud_RadPre.F90 create mode 100644 physics/module_SGSCloud_RadPre.meta diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index b179a74db..6b5382e65 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -20,7 +20,8 @@ end subroutine GFS_rrtmg_pre_init ! in the CCPP version - they are defined in the interstitial_create routine subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & - Radtend, & ! input/output + Radtend, qc, qi, nc, ni, nwfa, & ! 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,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & proflw_type, NBDLW use surface_perturbation, only: cdfnor + !tgs for Thompson MP + use module_mp_thompson, only : calc_effectRad + use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber, make_RainNumber + implicit none type(GFS_control_type), intent(in) :: Model @@ -81,7 +87,15 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input type(GFS_cldprop_type), intent(in) :: Cldprop type(GFS_coupling_type), intent(in) :: Coupling + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: qc + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: qi + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: nc + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: ni + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: nwfa + + 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 +137,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 +156,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 integer :: i, j, k, k1, k2, lsk, lv, n, itop, ibtc, LP1, lla, llb, lya, lyb @@ -154,7 +168,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 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 +183,9 @@ 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 + + logical :: clduni + real(kind=kind_phys) :: qvs ! !===> ... begin here ! @@ -180,6 +201,8 @@ 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 @@ -257,6 +280,9 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input 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 qs = max( QMIN, eps * es / (Statein%prsl(i,k2) + epsm1*es) ) @@ -273,6 +299,15 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input tracer1(:,k1,j) = max(0.0, Statein%qgrs(:,k2,j)) enddo enddo + if ((Model%do_mynnedmf.or. (imfdeepcnv == imfdeepcnv_gf)) .and. Model%kdt > 1) then + ! for MYNN PBL and GF convective include subgrid clouds into tracer1 + do k = 1, LM + k1 = k + kd + k2 = k + lsk + tracer1(:,k1,ntcw) = max(0.0, qc(:,k2)) + tracer1(:,k1,ntiw) = max(0.0, qi(:,k2)) + enddo + endif ! if (ivflip == 0) then ! input data from toa to sfc do i = 1, IM @@ -552,6 +587,17 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input 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 + + ! for Thompson MP - prepare variables for calc_effr + if (Model%imp_physics == Model%imp_physics_thompson) then + qvs = Statein%qgrs(i,k2,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) + endif enddo enddo endif @@ -562,7 +608,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 @@ -583,7 +629,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! do j=1,Model%ncld ! ccnd(:,:,1) = ccnd(:,:,1) + tracer1(:,1:LMK,ntcw+j-1) ! cloud condensate amount ! enddo - endif + endif ! imp_physics == 11 do k=1,LMK do i=1,IM if (ccnd(i,k,1) < EPSQ ) ccnd(i,k,1) = 0.0 @@ -612,7 +658,29 @@ 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) THEN + if(Model%kdt == 1) then + ! GFDL cloud fraction + cldcov(1:IM,1+kd:LM+kd) = tracer1(1:IM,1:LM,Model%ntclamt) + else ! kdt > 1 + 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 + endif + 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 @@ -634,6 +702,103 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo endif + elseif (Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP + if(Model%kdt == 1 ) then + do k=1,lm + k1 = k + kd + do i=1,im + effrl(i,k1) = Tbd%phy_f3d(i,k,Model%nleffr) + effri(i,k1) = Tbd%phy_f3d(i,k,Model%nieffr) + effrr(i,k1) = 1000. ! rrain_def=1000. + effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) + enddo + enddo + else ! kdt>1 + if(Model%do_mynnedmf .or. & + Model%imfdeepcnv == Model%imfdeepcnv_gf ) then + !tgs - take into account sub-grid clouds from GF or MYNN PBL + + ! Compute effective radii for QC and QI with sub-grid clouds + do k=1,lm + do i=1,im + re_cloud(i,k) = 2.49E-6 + re_ice(i,k) = 4.99E-6 + re_snow(i,k) = 999.E-6 + ! make NC consistent with sub-grid clouds + if (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 + do i = 1, im + 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 + do k=1,lm + do i=1,im + 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.)) + !tgs: clduni has different limits for ice radii: 10.0-150.0 + ! it will raise the low limit from 5 to 10, but the + ! high limit will remain 125. + re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) + end do + end do + if(1==2) then + write(0,'(a,3e16.7)') " before progclduni: re_cloud min/mean/max =", & + minval(re_cloud), & + sum(re_cloud)/real(size(re_cloud)), & + maxval(re_cloud) + write(0,'(a,3e16.7)') " before progclduni: re_ice min/mean/max =", & + minval(re_ice), & + sum(re_ice)/real(size(re_ice)), & + maxval(re_ice) + write(0,'(a,3e16.7)') " before progclduni: clouds3 min/mean/max =", & + minval(clouds3), & + sum(clouds3)/real(size(clouds3)), & + maxval(clouds3) + write(0,'(a,3e16.7)') " before progclduni: clouds5 min/mean/max =", & + minval(clouds5), & + sum(clouds5)/real(size(clouds5)), & + maxval(clouds5) + write(0,'(a,3e16.7)') " before progcld5: phy_f3d cl min/mean/max =", & + minval(Tbd%phy_f3d(:,:,Model%nleffr)), & + sum(Tbd%phy_f3d(:,:,Model%nleffr))/real(size(Tbd%phy_f3d(:,:,Model%nleffr))), & + maxval(Tbd%phy_f3d(:,:,Model%nleffr)) + write(0,'(a,3e16.7)')" before progcld5: phy_f3d ice min/mean/max =", & + minval(Tbd%phy_f3d(:,:,Model%nieffr)), & + sum(Tbd%phy_f3d(:,:,Model%nieffr))/real(size(Tbd%phy_f3d(:,:,Model%nieffr))), & + maxval(Tbd%phy_f3d(:,:,Model%nieffr)) + endif + + do k=1,lm + k1 = k + kd + do i=1,im + !effrl(i,k1) = clouds3 (i,k) ! Tbd%phy_f3d(i,k,Model%nleffr) + !effri(i,k1) = clouds5 (i,k) ! Tbd%phy_f3d(i,k,Model%nieffr) + effrl(i,k1) = re_cloud (i,k) ! Tbd%phy_f3d(i,k,Model%nleffr) + effri(i,k1) = re_ice (i,k) ! Tbd%phy_f3d(i,k,Model%nieffr) + effrr(i,k1) = 1000. ! rrain_def=1000. + effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) + enddo + enddo + else ! not MYNN or not GF + do k=1,lm + k1 = k + kd + do i=1,im + effrl(i,k1) = Tbd%phy_f3d(i,k,Model%nleffr) + effri(i,k1) = Tbd%phy_f3d(i,k,Model%nieffr) + effrr(i,k1) = 1000. ! rrain_def=1000. + effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) + enddo + enddo + endif ! MYNN PBL or GF conv + endif ! kdt + else ! neither of the other two cases cldcov = 0.0 endif @@ -748,9 +913,8 @@ 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 - if (Model%kdt == 1 .and. .not.Model%imp_physics == 8) 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. Tbd%phy_f3d(:,:,Model%nseffr) = 250. @@ -766,6 +930,118 @@ 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 + + clduni = .true. + + if(Model%do_mynnedmf .or. & + Model%imfdeepcnv == Model%imfdeepcnv_gf ) then ! MYNN PBL or GF conv + ! MYNN PBL or convective GF + + if (Model%kdt == 1 ) then + ! --- call progcld5 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) at + ! --- initial time step, it takes into account subgrid PBL + ! --- clouds + 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(:,:,Model%nleffr), & + Tbd%phy_f3d(:,:,Model%nieffr), & + Tbd%phy_f3d(:,:,Model%nseffr), & + clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + if ( clduni) then + ! use progclduni for interaction with radiation, + ! overwrites 'clouds' from progcld5 + 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 + endif + + else ! kdt > 1 + + 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 + + ! --- call progcld5 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) + ! tgs: a short subroutine could be made of progcld5 only to + ! compute total cloud fraction. + 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(:,:,Model%nleffr), & + Tbd%phy_f3d(:,:,Model%nieffr), & + Tbd%phy_f3d(:,:,Model%nseffr), & + clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + + do k=1,lmk + do i=1,im + !IF (tracer1(i,k,ntrw) > 1.0e-7 .OR. tracer1(i,k,ntsw) > 1.0e-7) then + ! ! Xu-Randall cloud fraction computed in progcld5 + ! cldcov(i,k) = clouds(i,k,1) + ! clouds(i,k,1) = clouds(i,k,1) + !ELSE + ! MYNN sub-grid cloud fraction + !tgs - let's use only PBL cloud fraction + cldcov(i,k) = clouds1(i,k) + clouds(i,k,1) = clouds1(i,k) + !ENDIF + enddo + enddo + if( .not. clduni) then + ! --- call progcld5 for interaction with the radiation with setting + ! --- uni_cld=.true. to keep precomputed cloud + ! --- fraction + 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, .true., & ! Model%uni_cld, + Model%lmfshal,Model%lmfdeep2, & + cldcov(:,1:LMK),Tbd%phy_f3d(:,:,Model%nleffr), & + Tbd%phy_f3d(:,:,Model%nieffr), & + Tbd%phy_f3d(:,:,Model%nseffr), & + clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + + else ! clduni + ! --- 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 + endif ! clduni + + endif ! kdt + + 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..423a50ff0 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -270,6 +270,67 @@ kind = kind_phys intent = out optional = F +[qc] + standard_name = cloud_condensed_water_mixing_ratio + long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + 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 = moist (dry+vapor, no condensates) mixing ratio of ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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 +[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 +[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 = inout + optional = T +[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 diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 53e26fb46..1d21a7f4e 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -75,7 +75,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & 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) + qci_conv,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -98,8 +98,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & integer :: its,ite, jts,jte, kts,kte integer, intent(in ) :: im,ix,km,ntracer - 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 , 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 , km ), intent(inout ) :: qci_conv 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 @@ -751,6 +752,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. diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index d3687a352..3966c1eba 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -417,6 +417,15 @@ type = integer intent = in 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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_MYNNrad_pre.F90 b/physics/module_MYNNrad_pre.F90 index 95dc95445..54c47f681 100644 --- a/physics/module_MYNNrad_pre.F90 +++ b/physics/module_MYNNrad_pre.F90 @@ -85,6 +85,13 @@ SUBROUTINE mynnrad_pre_run( & qi_save(i,k) = qi(i,k) clouds1(i,k) = CLDFRA_BL(i,k) + !IF (qr(i,k) > 1.0e-7 .OR. qs(i,k) > 1.0e-7) then ! .OR. & + !(Model%imfdeepcnv == Model%imfdeepcnv_gf .AND. qci_conv(i,k)>1.0e-7)) THEN + !Keep Xu-RandalL clouds fraction + !ELSE + ! clouds1(i,k) = CLDFRA_BL(i,k) + !ENDIF + 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 diff --git a/physics/module_SGSCloud_RadPost.F90 b/physics/module_SGSCloud_RadPost.F90 new file mode 100644 index 000000000..810c3bcd3 --- /dev/null +++ b/physics/module_SGSCloud_RadPost.F90 @@ -0,0 +1,75 @@ +!> \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). +#if 0 +!! \section arg_table_sgscloud_radpost_run Argument Table +!! \htmlinclude sgscloud_radpost_run.html +!! +#endif +SUBROUTINE sgscloud_radpost_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 sgscloud_radpost_run + +!###================================================================= + +END MODULE sgscloud_radpost diff --git a/physics/module_SGSCloud_RadPost.meta b/physics/module_SGSCloud_RadPost.meta new file mode 100644 index 000000000..0318aa231 --- /dev/null +++ b/physics/module_SGSCloud_RadPost.meta @@ -0,0 +1,96 @@ +[ccpp-arg-table] + 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 + 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 = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qi] + standard_name = ice_water_mixing_ratio + long_name = moist (dry+vapor, no condensates) mixing ratio of ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qc_save] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qi_save] + standard_name = ice_water_mixing_ratio_save + long_name = moist (dry+vapor, no condensates) mixing ratio of ice water before entering a physics scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_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_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 new file mode 100644 index 000000000..91617b06b --- /dev/null +++ b/physics/module_SGSCloud_RadPre.F90 @@ -0,0 +1,211 @@ +!>\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 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. +!> \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( & + & ix,im,levs, & + & flag_init,flag_restart, & + & do_mynnedmf, & + & qc, qi, T3D, & + & qr, qs, & + & qci_conv, & + & imfdeepcnv, & + & qc_save, qi_save, & + & qc_bl,cldfra_bl, & + & delp,clouds1,clouds2,clouds3, & + & clouds4,clouds5,slmsk, & + & nlay, plyr, xlat, dz,de_lgth, & + & cldsa,mtopa,mbota, & + & 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, con_pi + use module_radiation_clouds, only : gethml + +!------------------------------------------------------------------- + implicit none +!------------------------------------------------------------------- + ! Interface variables + real (kind=kind_phys), parameter :: gfac=1.0e5/con_g + integer, intent(in) :: ix, im, levs, imfdeepcnv, nlay + 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 + real(kind=kind_phys), dimension(im,levs), intent(inout) :: qci_conv + 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, xlat, de_lgth + real(kind=kind_phys), dimension(im,nlay), intent(in) :: plyr, dz + real(kind=kind_phys), dimension(im,5), intent(out) :: cldsa + integer, dimension(im,3), intent(out) :: 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, tem1 + integer :: i, k, id + + ! 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 + ! 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 + + ! add boundary layer clouds + IF (do_mynnedmf == .true.) THEN + do k = 1, levs + do i = 1, im + + clouds1(i,k) = CLDFRA_BL(i,k) + + !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. 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)-244.)/25.)))*CLDFRA_BL(i,k) + qi(i,k) = QC_BL(i,k)*(1. - MIN(1., MAX(0., (T3D(i,k)-244.)/25.)))*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 + !calculate water and ice paths for additional BL clouds + 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 + ENDIF ! do_mynnedmf + + ! add convective clouds + IF (imfdeepcnv == 3) THEN + do k = 1, levs + do i = 1, im + IF ( qci_conv(i,k) > 0.) THEN + !IF (qc(i,k) < 1.E-6 .AND. qi(i,k) < 1.E-8 .AND. 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 + ENDIF + enddo + enddo + ENDIF +!> - 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..349d37885 --- /dev/null +++ b/physics/module_SGSCloud_RadPre.meta @@ -0,0 +1,308 @@ +[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 +[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 = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + 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 = moist (dry+vapor, no condensates) mixing ratio of ice water + 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 +[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 +[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 +[qc_save] + standard_name = cloud_condensed_water_mixing_ratio_save + long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) 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 = moist (dry+vapor, no condensates) mixing ratio of ice water 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 +[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 = out + 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 = out + 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 = out + optional = F +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + 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 diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 49b394fe1..8e5c099aa 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 ! ================= @@ -2468,13 +2468,13 @@ subroutine progcld5 & ! !===> ... begin here ! - do nf=1,nf_clds - do k=1,nlay - do i=1,ix - clouds(i,k,nf) = 0.0 - enddo - enddo - enddo + !do nf=1,nf_clds + ! do k=1,nlay + ! do i=1,ix + ! clouds(i,k,nf) = 0.0 + ! enddo + ! enddo + !enddo ! clouds(:,:,:) = 0.0 do k = 1, NLAY @@ -2514,7 +2514,8 @@ subroutine progcld5 & do k = 1, NLAY do i = 1, IX - clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) & + & + clw(i,k,ntrw) + clw(i,k,ntgl) enddo enddo !> - Find top pressure for each cloud domain for given latitude. @@ -2558,30 +2559,30 @@ subroutine progcld5 & !> - Calculate layer cloud fraction. clwmin = 0.0 - if (.not. lmfshal) then - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) + !if (.not. lmfshal) then + !do k = 1, NLAY + !do i = 1, IX + ! clwt = 1.0e-6 * (plyr(i,k)*0.001) ! clwt = 2.0e-6 * (plyr(i,k)*0.001) - if (clwf(i,k) > clwt) then + !if (clwf(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) + ! onemrh= max( 1.e-10, 1.0-rhly(i,k) ) + ! clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) - tem1 = 2000.0 / tem1 + ! tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) + ! tem1 = 2000.0 / tem1 ! tem1 = 1000.0 / tem1 - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) + ! value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) + ! tem2 = sqrt( sqrt(rhly(i,k)) ) - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - else + ! cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + !endif + !enddo + !enddo + !else do k = 1, NLAY do i = 1, IX clwt = 1.0e-6 * (plyr(i,k)*0.001) @@ -2592,11 +2593,11 @@ subroutine progcld5 & clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) ! tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan - if (lmfdeep2) then - tem1 = xrc3 / tem1 - else + !if (lmfdeep2) then + ! tem1 = xrc3 / tem1 + !else tem1 = 100.0 / tem1 - endif + !endif ! value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) tem2 = sqrt( sqrt(rhly(i,k)) ) @@ -2605,14 +2606,14 @@ subroutine progcld5 & endif enddo enddo - endif + !endif endif ! if (uni_cld) then do k = 1, NLAY do i = 1, IX if (cldtot(i,k) < climit) then - cldtot(i,k) = 0.0 + !cldtot(i,k) = 0.0 cwp(i,k) = 0.0 cip(i,k) = 0.0 crp(i,k) = 0.0 From 63303d37527213f1a786ec1832494074c2f74468 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 4 Feb 2020 18:33:43 +0000 Subject: [PATCH 21/90] Several changes in the comments. --- physics/GFS_rrtmg_pre.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 6b5382e65..950ea3d5d 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -733,6 +733,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif end do end do + ! Call Thompson's subroutine to compoute effective radii do i = 1, im 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,:), & @@ -975,8 +976,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo ! --- call progcld5 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) - ! tgs: a short subroutine could be made of progcld5 only to - ! compute total cloud fraction. + ! tgs: a short subroutine could be made of progcld5 to + ! compute only total cloud fraction. 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, & @@ -988,6 +989,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd%phy_f3d(:,:,Model%nseffr), & clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + !tgs - let's use the PBL cloud fraction do k=1,lmk do i=1,im !IF (tracer1(i,k,ntrw) > 1.0e-7 .OR. tracer1(i,k,ntsw) > 1.0e-7) then @@ -996,7 +998,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! clouds(i,k,1) = clouds(i,k,1) !ELSE ! MYNN sub-grid cloud fraction - !tgs - let's use only PBL cloud fraction cldcov(i,k) = clouds1(i,k) clouds(i,k,1) = clouds1(i,k) !ENDIF From 4ae3591c2ab5c3f8ad912028e0385ffda0655433 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 5 Feb 2020 22:06:40 +0000 Subject: [PATCH 22/90] 1.The unnecessary arays NI and NC are removed. 2. Bug fix for the case when GF scheme is used without MYNN. In this case always use Xu-Randall cloud fraction. --- physics/GFS_rrtmg_pre.F90 | 41 ++++++++++++++++++++++---------------- physics/GFS_rrtmg_pre.meta | 18 ----------------- 2 files changed, 24 insertions(+), 35 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 950ea3d5d..351862cf5 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -20,7 +20,7 @@ end subroutine GFS_rrtmg_pre_init ! in the CCPP version - they are defined in the interstitial_create routine subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & - Radtend, qc, qi, nc, ni, nwfa, & ! input/output + Radtend, qc, qi, nwfa, & ! input/output imfdeepcnv, imfdeepcnv_gf, & f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only lm, im, lmk, lmp, & ! input @@ -89,8 +89,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: qc real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: qi - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: nc - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: ni real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: nwfa @@ -989,20 +987,29 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd%phy_f3d(:,:,Model%nseffr), & clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - !tgs - let's use the PBL cloud fraction - do k=1,lmk - do i=1,im - !IF (tracer1(i,k,ntrw) > 1.0e-7 .OR. tracer1(i,k,ntsw) > 1.0e-7) then - ! ! Xu-Randall cloud fraction computed in progcld5 - ! cldcov(i,k) = clouds(i,k,1) - ! clouds(i,k,1) = clouds(i,k,1) - !ELSE - ! MYNN sub-grid cloud fraction - cldcov(i,k) = clouds1(i,k) - clouds(i,k,1) = clouds1(i,k) - !ENDIF - enddo - enddo + if(Model%do_mynnedmf) then + !tgs - let's use the PBL cloud fraction for now + do k=1,lmk + do i=1,im + !IF (tracer1(i,k,ntrw) > 1.0e-7 .OR. tracer1(i,k,ntsw) > 1.0e-7) then + ! ! Xu-Randall cloud fraction computed in progcld5 + ! cldcov(i,k) = clouds(i,k,1) + !ELSE + ! MYNN sub-grid cloud fraction + cldcov(i,k) = clouds1(i,k) + clouds(i,k,1) = clouds1(i,k) + !ENDIF + enddo + enddo + elseif (Model%imfdeepcnv == Model%imfdeepcnv_gf ) then ! GF conv + do k=1,lmk + do i=1,im + ! Xu-Randall cloud fraction computed in progcld5 + cldcov(i,k) = clouds(i,k,1) + enddo + enddo + endif + if( .not. clduni) then ! --- call progcld5 for interaction with the radiation with setting ! --- uni_cld=.true. to keep precomputed cloud diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 423a50ff0..9a46ae3d9 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -288,24 +288,6 @@ kind = kind_phys intent = inout 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 -[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 [nwfa] standard_name = water_friendly_aerosol_number_concentration long_name = number concentration of water-friendly aerosols From 15f36e7b1b8d72c18cc82660ca6657b5b0e3c63f Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 6 Feb 2020 15:44:53 +0000 Subject: [PATCH 23/90] Correct tendency flag names, implement some more diagnostic tendencies, implement model/ccpp/total tendencies. --- physics/GFS_DCNV_generic.F90 | 5 +- physics/GFS_DCNV_generic.meta | 7 ++ physics/GFS_GWD_generic.F90 | 12 +- physics/GFS_GWD_generic.meta | 4 +- physics/GFS_PBL_generic.F90 | 6 +- physics/GFS_PBL_generic.meta | 2 +- physics/GFS_SCNV_generic.F90 | 5 +- physics/GFS_SCNV_generic.meta | 7 ++ physics/cires_ugwp.F90 | 11 +- physics/cires_ugwp.meta | 7 ++ physics/cu_gf_driver.F90 | 39 +++++- physics/cu_gf_driver.meta | 92 +++++++++++++++ physics/model_tend_post.F90 | 105 +++++++++++++++++ physics/model_tend_post.meta | 216 ++++++++++++++++++++++++++++++++++ physics/model_tend_pre.F90 | 75 ++++++++++++ physics/model_tend_pre.meta | 215 +++++++++++++++++++++++++++++++++ physics/moninedmf.f | 12 +- physics/moninedmf.meta | 7 ++ physics/rayleigh_damp.f | 6 +- physics/satmedmfvdif.F | 19 ++- physics/satmedmfvdif.meta | 47 ++++++++ physics/total_tend.F90 | 75 ++++++++++++ physics/total_tend.meta | 191 ++++++++++++++++++++++++++++++ 23 files changed, 1135 insertions(+), 30 deletions(-) create mode 100644 physics/model_tend_post.F90 create mode 100644 physics/model_tend_post.meta create mode 100644 physics/model_tend_pre.F90 create mode 100644 physics/model_tend_pre.meta create mode 100644 physics/total_tend.F90 create mode 100644 physics/total_tend.meta diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index eb6e277d5..42d9987c3 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -99,7 +99,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs isppt_deep, 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, clw_ice, clw_liquid, npdf3d, num_p3d, ncnvcld3d, & rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & - cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, & + cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, & cape, tconvtend, qconvtend, uconvtend, vconvtend, errmsg, errflg) use machine, only: kind_phys @@ -108,6 +108,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs integer, intent(in) :: im, levs logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep, qdiag3d + 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 @@ -175,7 +176,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs 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 diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index c5c006e88..5d940c8a4 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -544,6 +544,13 @@ kind = kind_phys intent = inout optional = F +[flag_for_dcnv_generic_tend] + standard_name = true_if_GFS_DCNV_generic_should_calculate_tendencies + long_name = true if GFS_DCNV_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in [tconvtend] standard_name = tendency_of_air_temperature_due_to_deep_convection_for_coupling_on_physics_timestep long_name = tendency of air temperature due to deep convection diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index f05fa508f..963269329 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -20,7 +20,7 @@ subroutine GFS_GWD_generic_pre_run( & & oc, oa4, clx, theta, & & sigma, gamma, elvmax, lssav, ldiag3d, & & dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, & - & gwd_generic_tend, errmsg, errflg) + & flag_for_gwd_generic_tend, errmsg, errflg) use machine, only : kind_phys implicit none @@ -32,7 +32,7 @@ subroutine GFS_GWD_generic_pre_run( & & oc(im), oa4(im,4), clx(im,4), & & theta(im), sigma(im), gamma(im), elvmax(im) - logical, intent(in) :: lssav, ldiag3d, gwd_generic_tend + logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend real(kind=kind_phys), intent(in) :: dtdt(im,levs), dudt(im,levs), dvdt(im,levs) ! dt3dt only allocated only if ldiag3d is .true. real(kind=kind_phys), intent(inout) :: dt3dt(:,:), du3dt(:,:), dv3dt(:,:) @@ -92,7 +92,7 @@ subroutine GFS_GWD_generic_pre_run( & endif ! end if_nmtvr if (lssav) then - if (ldiag3d .and. gwd_generic_tend) 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 @@ -128,12 +128,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, gwd_generic_tend, 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, gwd_generic_tend + 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(:,:) @@ -153,7 +153,7 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d dugwd(:) = dugwd(:) + dusfcg(:)*dtf dvgwd(:) = dvgwd(:) + dvsfcg(:)*dtf - if (ldiag3d .and. gwd_generic_tend) 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 782adfa59..13a0d7b49 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -177,7 +177,7 @@ kind = kind_phys intent = in optional = F -[gwd_generic_tend] +[flag_for_gwd_generic_tend] standard_name = true_if_GFS_GWD_generic_should_calculate_tendencies long_name = true if GFS_GWD_generic should calculate tendencies units = flag @@ -326,7 +326,7 @@ kind = kind_phys intent = inout optional = F -[gwd_generic_tend] +[flag_for_gwd_generic_tend] standard_name = true_if_GFS_GWD_generic_should_calculate_tendencies long_name = true if GFS_GWD_generic should calculate tendencies units = flag diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index cd4a30849..f0ab372a4 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -281,7 +281,7 @@ 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, pbl_generic_tend, ldiag3d, qdiag3d, lsidea, hybedmf, do_shoc, satmedmf, shinhong, do_ysu, & + 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, & @@ -301,7 +301,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu - logical, intent(in) :: pbl_generic_tend + logical, intent(in) :: flag_for_pbl_generic_tend real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap @@ -553,7 +553,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! & dtf,' kdt=',kdt,' lat=',lat ! endif - if (ldiag3d .and. pbl_generic_tend) then + if (ldiag3d .and. flag_for_pbl_generic_tend) then if (lsidea) then dt3dt(1:im,:) = dt3dt(1:im,:) + dtdt(1:im,:)*dtf else diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 4256049dd..ab4eca5da 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -601,7 +601,7 @@ type = logical intent = in optional = F -[pbl_generic_tend] +[flag_for_pbl_generic_tend] standard_name = true_if_GFS_PBL_generic_should_calculate_tendencies long_name = true if GFS_PBL_generic should calculate tendencies units = flag diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 1cbff590e..3aecee8f3 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -71,6 +71,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, 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 @@ -78,7 +79,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl implicit none integer, intent(in) :: im, levs, nn - logical, intent(in) :: lssav, ldiag3d, qdiag3d, 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 @@ -132,7 +133,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl 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 diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 24dd7236d..52538d3e8 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -332,6 +332,13 @@ kind = kind_phys intent = inout optional = F +[flag_for_scnv_generic_tend] + standard_name = true_if_GFS_SCNV_generic_should_calculate_tendencies + 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/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 1daa10af5..91b9b35f3 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -151,7 +151,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr dudt, dvdt, dtdt, rdxzb, con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, & rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & - ldiag3d, lssav, errmsg, errflg) + ldiag3d, lssav, flag_for_gwd_generic_tend, errmsg, errflg) implicit none @@ -159,6 +159,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 @@ -176,8 +177,8 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr real(kind=kind_phys), intent(out), dimension(im, levs):: dudt_mtb, dudt_ogw, dudt_tms ! These arrays are only allocated if ldiag=.true. - real(kind=kind_phys), intent(inout), dimension(im, levs) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw - real(kind=kind_phys), intent(inout), dimension(im, levs) :: ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw + 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. @@ -272,7 +273,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr endif ! do_ugwp - if(ldiag3d .and. lssav) then + 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 @@ -379,7 +380,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr gw_dudt = gw_dudt*(1.-pked) + ed_dudt*pked #endif - if(ldiag3d .and. lssav) then + 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 diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 32c64145f..6720bd7c7 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -911,6 +911,13 @@ dimensions = () type = logical intent = in +[flag_for_gwd_generic_tend] + standard_name = true_if_GFS_GWD_generic_should_calculate_tendencies + 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/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 53e26fb46..3f5e6ef78 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -75,7 +75,10 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & 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,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -97,6 +100,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte integer, intent(in ) :: im,ix,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( ix , km ), intent(in ) :: forcet,forceqv_spechum,w,phil real(kind=kind_phys), dimension( ix , km ), intent(inout ) :: t,us,vs @@ -106,6 +111,10 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & real(kind=kind_phys), dimension( ix , km ), intent(out ) :: cnvw_moist,cnvc real(kind=kind_phys), dimension( ix , 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 + ! change from ix to im integer, dimension (im), intent(inout) :: hbot,htop,kcnv integer, dimension (im), intent(in) :: xland @@ -879,6 +888,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(.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(.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 d3687a352..c75d944ee 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -417,6 +417,98 @@ type = integer intent = in optional = F +[flag_for_scnv_generic_tend] + standard_name = true_if_GFS_SCNV_generic_should_calculate_tendencies + long_name = true if GFS_SCNV_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in +[flag_for_dcnv_generic_tend] + standard_name = true_if_GFS_DCNV_generic_should_calculate_tendencies + 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_shal_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_SCNV] + standard_name = cumulative_change_in_y_wind_due_to_shal_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_SCNV] + standard_name = cumulative_change_in_temperature_due_to_shal_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_shal_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 = inout +[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 = logical + intent = in +[qdiag3d] + standard_name = flag_tracer_diagnostics_3D + long_name = flag for 3d tracer diagnostic fields + units = flag + dimensions = () + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/model_tend_post.F90 b/physics/model_tend_post.F90 new file mode 100644 index 000000000..8ae7b6844 --- /dev/null +++ b/physics/model_tend_post.F90 @@ -0,0 +1,105 @@ +!>\file model_tend_post.F90 +!! Calculates tendencies from all processes outside of CPPP + +module model_tend_post + +contains + + subroutine model_tend_post_init() + end subroutine model_tend_post_init + + subroutine model_tend_post_finalize() + end subroutine model_tend_post_finalize + + !> \section arg_table_model_tend_post_run Argument Table + !! \htmlinclude model_tend_post_run.html + !! + subroutine model_tend_post_run(kdt, & + gt0,gu0,gv0, gq0_water_vapor, & + t_start,u_start,v_start,q_start, & + t_end, u_end, v_end, q_end, & + dt3dt_ccpp, du3dt_ccpp, dv3dt_ccpp, dq3dt_ccpp, & +! dt3dt_total, du3dt_total, dv3dt_total, dq3dt_total, & + im, levs, ntrac, index_for_water_vapor, & + lssav, ldiag3d, qdiag3d, errmsg,errflg) + use machine, only: kind_phys + implicit none + + real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, gu0, gv0, gq0_water_vapor + real(kind=kind_phys), dimension(:,:), intent(in) :: t_start, u_start, v_start + real(kind=kind_phys), dimension(:,:), intent(in) :: q_start + real(kind=kind_phys), dimension(:,:), intent(inout) :: t_end, u_end, v_end + real(kind=kind_phys), dimension(:,:), intent(inout) :: q_end + real(kind=kind_phys), dimension(:,:), intent(inout) :: du3dt_ccpp, dv3dt_ccpp + real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt_ccpp, dq3dt_ccpp + ! real(kind=kind_phys), dimension(:,:), intent(inout) :: du3dt_total, dv3dt_total + ! real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt_total, dq3dt_total + + integer, intent(in) :: im, levs, ntrac, kdt + integer, intent(in) :: index_for_water_vapor + + logical, intent(in) :: lssav, qdiag3d, ldiag3d + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + real(kind=kind_phys) :: dt + integer :: i,k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + diag_enabled: if(lssav .and. ldiag3d) then + if(any(gt0(1:im,1:levs)<1e-3)) then + print *,'error: temperatures less than 1e-3' + endif + if(all(abs(gu0(1:im,1:levs))<1e-3)) then + print *,'error: all u wind is near zero' + endif + if(all(abs(gv0(1:im,1:levs))<1e-3)) then + print *,'error: all v wind is near zero' + endif + + if(any(t_start(1:im,1:levs)<1e-3)) then + print *,'error: start temperatures less than 1e-3' + endif + if(all(abs(u_start(1:im,1:levs))<1e-3)) then + print *,'error: all start u wind is near zero' + endif + if(all(abs(v_start(1:im,1:levs))<1e-3)) then + print *,'error: all start v wind is near zero' + endif + + do k=1,levs + do i=1,im + ! if(t_end(i,k)>1e-3 .and. gt0(i,k)>1e-3) then + ! dt3dt_total(i,k) = dt3dt_total(i,k) + gt0(i,k)-t_end(i,k) + ! du3dt_total(i,k) = du3dt_total(i,k) + gu0(i,k)-u_end(i,k) + ! dv3dt_total(i,k) = dv3dt_total(i,k) + gv0(i,k)-v_end(i,k) + ! if(qdiag3d) then + ! dq3dt_total(i,k) = dq3dt_total(i,k) + gq0_water_vapor(i,k)-q_end(i,k) + ! endif + ! endif + t_end(i,k) = gt0(i,k) + u_end(i,k) = gu0(i,k) + v_end(i,k) = gv0(i,k) + if(qdiag3d) then + q_end(i,k) = gq0_water_vapor(i,k) + endif + if(t_end(i,k)>1e-3 .and. t_start(i,k)>1e-3) then + dt3dt_ccpp(i,k) = dt3dt_ccpp(i,k) + t_end(i,k)-t_start(i,k) + du3dt_ccpp(i,k) = du3dt_ccpp(i,k) + u_end(i,k)-u_start(i,k) + dv3dt_ccpp(i,k) = dv3dt_ccpp(i,k) + v_end(i,k)-v_start(i,k) + if(qdiag3d) then + dq3dt_ccpp(i,k) = dq3dt_ccpp(i,k) + q_end(i,k)-q_start(i,k) + endif + endif + enddo + enddo + + endif diag_enabled + + end subroutine model_tend_post_run + +end module model_tend_post diff --git a/physics/model_tend_post.meta b/physics/model_tend_post.meta new file mode 100644 index 000000000..a97fa4dad --- /dev/null +++ b/physics/model_tend_post.meta @@ -0,0 +1,216 @@ +[ccpp-arg-table] + name = model_tend_post_init + type = scheme +[ccpp-arg-table] + name = model_tend_post_finalize + type = scheme +[ccpp-arg-table] + name = model_tend_post_run + type = scheme +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + 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 +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[gq0_water_vapor] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[t_start] + standard_name = temperature_at_start_of_ccpp + long_name = temperature at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[u_start] + standard_name = x_wind_at_start_of_ccpp + long_name = x wind at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[v_start] + standard_name = y_wind_at_start_of_ccpp + long_name = y wind at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[q_start] + standard_name = water_vapor_specific_humidity_at_start_of_ccpp + long_name = water vapor specific humidity at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[t_end] + standard_name = temperature_at_end_of_ccpp + long_name = temperature at end of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[u_end] + standard_name = x_wind_at_end_of_ccpp + long_name = x wind at end of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[v_end] + standard_name = y_wind_at_end_of_ccpp + long_name = y wind at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[q_end] + standard_name = water_vapor_specific_humidity_at_end_of_ccpp + long_name = water vapor specific humidity at end of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dt3dt_ccpp] + standard_name = cumulative_change_in_temperature_from_ccpp + long_name = cumulative change in temperature from CCPP + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[du3dt_ccpp] + standard_name = cumulative_change_in_x_wind_from_ccpp + long_name = cumulative change in x wind from CCPP + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_ccpp] + standard_name = cumulative_change_in_y_wind_from_ccpp + long_name = cumulative change in y wind from CCPP + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_ccpp] + standard_name = cumulative_change_in_water_vapor_specific_humidity_from_CCPP + long_name = cumulative change in water vapor specific humidity from CCPP + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in +[index_for_water_vapor] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in +[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 +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + + + + + + + diff --git a/physics/model_tend_pre.F90 b/physics/model_tend_pre.F90 new file mode 100644 index 000000000..94ad2ee1a --- /dev/null +++ b/physics/model_tend_pre.F90 @@ -0,0 +1,75 @@ +!>\file model_tend_pre.F90 +!! Calculates tendencies from all processes outside of CPPP + +module model_tend_pre + +contains + +!> \section arg_table_model_tend_pre_init Argument Table +!! +subroutine model_tend_pre_init() +end subroutine model_tend_pre_init + +!> \section arg_table_model_tend_pre_finalize Argument Table +!! +subroutine model_tend_pre_finalize() +end subroutine model_tend_pre_finalize + +!> \section arg_table_model_tend_pre_run Argument Table +!! \htmlinclude model_tend_pre_run.html +!! +subroutine model_tend_pre_run(dtp, kdt, & + tgrs,ugrs,vgrs,qvgrs, t_start,u_start,v_start,q_start, & + dt3dt_model,du3dt_model,dv3dt_model,dq3dt_model, & + t_end,u_end,v_end,q_end, & + im, levs, ntrac, & + lssav, ldiag3d, qdiag3d, errmsg,errflg) + use machine, only: kind_phys + implicit none + + real(kind=kind_phys), dimension(:,:), intent(in) :: tgrs, ugrs, vgrs, qvgrs + real(kind=kind_phys), dimension(:,:), intent(out) :: t_start, u_start, v_start + real(kind=kind_phys), dimension(:,:), intent(out) :: q_start + real(kind=kind_phys), dimension(:,:), intent(out) :: t_end, u_end, v_end + real(kind=kind_phys), dimension(:,:), intent(out) :: q_end + real(kind=kind_phys), dimension(:,:), intent(inout) :: & + dt3dt_model,du3dt_model,dv3dt_model,dq3dt_model + + integer, intent(in) :: im, levs, ntrac, kdt + + logical, intent(in) :: lssav, qdiag3d, ldiag3d + + real(kind=kind_phys) :: dtp + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if(Lssav .and. ldiag3d) then + do k=1,levs + do i=1,im + t_start(i,k) = tgrs(i,k) + u_start(i,k) = ugrs(i,k) + v_start(i,k) = vgrs(i,k) + if(qdiag3d) then + q_start(i,k) = qvgrs(i,k) + endif + if(t_start(i,k)>1e-3 .and. t_end(i,k)>1e-3) then + dt3dt_model(i,k) = dt3dt_model(i,k) + (t_start(i,k)-t_end(i,k)) + du3dt_model(i,k) = du3dt_model(i,k) + (u_start(i,k)-u_end(i,k)) + dv3dt_model(i,k) = dv3dt_model(i,k) + (v_start(i,k)-v_end(i,k)) + if(qdiag3d) then + dq3dt_model(i,k) = dq3dt_model(i,k) + (q_start(i,k)-q_end(i,k)) + endif + endif + enddo + enddo + endif +end subroutine model_tend_pre_run + +end module model_tend_pre diff --git a/physics/model_tend_pre.meta b/physics/model_tend_pre.meta new file mode 100644 index 000000000..0cbb9b4e9 --- /dev/null +++ b/physics/model_tend_pre.meta @@ -0,0 +1,215 @@ +[ccpp-arg-table] + name = model_tend_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = model_tend_pre_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = model_tend_pre_run + type = scheme +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + 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 +[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 +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[qvgrs] + 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 +[t_start] + standard_name = temperature_at_start_of_ccpp + long_name = temperature at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out +[u_start] + standard_name = x_wind_at_start_of_ccpp + long_name = x wind at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out +[v_start] + standard_name = y_wind_at_start_of_ccpp + long_name = y wind at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out +[q_start] + standard_name = water_vapor_specific_humidity_at_start_of_ccpp + long_name = water vapor specific humidity at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out +[dt3dt_model] + standard_name = cumulative_change_in_temperature_from_model + long_name = cumulative change in temperature from model + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[du3dt_model] + standard_name = cumulative_change_in_x_wind_from_model + long_name = cumulative change in x wind from model + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_model] + standard_name = cumulative_change_in_y_wind_from_model + long_name = cumulative change in y wind from model + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_model] + standard_name = cumulative_change_in_water_vapor_specific_humidity_from_model + long_name = cumulative change in water vapor specific humidity from model + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[t_end] + standard_name = temperature_at_end_of_ccpp + long_name = temperature at end of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[u_end] + standard_name = x_wind_at_end_of_ccpp + long_name = x wind at end of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[v_end] + standard_name = y_wind_at_end_of_ccpp + long_name = y wind at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[q_end] + standard_name = water_vapor_specific_humidity_at_end_of_ccpp + long_name = water vapor specific humidity at end of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in +[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 +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out diff --git a/physics/moninedmf.f b/physics/moninedmf.f index f6558a861..d3fd9e45e 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -66,7 +66,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & & xkzminv,moninq_fac,lssav,ldiag3d,qdiag3d,lsidea,ntoz, & & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL,do3dt_PBL, & - & errmsg,errflg) + & flag_for_pbl_generic_tend, errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -77,6 +77,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! arguments ! 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), ntoz integer, intent(out) :: kpbl(im) @@ -1041,7 +1042,8 @@ 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) then + 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 @@ -1064,7 +1066,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo enddo - if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d) then + if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & + & flag_for_pbl_generic_tend) then is = (ntoz-1) * km do k = 1, km do i = 1, im @@ -1174,7 +1177,8 @@ 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) then + 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 diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index b5a6947c3..6a923d36b 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -575,6 +575,13 @@ type = real kind = kind_phys intent = inout +[flag_for_pbl_generic_tend] + standard_name = true_if_GFS_PBL_generic_should_calculate_tendencies + 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/rayleigh_damp.f b/physics/rayleigh_damp.f index 814704385..8ef5aa947 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -74,9 +74,9 @@ subroutine rayleigh_damp_run ( & 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(inout) :: du3dt(IX,KM) - real(kind=kind_phys),intent(inout) :: dv3dt(IX,KM) - real(kind=kind_phys),intent(inout) :: dt3dt(IX,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 diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 5900349e9..64d2c4517 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -60,7 +60,9 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & 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 @@ -71,6 +73,10 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & integer, intent(in) :: ix, 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 @@ -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,8 +1503,13 @@ 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 + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> -# Save PBL height for diagnostic purpose diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 63480e01b..28cb942c0 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -551,6 +551,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/total_tend.F90 b/physics/total_tend.F90 new file mode 100644 index 000000000..c7c5dfe28 --- /dev/null +++ b/physics/total_tend.F90 @@ -0,0 +1,75 @@ +!>\file total_tend.F90 +!! Calculates tendencies from all processes outside of CPPP + +module total_tend + +contains + +!> \section arg_table_total_tend_init Argument Table +!! +subroutine total_tend_init() +end subroutine total_tend_init + +!> \section arg_table_total_tend_finalize Argument Table +!! +subroutine total_tend_finalize() +end subroutine total_tend_finalize + +!> \section arg_table_total_tend_run Argument Table +!! \htmlinclude total_tend_run.html +!! +subroutine total_tend_run(dtp, kdt, & + tgrs,ugrs,vgrs,qvgrs, t_start,u_start,v_start,q_start, & + dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total, & + im, levs, ntrac, & + lssav, ldiag3d, qdiag3d, errmsg,errflg) + use machine, only: kind_phys + implicit none + + real(kind=kind_phys), dimension(:,:), intent(in) :: tgrs, ugrs, vgrs, qvgrs + real(kind=kind_phys), dimension(:,:), intent(out) :: t_start, u_start, v_start + real(kind=kind_phys), dimension(:,:), intent(out) :: q_start + real(kind=kind_phys), dimension(:,:), intent(inout) :: & + dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total + + integer, intent(in) :: im, levs, ntrac, kdt + + logical, intent(in) :: lssav, qdiag3d, ldiag3d + + real(kind=kind_phys) :: dtp + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: i, k, good + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + good=0 + + if(Lssav .and. ldiag3d) then + print *,'total_tend_run' + do k=1,levs + do i=1,im + if(t_start(i,k)>1e-3 .and. tgrs(i,k)>1e-3) then + good=good+1 + dt3dt_total(i,k) = dt3dt_total(i,k) + tgrs(i,k)-t_start(i,k) + du3dt_total(i,k) = du3dt_total(i,k) + ugrs(i,k)-u_start(i,k) + dv3dt_total(i,k) = dv3dt_total(i,k) + vgrs(i,k)-v_start(i,k) + if(qdiag3d) then + dq3dt_total(i,k) = dq3dt_total(i,k) + qvgrs(i,k)-q_start(i,k) + endif + endif + t_start(i,k)=tgrs(i,k) + u_start(i,k)=ugrs(i,k) + v_start(i,k)=vgrs(i,k) + q_start(i,k)=qvgrs(i,k) + enddo + enddo + print *,'total tend valid points: ',good + endif +end subroutine total_tend_run + +end module total_tend diff --git a/physics/total_tend.meta b/physics/total_tend.meta new file mode 100644 index 000000000..a64fd872b --- /dev/null +++ b/physics/total_tend.meta @@ -0,0 +1,191 @@ +[ccpp-arg-table] + name = total_tend_pre_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = total_tend_pre_finalize + type = scheme + +######################################################################## +[ccpp-arg-table] + name = total_tend_pre_run + type = scheme +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + 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 +[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 +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[qvgrs] + 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 +[t_start] + standard_name = temperature_at_start_of_ccpp + long_name = temperature at start of ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out +[t_start] + standard_name = temperature_at_total_check_point + long_name = temperature when model total is calculated in ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[u_start] + standard_name = x_wind_at_total_check_point + long_name = x when model total is calculated in ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[v_start] + standard_name = y_wind_at_total_check_point + long_name = y when model total is calculated in ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[q_start] + standard_name = water_vapor_specific_humidity_at_total_check_point + long_name = water vapor specific humidity when model total is calculated in ccpp + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dt3dt_total] + standard_name = cumulative_change_in_temperature + long_name = cumulative change in temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[du3dt_total] + standard_name = cumulative_change_in_x_wind + long_name = cumulative change in x wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_total] + standard_name = cumulative_change_in_y_wind + long_name = cumulative change in y wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_total] + standard_name = cumulative_change_in_water_vapor_specific_humidity + long_name = cumulative change in water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in +[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 +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out From a76c0662d07033bda017f07216f828df2d76ab04 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 12 Feb 2020 13:07:07 -0700 Subject: [PATCH 24/90] Workaround/bugfix for correct initialization of Thompson aerosol surface emissions and 2nd moments (number concentrations) --- physics/module_mp_thompson.F90 | 23 +- physics/mp_thompson.F90 | 484 ++++++++----- physics/mp_thompson.meta | 308 +++----- .../mp_thompson.meta.backup.before.workaround | 676 ++++++++++++++++++ physics/mp_thompson_post.F90 | 27 +- physics/mp_thompson_post.meta | 9 + 6 files changed, 1108 insertions(+), 419 deletions(-) create mode 100644 physics/mp_thompson.meta.backup.before.workaround diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 5e118c070..e228bf8ed 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -410,23 +410,22 @@ 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 +#if 0 + REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: nwfa, nifa + REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d +#else +! DH* 20200208 - change dimensions for nasty init hack + REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: nwfa, nifa + REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d +#endif INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot INTEGER, INTENT(IN) :: threads CHARACTER(len=*), INTENT(INOUT) :: errmsg diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 4ecbc47df..8c341d05b 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -23,10 +23,17 @@ module mp_thompson contains +! DH* Note. The following is a nasty modification of the mp_thompson_init +! routine to account for the fact that the initialization of the physics +! must run over all blocks concurrently. In order to pass in the arguments +! as individual Fortran arrays as before, we need to remove the dynamic +! build first and add logic to detect that an array ... + !> This subroutine is a wrapper around the actual thompson_init(). !! \section arg_table_mp_thompson_init Argument Table !! \htmlinclude mp_thompson_init.html !! +#if 0 subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & imp_physics, imp_physics_thompson, & spechum, qc, qr, qi, qs, qg, ni, nr, & @@ -81,10 +88,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & 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) @@ -102,6 +105,91 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 integer :: i, k +#else + subroutine mp_thompson_init(Data, ntqv, ntcw, ntrw, ntiw, ntsw, ntgl, & + ntinc, ntrnc, ntlnc, ntwa, ntia, nleffr, & + nieffr, nseffr, con_g, con_rd, & + restart, imp_physics, imp_physics_thompson, & + is_aerosol_aware, mpicomm, mpirank, mpiroot,& + threads, errmsg, errflg) + + use GFS_typedefs, only : GFS_data_type + + implicit none + + ! Interface variables + type(GFS_data_type), intent(inout) :: Data(:) + integer, intent(in ) :: ntqv + integer, intent(in ) :: ntcw + integer, intent(in ) :: ntrw + integer, intent(in ) :: ntiw + integer, intent(in ) :: ntsw + integer, intent(in ) :: ntgl + integer, intent(in ) :: ntinc + integer, intent(in ) :: ntrnc + integer, intent(in ) :: ntlnc + integer, intent(in ) :: ntwa + integer, intent(in ) :: ntia + integer, intent(in ) :: nleffr + integer, intent(in ) :: nieffr + integer, intent(in ) :: nseffr + real(kind_phys), intent(in ) :: con_g, con_rd + logical, intent(in ) :: restart + integer, intent(in ) :: imp_physics + integer, intent(in ) :: imp_physics_thompson + ! Aerosols + logical, intent(in ) :: is_aerosol_aware + ! 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/pointers + + ! Hydrometeors + real(kind_phys), dimension(:,:), allocatable :: qv_mp !< kg kg-1 (dry mixing ratio) + real(kind_phys), dimension(:,:), allocatable :: qc_mp !< kg kg-1 (dry mixing ratio) + real(kind_phys), dimension(:,:), allocatable :: qr_mp !< kg kg-1 (dry mixing ratio) + real(kind_phys), dimension(:,:), allocatable :: qi_mp !< kg kg-1 (dry mixing ratio) + real(kind_phys), dimension(:,:), allocatable :: qs_mp !< kg kg-1 (dry mixing ratio) + real(kind_phys), dimension(:,:), allocatable :: qg_mp !< kg kg-1 (dry mixing ratio) + real(kind_phys), dimension(:,:), allocatable :: ni_mp !< kg-1 + real(kind_phys), dimension(:,:), allocatable :: nr_mp !< kg-1 + real(kind_phys), dimension(:,:), allocatable :: nc_mp !< kg-1 + ! + real(kind_phys), dimension(:,:), allocatable :: hgt ! m + real(kind_phys), dimension(:,:), allocatable :: rho ! kg m-3 + real(kind_phys), dimension(:,:), allocatable :: orho ! m3 kg-1 + real(kind_phys), pointer :: spechum (:,:) + real(kind_phys), pointer :: qc (:,:) + real(kind_phys), pointer :: qr (:,:) + real(kind_phys), pointer :: qi (:,:) + real(kind_phys), pointer :: qs (:,:) + real(kind_phys), pointer :: qg (:,:) + real(kind_phys), pointer :: ni (:,:) + real(kind_phys), pointer :: nr (:,:) + real(kind_phys), pointer :: nc (:,:) + real(kind_phys), pointer :: nwfa (:,:) + real(kind_phys), pointer :: nifa (:,:) + real(kind_phys), pointer :: nwfa2d (:) + real(kind_phys), pointer :: nifa2d (:) + real(kind_phys), pointer :: tgrs (:,:) + real(kind_phys), pointer :: prsl (:,:) + real(kind_phys), pointer :: phil (:,:) + real(kind_phys), pointer :: area (:) + real(kind_phys), pointer :: re_cloud (:,:) + real(kind_phys), pointer :: re_ice (:,:) + real(kind_phys), pointer :: re_snow (:,:) + + ! + real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 + integer :: i, k, blkno, nblocks, ncol, nlev +#endif ! Initialize the CCPP error handling variables errmsg = '' @@ -124,153 +212,158 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & return end if - 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_init:', & - ' aerosol-aware microphysics require all of the following', & - ' optional arguments: nc, nwfa2d, nifa2d, nwfa, nifa' - 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, & - 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 - 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 - 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. + nblocks = size(Data) + block_loop: do blkno=1,nblocks + + ! associate_arrays: associate( & + spechum => Data(blkno)%Statein%qgrs(:,:,ntqv) !,& + qc => Data(blkno)%Statein%qgrs(:,:,ntcw) !,& + qr => Data(blkno)%Statein%qgrs(:,:,ntrw) !,& + qi => Data(blkno)%Statein%qgrs(:,:,ntiw) !,& + qs => Data(blkno)%Statein%qgrs(:,:,ntsw) !,& + qg => Data(blkno)%Statein%qgrs(:,:,ntgl) !,& + ni => Data(blkno)%Statein%qgrs(:,:,ntinc)!,& + nr => Data(blkno)%Statein%qgrs(:,:,ntrnc)!,& + nc => Data(blkno)%Statein%qgrs(:,:,ntlnc)!,& + nwfa => Data(blkno)%Statein%qgrs(:,:,ntwa) !,& + nifa => Data(blkno)%Statein%qgrs(:,:,ntia) !,& + nwfa2d => Data(blkno)%Coupling%nwfa2d !,& + nifa2d => Data(blkno)%Coupling%nifa2d !,& + tgrs => Data(blkno)%Statein%tgrs !,& + prsl => Data(blkno)%Statein%prsl !,& + phil => Data(blkno)%Statein%phil !,& + area => Data(blkno)%Grid%area !,& + re_cloud => Data(blkno)%Tbd%phy_f3d(:,:,nleffr)!,& + re_ice => Data(blkno)%Tbd%phy_f3d(:,:,nieffr)!,& + re_snow => Data(blkno)%Tbd%phy_f3d(:,:,nseffr)! ) + + ncol = size(spechum(:,1)) + nlev = size(spechum(1,:)) + allocate(qv_mp(ncol,nlev)) + allocate(qc_mp(ncol,nlev)) + allocate(qr_mp(ncol,nlev)) + allocate(qi_mp(ncol,nlev)) + allocate(qs_mp(ncol,nlev)) + allocate(qg_mp(ncol,nlev)) + allocate(ni_mp(ncol,nlev)) + allocate(nr_mp(ncol,nlev)) + allocate(nc_mp(ncol,nlev)) + allocate(hgt (ncol,nlev)) + allocate(rho (ncol,nlev)) + allocate(orho (ncol,nlev)) + + only_for_first_block: if (blkno==1) then + + ! 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 + + end if only_for_first_block + + ! 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 - !> - 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) + ! 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 - !> - 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 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 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 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 - ! 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 - !..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 .and. blkno==1) write(*,*) ' Apparently there are no initial CCN aerosols.' - do i = 1, ncol + ! 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 + h_01 = 0.8 elseif (hgt(i,1).ge.2500.0) then - h_01 = 0.01 + h_01 = 0.01 else - h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) + 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) + 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 + 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 !+---+-----------------------------------------------------------------+ @@ -312,15 +405,15 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & 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 + 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 @@ -334,54 +427,53 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & 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 + 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 + else if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial IN aerosol surface emission rates are present.' - endif - endif + 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 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 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 - else + else - ! 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 + ! 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 + end if - ! Calculate initial cloud effective radii if requested - if (present(re_cloud) .and. present(re_ice) .and. present(re_snow)) then + ! Calculate initial cloud effective radii if requested do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = 2.49E-6 - re_ice(i,k) = 4.99E-6 - re_snow(i,k) = 9.99E-6 - end do + do k = 1, nlev + re_cloud(i,k) = 2.49E-6 + re_ice(i,k) = 4.99E-6 + re_snow(i,k) = 9.99E-6 + end do end do 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,:), kts, kte) + 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 do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) - re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) - re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) - end do + do k = 1, nlev + re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) + re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) + re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) + end do end do ! Convert to micron: required for bit-for-bit identical restarts; ! otherwise entering mp_thompson_init and converting mu to m and @@ -389,22 +481,30 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & re_cloud = 1.0E6*re_cloud re_ice = 1.0E6*re_ice re_snow = 1.0E6*re_snow - else if (.not.present(re_cloud) .and. .not.present(re_ice) .and. .not.present(re_snow)) then - ! Do nothing - else - write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_run:', & - ' 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 + !> - 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 + + deallocate(qv_mp) + deallocate(qc_mp) + deallocate(qr_mp) + deallocate(qi_mp) + deallocate(qs_mp) + deallocate(qg_mp) + deallocate(ni_mp) + deallocate(nr_mp) + deallocate(nc_mp) + deallocate(hgt ) + deallocate(rho ) + deallocate(orho ) + + !end associate associate_arrays + + end do block_loop is_initialized = .true. @@ -552,7 +652,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 0419a6c15..7113cf670 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -1,18 +1,122 @@ [ccpp-arg-table] name = mp_thompson_init type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = instance of derived type GFS_data_type + units = DDT + dimensions = (ccpp_block_number) + type = GFS_data_type + intent = inout + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index dimensions = () type = integer intent = in optional = F -[nlev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[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 +[ntrnc] + standard_name = index_for_rain_number_concentration + long_name = tracer index for rain number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[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 +[ntwa] + standard_name = index_for_water_friendly_aerosols + long_name = tracer index for water friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntia] + standard_name = index_for_ice_friendly_aerosols + long_name = tracer index for ice friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[nleffr] + standard_name = index_for_cloud_liquid_water_effective_radius + long_name = the index of cloud liquid water effective radius in phy_f3d + units = + dimensions = () + type = integer + intent = in + optional = F +[nieffr] + standard_name = index_for_ice_effective_radius + long_name = the index of ice effective radius in phy_f3d + units = + dimensions = () + type = integer + intent = in + optional = F +[nseffr] + standard_name = index_for_snow_effective_radius + long_name = the index of snow effective radius in phy_f3d + units = dimensions = () type = integer intent = in @@ -59,78 +163,6 @@ 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 @@ -139,114 +171,6 @@ 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 - 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 -[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 = inout - optional = T -[nifa] - standard_name = ice_friendly_aerosol_number_concentration - 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 -[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 = um - 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 = um - 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 = um - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T [mpicomm] standard_name = mpi_comm long_name = MPI communicator @@ -279,14 +203,6 @@ 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/mp_thompson.meta.backup.before.workaround b/physics/mp_thompson.meta.backup.before.workaround new file mode 100644 index 000000000..0419a6c15 --- /dev/null +++ b/physics/mp_thompson.meta.backup.before.workaround @@ -0,0 +1,676 @@ +[ccpp-arg-table] + name = mp_thompson_init + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + 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 +[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 + units = flag + dimensions = () + 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 + 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 +[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 = inout + optional = T +[nifa] + standard_name = ice_friendly_aerosol_number_concentration + 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 +[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 = um + 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 = um + 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 = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + 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 +[threads] + standard_name = omp_threads + long_name = number of OpenMP threads available to scheme + units = count + 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 + 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 = mp_thompson_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + 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 = in + 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 = in + optional = T +[tgrs] + standard_name = air_temperature_updated_by_physics + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + 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 +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[omega] + standard_name = omega + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[prcp] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rain] + standard_name = lwe_thickness_of_explicit_rain_amount + long_name = explicit rain fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[graupel] + standard_name = lwe_thickness_of_graupel_amount + long_name = graupel fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ice] + standard_name = lwe_thickness_of_ice_amount + long_name = ice fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snow] + standard_name = lwe_thickness_of_snow_amount + long_name = snow fall on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = ratio of snowfall to large-scale rainfall + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[do_radar_ref] + standard_name = flag_for_radar_reflectivity + long_name = flag for radar reflectivity + units = flag + dimensions = () + type = logical + 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 (meter here) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + 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) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + 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) + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = T +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + 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 +[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 = mp_thompson_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 diff --git a/physics/mp_thompson_post.F90 b/physics/mp_thompson_post.F90 index 2452fa337..dd4a2b3f5 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -12,8 +12,6 @@ module mp_thompson_post logical :: apply_limiter - real(kind_phys), dimension(:), allocatable :: mp_tend_lim - contains !! \section arg_table_mp_thompson_post_init Argument Table @@ -43,18 +41,10 @@ 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 @@ -62,7 +52,7 @@ end subroutine mp_thompson_post_init !! \section arg_table_mp_thompson_post_run Argument Table !! \htmlinclude mp_thompson_post_run.html !! - 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 @@ -74,6 +64,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 @@ -102,13 +93,13 @@ 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 events = 0 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 @@ -122,7 +113,7 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, & end do 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 @@ -142,12 +133,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..7a26db6f5 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -92,6 +92,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 From d2f38dd0de89ab20686c3fda84cc98355403ae2a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 13 Feb 2020 11:18:49 -0700 Subject: [PATCH 25/90] Reorganize interstitial code around convection, bugfixes for Hannah's code --- physics/GFS_DCNV_generic.F90 | 14 ++------ physics/GFS_DCNV_generic.meta | 25 ------------- physics/GFS_suite_interstitial.F90 | 55 ++++++++++++++++------------- physics/GFS_suite_interstitial.meta | 22 ++++++++++-- 4 files changed, 53 insertions(+), 63 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 02230904c..0c7573c63 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -18,9 +18,8 @@ end subroutine GFS_DCNV_generic_pre_finalize !! #endif subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, & - isppt_deep, imp_physics, imp_physics_thompson, & - gu0, gv0, gt0, gq0_water_vapor, & - save_u, save_v, save_t, save_tcp, save_qv, & + isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & + save_u, save_v, save_t, save_qv, & ca_deep, errmsg, errflg) use machine, only: kind_phys @@ -36,7 +35,6 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_u real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_v real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t - real(kind=kind_phys), dimension(im,levs), intent(out), optional :: save_tcp real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv real(kind=kind_phys), dimension(im), intent(in) :: ca_deep character(len=*), intent(out) :: errmsg @@ -72,14 +70,6 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, enddo endif - if (imp_physics == imp_physics_thompson) then - do k=1,levs - do i=1,im - save_tcp(i,k) = gt0(i,k) - enddo - enddo - endif - if (ldiag3d .or. isppt_deep) then do k=1,levs do i=1,im diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 65c44e53b..eae53a910 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -49,22 +49,6 @@ 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 [gu0] standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics @@ -128,15 +112,6 @@ 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 = out - optional = T [save_qv] standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 79b14c18e..1e3035cbf 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -463,13 +463,13 @@ end subroutine GFS_suite_interstitial_3_finalize 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, & - xlat, gq0, imp_physics, imp_physics_mg, & + 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,clw, rhc, save_qc, save_qi, & - errmsg, errflg) + save_tcp, errmsg, errflg) use machine, only: kind_phys @@ -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) :: 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 @@ -615,8 +617,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 @@ -625,6 +628,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & else save_qi(:,:) = clw(:,:,1) endif + elseif (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_mg .or. imp_physics == imp_physics_fer_hires) then do k=1,levs do i=1,im @@ -686,7 +690,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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(im,levs), intent(in), optional :: nwfa, save_tcp + 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 @@ -699,7 +703,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! local variables integer :: i,k,n,tracers - real(kind=kind_phys), dimension(im,levs) :: rho_dryar + 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) @@ -746,28 +750,31 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to enddo enddo - if (imp_physics == imp_physics_thompson) then + 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_dryar(i,k) = prsl(i,k)/(con_rd*save_tcp(i,k)) - - !> - Convert specific humidity/moist mixing ratios to dry mixing ratios + 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)) - qc_mp(i,k) = save_qc(i,k)/(1.0_kind_phys-spechum(i,k)) - qi_mp(i,k) = save_qi(i,k)/(1.0_kind_phys-spechum(i,k)) - - !> - Convert number concentrations from moist to dry - nc_mp(i,k) = gq0(i,k,ntlnc)/(1.0_kind_phys-spechum(i,k)) - ni_mp(i,k) = gq0(i,k,ntinc)/(1.0_kind_phys-spechum(i,k)) - - - nc_mp(i,k) = nc_mp(i,k) + max(0.0, make_DropletNumber(qc_mp(i,k) * rho_dryar(i,k), nwfa(i,k)) * (1.0/rho_dryar(i,k))) - ni_mp(i,k) = ni_mp(i,k) + max(0.0, make_IceNumber(qi_mp(i,k) * rho_dryar(i,k), save_tcp(i,k)) * (1.0/rho_dryar(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)) - gq0(i,k,ntinc) = ni_mp(i,k)/(1.0_kind_phys+qv_mp(i,k)) + if (ntlnc>0) then + !> - Convert moist mixing ratio to dry mixing ratio + qc_mp(i,k) = 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) = nc_mp(i,k) + max(0.0, 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) = 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) = ni_mp(i,k) + max(0.0, 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 diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 7316bb048..86e21f0a9 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1218,6 +1218,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 @@ -1432,6 +1441,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 @@ -1709,7 +1727,7 @@ type = real kind = kind_phys intent = in - optional = T + optional = F [con_rd] standard_name = gas_constant_dry_air long_name = ideal gas constant for dry air @@ -1727,7 +1745,7 @@ type = real kind = kind_phys intent = in - optional = T + optional = F [spechum] standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity From 1a3c4d1d020bc9edca46a1911232156143cf3001 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 13 Feb 2020 18:28:44 +0000 Subject: [PATCH 26/90] All gfs v15p2 and v16beta 3d diagnostic tendencies look reasonable --- physics/GFS_SCNV_generic.F90 | 41 ++++++++++------ physics/GFS_SCNV_generic.meta | 91 +++++++++++++++++++++++++++++++++++ physics/model_tend_post.F90 | 13 +---- physics/model_tend_pre.F90 | 2 + physics/moninedmf.f | 3 +- physics/total_tend.F90 | 4 +- physics/total_tend.meta | 14 ++---- 7 files changed, 128 insertions(+), 40 deletions(-) diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 3aecee8f3..5496d0f48 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, qdiag3d, 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, qdiag3d - 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,9 +35,12 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gt0, gq0_water_ errmsg = '' errflg = 0 - if (ldiag3d) then + save_fields: if (ldiag3d .and. flag_for_scnv_generic_tend) then + print *,'save fields in GFS_SCNV_generic_pre_run' 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 @@ -48,7 +51,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gt0, gq0_water_ enddo enddo endif - endif + endif save_fields end subroutine GFS_SCNV_generic_pre_run @@ -68,7 +71,7 @@ end subroutine GFS_SCNV_generic_post_finalize !! \htmlinclude GFS_SCNV_generic_post_run.html !! subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cplchm, & - frain, gt0, gq0_water_vapor, save_t, save_qv, dqdti, dt3dt, dq3dt, clw, & + 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, & @@ -81,12 +84,12 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl integer, intent(in) :: im, levs, nn 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 @@ -112,7 +115,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl errmsg = '' errflg = 0 - if (imfshalcnv==imfshalcnv_sas .or. imfshalcnv==imfshalcnv_samf) then + update_cnvw_cnvc: if (imfshalcnv==imfshalcnv_sas .or. imfshalcnv==imfshalcnv_samf) then do i=1,im rainc(i) = rainc(i) + frain * rain1(i) enddo @@ -131,13 +134,19 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl enddo enddo endif - endif + endif update_cnvw_cnvc - if (lssav .and. flag_for_scnv_generic_tend) then + diagtend: if (lssav .and. flag_for_scnv_generic_tend) then + print *,'diagtend in GFS_SCNV_generic.F90' + if(frain<1e-5) then + print *,'bad frain: ',frain + endif 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 + 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 @@ -148,7 +157,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl enddo endif endif - endif ! end if_lssav + endif diagtend ! if (cplchm) then do k=1,levs diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 52538d3e8..f1312bfc6 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -33,6 +33,24 @@ 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 @@ -51,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 @@ -69,6 +103,13 @@ kind = kind_phys intent = inout optional = F +[flag_for_scnv_generic_tend] + standard_name = true_if_GFS_SCNV_generic_should_calculate_tendencies + 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 @@ -156,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 @@ -174,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 @@ -201,6 +276,22 @@ kind = kind_phys intent = inout optional = F +[du3dt] + standard_name = cumulative_change_in_x_wind_due_to_shal_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_shal_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 long_name = cumulative change in temperature due to shal conv. diff --git a/physics/model_tend_post.F90 b/physics/model_tend_post.F90 index 8ae7b6844..509c4a834 100644 --- a/physics/model_tend_post.F90 +++ b/physics/model_tend_post.F90 @@ -19,7 +19,6 @@ subroutine model_tend_post_run(kdt, & t_start,u_start,v_start,q_start, & t_end, u_end, v_end, q_end, & dt3dt_ccpp, du3dt_ccpp, dv3dt_ccpp, dq3dt_ccpp, & -! dt3dt_total, du3dt_total, dv3dt_total, dq3dt_total, & im, levs, ntrac, index_for_water_vapor, & lssav, ldiag3d, qdiag3d, errmsg,errflg) use machine, only: kind_phys @@ -32,8 +31,6 @@ subroutine model_tend_post_run(kdt, & real(kind=kind_phys), dimension(:,:), intent(inout) :: q_end real(kind=kind_phys), dimension(:,:), intent(inout) :: du3dt_ccpp, dv3dt_ccpp real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt_ccpp, dq3dt_ccpp - ! real(kind=kind_phys), dimension(:,:), intent(inout) :: du3dt_total, dv3dt_total - ! real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt_total, dq3dt_total integer, intent(in) :: im, levs, ntrac, kdt integer, intent(in) :: index_for_water_vapor @@ -50,6 +47,8 @@ subroutine model_tend_post_run(kdt, & errmsg = '' errflg = 0 + print *, 'in model_tend_post_run' + diag_enabled: if(lssav .and. ldiag3d) then if(any(gt0(1:im,1:levs)<1e-3)) then print *,'error: temperatures less than 1e-3' @@ -73,14 +72,6 @@ subroutine model_tend_post_run(kdt, & do k=1,levs do i=1,im - ! if(t_end(i,k)>1e-3 .and. gt0(i,k)>1e-3) then - ! dt3dt_total(i,k) = dt3dt_total(i,k) + gt0(i,k)-t_end(i,k) - ! du3dt_total(i,k) = du3dt_total(i,k) + gu0(i,k)-u_end(i,k) - ! dv3dt_total(i,k) = dv3dt_total(i,k) + gv0(i,k)-v_end(i,k) - ! if(qdiag3d) then - ! dq3dt_total(i,k) = dq3dt_total(i,k) + gq0_water_vapor(i,k)-q_end(i,k) - ! endif - ! endif t_end(i,k) = gt0(i,k) u_end(i,k) = gu0(i,k) v_end(i,k) = gv0(i,k) diff --git a/physics/model_tend_pre.F90 b/physics/model_tend_pre.F90 index 94ad2ee1a..e3a9db943 100644 --- a/physics/model_tend_pre.F90 +++ b/physics/model_tend_pre.F90 @@ -50,6 +50,8 @@ subroutine model_tend_pre_run(dtp, kdt, & errmsg = '' errflg = 0 + print *,'in model_tend_pre_run' + if(Lssav .and. ldiag3d) then do k=1,levs do i=1,im diff --git a/physics/moninedmf.f b/physics/moninedmf.f index d3fd9e45e..bfe8d512f 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -1068,7 +1068,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & & flag_for_pbl_generic_tend) then - is = (ntoz-1) * km + kk = ntoz + is = (kk-1) * km do k = 1, km do i = 1, im qtend = (a2(i,k+is)-q1(i,k,kk))*rdt diff --git a/physics/total_tend.F90 b/physics/total_tend.F90 index c7c5dfe28..7950c6b90 100644 --- a/physics/total_tend.F90 +++ b/physics/total_tend.F90 @@ -49,8 +49,10 @@ subroutine total_tend_run(dtp, kdt, & good=0 + print *,'entered total_tend_run' + if(Lssav .and. ldiag3d) then - print *,'total_tend_run' + print *,'if = TRUE in total_tend_run' do k=1,levs do i=1,im if(t_start(i,k)>1e-3 .and. tgrs(i,k)>1e-3) then diff --git a/physics/total_tend.meta b/physics/total_tend.meta index a64fd872b..873bc1c61 100644 --- a/physics/total_tend.meta +++ b/physics/total_tend.meta @@ -1,15 +1,15 @@ [ccpp-arg-table] - name = total_tend_pre_init + name = total_tend_init type = scheme ######################################################################## [ccpp-arg-table] - name = total_tend_pre_finalize + name = total_tend_finalize type = scheme ######################################################################## [ccpp-arg-table] - name = total_tend_pre_run + name = total_tend_run type = scheme [dtp] standard_name = time_step_for_physics @@ -60,14 +60,6 @@ type = real kind = kind_phys intent = in -[t_start] - standard_name = temperature_at_start_of_ccpp - long_name = temperature at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out [t_start] standard_name = temperature_at_total_check_point long_name = temperature when model total is calculated in ccpp From 4261b1554689bd5faad1370ef3f2ebf670dfb916 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 14 Feb 2020 19:31:17 +0000 Subject: [PATCH 27/90] QC, Qi and NWFA are not needed in the parameters list as they come into this subroutine as the qgrs entries. Results before/after this change are identical. --- physics/GFS_rrtmg_pre.F90 | 75 ++++++++++++++++---------------------- physics/GFS_rrtmg_pre.meta | 27 -------------- 2 files changed, 31 insertions(+), 71 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 351862cf5..b5055757c 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -20,7 +20,7 @@ end subroutine GFS_rrtmg_pre_init ! in the CCPP version - they are defined in the interstitial_create routine subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & - Radtend, qc, qi, nwfa, & ! input/output + Radtend, & ! input/output imfdeepcnv, imfdeepcnv_gf, & f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only lm, im, lmk, lmp, & ! input @@ -87,11 +87,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input type(GFS_cldprop_type), intent(in) :: Cldprop type(GFS_coupling_type), intent(in) :: Coupling - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: qc - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: qi - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: nwfa - - integer, intent(in) :: im, lm, lmk, lmp integer, intent(in) :: imfdeepcnv, imfdeepcnv_gf integer, intent(out) :: kd, kt, kb @@ -154,7 +149,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, ntlnc, ntinc + 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 @@ -170,7 +165,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! 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 + 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 @@ -205,6 +200,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input 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 @@ -297,15 +293,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input tracer1(:,k1,j) = max(0.0, Statein%qgrs(:,k2,j)) enddo enddo - if ((Model%do_mynnedmf.or. (imfdeepcnv == imfdeepcnv_gf)) .and. Model%kdt > 1) then - ! for MYNN PBL and GF convective include subgrid clouds into tracer1 - do k = 1, LM - k1 = k + kd - k2 = k + lsk - tracer1(:,k1,ntcw) = max(0.0, qc(:,k2)) - tracer1(:,k1,ntiw) = max(0.0, qi(:,k2)) - enddo - endif ! if (ivflip == 0) then ! input data from toa to sfc do i = 1, IM @@ -595,6 +582,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input 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) endif enddo enddo @@ -731,7 +719,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif end do end do - ! Call Thompson's subroutine to compoute effective radii + ! Call Thompson's subroutine to compute effective radii do i = 1, im 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,:), & @@ -747,32 +735,31 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) end do end do - if(1==2) then - write(0,'(a,3e16.7)') " before progclduni: re_cloud min/mean/max =", & - minval(re_cloud), & - sum(re_cloud)/real(size(re_cloud)), & - maxval(re_cloud) - write(0,'(a,3e16.7)') " before progclduni: re_ice min/mean/max =", & - minval(re_ice), & - sum(re_ice)/real(size(re_ice)), & - maxval(re_ice) - write(0,'(a,3e16.7)') " before progclduni: clouds3 min/mean/max =", & - minval(clouds3), & - sum(clouds3)/real(size(clouds3)), & - maxval(clouds3) - write(0,'(a,3e16.7)') " before progclduni: clouds5 min/mean/max =", & - minval(clouds5), & - sum(clouds5)/real(size(clouds5)), & - maxval(clouds5) - write(0,'(a,3e16.7)') " before progcld5: phy_f3d cl min/mean/max =", & - minval(Tbd%phy_f3d(:,:,Model%nleffr)), & - sum(Tbd%phy_f3d(:,:,Model%nleffr))/real(size(Tbd%phy_f3d(:,:,Model%nleffr))), & - maxval(Tbd%phy_f3d(:,:,Model%nleffr)) - write(0,'(a,3e16.7)')" before progcld5: phy_f3d ice min/mean/max =", & - minval(Tbd%phy_f3d(:,:,Model%nieffr)), & - sum(Tbd%phy_f3d(:,:,Model%nieffr))/real(size(Tbd%phy_f3d(:,:,Model%nieffr))), & - maxval(Tbd%phy_f3d(:,:,Model%nieffr)) - endif + + !write(0,'(a,3e16.7)') " before progclduni: re_cloud min/mean/max =", & + ! minval(re_cloud), & + ! sum(re_cloud)/real(size(re_cloud)), & + ! maxval(re_cloud) + !write(0,'(a,3e16.7)') " before progclduni: re_ice min/mean/max =", & + ! minval(re_ice), & + ! sum(re_ice)/real(size(re_ice)), & + ! maxval(re_ice) + !write(0,'(a,3e16.7)') " before progclduni: clouds3 min/mean/max =", & + ! minval(clouds3), & + ! sum(clouds3)/real(size(clouds3)), & + ! maxval(clouds3) + !write(0,'(a,3e16.7)') " before progclduni: clouds5 min/mean/max =", & + ! minval(clouds5), & + ! sum(clouds5)/real(size(clouds5)), & + ! maxval(clouds5) + !write(0,'(a,3e16.7)') " before progcld5: phy_f3d cl min/mean/max =", & + ! minval(Tbd%phy_f3d(:,:,Model%nleffr)), & + ! sum(Tbd%phy_f3d(:,:,Model%nleffr))/real(size(Tbd%phy_f3d(:,:,Model%nleffr))), & + ! maxval(Tbd%phy_f3d(:,:,Model%nleffr)) + !write(0,'(a,3e16.7)')" before progcld5: phy_f3d ice min/mean/max =", & + ! minval(Tbd%phy_f3d(:,:,Model%nieffr)), & + ! sum(Tbd%phy_f3d(:,:,Model%nieffr))/real(size(Tbd%phy_f3d(:,:,Model%nieffr))), & + ! maxval(Tbd%phy_f3d(:,:,Model%nieffr)) do k=1,lm k1 = k + kd diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 9a46ae3d9..901015f04 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -270,33 +270,6 @@ kind = kind_phys intent = out optional = F -[qc] - standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) - 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 = moist (dry+vapor, no condensates) mixing ratio of ice water - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - 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 = inout - optional = T [imfdeepcnv] standard_name = flag_for_mass_flux_deep_convection_scheme long_name = flag for mass-flux deep convection scheme From cebdfa40bdd3059e689fd579c9fba2c689d33f2f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 17 Feb 2020 09:47:43 -0700 Subject: [PATCH 28/90] Minor cleanup of physics/GFS_suite_interstitial.F90 --- physics/GFS_suite_interstitial.F90 | 40 +++--------------------------- 1 file changed, 3 insertions(+), 37 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 1e3035cbf..db3966cee 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -514,33 +514,6 @@ 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 == 8) 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 ) then tracers = 2 do n=2,ntrac @@ -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 @@ -628,7 +603,6 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & else save_qi(:,:) = clw(:,:,1) endif - elseif (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_mg .or. imp_physics == imp_physics_fer_hires) then do k=1,levs do i=1,im @@ -636,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 From 3a852e8a3cd016571a5b08ddffda28585b2347f9 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 21 Feb 2020 08:12:13 -0700 Subject: [PATCH 29/90] physics/GFS_PBL_generic.F90: add missing tracers to vertical diffusion array for Thompson MP --- physics/GFS_PBL_generic.F90 | 40 ++++++++++++++++++++----------------- 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 7e28d2cec..e157013ec 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -150,12 +150,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,ntrnc) - vdftra(i,k,9) = qgrs(i,k,ntoz) - vdftra(i,k,10) = qgrs(i,k,ntwa) - vdftra(i,k,11) = 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 @@ -166,9 +167,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,ntrnc) - vdftra(i,k,8) = 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 @@ -406,12 +408,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,ntrnc) = dvdftra(i,k,8) - dqdt(i,k,ntoz) = dvdftra(i,k,9) - dqdt(i,k,ntwa) = dvdftra(i,k,10) - dqdt(i,k,ntia) = dvdftra(i,k,11) + 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 @@ -422,9 +425,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,ntrnc) = dvdftra(i,k,7) - dqdt(i,k,ntoz) = dvdftra(i,k,8) + 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 From 762f7f4e162814232f6d747530149574b919b3c3 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 28 Feb 2020 16:34:11 +0000 Subject: [PATCH 30/90] Update to MYNN Surface Layer Scheme and related modules - part I --- physics/GFS_debug.F90 | 2 +- physics/module_MYNNSFC_wrapper.F90 | 152 +++++++++++++--------------- physics/module_MYNNSFC_wrapper.meta | 21 ++-- physics/module_sf_mynn.F90 | 67 +++++++----- 4 files changed, 125 insertions(+), 117 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index df56cc069..486ee604e 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -225,6 +225,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) @@ -294,7 +295,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) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index dee855ff7..951d7e7c8 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -27,7 +27,8 @@ end subroutine mynnsfc_wrapper_finalize !###=================================================================== SUBROUTINE mynnsfc_wrapper_run( & & ix,im,levs, & - & iter,flag_init,flag_restart, & + & itimestep,iter, & + & flag_init,flag_restart, & & delt,dx, & & u, v, t3d, qvsh, qc, prsl, phii, & & exner, ps, PBLH, slmsk, & @@ -47,7 +48,7 @@ SUBROUTINE mynnsfc_wrapper_run( & & fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) & fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) & QSFC, USTM, ZOL, MOL, RMOL, & - & WSPD, ch, HFLX, evap, QFX, LH, & + & WSPD, ch, HFLX, QFLX, LH, & & FLHC, FLQC, & & U10, V10, TH2, T2, Q2, & & wstar, CHS2, CQS2, & @@ -111,14 +112,14 @@ SUBROUTINE mynnsfc_wrapper_run( & & IMS,IME,JMS,JME,KMS,KME, & & ITS,ITE,JTS,JTE,KTS,KTE - real(kind=kind_phys), dimension(im,levs+1) :: phii - real(kind=kind_phys), dimension(im,levs) :: & - & exner, PRSL, & - & u, v, t3d, qvsh, qc + 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, th, qv, & - & pattern_spp_pbl + & pattern_spp_pbl, dz, th, qv logical, dimension(im), intent(in) :: wet, dry, icy @@ -141,9 +142,11 @@ SUBROUTINE mynnsfc_wrapper_run( & & qsfc_ocn, qsfc_lnd, qsfc_ice !MYNN-2D - real(kind=kind_phys), dimension(im) :: & - & dx, pblh, slmsk, evap, qsfc, ps, & - & ustm, hflx, qfx, wspd, & + 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, & & FLHC, FLQC, U10, V10, TH2, T2, Q2, & & CHS2, CQS2, rmol, zol, mol, ch, & & lh, wstar @@ -151,7 +154,7 @@ SUBROUTINE mynnsfc_wrapper_run( & real, dimension(im) :: & & hfx, znt, ts, psim, psih, & & chs, ck, cd, mavail, xland, GZ1OZ0, & - & cpm, qgh + & cpm, qgh, qfx ! Initialize CCPP error handling variables errmsg = '' @@ -165,19 +168,8 @@ SUBROUTINE mynnsfc_wrapper_run( & ! 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 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) @@ -202,33 +194,33 @@ SUBROUTINE mynnsfc_wrapper_run( & cpm(i)=cp enddo - 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 +! 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( & @@ -239,7 +231,7 @@ SUBROUTINE mynnsfc_wrapper_run( & SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0, & EP1=ep_1,EP2=ep_2,KARMAN=karman, & ISFFLX=isfflx,isftcflx=isftcflx, & - iz0tlnd=iz0tlnd,itimestep=itimestep, & + iz0tlnd=iz0tlnd,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) @@ -258,7 +250,7 @@ SUBROUTINE mynnsfc_wrapper_run( & 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,QFX=qfx,LH=lh,FLHC=flhc,FLQC=flqc, & + HFLX=hflx,HFX=hfx,QFLX=qflx,QFX=qfx,LH=lh,FLHC=flhc,FLQC=flqc, & QGH=qgh,QSFC=qsfc, & U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2, & GZ1OZ0=GZ1OZ0,WSPD=wspd,wstar=wstar, & @@ -277,38 +269,40 @@ SUBROUTINE mynnsfc_wrapper_run( & !* 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 - evap(i)=QFX(i) + !NOTE: evap & qflx will be solved for later + !qflx(i)=QFX(i)/ + !evap(i)=QFX(i) !or /rho ?? znt_lnd(i)=znt_lnd(i)*100. !m -> cm znt_ocn(i)=znt_ocn(i)*100. znt_ice(i)=znt_ice(i)*100. enddo - 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 +! 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 cf481ddbf..0a988f575 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -25,6 +25,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 @@ -575,7 +583,7 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F [ustm] standard_name = surface_friction_velocity_drag @@ -640,16 +648,7 @@ kind = kind_phys intent = inout optional = F -[evap] - 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 = 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 diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index e2cd7f70c..788ff0ace 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -137,7 +137,7 @@ SUBROUTINE SFCLAY_mynn( & PSFCPA,PBLH,MAVAIL,XLAND,DX, & !in CP,G,ROVCP,R,XLV, & !in SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, & !in - ISFFLX,isftcflx,iz0tlnd,itimestep, & !in + ISFFLX,isftcflx,iz0tlnd,itimestep,iter,& !in wet, dry, icy, & !intent(in) tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) @@ -156,7 +156,7 @@ SUBROUTINE SFCLAY_mynn( & CH,CHS,CHS2,CQS2,CPM, & ZNT,USTM,ZOL,MOL,RMOL, & PSIM,PSIH, & - HFLX,HFX,QFX,LH,FLHC,FLQC, & + HFLX,HFX,QFLX,QFX,LH,FLHC,FLQC, & QGH,QSFC, & U10,V10,TH2,T2,Q2, & GZ1OZ0,WSPD,WSTAR, & @@ -194,8 +194,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) @@ -260,7 +263,7 @@ 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 @@ -300,7 +303,7 @@ SUBROUTINE SFCLAY_mynn( & REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: HFLX,HFX, & - QFX, & + QFLX,QFX, & LH, & MOL,RMOL, & QSFC, QGH, & @@ -391,7 +394,7 @@ SUBROUTINE SFCLAY_mynn( & endif ENDDO - IF (itimestep==1) THEN + IF (itimestep==1 .AND. iter==1) THEN DO i=its,ite !Everything here is used before calculated UST_OCN(i)=MAX(0.04*SQRT(U1D(i)*U1D(i) + V1D(i)*V1D(i)),0.001) @@ -412,7 +415,7 @@ SUBROUTINE SFCLAY_mynn( & XLAND(ims,j),DX(ims,j), & CP,G,ROVCP,R,XLV,SVP1,SVP2,SVP3,SVPT0, & EP1,EP2,KARMAN, & - ISFFLX,isftcflx,iz0tlnd,itimestep, & + ISFFLX,isftcflx,iz0tlnd,itimestep,iter, & wet, dry, icy, & !intent(in) tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) @@ -433,8 +436,8 @@ SUBROUTINE SFCLAY_mynn( & 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),QFX(ims,j),LH(ims,j), & - FLHC(ims,j),FLQC(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), & @@ -456,7 +459,7 @@ SUBROUTINE SFCLAY1D_mynn( & PSFCPA,PBLH,MAVAIL,XLAND,DX, & CP,G,ROVCP,R,XLV,SVP1,SVP2,SVP3,SVPT0, & EP1,EP2,KARMAN, & - ISFFLX,isftcflx,iz0tlnd,itimestep, & + ISFFLX,isftcflx,iz0tlnd,itimestep,iter, & wet, dry, icy, & !intent(in) tskin_ocn, tskin_lnd, tskin_ice, & !intent(in) tsurf_ocn, tsurf_lnd, tsurf_ice, & !intent(in) @@ -475,7 +478,7 @@ SUBROUTINE SFCLAY1D_mynn( & ch,CHS,CHS2,CQS2,CPM, & ZNT,USTM,ZOL,MOL,RMOL, & PSIM,PSIH, & - HFLX,HFX,QFX,LH,FLHC,FLQC, & + HFLX,HFX,QFLX,QFX,LH,FLHC,FLQC, & QGH,QSFC, & U10,V10,TH2,T2,Q2, & GZ1OZ0,WSPD,wstar, & @@ -493,7 +496,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 @@ -524,7 +527,7 @@ SUBROUTINE SFCLAY1D_mynn( & dz2w1d REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: HFLX,HFX, & - QFX,LH, & + QFLX,QFX,LH, & MOL,RMOL, & QGH,QSFC, & ZNT, & @@ -618,10 +621,10 @@ SUBROUTINE SFCLAY1D_mynn( & !------------------------------------------------------------------- IF (debug_code >= 1) THEN - write(*,*)"ITIMESTEP=",ITIMESTEP + write(*,*)"ITIMESTEP=",ITIMESTEP," iter=",iter DO I=its,ite write(*,*)"=== input to mynnsfclayer, i:", i - write(*,*)" land, ice, water" + !write(*,*)" land, ice, water" write(*,*)"dry=",dry(i)," icy=",icy(i)," wet=",wet(i) write(*,*)"tsk=", tskin_lnd(i),tskin_ice(i),tskin_ocn(i) write(*,*)"tsurf=", tsurf_lnd(i),tsurf_ice(i),tsurf_ocn(i) @@ -629,7 +632,9 @@ SUBROUTINE SFCLAY1D_mynn( & write(*,*)"znt=", znt_lnd(i),znt_ice(i),znt_ocn(i) write(*,*)"ust=", ust_lnd(i),ust_ice(i),ust_ocn(i) write(*,*)"snowh=", snowh_lnd(i),snowh_ice(i),snowh_ocn(i) - write(*,*)" psfcpa=",PSFCPA(i)," dz=",dz8w1d(i) + write(*,*)"psfcpa=",PSFCPA(i)," dz=",dz8w1d(i) + write(*,'(A5,F0.8,A6,F0.6,A6,F5.0)') & + "qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) ENDDO ENDIF @@ -671,14 +676,19 @@ SUBROUTINE SFCLAY1D_mynn( & ENDDO DO I=its,ite - RHO1D(I)=PSFCPA(I)/(R*TV1D(I)) !now using value calculated in sfc driver + 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 + QFX(i)=QFLX(i)*RHO1D(I) + HFX(i)=HFLX(i)*RHO1D(I)*cp + ENDDO + IF (debug_code ==2) THEN - write(*,*)"ITIMESTEP=",ITIMESTEP + !write(*,*)"ITIMESTEP=",ITIMESTEP DO I=its,ite write(*,*)"=== derived quantities in mynn sfc layer, i:", i write(*,*)" land, ice, water" @@ -745,7 +755,7 @@ SUBROUTINE SFCLAY1D_mynn( & ! 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) @@ -1642,7 +1652,8 @@ SUBROUTINE SFCLAY1D_mynn( & !---------------------------------- QFX(I)=FLQC(I)*(QSFCMR_lnd(I)-QV1D(I)) QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX - LH(I)=XLV*QFX(I) + LH(i)=XLV*QFX(i) + QFLX(i)=QFX(i)/RHO1D(i) !---------------------------------- ! COMPUTE SURFACE HEAT FLUX: @@ -1660,6 +1671,8 @@ SUBROUTINE SFCLAY1D_mynn( & 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 !------------------------------------------ @@ -1675,6 +1688,7 @@ SUBROUTINE SFCLAY1D_mynn( & QFX(I)=FLQC(I)*(QSFCMR_ocn(I)-QV1D(I)) QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX LH(I)=XLV*QFX(I) + QFLX(i)=QFX(i)/RHO1D(i) !---------------------------------- ! COMPUTE SURFACE HEAT FLUX: @@ -1697,6 +1711,8 @@ SUBROUTINE SFCLAY1D_mynn( & 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 !------------------------------------------ @@ -1711,7 +1727,8 @@ SUBROUTINE SFCLAY1D_mynn( & !---------------------------------- QFX(I)=FLQC(I)*(QSFCMR_ice(I)-QV1D(I)) QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX - LH(I)=XLV*QFX(I) + LH(I)=XLF*QFX(I) + QFLX(i)=QFX(i)/RHO1D(i) !---------------------------------- ! COMPUTE SURFACE HEAT FLUX: @@ -1729,6 +1746,8 @@ SUBROUTINE SFCLAY1D_mynn( & CQS2(I)=UST_ice(I)*KARMAN/PSIQ2_ice(i) CHS2(I)=UST_ice(I)*KARMAN/PSIT2_ice(I) + QSFC(I)=QSFC_ice(I) + ENDIF IF (debug_code >= 1) THEN @@ -1738,12 +1757,12 @@ SUBROUTINE SFCLAY1D_mynn( & if(wet(i))write(*,*)"ocn, MAVAIL:",MAVAIL(I)," u*=",UST_ocn(I)," psiq=",PSIQ_ocn(i) ENDIF - ! The exchange coefficient for cloud water is assumed to be the + ! 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 + !--- COMPUTE EXCHANGE COEFFICIENTS FOR FV3 !----------------------------------------- IF (wet(i)) THEN ch_ocn(I)=(karman/psix_ocn(I))*(karman/psit_ocn(i)) @@ -1838,8 +1857,6 @@ SUBROUTINE SFCLAY1D_mynn( & Q2(I)=QSFCMR_lnd(I)+(QV1D(I)-QSFCMR_lnd(I))*PSIQ2_lnd(i)/PSIQ_lnd(i) Q2(I)= MAX(Q2(I), MIN(QSFCMR_lnd(I), QV1D(I))) Q2(I)= MIN(Q2(I), 1.05*QV1D(I)) - - QSFC(I)=QSFC_lnd(I) ELSEIF (wet(i)) THEN DTG=TH1D(I)-THSK_ocn(I) TH2(I)=THSK_ocn(I)+DTG*PSIT2_ocn(I)/PSIT_ocn(I) @@ -1854,7 +1871,6 @@ SUBROUTINE SFCLAY1D_mynn( & Q2(I)=QSFCMR_ocn(I)+(QV1D(I)-QSFCMR_ocn(I))*PSIQ2_ocn(i)/PSIQ_ocn(i) Q2(I)= MAX(Q2(I), MIN(QSFCMR_ocn(I), QV1D(I))) Q2(I)= MIN(Q2(I), 1.05*QV1D(I)) - QSFC(I)=QSFC_ocn(I) ELSEIF (icy(i)) THEN DTG=TH1D(I)-THSK_ice(I) TH2(I)=THSK_ice(I)+DTG*PSIT2_ice(I)/PSIT_ice(I) @@ -1869,7 +1885,6 @@ SUBROUTINE SFCLAY1D_mynn( & Q2(I)=QSFCMR_ice(I)+(QV1D(I)-QSFCMR_ice(I))*PSIQ2_ice(i)/PSIQ_ice(i) Q2(I)= MAX(Q2(I), MIN(QSFCMR_ice(I), QV1D(I))) Q2(I)= MIN(Q2(I), 1.05*QV1D(I)) - QSFC(I)=QSFC_ice(I) ENDIF ENDDO ENDIF ! end compute_diag From b4918a451256eb4f811851c7973bfee7e26f0c8c Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 4 Mar 2020 20:06:02 +0000 Subject: [PATCH 31/90] Model tendencies add up to total change in 3 hours for the gfs v16 beta suite --- physics/GFS_PBL_generic.F90 | 70 +++++++++++------ physics/GFS_PBL_generic.meta | 142 +++++++++++++++++++++++++++++++++-- physics/model_tend_post.F90 | 27 +++++-- physics/model_tend_post.meta | 32 ++++++++ physics/model_tend_pre.F90 | 92 ++++++++++++++++++++--- physics/model_tend_pre.meta | 64 ++++++++++++++++ physics/total_tend.F90 | 37 ++++++--- physics/total_tend.meta | 32 ++++++++ 8 files changed, 439 insertions(+), 57 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index f0ab372a4..f023a103a 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,7 +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, errmsg, errflg) + 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 @@ -94,13 +95,16 @@ 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), intent(in) :: ugrs, vgrs, tgrs real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra + 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 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -258,6 +262,24 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ! endif + 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 end module GFS_PBL_generic_pre @@ -285,9 +307,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, 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, & + 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, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & - dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, errmsg, errflg) + dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, & + 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 @@ -302,6 +325,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu 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 @@ -309,6 +335,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, 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_ocn, hflx_ocn, evap_ocn, 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 @@ -553,39 +583,29 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! & dtf,' kdt=',kdt,' lat=',lat ! endif - if (ldiag3d .and. flag_for_pbl_generic_tend) 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 - tem = dqdt(i,k,ntqv) * dtf - dq3dt(i,k) = dq3dt(i,k) + tem - enddo - enddo - if (ntoz > 0) then - do k=1,levs - do i=1,im - dq3dt_ozone(i,k) = dq3dt_ozone(i,k) + dqdt(i,k,ntoz) * dtf - enddo - enddo - endif + 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 diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index ab4eca5da..54c661125 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -307,6 +307,78 @@ kind = kind_phys intent = inout 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 +[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 +[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 +[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 +[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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -601,13 +673,6 @@ type = logical intent = in optional = F -[flag_for_pbl_generic_tend] - standard_name = true_if_GFS_PBL_generic_should_calculate_tendencies - long_name = true if GFS_PBL_generic should calculate tendencies - units = flag - dimensions = () - type = logical - intent = in [lssav] standard_name = flag_diagnostics long_name = logical flag for storing diagnostics @@ -616,6 +681,13 @@ type = logical intent = in optional = F +[flag_for_pbl_generic_tend] + standard_name = true_if_GFS_PBL_generic_should_calculate_tendencies + 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 @@ -1235,6 +1307,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/model_tend_post.F90 b/physics/model_tend_post.F90 index 509c4a834..a06997f5e 100644 --- a/physics/model_tend_post.F90 +++ b/physics/model_tend_post.F90 @@ -19,6 +19,7 @@ subroutine model_tend_post_run(kdt, & t_start,u_start,v_start,q_start, & t_end, u_end, v_end, q_end, & dt3dt_ccpp, du3dt_ccpp, dv3dt_ccpp, dq3dt_ccpp, & + dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total, & im, levs, ntrac, index_for_water_vapor, & lssav, ldiag3d, qdiag3d, errmsg,errflg) use machine, only: kind_phys @@ -29,8 +30,9 @@ subroutine model_tend_post_run(kdt, & real(kind=kind_phys), dimension(:,:), intent(in) :: q_start real(kind=kind_phys), dimension(:,:), intent(inout) :: t_end, u_end, v_end real(kind=kind_phys), dimension(:,:), intent(inout) :: q_end - real(kind=kind_phys), dimension(:,:), intent(inout) :: du3dt_ccpp, dv3dt_ccpp - real(kind=kind_phys), dimension(:,:), intent(inout) :: dt3dt_ccpp, dq3dt_ccpp + real(kind=kind_phys), dimension(:,:), intent(inout) :: & + dt3dt_ccpp,du3dt_ccpp,dv3dt_ccpp,dq3dt_ccpp, & + dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total integer, intent(in) :: im, levs, ntrac, kdt integer, intent(in) :: index_for_water_vapor @@ -40,7 +42,7 @@ subroutine model_tend_post_run(kdt, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - real(kind=kind_phys) :: dt + real(kind=kind_phys) :: dt, change integer :: i,k ! Initialize CCPP error handling variables @@ -79,11 +81,22 @@ subroutine model_tend_post_run(kdt, & q_end(i,k) = gq0_water_vapor(i,k) endif if(t_end(i,k)>1e-3 .and. t_start(i,k)>1e-3) then - dt3dt_ccpp(i,k) = dt3dt_ccpp(i,k) + t_end(i,k)-t_start(i,k) - du3dt_ccpp(i,k) = du3dt_ccpp(i,k) + u_end(i,k)-u_start(i,k) - dv3dt_ccpp(i,k) = dv3dt_ccpp(i,k) + v_end(i,k)-v_start(i,k) + change=t_end(i,k)-t_start(i,k) + dt3dt_ccpp(i,k) = dt3dt_ccpp(i,k) + change + !dt3dt_total(i,k) = dt3dt_total(i,k) + change + + change=u_end(i,k)-u_start(i,k) + du3dt_ccpp(i,k) = du3dt_ccpp(i,k) + change + !du3dt_total(i,k) = du3dt_total(i,k) + change + + change=v_end(i,k)-v_start(i,k) + dv3dt_ccpp(i,k) = dv3dt_ccpp(i,k) + change + !dv3dt_total(i,k) = dv3dt_total(i,k) + change + if(qdiag3d) then - dq3dt_ccpp(i,k) = dq3dt_ccpp(i,k) + q_end(i,k)-q_start(i,k) + change=q_end(i,k)-q_start(i,k) + dq3dt_ccpp(i,k) = dq3dt_ccpp(i,k) + change + !dq3dt_total(i,k) = dq3dt_total(i,k) + change endif endif enddo diff --git a/physics/model_tend_post.meta b/physics/model_tend_post.meta index a97fa4dad..8a730059f 100644 --- a/physics/model_tend_post.meta +++ b/physics/model_tend_post.meta @@ -143,6 +143,38 @@ type = real kind = kind_phys intent = inout +[dt3dt_total] + standard_name = cumulative_change_in_temperature + long_name = cumulative change in temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[du3dt_total] + standard_name = cumulative_change_in_x_wind + long_name = cumulative change in x wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_total] + standard_name = cumulative_change_in_y_wind + long_name = cumulative change in y wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_total] + standard_name = cumulative_change_in_water_vapor_specific_humidity + long_name = cumulative change in water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/model_tend_pre.F90 b/physics/model_tend_pre.F90 index e3a9db943..198a0ac75 100644 --- a/physics/model_tend_pre.F90 +++ b/physics/model_tend_pre.F90 @@ -15,12 +15,62 @@ end subroutine model_tend_pre_init subroutine model_tend_pre_finalize() end subroutine model_tend_pre_finalize +! subroutine model_tend_pre_run(diag, statein, stateout, control, & +! errmsg, errflg) +! implicit none +! use GFS_typedefs, only: GFS_statein_type, GFS_stateout_type, GFS_diag_type, GFS_control_type + +! type(GFS_diag_type), intent(inout) :: diag +! type(GFS_statein_type), intent(in) :: statein +! type(GFS_stateout_type), intent(in) :: stateout +! type(GFS_control_type), intent(in) :: control + +! character(len=*), intent(out) :: errmsg +! integer, intent(out) :: errflg + +! integer :: i, k + +! ! Initialize CCPP error handling variables +! errmsg = '' +! errflg = 0 + +! print *,'in model_tend_pre_run' + +! if(control%Lssav .and. control%ldiag3d) then +! do k=1,control%levs +! do i=1,control%im +! diag%t_start(i,k) = statein%tgrs(i,k) +! diag%u_start(i,k) = statein%ugrs(i,k) +! v_start(i,k) = vgrs(i,k) +! if(qdiag3d) then +! q_start(i,k) = qvgrs(i,k) +! endif +! if(t_start(i,k)>1e-3 .and. t_end(i,k)>1e-3) then +! dt3dt_model(i,k) = dt3dt_model(i,k) + (t_start(i,k)-t_end(i,k)) +! du3dt_model(i,k) = du3dt_model(i,k) + (u_start(i,k)-u_end(i,k)) +! dv3dt_model(i,k) = dv3dt_model(i,k) + (v_start(i,k)-v_end(i,k)) +! if(qdiag3d) then +! dq3dt_model(i,k) = dq3dt_model(i,k) + (q_start(i,k)-q_end(i,k)) +! endif +! endif +! enddo +! enddo +! endif + +! end subroutine model_tend_pre_run + + + !> \section arg_table_model_tend_pre_run Argument Table !! \htmlinclude model_tend_pre_run.html !! + subroutine model_tend_pre_run(dtp, kdt, & - tgrs,ugrs,vgrs,qvgrs, t_start,u_start,v_start,q_start, & + tgrs,ugrs,vgrs,qvgrs, & + gt0,gu0,gv0, gq0_water_vapor, & + t_start,u_start,v_start,q_start, & dt3dt_model,du3dt_model,dv3dt_model,dq3dt_model, & + dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total, & t_end,u_end,v_end,q_end, & im, levs, ntrac, & lssav, ldiag3d, qdiag3d, errmsg,errflg) @@ -28,22 +78,24 @@ subroutine model_tend_pre_run(dtp, kdt, & implicit none real(kind=kind_phys), dimension(:,:), intent(in) :: tgrs, ugrs, vgrs, qvgrs + real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, gu0, gv0, gq0_water_vapor real(kind=kind_phys), dimension(:,:), intent(out) :: t_start, u_start, v_start real(kind=kind_phys), dimension(:,:), intent(out) :: q_start real(kind=kind_phys), dimension(:,:), intent(out) :: t_end, u_end, v_end real(kind=kind_phys), dimension(:,:), intent(out) :: q_end real(kind=kind_phys), dimension(:,:), intent(inout) :: & - dt3dt_model,du3dt_model,dv3dt_model,dq3dt_model + dt3dt_model,du3dt_model,dv3dt_model,dq3dt_model, & + dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total integer, intent(in) :: im, levs, ntrac, kdt logical, intent(in) :: lssav, qdiag3d, ldiag3d - real(kind=kind_phys) :: dtp + real(kind=kind_phys) :: dtp, change character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + logical :: logical integer :: i, k ! Initialize CCPP error handling variables @@ -52,9 +104,17 @@ subroutine model_tend_pre_run(dtp, kdt, & print *,'in model_tend_pre_run' + logical = .false. + if(Lssav .and. ldiag3d) then do k=1,levs do i=1,im + ! t_start(i,k) = gt0(i,k) + ! u_start(i,k) = gu0(i,k) + ! v_start(i,k) = gv0(i,k) + ! if(qdiag3d) then + ! q_start(i,k) = gq0_water_vapor(i,k) + ! endif t_start(i,k) = tgrs(i,k) u_start(i,k) = ugrs(i,k) v_start(i,k) = vgrs(i,k) @@ -62,11 +122,25 @@ subroutine model_tend_pre_run(dtp, kdt, & q_start(i,k) = qvgrs(i,k) endif if(t_start(i,k)>1e-3 .and. t_end(i,k)>1e-3) then - dt3dt_model(i,k) = dt3dt_model(i,k) + (t_start(i,k)-t_end(i,k)) - du3dt_model(i,k) = du3dt_model(i,k) + (u_start(i,k)-u_end(i,k)) - dv3dt_model(i,k) = dv3dt_model(i,k) + (v_start(i,k)-v_end(i,k)) - if(qdiag3d) then - dq3dt_model(i,k) = dq3dt_model(i,k) + (q_start(i,k)-q_end(i,k)) + if(t_end(i,k)/=t_start(i,k)) then + logical=.true. + change=t_start(i,k)-t_end(i,k) + dt3dt_model(i,k) = dt3dt_model(i,k) + change + !dt3dt_total(i,k) = dt3dt_total(i,k) + change + + change=u_start(i,k)-u_end(i,k) + du3dt_model(i,k) = du3dt_model(i,k) + change + !du3dt_total(i,k) = du3dt_total(i,k) + change + + change=v_start(i,k)-v_end(i,k) + dv3dt_model(i,k) = dv3dt_model(i,k) + change + !dv3dt_total(i,k) = dv3dt_total(i,k) + change + + if(qdiag3d) then + change=q_start(i,k)-q_end(i,k) + dq3dt_model(i,k) = dq3dt_model(i,k) + change + !dq3dt_total(i,k) = dq3dt_total(i,k) + change + endif endif endif enddo diff --git a/physics/model_tend_pre.meta b/physics/model_tend_pre.meta index 0cbb9b4e9..7ec047161 100644 --- a/physics/model_tend_pre.meta +++ b/physics/model_tend_pre.meta @@ -60,6 +60,38 @@ type = real kind = kind_phys intent = in +[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 +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[gq0_water_vapor] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in [t_start] standard_name = temperature_at_start_of_ccpp long_name = temperature at start of ccpp @@ -124,6 +156,38 @@ type = real kind = kind_phys intent = inout +[dt3dt_total] + standard_name = cumulative_change_in_temperature + long_name = cumulative change in temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[du3dt_total] + standard_name = cumulative_change_in_x_wind + long_name = cumulative change in x wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dv3dt_total] + standard_name = cumulative_change_in_y_wind + long_name = cumulative change in y wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout +[dq3dt_total] + standard_name = cumulative_change_in_water_vapor_specific_humidity + long_name = cumulative change in water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout [t_end] standard_name = temperature_at_end_of_ccpp long_name = temperature at end of ccpp diff --git a/physics/total_tend.F90 b/physics/total_tend.F90 index 7950c6b90..8369c304b 100644 --- a/physics/total_tend.F90 +++ b/physics/total_tend.F90 @@ -21,11 +21,13 @@ end subroutine total_tend_finalize subroutine total_tend_run(dtp, kdt, & tgrs,ugrs,vgrs,qvgrs, t_start,u_start,v_start,q_start, & dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total, & + gt0,gu0,gv0, gq0_water_vapor, & im, levs, ntrac, & lssav, ldiag3d, qdiag3d, errmsg,errflg) use machine, only: kind_phys implicit none + real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, gu0, gv0, gq0_water_vapor real(kind=kind_phys), dimension(:,:), intent(in) :: tgrs, ugrs, vgrs, qvgrs real(kind=kind_phys), dimension(:,:), intent(out) :: t_start, u_start, v_start real(kind=kind_phys), dimension(:,:), intent(out) :: q_start @@ -55,19 +57,36 @@ subroutine total_tend_run(dtp, kdt, & print *,'if = TRUE in total_tend_run' do k=1,levs do i=1,im - if(t_start(i,k)>1e-3 .and. tgrs(i,k)>1e-3) then + if(t_start(i,k)>1e-3 .and. gt0(i,k)>1e-3) then good=good+1 - dt3dt_total(i,k) = dt3dt_total(i,k) + tgrs(i,k)-t_start(i,k) - du3dt_total(i,k) = du3dt_total(i,k) + ugrs(i,k)-u_start(i,k) - dv3dt_total(i,k) = dv3dt_total(i,k) + vgrs(i,k)-v_start(i,k) + dt3dt_total(i,k) = dt3dt_total(i,k) + (gt0(i,k)-t_start(i,k)) + du3dt_total(i,k) = du3dt_total(i,k) + (gu0(i,k)-u_start(i,k)) + dv3dt_total(i,k) = dv3dt_total(i,k) + (gv0(i,k)-v_start(i,k)) if(qdiag3d) then - dq3dt_total(i,k) = dq3dt_total(i,k) + qvgrs(i,k)-q_start(i,k) + dq3dt_total(i,k) = dq3dt_total(i,k) + (gq0_water_vapor(i,k)-q_start(i,k)) endif endif - t_start(i,k)=tgrs(i,k) - u_start(i,k)=ugrs(i,k) - v_start(i,k)=vgrs(i,k) - q_start(i,k)=qvgrs(i,k) + t_start(i,k)=gt0(i,k) + u_start(i,k)=gu0(i,k) + v_start(i,k)=gv0(i,k) + if(qdiag3d) then + q_start(i,k)=gq0_water_vapor(i,k) + endif + ! if(t_start(i,k)>1e-3 .and. tgrs(i,k)>1e-3) then + ! good=good+1 + ! dt3dt_total(i,k) = dt3dt_total(i,k) + (tgrs(i,k)-t_start(i,k)) + ! du3dt_total(i,k) = du3dt_total(i,k) + (ugrs(i,k)-u_start(i,k)) + ! dv3dt_total(i,k) = dv3dt_total(i,k) + (vgrs(i,k)-v_start(i,k)) + ! if(qdiag3d) then + ! dq3dt_total(i,k) = dq3dt_total(i,k) + (qvgrs(i,k)-q_start(i,k)) + ! endif + ! endif + ! t_start(i,k)=tgrs(i,k) + ! u_start(i,k)=ugrs(i,k) + ! v_start(i,k)=vgrs(i,k) + ! if(qdiag3d) then + ! q_start(i,k)=qvgrs(i,k) + ! endif enddo enddo print *,'total tend valid points: ',good diff --git a/physics/total_tend.meta b/physics/total_tend.meta index 873bc1c61..82e49a081 100644 --- a/physics/total_tend.meta +++ b/physics/total_tend.meta @@ -124,6 +124,38 @@ type = real kind = kind_phys intent = inout +[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 +[gu0] + standard_name = x_wind_updated_by_physics + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[gv0] + standard_name = y_wind_updated_by_physics + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in +[gq0_water_vapor] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent From abde3d01f61e20a64e6605f8ac2dfd7a9aff6fba Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 4 Mar 2020 22:28:16 +0000 Subject: [PATCH 32/90] Remove debug prints and commented-out code. One piece of commented-out code is retained, and this commit adds an explanatory comment --- physics/GFS_SCNV_generic.F90 | 5 ---- physics/model_tend_post.F90 | 22 ----------------- physics/model_tend_pre.F90 | 46 ------------------------------------ physics/total_tend.F90 | 5 +--- 4 files changed, 1 insertion(+), 77 deletions(-) diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 5496d0f48..82b0818fd 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -36,7 +36,6 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, errflg = 0 save_fields: if (ldiag3d .and. flag_for_scnv_generic_tend) then - print *,'save fields in GFS_SCNV_generic_pre_run' do k=1,levs do i=1,im save_u(i,k) = gu0(i,k) @@ -137,10 +136,6 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl endif update_cnvw_cnvc diagtend: if (lssav .and. flag_for_scnv_generic_tend) then - print *,'diagtend in GFS_SCNV_generic.F90' - if(frain<1e-5) then - print *,'bad frain: ',frain - endif if (ldiag3d) then do k=1,levs do i=1,im diff --git a/physics/model_tend_post.F90 b/physics/model_tend_post.F90 index a06997f5e..0ff43f9eb 100644 --- a/physics/model_tend_post.F90 +++ b/physics/model_tend_post.F90 @@ -49,29 +49,7 @@ subroutine model_tend_post_run(kdt, & errmsg = '' errflg = 0 - print *, 'in model_tend_post_run' - diag_enabled: if(lssav .and. ldiag3d) then - if(any(gt0(1:im,1:levs)<1e-3)) then - print *,'error: temperatures less than 1e-3' - endif - if(all(abs(gu0(1:im,1:levs))<1e-3)) then - print *,'error: all u wind is near zero' - endif - if(all(abs(gv0(1:im,1:levs))<1e-3)) then - print *,'error: all v wind is near zero' - endif - - if(any(t_start(1:im,1:levs)<1e-3)) then - print *,'error: start temperatures less than 1e-3' - endif - if(all(abs(u_start(1:im,1:levs))<1e-3)) then - print *,'error: all start u wind is near zero' - endif - if(all(abs(v_start(1:im,1:levs))<1e-3)) then - print *,'error: all start v wind is near zero' - endif - do k=1,levs do i=1,im t_end(i,k) = gt0(i,k) diff --git a/physics/model_tend_pre.F90 b/physics/model_tend_pre.F90 index 198a0ac75..f88b4d789 100644 --- a/physics/model_tend_pre.F90 +++ b/physics/model_tend_pre.F90 @@ -15,52 +15,6 @@ end subroutine model_tend_pre_init subroutine model_tend_pre_finalize() end subroutine model_tend_pre_finalize -! subroutine model_tend_pre_run(diag, statein, stateout, control, & -! errmsg, errflg) -! implicit none -! use GFS_typedefs, only: GFS_statein_type, GFS_stateout_type, GFS_diag_type, GFS_control_type - -! type(GFS_diag_type), intent(inout) :: diag -! type(GFS_statein_type), intent(in) :: statein -! type(GFS_stateout_type), intent(in) :: stateout -! type(GFS_control_type), intent(in) :: control - -! character(len=*), intent(out) :: errmsg -! integer, intent(out) :: errflg - -! integer :: i, k - -! ! Initialize CCPP error handling variables -! errmsg = '' -! errflg = 0 - -! print *,'in model_tend_pre_run' - -! if(control%Lssav .and. control%ldiag3d) then -! do k=1,control%levs -! do i=1,control%im -! diag%t_start(i,k) = statein%tgrs(i,k) -! diag%u_start(i,k) = statein%ugrs(i,k) -! v_start(i,k) = vgrs(i,k) -! if(qdiag3d) then -! q_start(i,k) = qvgrs(i,k) -! endif -! if(t_start(i,k)>1e-3 .and. t_end(i,k)>1e-3) then -! dt3dt_model(i,k) = dt3dt_model(i,k) + (t_start(i,k)-t_end(i,k)) -! du3dt_model(i,k) = du3dt_model(i,k) + (u_start(i,k)-u_end(i,k)) -! dv3dt_model(i,k) = dv3dt_model(i,k) + (v_start(i,k)-v_end(i,k)) -! if(qdiag3d) then -! dq3dt_model(i,k) = dq3dt_model(i,k) + (q_start(i,k)-q_end(i,k)) -! endif -! endif -! enddo -! enddo -! endif - -! end subroutine model_tend_pre_run - - - !> \section arg_table_model_tend_pre_run Argument Table !! \htmlinclude model_tend_pre_run.html !! diff --git a/physics/total_tend.F90 b/physics/total_tend.F90 index 8369c304b..24d5c92ef 100644 --- a/physics/total_tend.F90 +++ b/physics/total_tend.F90 @@ -51,10 +51,7 @@ subroutine total_tend_run(dtp, kdt, & good=0 - print *,'entered total_tend_run' - if(Lssav .and. ldiag3d) then - print *,'if = TRUE in total_tend_run' do k=1,levs do i=1,im if(t_start(i,k)>1e-3 .and. gt0(i,k)>1e-3) then @@ -72,6 +69,7 @@ subroutine total_tend_run(dtp, kdt, & if(qdiag3d) then q_start(i,k)=gq0_water_vapor(i,k) endif + ! Alternative is to use the state in: ! if(t_start(i,k)>1e-3 .and. tgrs(i,k)>1e-3) then ! good=good+1 ! dt3dt_total(i,k) = dt3dt_total(i,k) + (tgrs(i,k)-t_start(i,k)) @@ -89,7 +87,6 @@ subroutine total_tend_run(dtp, kdt, & ! endif enddo enddo - print *,'total tend valid points: ',good endif end subroutine total_tend_run From 2edeeadb4416937dfb18eb32f3bf327449d47de2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 12 Mar 2020 15:14:23 -0600 Subject: [PATCH 33/90] Bugfixes: uninitialized data before entering effective radii calculation; array qci_conv may not be allocated, thus use assumed-size declaration --- physics/GFS_rrtmg_pre.F90 | 4 ++++ physics/module_SGSCloud_RadPre.F90 | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 170cb707a..d123c9e4b 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -729,6 +729,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input end do ! Call Thompson's subroutine to compute effective radii do i=1,im + ! Initialize to default in units m as in module_mp_thompson.F90 + re_cloud(i,:) = 2.49E-6 + re_ice(i,:) = 4.99E-6 + re_snow(i,:) = 9.99E-6 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 ) diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index 15ac383f5..544fe1004 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -61,13 +61,13 @@ subroutine sgscloud_radpre_run( & 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 - real(kind=kind_phys), dimension(im,levs), intent(inout) :: qci_conv + ! 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 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, cldfra_bl - ! DH* TODO add intent() information for delp,clouds1,clouds2,clouds3,clouds4,clouds5 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 From 5960e5e8a1e15ebb7040656ebe1ea2c62253ae87 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 17 Mar 2020 14:30:47 -0600 Subject: [PATCH 34/90] Cosmetic changes to physics/GFS_debug.F90 --- physics/GFS_debug.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 486ee604e..3bb50d9ef 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -310,6 +310,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 @@ -345,6 +346,7 @@ 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) From 10e357f8f03d03ec2a704529685e2b047cec9af0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 20 Mar 2020 09:34:37 -0600 Subject: [PATCH 35/90] physics/module_MYNNSFC_wrapper.F90: add comment about CCPP being able to do automatic unit conversions --- physics/module_MYNNSFC_wrapper.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 951d7e7c8..9fd71c37d 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -186,9 +186,10 @@ SUBROUTINE mynnsfc_wrapper_run( & endif qgh(i)=0.0 !snowh(i)=snowd(i)*800. !mm -> m + ! DH* note - this could be automated (CCPP knows how to convert cm to 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 + znt_ice(i)=znt_ice(i)*0.01 !cm -> m ts(i)=tskin_ocn(i)/exner(i,1) !theta mavail(i)=1.0 !???? cpm(i)=cp @@ -272,6 +273,7 @@ SUBROUTINE mynnsfc_wrapper_run( & !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. From 92b6ee80c7ee93b91b8072c1f6b4b7a619d4af44 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 23 Mar 2020 10:32:06 -0600 Subject: [PATCH 36/90] physics/module_MYNNSFC_wrapper.F90: perform unit conversion m <-> cm only for valid data --- physics/module_MYNNSFC_wrapper.F90 | 98 ++++++++++++++++-------------- 1 file changed, 54 insertions(+), 44 deletions(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 9fd71c37d..42d0108a1 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -168,32 +168,38 @@ SUBROUTINE mynnsfc_wrapper_run( & ! 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 - 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 - ! DH* note - this could be automated (CCPP knows how to convert cm to 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 - ts(i)=tskin_ocn(i)/exner(i,1) !theta - mavail(i)=1.0 !???? - cpm(i)=cp - enddo + ! 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 + 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:" @@ -261,24 +267,28 @@ SUBROUTINE mynnsfc_wrapper_run( & 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 - + !! 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,*) From 65da24ee5def2e86a19614bf2536af76b9074d99 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 23 Mar 2020 16:52:00 -0600 Subject: [PATCH 37/90] physics/GFS_surface_composites.*: initialize composites uustar_*, qss_*, hflx_* --- physics/GFS_surface_composites.F90 | 21 +++++--- physics/GFS_surface_composites.meta | 81 +++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+), 6 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 9636eb384..0060e1a7b 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -28,10 +28,11 @@ end subroutine GFS_surface_composites_pre_finalize subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, landfrac, lakefrac, oceanfrac, & frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorl_ocn, & zorl_lnd, zorl_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & - tprcp_lnd, tprcp_ice, uustar, uustar_lnd, uustar_ice, weasd, weasd_ocn, & - weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_ocn, tsfc_lnd, & - tsfc_ice, tisfc, tice, tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, gflx_ice, & - tgice, islmsk, semis_rad, semis_ocn, semis_lnd, semis_ice, & + tprcp_lnd, tprcp_ice, uustar, uustar_ocn, uustar_lnd, uustar_ice, & + weasd, weasd_ocn, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_ocn,& + tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_ocn, tsurf_lnd, tsurf_ice, & + gflx_ice, tgice, islmsk, semis_rad, semis_ocn, semis_lnd, semis_ice, & + qss, qss_ocn, qss_lnd, qss_ice, hflx, hflx_ocn, 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, lan 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_ocn, snowd_lnd, snowd_ice, tprcp_ocn, & tprcp_lnd, tprcp_ice, zorl_ocn, zorl_lnd, zorl_ice, tsfc_ocn, tsfc_lnd, tsfc_ice, tsurf_ocn, & - tsurf_lnd, tsurf_ice, uustar_lnd, uustar_ice, weasd_ocn, weasd_lnd, weasd_ice, ep1d_ice, gflx_ice + tsurf_lnd, tsurf_ice, uustar_ocn, uustar_lnd, uustar_ice, weasd_ocn, weasd_lnd, weasd_ice, & + qss_ocn, qss_lnd, qss_ice, hflx_ocn, 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 @@ -145,6 +147,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan tprcp_lnd(i) = tprcp(i) tprcp_ice(i) = tprcp(i) if (wet(i)) then ! Water + uustar_ocn(i) = uustar(i) zorl_ocn(i) = zorlo(i) tsfc_ocn(i) = tsfco(i) tsurf_ocn(i) = tsfco(i) @@ -153,6 +156,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan weasd_ocn(i) = zero snowd_ocn(i) = zero semis_ocn(i) = 0.984d0 + qss_ocn(i) = qss(i) + hflx_ocn(i) = hflx(i) endif if (dry(i)) then ! Land uustar_lnd(i) = uustar(i) @@ -162,6 +167,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan 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) @@ -173,6 +180,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan ep1d_ice(i) = zero gflx_ice(i) = zero semis_ice(i) = 0.95d0 + qss_ice(i) = qss(i) + hflx_ice(i) = hflx(i) end if enddo diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 74c6b9575..bf613e160 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -262,6 +262,15 @@ kind = kind_phys intent = in optional = F +[uustar_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 [uustar_lnd] standard_name = surface_friction_velocity_over_land long_name = surface friction velocity over land @@ -495,6 +504,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_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 = 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_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 [min_lakeice] standard_name = lake_ice_minimum long_name = minimum lake ice value From a6f3dedf3311863e4a3fd66086d7c53472b11fdc Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 26 Mar 2020 13:06:25 -0600 Subject: [PATCH 38/90] Updates from @joeolson42 for physics/module_MYNNSFC_wrapper.F90, physics/module_MYNNSFC_wrapper.meta, physics/module_sf_mynn.F90 --- physics/module_MYNNSFC_wrapper.F90 | 14 +- physics/module_MYNNSFC_wrapper.meta | 17 ++ physics/module_sf_mynn.F90 | 256 ++++++++++++++++++---------- 3 files changed, 189 insertions(+), 98 deletions(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 42d0108a1..82cdbca76 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -28,7 +28,7 @@ end subroutine mynnsfc_wrapper_finalize SUBROUTINE mynnsfc_wrapper_run( & & ix,im,levs, & & itimestep,iter, & - & flag_init,flag_restart, & + & flag_init,flag_restart,lsm, & & delt,dx, & & u, v, t3d, qvsh, qc, prsl, phii, & & exner, ps, PBLH, slmsk, & @@ -47,8 +47,8 @@ SUBROUTINE mynnsfc_wrapper_run( & & fh_ocn, fh_lnd, fh_ice, & !intent(inout) & fm10_ocn, fm10_lnd, fm10_ice, & !intent(inout) & fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) - & QSFC, USTM, ZOL, MOL, RMOL, & - & WSPD, ch, HFLX, QFLX, LH, & + & QSFC, qsfc_ruc, USTM, ZOL, MOL, & + & RMOL, WSPD, ch, HFLX, QFLX, LH, & & FLHC, FLQC, & & U10, V10, TH2, T2, Q2, & & wstar, CHS2, CQS2, & @@ -106,7 +106,7 @@ SUBROUTINE mynnsfc_wrapper_run( & !MYNN-1D REAL :: delt INTEGER :: im, ix, levs - INTEGER :: iter, k, i, itimestep + 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, & @@ -146,7 +146,7 @@ SUBROUTINE mynnsfc_wrapper_run( & & dx, pblh, slmsk, ps real(kind=kind_phys), dimension(im), intent(inout) :: & - & ustm, hflx, qflx, wspd, qsfc, & + & ustm, hflx, qflx, wspd, qsfc, qsfc_ruc, & & FLHC, FLQC, U10, V10, TH2, T2, Q2, & & CHS2, CQS2, rmol, zol, mol, ch, & & lh, wstar @@ -237,7 +237,7 @@ SUBROUTINE mynnsfc_wrapper_run( & 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, & + ISFFLX=isfflx,isftcflx=isftcflx,LSM=lsm, & iz0tlnd=iz0tlnd,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) @@ -258,7 +258,7 @@ SUBROUTINE mynnsfc_wrapper_run( & 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, & + 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, & diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 0a988f575..b12837233 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -57,6 +57,14 @@ 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 [delt] standard_name = time_step_for_physics long_name = time step for physics @@ -585,6 +593,15 @@ 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 diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 788ff0ace..2ac9d832c 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -106,6 +106,9 @@ MODULE module_sf_mynn !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 @@ -137,7 +140,8 @@ SUBROUTINE SFCLAY_mynn( & PSFCPA,PBLH,MAVAIL,XLAND,DX, & !in CP,G,ROVCP,R,XLV, & !in SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, & !in - ISFFLX,isftcflx,iz0tlnd,itimestep,iter,& !in + ISFFLX,isftcflx,lsm,iz0tlnd, & !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) @@ -157,7 +161,7 @@ SUBROUTINE SFCLAY_mynn( & ZNT,USTM,ZOL,MOL,RMOL, & PSIM,PSIH, & HFLX,HFX,QFLX,QFX,LH,FLHC,FLQC, & - QGH,QSFC, & + QGH,QSFC,QSFC_RUC, & U10,V10,TH2,T2,Q2, & GZ1OZ0,WSPD,WSTAR, & spp_pbl,pattern_spp_pbl, & @@ -268,8 +272,8 @@ SUBROUTINE SFCLAY_mynn( & 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 + INTEGER, INTENT(IN) :: ISFFLX, LSM + INTEGER, OPTIONAL, INTENT(IN) :: ISFTCFLX, IZ0TLND INTEGER, OPTIONAL, INTENT(IN) :: spp_pbl !=================================== @@ -306,7 +310,8 @@ SUBROUTINE SFCLAY_mynn( & QFLX,QFX, & LH, & MOL,RMOL, & - QSFC, QGH, & + QSFC, & + QGH, & ZNT, & ZOL, & USTM, & @@ -339,7 +344,8 @@ SUBROUTINE SFCLAY_mynn( & & fh_ocn, fh_lnd, fh_ice, & & fm10_ocn, fm10_lnd, fm10_ice, & & fh2_ocn, fh2_lnd, fh2_ice, & - & qsfc_ocn, qsfc_lnd, qsfc_ice + & qsfc_ocn, qsfc_lnd, qsfc_ice, & + & qsfc_ruc !ADDITIONAL OUTPUT !JOE-begin @@ -402,10 +408,21 @@ SUBROUTINE SFCLAY_mynn( & 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 + IF (LSM == 3) THEN + DO i=its,ite + QSFC_LND(i)=QSFC_RUC(i) + ENDDO + ENDIF ENDIF CALL SFCLAY1D_mynn( & @@ -453,7 +470,10 @@ END SUBROUTINE SFCLAY_MYNN !------------------------------------------------------------------- !>\ingroup module_sf_mynn_mod -!! This subroutine calculates +!! 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, & @@ -621,20 +641,27 @@ SUBROUTINE SFCLAY1D_mynn( & !------------------------------------------------------------------- IF (debug_code >= 1) THEN - write(*,*)"ITIMESTEP=",ITIMESTEP," iter=",iter + write(0,*)"ITIMESTEP=",ITIMESTEP," iter=",iter DO I=its,ite - write(*,*)"=== input to mynnsfclayer, i:", i - !write(*,*)" land, ice, water" - write(*,*)"dry=",dry(i)," icy=",icy(i)," wet=",wet(i) - write(*,*)"tsk=", tskin_lnd(i),tskin_ice(i),tskin_ocn(i) - write(*,*)"tsurf=", tsurf_lnd(i),tsurf_ice(i),tsurf_ocn(i) - write(*,*)"qsfc=", qsfc_lnd(i),qsfc_ice(i),qsfc_ocn(i) - write(*,*)"znt=", znt_lnd(i),znt_ice(i),znt_ocn(i) - write(*,*)"ust=", ust_lnd(i),ust_ice(i),ust_ocn(i) - write(*,*)"snowh=", snowh_lnd(i),snowh_ice(i),snowh_ocn(i) - write(*,*)"psfcpa=",PSFCPA(i)," dz=",dz8w1d(i) - write(*,'(A5,F0.8,A6,F0.6,A6,F5.0)') & - "qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) + write(0,*)"=== imortant input to mynnsfclayer, i:", i + IF (dry(i)) THEN + write(0,*)"dry=",dry(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)," 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)," 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 @@ -1161,8 +1188,14 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF IF (debug_code >= 1) 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) + 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)) @@ -1219,8 +1252,14 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF IF (debug_code >= 1) 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) + 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)) @@ -1280,8 +1319,14 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF IF (debug_code >= 1) THEN - write(0,*)"===(dry) capture bad input in mynn sfc layer, i=:",i - write(0,*)"rb=", rb_lnd(I)," ZNT=", ZNTstoch_lnd(i)," ZT=",Zt_lnd(i) + 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)) @@ -1337,8 +1382,14 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF IF (debug_code >= 1) THEN - write(0,*)"===(dry) capture bad input in mynn sfc layer, i=:",i - write(0,*)"rb=", rb_lnd(I)," ZNT=", ZNTstoch_lnd(i)," ZT=",Zt_lnd(i) + 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)) @@ -1397,8 +1448,14 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF IF (debug_code >= 1) 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) + 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)) @@ -1454,8 +1511,14 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF IF (debug_code >= 1) 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) + 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)) @@ -1593,9 +1656,9 @@ SUBROUTINE SFCLAY1D_mynn( & IF (debug_code == 2) THEN DO I=its,ite - IF(wet(i))write(*,*)"==== AT END OF ITER LOOP, i=",i, "(wet)" - IF(dry(i))write(*,*)"==== AT END OF ITER LOOP, i=",i, "(land)" - IF(icy(i))write(*,*)"==== AT END OF ITER LOOP, i=",i, "(ice)" + 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) @@ -1647,20 +1710,23 @@ SUBROUTINE SFCLAY1D_mynn( & 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) - !---------------------------------- - ! COMPUTE SURFACE MOISTURE FLUX: - !---------------------------------- - QFX(I)=FLQC(I)*(QSFCMR_lnd(I)-QV1D(I)) - QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX - LH(i)=XLV*QFX(i) - QFLX(i)=QFX(i)/RHO1D(i) - - !---------------------------------- - ! COMPUTE SURFACE HEAT FLUX: - !---------------------------------- - HFX(I)=FLHC(I)*(THSK_lnd(I)-TH1D(I)) - HFX(I)=MAX(HFX(I),-250.) - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(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) + QFLX(i)=QFX(i)/RHO1D(i) + + !---------------------------------- + ! COMPUTE SURFACE HEAT FLUX: + !---------------------------------- + HFX(I)=FLHC(I)*(THSK_lnd(I)-TH1D(I)) + HFX(I)=MAX(HFX(I),-250.) + HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) + ENDIF !TRANSFER COEFF FOR SOME LSMs: !CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) & @@ -1682,25 +1748,28 @@ SUBROUTINE SFCLAY1D_mynn( & 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) - !---------------------------------- - ! COMPUTE SURFACE MOISTURE FLUX: - !---------------------------------- - QFX(I)=FLQC(I)*(QSFCMR_ocn(I)-QV1D(I)) - QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX - LH(I)=XLV*QFX(I) - QFLX(i)=QFX(i)/RHO1D(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) + 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) + QFLX(i)=QFX(i)/RHO1D(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 + HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) ENDIF - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) !TRANSFER COEFF FOR SOME LSMs: !CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) & @@ -1722,20 +1791,23 @@ SUBROUTINE SFCLAY1D_mynn( & 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) - !---------------------------------- - ! COMPUTE SURFACE MOISTURE FLUX: - !---------------------------------- - QFX(I)=FLQC(I)*(QSFCMR_ice(I)-QV1D(I)) - QFX(I)=MAX(QFX(I),-0.02) !allows small neg QFX - LH(I)=XLF*QFX(I) - QFLX(i)=QFX(i)/RHO1D(i) - - !---------------------------------- - ! COMPUTE SURFACE HEAT FLUX: - !---------------------------------- - HFX(I)=FLHC(I)*(THSK_ice(I)-TH1D(I)) - HFX(I)=MAX(HFX(I),-250.) - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(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) + QFLX(i)=QFX(i)/RHO1D(i) + + !---------------------------------- + ! COMPUTE SURFACE HEAT FLUX: + !---------------------------------- + HFX(I)=FLHC(I)*(THSK_ice(I)-TH1D(I)) + HFX(I)=MAX(HFX(I),-250.) + HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) + ENDIF !TRANSFER COEFF FOR SOME LSMs: !CHS(I)=UST(I)*KARMAN/(ALOG(KARMAN*UST(I)*ZA(I) & @@ -1854,8 +1926,8 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF T2(I)=TH2(I)*(PSFCPA(I)/100000.)**ROVCP - Q2(I)=QSFCMR_lnd(I)+(QV1D(I)-QSFCMR_lnd(I))*PSIQ2_lnd(i)/PSIQ_lnd(i) - Q2(I)= MAX(Q2(I), MIN(QSFCMR_lnd(I), QV1D(I))) + Q2(I)=QSFC_lnd(I)+(QV1D(I)-QSFC_lnd(I))*PSIQ2_lnd(i)/PSIQ_lnd(i) + Q2(I)= MAX(Q2(I), MIN(QSFC_lnd(I), QV1D(I))) Q2(I)= MIN(Q2(I), 1.05*QV1D(I)) ELSEIF (wet(i)) THEN DTG=TH1D(I)-THSK_ocn(I) @@ -1868,8 +1940,8 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF T2(I)=TH2(I)*(PSFCPA(I)/100000.)**ROVCP - Q2(I)=QSFCMR_ocn(I)+(QV1D(I)-QSFCMR_ocn(I))*PSIQ2_ocn(i)/PSIQ_ocn(i) - Q2(I)= MAX(Q2(I), MIN(QSFCMR_ocn(I), QV1D(I))) + Q2(I)=QSFC_ocn(I)+(QV1D(I)-QSFC_ocn(I))*PSIQ2_ocn(i)/PSIQ_ocn(i) + Q2(I)= MAX(Q2(I), MIN(QSFC_ocn(I), QV1D(I))) Q2(I)= MIN(Q2(I), 1.05*QV1D(I)) ELSEIF (icy(i)) THEN DTG=TH1D(I)-THSK_ice(I) @@ -1882,8 +1954,8 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF T2(I)=TH2(I)*(PSFCPA(I)/100000.)**ROVCP - Q2(I)=QSFCMR_ice(I)+(QV1D(I)-QSFCMR_ice(I))*PSIQ2_ice(i)/PSIQ_ice(i) - Q2(I)= MAX(Q2(I), MIN(QSFCMR_ice(I), QV1D(I))) + Q2(I)=QSFC_ice(I)+(QV1D(I)-QSFC_ice(I))*PSIQ2_ice(i)/PSIQ_ice(i) + Q2(I)= MAX(Q2(I), MIN(QSFC_ice(I), QV1D(I))) Q2(I)= MIN(Q2(I), 1.05*QV1D(I)) ENDIF ENDDO @@ -1895,15 +1967,17 @@ SUBROUTINE SFCLAY1D_mynn( & IF ( debug_code == 2) THEN DO I=its,ite yesno = 0 - IF (HFX(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 + ENDIF + IF (LH(I) > 1200. .OR. LH(I) < -700.)THEN print*,"SUSPICIOUS VALUES IN MYNN SFCLAYER",& I,J, "LH: ",LH(I) yesno = 1 + ENDIF ENDIF IF (wet(i)) THEN IF (UST_ocn(I) < 0.0 .OR. UST_ocn(I) > 4.0 )THEN @@ -2608,9 +2682,9 @@ SUBROUTINE PSI_CB2005(psim1,psih1,zL,z0L) REAL, INTENT(IN) :: zL,z0L REAL, INTENT(OUT) :: psim1,psih1 - psim1 = -6.1*LOG(zL + (1.+ zL**2.5)**0.4) - & + 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) - & + psih1 = -5.5*log(zL + (1.+ zL**1.1)**0.90909090909) & -5.5*log(z0L + (1.+ z0L**1.1)**0.90909090909) return From afd6481120054a5531bdaa3a8ccbf24c884b7f88 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 1 Apr 2020 15:25:28 -0600 Subject: [PATCH 39/90] Compile physics/module_sf_mynn.F90 with -O1 instead of -O2 to avoid a bug with Intel 18 on hera; add a corresponding note in physics/module_sf_mynn.F90 --- CMakeLists.txt | 8 +++++--- physics/module_sf_mynn.F90 | 12 ++++++++---- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b8d3c3e18..8e6785c71 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -191,15 +191,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/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 2ac9d832c..73ef5e1fb 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -645,19 +645,19 @@ SUBROUTINE SFCLAY1D_mynn( & DO I=its,ite write(0,*)"=== imortant input to mynnsfclayer, i:", i IF (dry(i)) THEN - write(0,*)"dry=",dry(i)," tsk=", tskin_lnd(i),& + 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)," tsk=", tskin_ice(i),& + 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)," tsk=", tskin_ocn(i),& + 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) @@ -813,7 +813,11 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF DO I=its,ite - WSPD(I)=SQRT(U1D(I)*U1D(I)+V1D(I)*V1D(I)) + ! 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. From 680c365dbe4b660425b24198d743f4a7d6fa09e7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 16 Apr 2020 16:00:50 -0600 Subject: [PATCH 40/90] Remove code that does not belong to CCPP, minor formatting changes and updates to new tendency code --- physics/GFS_SCNV_generic.F90 | 12 +- physics/cu_gf_driver.F90 | 4 +- physics/model_tend_post.F90 | 87 --------- physics/model_tend_post.meta | 248 ------------------------- physics/model_tend_pre.F90 | 105 ----------- physics/model_tend_pre.meta | 279 ----------------------------- physics/module_MYNNPBL_wrapper.F90 | 40 ++--- physics/moninedmf.f | 3 +- physics/ozphys_2015.f | 1 - physics/satmedmfvdif.F | 1 - physics/total_tend.F90 | 93 ---------- physics/total_tend.meta | 215 ---------------------- 12 files changed, 30 insertions(+), 1058 deletions(-) delete mode 100644 physics/model_tend_post.F90 delete mode 100644 physics/model_tend_post.meta delete mode 100644 physics/model_tend_pre.F90 delete mode 100644 physics/model_tend_pre.meta delete mode 100644 physics/total_tend.F90 delete mode 100644 physics/total_tend.meta diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 82b0818fd..2b74c1837 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -35,7 +35,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, errmsg = '' errflg = 0 - save_fields: if (ldiag3d .and. flag_for_scnv_generic_tend) 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) @@ -50,7 +50,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, enddo enddo endif - endif save_fields + endif end subroutine GFS_SCNV_generic_pre_run @@ -114,7 +114,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl errmsg = '' errflg = 0 - update_cnvw_cnvc: if (imfshalcnv==imfshalcnv_sas .or. imfshalcnv==imfshalcnv_samf) then + if (imfshalcnv==imfshalcnv_sas .or. imfshalcnv==imfshalcnv_samf) then do i=1,im rainc(i) = rainc(i) + frain * rain1(i) enddo @@ -133,9 +133,9 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl enddo enddo endif - endif update_cnvw_cnvc + endif - diagtend: if (lssav .and. flag_for_scnv_generic_tend) then + if (lssav .and. flag_for_scnv_generic_tend) then if (ldiag3d) then do k=1,levs do i=1,im @@ -152,7 +152,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, cpl enddo endif endif - endif diagtend + endif ! if (cplchm) then do k=1,levs diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index ed3c73824..927b452cd 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -867,7 +867,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & ! Diagnostic tendency updates ! if(ldiag3d) then - if(.not.flag_for_scnv_generic_tend) 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 @@ -879,7 +879,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,ix,km,dt,cactiv, & enddo enddo endif - if(.not.flag_for_dcnv_generic_tend) then + 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 diff --git a/physics/model_tend_post.F90 b/physics/model_tend_post.F90 deleted file mode 100644 index 0ff43f9eb..000000000 --- a/physics/model_tend_post.F90 +++ /dev/null @@ -1,87 +0,0 @@ -!>\file model_tend_post.F90 -!! Calculates tendencies from all processes outside of CPPP - -module model_tend_post - -contains - - subroutine model_tend_post_init() - end subroutine model_tend_post_init - - subroutine model_tend_post_finalize() - end subroutine model_tend_post_finalize - - !> \section arg_table_model_tend_post_run Argument Table - !! \htmlinclude model_tend_post_run.html - !! - subroutine model_tend_post_run(kdt, & - gt0,gu0,gv0, gq0_water_vapor, & - t_start,u_start,v_start,q_start, & - t_end, u_end, v_end, q_end, & - dt3dt_ccpp, du3dt_ccpp, dv3dt_ccpp, dq3dt_ccpp, & - dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total, & - im, levs, ntrac, index_for_water_vapor, & - lssav, ldiag3d, qdiag3d, errmsg,errflg) - use machine, only: kind_phys - implicit none - - real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, gu0, gv0, gq0_water_vapor - real(kind=kind_phys), dimension(:,:), intent(in) :: t_start, u_start, v_start - real(kind=kind_phys), dimension(:,:), intent(in) :: q_start - real(kind=kind_phys), dimension(:,:), intent(inout) :: t_end, u_end, v_end - real(kind=kind_phys), dimension(:,:), intent(inout) :: q_end - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - dt3dt_ccpp,du3dt_ccpp,dv3dt_ccpp,dq3dt_ccpp, & - dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total - - integer, intent(in) :: im, levs, ntrac, kdt - integer, intent(in) :: index_for_water_vapor - - logical, intent(in) :: lssav, qdiag3d, ldiag3d - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - real(kind=kind_phys) :: dt, change - integer :: i,k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - diag_enabled: if(lssav .and. ldiag3d) then - do k=1,levs - do i=1,im - t_end(i,k) = gt0(i,k) - u_end(i,k) = gu0(i,k) - v_end(i,k) = gv0(i,k) - if(qdiag3d) then - q_end(i,k) = gq0_water_vapor(i,k) - endif - if(t_end(i,k)>1e-3 .and. t_start(i,k)>1e-3) then - change=t_end(i,k)-t_start(i,k) - dt3dt_ccpp(i,k) = dt3dt_ccpp(i,k) + change - !dt3dt_total(i,k) = dt3dt_total(i,k) + change - - change=u_end(i,k)-u_start(i,k) - du3dt_ccpp(i,k) = du3dt_ccpp(i,k) + change - !du3dt_total(i,k) = du3dt_total(i,k) + change - - change=v_end(i,k)-v_start(i,k) - dv3dt_ccpp(i,k) = dv3dt_ccpp(i,k) + change - !dv3dt_total(i,k) = dv3dt_total(i,k) + change - - if(qdiag3d) then - change=q_end(i,k)-q_start(i,k) - dq3dt_ccpp(i,k) = dq3dt_ccpp(i,k) + change - !dq3dt_total(i,k) = dq3dt_total(i,k) + change - endif - endif - enddo - enddo - - endif diag_enabled - - end subroutine model_tend_post_run - -end module model_tend_post diff --git a/physics/model_tend_post.meta b/physics/model_tend_post.meta deleted file mode 100644 index 8a730059f..000000000 --- a/physics/model_tend_post.meta +++ /dev/null @@ -1,248 +0,0 @@ -[ccpp-arg-table] - name = model_tend_post_init - type = scheme -[ccpp-arg-table] - name = model_tend_post_finalize - type = scheme -[ccpp-arg-table] - name = model_tend_post_run - type = scheme -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - 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 -[gu0] - standard_name = x_wind_updated_by_physics - long_name = zonal wind updated by physics - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[gv0] - standard_name = y_wind_updated_by_physics - long_name = meridional wind updated by physics - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[t_start] - standard_name = temperature_at_start_of_ccpp - long_name = temperature at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[u_start] - standard_name = x_wind_at_start_of_ccpp - long_name = x wind at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[v_start] - standard_name = y_wind_at_start_of_ccpp - long_name = y wind at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[q_start] - standard_name = water_vapor_specific_humidity_at_start_of_ccpp - long_name = water vapor specific humidity at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[t_end] - standard_name = temperature_at_end_of_ccpp - long_name = temperature at end of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[u_end] - standard_name = x_wind_at_end_of_ccpp - long_name = x wind at end of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[v_end] - standard_name = y_wind_at_end_of_ccpp - long_name = y wind at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[q_end] - standard_name = water_vapor_specific_humidity_at_end_of_ccpp - long_name = water vapor specific humidity at end of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dt3dt_ccpp] - standard_name = cumulative_change_in_temperature_from_ccpp - long_name = cumulative change in temperature from CCPP - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[du3dt_ccpp] - standard_name = cumulative_change_in_x_wind_from_ccpp - long_name = cumulative change in x wind from CCPP - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dv3dt_ccpp] - standard_name = cumulative_change_in_y_wind_from_ccpp - long_name = cumulative change in y wind from CCPP - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_ccpp] - standard_name = cumulative_change_in_water_vapor_specific_humidity_from_CCPP - long_name = cumulative change in water vapor specific humidity from CCPP - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dt3dt_total] - standard_name = cumulative_change_in_temperature - long_name = cumulative change in temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[du3dt_total] - standard_name = cumulative_change_in_x_wind - long_name = cumulative change in x wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dv3dt_total] - standard_name = cumulative_change_in_y_wind - long_name = cumulative change in y wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_total] - standard_name = cumulative_change_in_water_vapor_specific_humidity - long_name = cumulative change in water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[levs] - standard_name = vertical_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[index_for_water_vapor] - standard_name = index_for_water_vapor - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in -[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 -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - - - - - - - diff --git a/physics/model_tend_pre.F90 b/physics/model_tend_pre.F90 deleted file mode 100644 index f88b4d789..000000000 --- a/physics/model_tend_pre.F90 +++ /dev/null @@ -1,105 +0,0 @@ -!>\file model_tend_pre.F90 -!! Calculates tendencies from all processes outside of CPPP - -module model_tend_pre - -contains - -!> \section arg_table_model_tend_pre_init Argument Table -!! -subroutine model_tend_pre_init() -end subroutine model_tend_pre_init - -!> \section arg_table_model_tend_pre_finalize Argument Table -!! -subroutine model_tend_pre_finalize() -end subroutine model_tend_pre_finalize - -!> \section arg_table_model_tend_pre_run Argument Table -!! \htmlinclude model_tend_pre_run.html -!! - -subroutine model_tend_pre_run(dtp, kdt, & - tgrs,ugrs,vgrs,qvgrs, & - gt0,gu0,gv0, gq0_water_vapor, & - t_start,u_start,v_start,q_start, & - dt3dt_model,du3dt_model,dv3dt_model,dq3dt_model, & - dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total, & - t_end,u_end,v_end,q_end, & - im, levs, ntrac, & - lssav, ldiag3d, qdiag3d, errmsg,errflg) - use machine, only: kind_phys - implicit none - - real(kind=kind_phys), dimension(:,:), intent(in) :: tgrs, ugrs, vgrs, qvgrs - real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, gu0, gv0, gq0_water_vapor - real(kind=kind_phys), dimension(:,:), intent(out) :: t_start, u_start, v_start - real(kind=kind_phys), dimension(:,:), intent(out) :: q_start - real(kind=kind_phys), dimension(:,:), intent(out) :: t_end, u_end, v_end - real(kind=kind_phys), dimension(:,:), intent(out) :: q_end - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - dt3dt_model,du3dt_model,dv3dt_model,dq3dt_model, & - dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total - - integer, intent(in) :: im, levs, ntrac, kdt - - logical, intent(in) :: lssav, qdiag3d, ldiag3d - - real(kind=kind_phys) :: dtp, change - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - logical :: logical - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - print *,'in model_tend_pre_run' - - logical = .false. - - if(Lssav .and. ldiag3d) then - do k=1,levs - do i=1,im - ! t_start(i,k) = gt0(i,k) - ! u_start(i,k) = gu0(i,k) - ! v_start(i,k) = gv0(i,k) - ! if(qdiag3d) then - ! q_start(i,k) = gq0_water_vapor(i,k) - ! endif - t_start(i,k) = tgrs(i,k) - u_start(i,k) = ugrs(i,k) - v_start(i,k) = vgrs(i,k) - if(qdiag3d) then - q_start(i,k) = qvgrs(i,k) - endif - if(t_start(i,k)>1e-3 .and. t_end(i,k)>1e-3) then - if(t_end(i,k)/=t_start(i,k)) then - logical=.true. - change=t_start(i,k)-t_end(i,k) - dt3dt_model(i,k) = dt3dt_model(i,k) + change - !dt3dt_total(i,k) = dt3dt_total(i,k) + change - - change=u_start(i,k)-u_end(i,k) - du3dt_model(i,k) = du3dt_model(i,k) + change - !du3dt_total(i,k) = du3dt_total(i,k) + change - - change=v_start(i,k)-v_end(i,k) - dv3dt_model(i,k) = dv3dt_model(i,k) + change - !dv3dt_total(i,k) = dv3dt_total(i,k) + change - - if(qdiag3d) then - change=q_start(i,k)-q_end(i,k) - dq3dt_model(i,k) = dq3dt_model(i,k) + change - !dq3dt_total(i,k) = dq3dt_total(i,k) + change - endif - endif - endif - enddo - enddo - endif -end subroutine model_tend_pre_run - -end module model_tend_pre diff --git a/physics/model_tend_pre.meta b/physics/model_tend_pre.meta deleted file mode 100644 index 7ec047161..000000000 --- a/physics/model_tend_pre.meta +++ /dev/null @@ -1,279 +0,0 @@ -[ccpp-arg-table] - name = model_tend_pre_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = model_tend_pre_finalize - type = scheme - -######################################################################## -[ccpp-arg-table] - name = model_tend_pre_run - type = scheme -[dtp] - standard_name = time_step_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - 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 -[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 -[ugrs] - standard_name = x_wind - long_name = zonal wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[vgrs] - standard_name = y_wind - long_name = meridional wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[qvgrs] - 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 -[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 -[gu0] - standard_name = x_wind_updated_by_physics - long_name = zonal wind updated by physics - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[gv0] - standard_name = y_wind_updated_by_physics - long_name = meridional wind updated by physics - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[t_start] - standard_name = temperature_at_start_of_ccpp - long_name = temperature at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out -[u_start] - standard_name = x_wind_at_start_of_ccpp - long_name = x wind at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out -[v_start] - standard_name = y_wind_at_start_of_ccpp - long_name = y wind at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out -[q_start] - standard_name = water_vapor_specific_humidity_at_start_of_ccpp - long_name = water vapor specific humidity at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out -[dt3dt_model] - standard_name = cumulative_change_in_temperature_from_model - long_name = cumulative change in temperature from model - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[du3dt_model] - standard_name = cumulative_change_in_x_wind_from_model - long_name = cumulative change in x wind from model - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dv3dt_model] - standard_name = cumulative_change_in_y_wind_from_model - long_name = cumulative change in y wind from model - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_model] - standard_name = cumulative_change_in_water_vapor_specific_humidity_from_model - long_name = cumulative change in water vapor specific humidity from model - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dt3dt_total] - standard_name = cumulative_change_in_temperature - long_name = cumulative change in temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[du3dt_total] - standard_name = cumulative_change_in_x_wind - long_name = cumulative change in x wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dv3dt_total] - standard_name = cumulative_change_in_y_wind - long_name = cumulative change in y wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_total] - standard_name = cumulative_change_in_water_vapor_specific_humidity - long_name = cumulative change in water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[t_end] - standard_name = temperature_at_end_of_ccpp - long_name = temperature at end of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[u_end] - standard_name = x_wind_at_end_of_ccpp - long_name = x wind at end of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[v_end] - standard_name = y_wind_at_end_of_ccpp - long_name = y wind at start of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[q_end] - standard_name = water_vapor_specific_humidity_at_end_of_ccpp - long_name = water vapor specific humidity at end of ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[levs] - standard_name = vertical_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[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 -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 471c99f50..2065c2844 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -287,7 +287,7 @@ SUBROUTINE mynnedmf_wrapper_run( & endif ! Assign variables for each microphysics scheme - init_if_imp_physics: if (imp_physics == imp_physics_wsm6) then + if (imp_physics == imp_physics_wsm6) then ! WSM6 FLAG_QI = .true. FLAG_QNI= .false. @@ -316,7 +316,7 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo elseif (imp_physics == imp_physics_thompson) then ! Thompson - tmp_init_if_aer: if(ltaerosol) then + if(ltaerosol) then FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. @@ -368,7 +368,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qnifa(i,k) = 0. enddo enddo - endif tmp_init_if_aer + endif elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP FLAG_QI = .true. @@ -422,7 +422,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qnifa(i,k) = 0. enddo enddo - endif init_if_imp_physics + endif if (lprnt)write(0,*)"prepping MYNN-EDMF variables..." @@ -438,7 +438,7 @@ SUBROUTINE mynnedmf_wrapper_run( & pattern_spp_pbl(i,k)=0.0 enddo enddo - big_init_i_loop: do i=1,im + 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 @@ -481,9 +481,9 @@ SUBROUTINE mynnedmf_wrapper_run( & ! qsfc(i)=qss(i) ! ps(i)=pgr(i) ! wspd(i)=wind(i) - enddo big_init_i_loop + enddo - lprnt_before: if (lprnt) then + if (lprnt) then print* write(0,*)"===CALLING mynn_bl_driver; input:" print*,"bl_mynn_tkebudget=",bl_mynn_tkebudget," bl_mynn_tkeadvect=",bl_mynn_tkeadvect @@ -520,7 +520,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"exch_h:",exch_h(1,1),exch_h(1,2),exch_h(1,levs) ! - intent(out) !print*,"exch_m:",exch_m(1,1),exch_m(1,2),exch_m(1,levs) ! - intent(out) print*,"max cf_bl:",maxval(cldfra_bl(1,:)) - endif lprnt_before + endif CALL mynn_bl_driver( & @@ -623,7 +623,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !enddo !DO moist/scalar/tracer tendencies: - if_imp_physics: if (imp_physics == imp_physics_wsm6) then + if (imp_physics == imp_physics_wsm6) then ! WSM6 do k=1,levs do i=1,im @@ -651,8 +651,8 @@ SUBROUTINE mynnedmf_wrapper_run( & !enddo elseif (imp_physics == imp_physics_thompson) then ! Thompson-Aerosol - thmp_if_ltaerosol: if(ltaerosol) then - thmp_aer_tend: do k=1,levs + 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)) @@ -663,7 +663,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) enddo - enddo thmp_aer_tend + enddo if(lssav .and. ldiag3d .and. qdiag3d) then do k=1,levs do i=1,im @@ -685,7 +685,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !enddo else !Thompson (2008) - thmp_noaer_tend: do k=1,levs + 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)) @@ -693,7 +693,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) !dqdt_ozone(i,k) = 0.0 enddo - enddo thmp_noaer_tend + enddo if(lssav .and. ldiag3d .and. qdiag3d) then do k=1,levs do i=1,im @@ -710,10 +710,10 @@ SUBROUTINE mynnedmf_wrapper_run( & ! !dqdt_ozone(i,k) = 0.0 ! enddo !enddo - endif thmp_if_ltaerosol !end thompson choice + endif !end thompson choice elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP - gfdl_mp_tend: do k=1,levs + 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)) @@ -723,7 +723,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !dqdt_graupel(i,k) = 0.0 !dqdt_ozone(i,k) = 0.0 enddo - enddo gfdl_mp_tend + enddo if(lssav .and. ldiag3d .and. qdiag3d) then do k=1,levs do i=1,im @@ -759,9 +759,9 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo endif - endif if_imp_physics + endif - lprnt_after: if (lprnt) then + if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" print*,"T:",t3d(1,1),t3d(1,2),t3d(1,levs) @@ -800,7 +800,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"ktop_shallow:",ktop_shallow(1)," maxmf:",maxmf(1) print*,"nup:",nupdraft(1) print* - endif lprnt_after +s endif END SUBROUTINE mynnedmf_wrapper_run diff --git a/physics/moninedmf.f b/physics/moninedmf.f index bfe8d512f..50400ee04 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -87,7 +87,8 @@ 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) - real(kind=kind_phys), intent(inout), dimension(ix,km) :: & + ! 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), & diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index 766cfdd62..a42c74bfc 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -167,7 +167,6 @@ subroutine ozphys_2015_run ( & 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 -!!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) diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 64d2c4517..f17aaa35c 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -1509,7 +1509,6 @@ subroutine satmedmfvdif_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo enddo - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> -# Save PBL height for diagnostic purpose diff --git a/physics/total_tend.F90 b/physics/total_tend.F90 deleted file mode 100644 index 24d5c92ef..000000000 --- a/physics/total_tend.F90 +++ /dev/null @@ -1,93 +0,0 @@ -!>\file total_tend.F90 -!! Calculates tendencies from all processes outside of CPPP - -module total_tend - -contains - -!> \section arg_table_total_tend_init Argument Table -!! -subroutine total_tend_init() -end subroutine total_tend_init - -!> \section arg_table_total_tend_finalize Argument Table -!! -subroutine total_tend_finalize() -end subroutine total_tend_finalize - -!> \section arg_table_total_tend_run Argument Table -!! \htmlinclude total_tend_run.html -!! -subroutine total_tend_run(dtp, kdt, & - tgrs,ugrs,vgrs,qvgrs, t_start,u_start,v_start,q_start, & - dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total, & - gt0,gu0,gv0, gq0_water_vapor, & - im, levs, ntrac, & - lssav, ldiag3d, qdiag3d, errmsg,errflg) - use machine, only: kind_phys - implicit none - - real(kind=kind_phys), dimension(:,:), intent(in) :: gt0, gu0, gv0, gq0_water_vapor - real(kind=kind_phys), dimension(:,:), intent(in) :: tgrs, ugrs, vgrs, qvgrs - real(kind=kind_phys), dimension(:,:), intent(out) :: t_start, u_start, v_start - real(kind=kind_phys), dimension(:,:), intent(out) :: q_start - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - dt3dt_total,du3dt_total,dv3dt_total,dq3dt_total - - integer, intent(in) :: im, levs, ntrac, kdt - - logical, intent(in) :: lssav, qdiag3d, ldiag3d - - real(kind=kind_phys) :: dtp - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: i, k, good - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - good=0 - - if(Lssav .and. ldiag3d) then - do k=1,levs - do i=1,im - if(t_start(i,k)>1e-3 .and. gt0(i,k)>1e-3) then - good=good+1 - dt3dt_total(i,k) = dt3dt_total(i,k) + (gt0(i,k)-t_start(i,k)) - du3dt_total(i,k) = du3dt_total(i,k) + (gu0(i,k)-u_start(i,k)) - dv3dt_total(i,k) = dv3dt_total(i,k) + (gv0(i,k)-v_start(i,k)) - if(qdiag3d) then - dq3dt_total(i,k) = dq3dt_total(i,k) + (gq0_water_vapor(i,k)-q_start(i,k)) - endif - endif - t_start(i,k)=gt0(i,k) - u_start(i,k)=gu0(i,k) - v_start(i,k)=gv0(i,k) - if(qdiag3d) then - q_start(i,k)=gq0_water_vapor(i,k) - endif - ! Alternative is to use the state in: - ! if(t_start(i,k)>1e-3 .and. tgrs(i,k)>1e-3) then - ! good=good+1 - ! dt3dt_total(i,k) = dt3dt_total(i,k) + (tgrs(i,k)-t_start(i,k)) - ! du3dt_total(i,k) = du3dt_total(i,k) + (ugrs(i,k)-u_start(i,k)) - ! dv3dt_total(i,k) = dv3dt_total(i,k) + (vgrs(i,k)-v_start(i,k)) - ! if(qdiag3d) then - ! dq3dt_total(i,k) = dq3dt_total(i,k) + (qvgrs(i,k)-q_start(i,k)) - ! endif - ! endif - ! t_start(i,k)=tgrs(i,k) - ! u_start(i,k)=ugrs(i,k) - ! v_start(i,k)=vgrs(i,k) - ! if(qdiag3d) then - ! q_start(i,k)=qvgrs(i,k) - ! endif - enddo - enddo - endif -end subroutine total_tend_run - -end module total_tend diff --git a/physics/total_tend.meta b/physics/total_tend.meta deleted file mode 100644 index 82e49a081..000000000 --- a/physics/total_tend.meta +++ /dev/null @@ -1,215 +0,0 @@ -[ccpp-arg-table] - name = total_tend_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = total_tend_finalize - type = scheme - -######################################################################## -[ccpp-arg-table] - name = total_tend_run - type = scheme -[dtp] - standard_name = time_step_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - 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 -[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 -[ugrs] - standard_name = x_wind - long_name = zonal wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[vgrs] - standard_name = y_wind - long_name = meridional wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[qvgrs] - 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 -[t_start] - standard_name = temperature_at_total_check_point - long_name = temperature when model total is calculated in ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[u_start] - standard_name = x_wind_at_total_check_point - long_name = x when model total is calculated in ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[v_start] - standard_name = y_wind_at_total_check_point - long_name = y when model total is calculated in ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[q_start] - standard_name = water_vapor_specific_humidity_at_total_check_point - long_name = water vapor specific humidity when model total is calculated in ccpp - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dt3dt_total] - standard_name = cumulative_change_in_temperature - long_name = cumulative change in temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[du3dt_total] - standard_name = cumulative_change_in_x_wind - long_name = cumulative change in x wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dv3dt_total] - standard_name = cumulative_change_in_y_wind - long_name = cumulative change in y wind - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[dq3dt_total] - standard_name = cumulative_change_in_water_vapor_specific_humidity - long_name = cumulative change in water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout -[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 -[gu0] - standard_name = x_wind_updated_by_physics - long_name = zonal wind updated by physics - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[gv0] - standard_name = y_wind_updated_by_physics - long_name = meridional wind updated by physics - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[levs] - standard_name = vertical_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[ntrac] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in -[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 -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out From 5e990730cbd83250e5fd6cc1853a38557a18aec7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 16 Apr 2020 17:10:05 -0600 Subject: [PATCH 41/90] Update standard names as per code review --- physics/GFS_DCNV_generic.meta | 2 +- physics/GFS_GWD_generic.meta | 4 ++-- physics/GFS_PBL_generic.meta | 2 +- physics/GFS_SCNV_generic.meta | 12 ++++++------ physics/GFS_suite_interstitial.meta | 2 +- physics/cires_ugwp.meta | 2 +- physics/cu_gf_driver.meta | 12 ++++++------ physics/moninedmf.meta | 2 +- 8 files changed, 19 insertions(+), 19 deletions(-) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 983d6ad94..1e4a59a77 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -562,7 +562,7 @@ intent = inout optional = F [flag_for_dcnv_generic_tend] - standard_name = true_if_GFS_DCNV_generic_should_calculate_tendencies + standard_name = flag_for_generic_deep_convection_tendency long_name = true if GFS_DCNV_generic should calculate tendencies units = flag dimensions = () diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 13a0d7b49..b31393546 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -178,7 +178,7 @@ intent = in optional = F [flag_for_gwd_generic_tend] - standard_name = true_if_GFS_GWD_generic_should_calculate_tendencies + standard_name = flag_for_generic_gravity_wave_drag_tendency long_name = true if GFS_GWD_generic should calculate tendencies units = flag dimensions = () @@ -327,7 +327,7 @@ intent = inout optional = F [flag_for_gwd_generic_tend] - standard_name = true_if_GFS_GWD_generic_should_calculate_tendencies + standard_name = flag_for_generic_gravity_wave_drag_tendency long_name = true if GFS_GWD_generic should calculate tendencies units = flag dimensions = () diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 54c661125..57a1163a2 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -682,7 +682,7 @@ intent = in optional = F [flag_for_pbl_generic_tend] - standard_name = true_if_GFS_PBL_generic_should_calculate_tendencies + standard_name = flag_for_generic_planetary_boundary_layer_tendency long_name = true if GFS_PBL_generic should calculate tendencies units = flag dimensions = () diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index f1312bfc6..702fe6df0 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -104,7 +104,7 @@ intent = inout optional = F [flag_for_scnv_generic_tend] - standard_name = true_if_GFS_SCNV_generic_should_calculate_tendencies + standard_name = flag_for_generic_shallow_convection_tendency long_name = true if GFS_SCNV_generic should calculate tendencies units = flag dimensions = () @@ -277,7 +277,7 @@ intent = inout optional = F [du3dt] - standard_name = cumulative_change_in_x_wind_due_to_shal_convection + 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) @@ -285,7 +285,7 @@ kind = kind_phys intent = inout [dv3dt] - standard_name = cumulative_change_in_y_wind_due_to_shal_convection + 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) @@ -293,7 +293,7 @@ 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) @@ -302,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) @@ -424,7 +424,7 @@ intent = inout optional = F [flag_for_scnv_generic_tend] - standard_name = true_if_GFS_SCNV_generic_should_calculate_tendencies + standard_name = flag_for_generic_shallow_convection_tendency long_name = true if GFS_SCNV_generic should calculate tendencies units = flag dimensions = () diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 86e21f0a9..c48f93c68 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) diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 6720bd7c7..5d5e0dd1a 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -912,7 +912,7 @@ type = logical intent = in [flag_for_gwd_generic_tend] - standard_name = true_if_GFS_GWD_generic_should_calculate_tendencies + standard_name = flag_for_generic_gravity_wave_drag_tendency long_name = true if GFS_GWD_generic should calculate tendencies units = flag dimensions = () diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index e896c7fa6..99e6ca650 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -359,21 +359,21 @@ intent = in optional = F [flag_for_scnv_generic_tend] - standard_name = true_if_GFS_SCNV_generic_should_calculate_tendencies + 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 = true_if_GFS_DCNV_generic_should_calculate_tendencies + 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_shal_convection + 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) @@ -381,7 +381,7 @@ kind = kind_phys intent = inout [dv3dt_SCNV] - standard_name = cumulative_change_in_y_wind_due_to_shal_convection + 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) @@ -389,7 +389,7 @@ kind = kind_phys intent = inout [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 shallow convection units = K dimensions = (horizontal_dimension,vertical_dimension) @@ -397,7 +397,7 @@ kind = kind_phys intent = inout [dq3dt_SCNV] - 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 shallow convection units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 6a923d36b..706ac9a0f 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -576,7 +576,7 @@ kind = kind_phys intent = inout [flag_for_pbl_generic_tend] - standard_name = true_if_GFS_PBL_generic_should_calculate_tendencies + standard_name = flag_for_generic_planetary_boundary_layer_tendency long_name = true if GFS_PBL_generic should calculate tendencies units = flag dimensions = () From 8d9b7991a94ead20595b4d8cb0627aab9df2daad Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 17 Apr 2020 14:40:19 +0000 Subject: [PATCH 42/90] Updating MYNN-EDMF part I: ccpp-physics part --- physics/GFS_debug.F90 | 2 +- physics/module_MYNNPBL_wrapper.F90 | 127 +- physics/module_MYNNPBL_wrapper.meta | 71 +- physics/module_SGSCloud_RadPre.F90 | 40 +- physics/module_SGSCloud_RadPre.meta | 13 +- physics/module_bl_mynn.F90 | 1656 +++++++++++++++++---------- 6 files changed, 1206 insertions(+), 703 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 3bb50d9ef..b99529cc5 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -356,7 +356,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Diag%edmf_qc ', Diag%edmf_qc) 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/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 36c9e55de..320585f15 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -24,7 +24,7 @@ end subroutine mynnedmf_wrapper_finalize #endif SUBROUTINE mynnedmf_wrapper_run( & & ix,im,levs, & - & flag_init,flag_restart, & + & flag_init,flag_restart,cycling, & & lssav, ldiag3d, lsidea, & & delt,dtf,dx,zorl, & & phii,u,v,omega,t3d, & @@ -46,10 +46,11 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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, & & RTHRATEN, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & @@ -62,6 +63,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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, & @@ -157,7 +159,7 @@ SUBROUTINE mynnedmf_wrapper_run( & LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea ! 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, & @@ -169,6 +171,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 @@ -206,10 +209,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, & @@ -230,8 +235,8 @@ SUBROUTINE mynnedmf_wrapper_run( & 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, & @@ -256,7 +261,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & dtsfci_diag,dqsfci_diag,dtsfc_diag,dqsfc_diag, & & maxMF integer, dimension(im), intent(inout) :: & - & kpbl,nupdraft,ktop_shallow + & kpbl,nupdraft,ktop_plume !LOCAL real, dimension(im) :: & @@ -302,9 +307,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. @@ -330,9 +335,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) @@ -356,9 +361,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) @@ -384,9 +389,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) = 0. qnwfa(i,k) = 0. @@ -411,9 +416,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) = 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. @@ -428,9 +433,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 @@ -498,9 +504,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) @@ -511,7 +517,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) @@ -523,17 +529,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, & @@ -544,7 +550,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 @@ -555,17 +561,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=RTHRATEN & !input & ,FLAG_QI=flag_qi,FLAG_QNI=flag_qni & !input @@ -605,9 +614,9 @@ 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 @@ -625,10 +634,10 @@ 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) @@ -651,9 +660,9 @@ 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 @@ -672,9 +681,9 @@ 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 @@ -693,8 +702,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 @@ -736,9 +745,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) @@ -749,7 +758,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) @@ -761,7 +770,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 61a9ccb70..2e267b059 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -41,6 +41,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 @@ -488,8 +496,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 +576,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 +629,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 @@ -852,6 +905,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_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index 544fe1004..e78941d81 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -40,7 +40,7 @@ subroutine sgscloud_radpre_run( & qci_conv, & imfdeepcnv, imfdeepcnv_gf, & qc_save, qi_save, & - qc_bl,cldfra_bl, & + qc_bl,qi_bl,cldfra_bl, & delp,clouds1,clouds2,clouds3, & clouds4,clouds5,slmsk, & nlay, plyr, xlat, dz,de_lgth, & @@ -67,7 +67,7 @@ subroutine sgscloud_radpre_run( & 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, cldfra_bl + 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 @@ -104,7 +104,8 @@ subroutine sgscloud_radpre_run( & end do end do - ! add boundary layer clouds + ! add boundary layer clouds - Note: now the temperature-dependent sorting of + ! ice and water subgrid-scale clouds is done inside the MYNN-EDMF if (do_mynnedmf) then do k = 1, levs do i = 1, im @@ -116,33 +117,30 @@ subroutine sgscloud_radpre_run( & ! clouds1(i,k) = cldfra_bl(i,k) !endif - 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)-244.)/25.)))*cldfra_bl(i,k) - qi(i,k) = qc_bl(i,k)*(1. - min(1., max(0., (T3D(i,k)-244.)/25.)))*cldfra_bl(i,k) + 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 - 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) + !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 - !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 - !calculate water and ice paths for additional BL clouds - clouds2(i,k) = max(0.0, qc(i,k) * gfac * delp(i,k)) + !calculate the ice water path using additional BL clouds clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) endif diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 507f4ba91..f8da4b262 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -140,8 +140,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 = 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 diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index e472a2873..4c1468797 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- @@ -450,12 +467,14 @@ 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, DIMENSION(kts:kte), INTENT(in) :: dz @@ -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,7 +539,7 @@ SUBROUTINE mym_initialize ( & ! ! ** Initialization with an iterative manner ** ! ** lmax is the iteration count. This is arbitrary. ** - lmax = 5 + lmax = 5 ! DO l = 1,lmax ! @@ -522,7 +549,7 @@ SUBROUTINE mym_initialize ( & & dz, 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) @@ -760,7 +794,7 @@ SUBROUTINE mym_length ( & & dz, zw, & & rmo, flt, flq, & & vt, vq, & - & qke, & + & u1, v1, qke, & & dtv, & & el, & & zi,theta, & @@ -780,7 +814,7 @@ SUBROUTINE mym_length ( & 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, 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 + 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 @@ -1598,7 +1635,7 @@ SUBROUTINE mym_turbulence ( & & dz, zw, & & rmo, flt, flq, & & vt, vq, & - & qke, & + & u, v, qke, & & dtv, & & el, & & zi,theta, & @@ -1996,7 +2033,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 +2398,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 +2420,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 +2443,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 +2499,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 +2512,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 +2558,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 +2565,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 +2574,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 +2628,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 +2667,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 +2682,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(0.9*q1k-2.6) + !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 @@ -2751,33 +2789,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 +2812,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 +2844,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, & @@ -2863,17 +2893,19 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! 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,7 +2914,7 @@ 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 + qnwfa2,qnifa2,ozone2 REAL, DIMENSION(kts:kte) :: zfac,plumeKh REAL, DIMENSION(kts:kte) :: a,b,c,d,x REAL, DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface @@ -2940,7 +2972,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & 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 + 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 !JOE - tend test ! a(k)=0. @@ -2953,7 +2986,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & 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 + 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 @@ -2992,7 +3026,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & 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 !JOE - tend test ! a(k)=0. @@ -3005,7 +3040,8 @@ SUBROUTINE mynn_tendencies(kts,kte, & 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 + 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 @@ -3040,18 +3076,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)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)/rho(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)/rho(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)/rho(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 +3129,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 +3147,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)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)/rho(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)/rho(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)/rho(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 +3192,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 +3211,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)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)/rho(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)/rho(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)/rho(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 +3248,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 +3268,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)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - 0.5*dtz(k)*s_aw(k+1) + c(k)= -dtz(k)*khdz(k+1)/rho(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)/rho(k) + 0.5*dtz(k)*s_aw(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + & + & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) + c(k)= -dtz(k)*khdz(k+1)/rho(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 +3318,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 +3335,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)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) + c(k)= -dtz(k)*khdz(k+1)/rho(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)/rho(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + c(k)= -dtz(k)*khdz(k+1)/rho(k) + d(k)=sqi(k) ENDDO !! no flux at the top @@ -3263,7 +3380,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) @@ -3437,6 +3555,39 @@ SUBROUTINE mynn_tendencies(kts,kte, & qnifa2=qnifa ENDIF +!============================================ +! Ozone - local mixing only +!============================================ + + k=kts + +!rho-weighted: + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) + c(k)= -dtz(k)*khdz(k+1)/rho(k) + d(k)=ozone(k) + + DO k=kts+1,kte-1 + a(k)= -dtz(k)*khdz(k)/rho(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) + c(k)= -dtz(k)*khdz(k+1)/rho(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 +3627,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 +3641,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 +3674,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 +3720,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 +3999,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 +4020,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 +4029,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 +4051,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 +4096,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 +4120,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 +4132,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 +4149,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 +4167,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 +4207,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 +4242,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 @@ -4091,8 +4266,22 @@ SUBROUTINE mynn_bl_driver( & !! 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 + + !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. @@ -4108,7 +4297,9 @@ SUBROUTINE mynn_bl_driver( & dqnc1(kts:kte)=0.0 dqnwfa1(kts:kte)=0.0 dqnifa1(kts:kte)=0.0 + dozone1(kts:kte)=0.0 qc_bl1D(kts:kte)=0.0 + qi_bl1D(kts:kte)=0.0 cldfra_bl1D(kts:kte)=0.0 qc_bl1D_old(kts:kte)=0.0 cldfra_bl1D_old(kts:kte)=0.0 @@ -4152,11 +4343,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 +4361,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 +4378,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 +4395,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) @@ -4247,6 +4446,7 @@ SUBROUTINE mynn_bl_driver( & &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 +4495,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 +4510,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 +4532,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 +4550,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 +4583,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 +4619,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 +4701,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 +4752,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 +4812,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,120.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 +4858,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, & @@ -4659,16 +4883,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 & ) @@ -4707,7 +4936,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 +4948,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 +4957,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 +5013,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 +5030,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 +5067,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 +5121,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 +5164,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 +5185,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 +5209,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 +5273,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 +5311,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 +5340,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 +5368,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 +5424,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 +5485,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 +5502,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 +5546,41 @@ 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. + !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 +5644,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 +5679,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 +5699,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 +5721,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 +5769,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 +5795,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 +5819,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 +5871,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.31/(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 +5901,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 +5966,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 +5984,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.064/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), .0004) ! 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*dzp + 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*dzp + 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*dzp + ENDIF + envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*dzp + envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*dzp + 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 +6088,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 +6110,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 +6140,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 +6182,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 +6202,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 +6224,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 > 1) 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) @@ -5973,13 +6378,34 @@ SUBROUTINE DMP_mf( & 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 + !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 ENDIF @@ -6001,8 +6427,8 @@ SUBROUTINE DMP_mf( & 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 +6440,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 +6519,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 +6573,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 +6584,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.)) From 43f107ca315d9c021d2cebdd035e931638a36e53 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 17 Apr 2020 16:58:07 -0600 Subject: [PATCH 43/90] Add new CCPP scheme phys_tend to sum up all physics tendencies --- physics/module_MYNNPBL_wrapper.F90 | 2 +- physics/phys_tend.F90 | 99 ++++++++ physics/phys_tend.meta | 351 +++++++++++++++++++++++++++++ 3 files changed, 451 insertions(+), 1 deletion(-) create mode 100644 physics/phys_tend.F90 create mode 100644 physics/phys_tend.meta diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 2065c2844..942759bda 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -800,7 +800,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"ktop_shallow:",ktop_shallow(1)," maxmf:",maxmf(1) print*,"nup:",nupdraft(1) print* -s endif + endif END SUBROUTINE mynnedmf_wrapper_run 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 From 0ef2dbac3fcbffc0d5d05d1b0a9b3d0439054f91 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Mon, 20 Apr 2020 18:26:22 +0000 Subject: [PATCH 44/90] tweak update: (1) slightly reduce high RH bias at 700 mb, (2) allow subsidence to impact momentum whenever bl_mynn_edmf_mom > 0 --- physics/module_bl_mynn.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 4c1468797..2922ee807 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -6016,7 +6016,7 @@ SUBROUTINE DMP_mf( & !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.064/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate + 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), .0004) ! 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*dzp @@ -6276,7 +6276,7 @@ SUBROUTINE DMP_mf( & det_sqv(k)=Cdet*(envm_sqv(k)-qv(k))*envi_a(k)*Psig_w det_sqc(k)=Cdet*(envm_sqc(k)-qc(k))*envi_a(k)*Psig_w ENDDO - IF (momentum_opt > 1) THEN + 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 From 8056b688022d6cf1fb2b607722561c31976ebd2f Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Tue, 21 Apr 2020 14:28:01 +0000 Subject: [PATCH 45/90] Bug fix: (1) ambiguous conditional for defining Fng, (2) alleviate excessive detrainment problem for coarse vertical resolution. --- physics/module_bl_mynn.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 2922ee807..20a169c3a 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -2770,9 +2770,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.) @@ -6017,21 +6017,21 @@ SUBROUTINE DMP_mf( & 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), .0004) ! dynamical detrainment rate (m^-1) + detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0003) ! 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*dzp + envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*MIN(dzp,300.) 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*dzp + envm_sqv(k)=envm_sqv(k) + (qv_ent-QV(K))*detrate*aratio*MIN(dzp,300.) 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*dzp + 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,300.) ENDIF - envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*dzp - envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*dzp + envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*MIN(dzp,300.) + envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*MIN(dzp,300.) IF (Wn > 0.) THEN !Update plume variables at current k index @@ -6419,9 +6419,9 @@ 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.) From d7bcc47963c3bb4fa7483ad29345b5a5208d4ab2 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Wed, 22 Apr 2020 18:45:33 +0000 Subject: [PATCH 46/90] Bug fixes for uninitialized variables... --- physics/module_bl_mynn.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 20a169c3a..73a101a3f 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -6017,7 +6017,7 @@ SUBROUTINE DMP_mf( & 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), .0003) ! dynamical detrainment rate (m^-1) + 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,300.) qv_ent = 0.5*(MAX(qt_ent-qc_ent,0.) + MAX(UPQT(K-1,I)-UPQC(K-1,I),0.)) @@ -6403,10 +6403,13 @@ SUBROUTINE DMP_mf( & 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: From 531d5577436abfd49801d5b4ade9f1ec9a8907d9 Mon Sep 17 00:00:00 2001 From: Xiaqiong Zhou Date: Tue, 28 Apr 2020 14:56:47 +0000 Subject: [PATCH 47/90] Fixes to run the CCPP multi_gases option with 32 bit --- physics/multi_gases.F90 | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) 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 From d0c9248747a48f4634f8af5e0fba7993b2e124e5 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Tue, 28 Apr 2020 16:31:11 +0000 Subject: [PATCH 48/90] bug fix for restart applications --- physics/module_bl_mynn.F90 | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 73a101a3f..6be141d9c 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -4265,7 +4265,7 @@ 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 @@ -4290,6 +4290,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 @@ -4298,9 +4302,6 @@ SUBROUTINE mynn_bl_driver( & dqnwfa1(kts:kte)=0.0 dqnifa1(kts:kte)=0.0 dozone1(kts:kte)=0.0 - qc_bl1D(kts:kte)=0.0 - qi_bl1D(kts:kte)=0.0 - cldfra_bl1D(kts:kte)=0.0 qc_bl1D_old(kts:kte)=0.0 cldfra_bl1D_old(kts:kte)=0.0 edmf_a1(kts:kte)=0.0 @@ -5575,6 +5576,7 @@ SUBROUTINE DMP_mf( & 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 @@ -6019,19 +6021,19 @@ SUBROUTINE DMP_mf( & 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,300.) + 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,300.) + 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,300.) + 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,300.) - envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*MIN(dzp,300.) + 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 @@ -6362,6 +6364,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) @@ -6373,7 +6376,7 @@ 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 From 3826fd9ea16756ee768ed3a8809cd3ad3e82c507 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Fri, 1 May 2020 22:13:16 +0000 Subject: [PATCH 49/90] Updated GSL orographic drag suite to enable use of custom orographic statistics static files --- physics/GFS_GWD_generic.F90 | 27 +++++++++++++++-- physics/GFS_GWD_generic.meta | 45 ++++++++++++++++++++++++++++ physics/drag_suite.F90 | 57 +++++++++++++++++++++--------------- physics/drag_suite.meta | 36 +++++++++++++++++++++++ 4 files changed, 139 insertions(+), 26 deletions(-) diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 963269329..7d3f86b00 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -17,7 +17,8 @@ end subroutine GFS_GWD_generic_pre_init !! @{ subroutine GFS_GWD_generic_pre_run( & & im, levs, nmtvr, mntvar, & - & oc, oa4, clx, theta, & + & var, oc, oa4, clx, theta, & + & varss, ocss, oa4ss, clxss, & & sigma, gamma, elvmax, lssav, ldiag3d, & & dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, & & flag_for_gwd_generic_tend, errmsg, errflg) @@ -29,7 +30,8 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) real(kind=kind_phys), intent(out) :: & - & oc(im), oa4(im,4), clx(im,4), & + & var(im), oc(im), oa4(im,4), clx(im,4), & + & varss(im), ocss(im), oa4ss(im,4), clxss(im,4), & & theta(im), sigma(im), gamma(im), elvmax(im) logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend @@ -81,6 +83,27 @@ 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 + var(:) = mntvar(:,1) + 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 diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index b31393546..78f2e742d 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -39,6 +39,15 @@ kind = kind_phys intent = in optional = F +[var] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [oc] standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography @@ -66,6 +75,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 diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 080bee156..0eb1f3b5f 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -196,8 +196,8 @@ end subroutine drag_suite_init subroutine drag_suite_run( & & IM,IX,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, & @@ -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,16 @@ subroutine drag_suite_run( & errmsg = '' errflg = 0 -if (me==master) print *,"Running drag suite" + +! Temporary line +!if (me==master) then +! print *, "Ahoj svete!: In drag suite -- cdmbgwd =", cdmbgwd(:) +! print *, "imx =", imx, " dx =", dx(1) +! print * +!end if + + +! if (me==master) print *,"Running drag suite" !-------------------------------------------------------------------- ! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME !-------------------------------------------------------------------- @@ -527,14 +536,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 +557,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 +567,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 +916,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 +952,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 +1033,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 +1089,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 +1157,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..b174f0fdb 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -208,6 +208,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 From bbc6f3356afc33b504811049848af986d07263d9 Mon Sep 17 00:00:00 2001 From: Hannah C Barnes <38660891+hannahcbarnes@users.noreply.github.com> Date: Wed, 13 May 2020 07:26:11 -0600 Subject: [PATCH 50/90] Number concentration bug and code clean up in GFS_suite_interstitial_4 (#26) Correction for a bug in the number concentration update in GFS_suite_interstitial_4, and removal of some variables that are no longer used in the code. --- physics/GFS_suite_interstitial.F90 | 8 ++++---- physics/GFS_suite_interstitial.meta | 16 ---------------- 2 files changed, 4 insertions(+), 20 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index db3966cee..e4026a75d 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -632,7 +632,7 @@ end subroutine GFS_suite_interstitial_4_finalize subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, dtf, save_qc, save_qi, con_pi, & - gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, 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 @@ -643,7 +643,7 @@ 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 @@ -725,7 +725,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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) = save_qc(i,k)/(1.0_kind_phys-spechum(i,k)) + 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) = nc_mp(i,k) + max(0.0, make_DropletNumber(qc_mp(i,k) * rho_dryair(i,k), nwfa(i,k)) * (1.0/rho_dryair(i,k))) @@ -734,7 +734,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to endif if (ntinc>0) then !> - Convert moist mixing ratio to dry mixing ratio - qi_mp(i,k) = save_qi(i,k)/(1.0_kind_phys-spechum(i,k)) + 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) = ni_mp(i,k) + max(0.0, make_IceNumber(qi_mp(i,k) * rho_dryair(i,k), save_tcp(i,k)) * (1.0/rho_dryair(i,k))) diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index c48f93c68..27af68a90 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1764,22 +1764,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 From 238c84cb3c789056c701b70d3373e640ed4fa599 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Wed, 13 May 2020 22:20:32 -0400 Subject: [PATCH 51/90] fix bugs found in pbl and ozone 3d diagnostic tendencies (#27) PBL tendencies were missing in two schemes; now fixed. Squashed commit of: * fix bugs found in pbl and ozone 3d diagnostic tendencies * remove debugging prints * implied shape arrays for five variables * more block labels * yet more bug fixes --- physics/GFS_PBL_generic.F90 | 26 +++++++------- physics/moninedmf.f | 2 +- physics/satmedmfvdifq.F | 66 ++++++++++++++++++++++++++++++----- physics/satmedmfvdifq.meta | 69 +++++++++++++++++++++++++++++++++++++ 4 files changed, 141 insertions(+), 22 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 4c641e4bf..bd9df41df 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -373,7 +373,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, errmsg = '' errflg = 0 !GJF: dvdftra is only used if nvdiff != ntrac or (nvdiff == ntrac .and. ) - if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then + if_nvdiff_ntrac: if (nvdiff == ntrac .and. (hybedmf .or. do_shoc .or. satmedmf)) then dqdt = dvdftra elseif (nvdiff /= ntrac .and. .not. shinhong .and. .not. do_ysu) then ! @@ -385,7 +385,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo endif ! - if (trans_aero) then + if_trans_aero: if (trans_aero) then ! Set kk if chemistry-aerosol tracers are diffused call set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & imp_physics_thompson, ltaerosol, & @@ -403,9 +403,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo enddo enddo - endif + endif if_trans_aero ! - if (imp_physics == imp_physics_wsm6) then + if_imp_physics: if (imp_physics == imp_physics_wsm6) then ! WSM6 do k=1,levs do i=1,im @@ -517,9 +517,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntoz) = dvdftra(i,k,3) enddo enddo - endif + endif if_imp_physics - endif ! nvdiff == ntrac + endif if_nvdiff_ntrac if (cplchm) then do i = 1, im @@ -534,7 +534,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! --- ... coupling insertion - if (cplflx) then + if_cplflx: if (cplflx) then do i=1,im if (oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES ! if (fice(i) == ceanfrac(i)) then ! use results from CICE @@ -572,10 +572,10 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, !! endif ! Ocean only, NO LAKES enddo - endif + endif if_cplflx !-------------------------------------------------------lssav if loop ---------- - if (lssav) then + if_lssav: if (lssav) then do i=1,im dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i)*dtf @@ -591,7 +591,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! & dtf,' kdt=',kdt,' lat=',lat ! endif - if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then + if_diag: 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 @@ -615,9 +615,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, enddo enddo endif - endif - - endif ! end if_lssav + endif if_diag + + endif if_lssav end subroutine GFS_PBL_generic_post_run diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 50400ee04..6cab9b7ed 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -1068,7 +1068,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo enddo if(lssav .and. ldiag3d .and. ntoz>0 .and. qdiag3d .and. & - & flag_for_pbl_generic_tend) then + & .not. flag_for_pbl_generic_tend) then kk = ntoz is = (kk-1) * km do k = 1, km diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index f5a5f1f78..a514de6ad 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -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,9 +74,10 @@ 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) :: ix, im, km, ntrac, ntcw, ntiw, ntke, ntoz integer, intent(in) :: kinver(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 @@ -97,6 +99,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & prsi(ix,km+1), del(ix,km), & & prsl(ix,km), prslk(ix,km), & & phii(ix,km+1), phil(ix,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), & @@ -1303,6 +1309,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 @@ -1314,19 +1336,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 c compute tridiagonal matrix elements for momentum @@ -1403,6 +1443,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 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! pbl height for diagnostic purpose diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index ec679faec..f2c735def 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -578,6 +578,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 From 187a69c92a501b46556815edea439ba43c463168 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 15 May 2020 10:43:16 -0600 Subject: [PATCH 52/90] Bugfixes for cu_gf_driver, cu_ntiedtke and module_MYNNPBL_wrapper related to lheatstrg --- physics/cu_gf_driver.meta | 8 ++--- physics/cu_ntiedtke.meta | 8 ++--- physics/module_MYNNPBL_wrapper.F90 | 37 +++++++++++++++++---- physics/module_MYNNPBL_wrapper.meta | 51 +++++++++++++++++++++++++++-- 4 files changed, 88 insertions(+), 16 deletions(-) diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 8d5e3a0c8..d89450273 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -261,8 +261,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 +270,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 diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 4208b6e46..6dcc54a15 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 diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index d62a0f71d..3097d38d5 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -10,7 +10,23 @@ 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 () @@ -36,8 +52,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ice_aer_num_conc, & & prsl,exner, & & slmsk,tsurf,qsfc,ps, & - & ust,ch,hflx,qflx,wspd,rb, & - & dtsfc1,dqsfc1, & + & ust,ch,hflx,qflx,hflxq,qflxq, & + & wspd,rb,dtsfc1,dqsfc1, & & dtsfci_diag,dqsfci_diag, & & dtsfc_diag,dqsfc_diag, & & recmol, & @@ -48,7 +64,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv,& - & nupdraft,maxMF,ktop_shallow, & + & nupdraft,maxMF,ktop_plume, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & & dqdt_ice_cloud, dqdt_ozone, & @@ -153,7 +169,7 @@ SUBROUTINE mynnedmf_wrapper_run( & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea, qdiag3d ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & @@ -252,13 +268,16 @@ 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(out) :: & + & hflxq, evapq + real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh real(kind=kind_phys), dimension(im), intent(out) :: & & ch,dtsfc1,dqsfc1, & & dtsfci_diag,dqsfci_diag,dtsfc_diag,dqsfc_diag, & & maxMF - integer, dimension(im), intent(inout) :: & + integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume !LOCAL @@ -287,6 +306,12 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"in MYNN, initflag=",initflag endif + ! Set "kinematic surface upward latent/sensible heat flux reduced by + ! surface roughness" to kinematic surface upward latent/sensible heat flux, + ! because the lheatstrg capability in GFS_PBL_generic_pre is not implemented + hflxq = hflx + qflxq = qflx + ! Assign variables for each microphysics scheme if (imp_physics == imp_physics_wsm6) then ! WSM6 diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 1152d3467..7db6c2621 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1,3 +1,32 @@ +[ccpp-arg-table] + name = mynnedmf_wrapper_init + type = scheme +[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 +[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 @@ -305,7 +334,7 @@ intent = out optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + standard_name = kinematic_surface_upward_sensible_heat_flux long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -313,8 +342,17 @@ 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 [qflx] - standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + 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) @@ -322,6 +360,15 @@ kind = kind_phys intent = in optional = F +[qflxq] + 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 [wspd] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level From 6d2cdfb267c5c6d066d9f4f3e4df888d3cd18867 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 15 May 2020 14:25:11 -0600 Subject: [PATCH 53/90] Fix bugs from merge process --- physics/GFS_suite_interstitial.F90 | 2 +- physics/module_MYNNPBL_wrapper.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 6b5083401..3d22cf33b 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -463,7 +463,7 @@ end subroutine GFS_suite_interstitial_3_finalize 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, gq0, imp_physics, imp_physics_mg, & + 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, & diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 3097d38d5..b215e5e62 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -269,7 +269,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol real(kind=kind_phys), dimension(im), intent(out) :: & - & hflxq, evapq + & hflxq, qflxq real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh From 6e4c7874d6685953b8887fd7638fdfb8870c4b2d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 19 May 2020 07:20:18 -0600 Subject: [PATCH 54/90] Move canopy heat storage calculation of reduced latent/sensible heat flux from GFS_PBL_generic_pre to GFS_surface_generic_post and remove workaround in MYNNPBL wrapper --- physics/GFS_PBL_generic.F90 | 47 +----------- physics/GFS_PBL_generic.meta | 107 ---------------------------- physics/GFS_surface_generic.F90 | 48 ++++++++++++- physics/GFS_surface_generic.meta | 89 +++++++++++++++++++++++ physics/module_MYNNPBL_wrapper.F90 | 10 +-- physics/module_MYNNPBL_wrapper.meta | 22 +----- 6 files changed, 141 insertions(+), 182 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index b17f031bc..75c27fcc7 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,9 +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, save_u, save_v, save_t, & - save_q, ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, 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 @@ -107,25 +106,12 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, 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 - ! 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 - ! 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 = '' @@ -281,35 +267,6 @@ 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) - enddo - endif - if(ldiag3d .and. lssav) then do k=1,levs do i=1,im diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index c46ed37f5..9a130831c 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -307,113 +307,6 @@ 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 - units = m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[v10m] - standard_name = y_wind_at_10m - long_name = 10 meter v wind speed - units = m s-1 - 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 [save_u] standard_name = x_wind_save long_name = x-wind before entering a physics scheme diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index dbcdec24b..30a29d393 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -221,7 +221,8 @@ 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 +244,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 +371,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 81ca18f94..10a060bc3 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/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index b215e5e62..e6c553350 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -52,7 +52,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ice_aer_num_conc, & & prsl,exner, & & slmsk,tsurf,qsfc,ps, & - & ust,ch,hflx,qflx,hflxq,qflxq, & + & ust,ch,hflx,qflx, & & wspd,rb,dtsfc1,dqsfc1, & & dtsfci_diag,dqsfci_diag, & & dtsfc_diag,dqsfc_diag, & @@ -268,8 +268,6 @@ 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(out) :: & - & hflxq, qflxq real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh @@ -306,12 +304,6 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"in MYNN, initflag=",initflag endif - ! Set "kinematic surface upward latent/sensible heat flux reduced by - ! surface roughness" to kinematic surface upward latent/sensible heat flux, - ! because the lheatstrg capability in GFS_PBL_generic_pre is not implemented - hflxq = hflx - qflxq = qflx - ! Assign variables for each microphysics scheme if (imp_physics == imp_physics_wsm6) then ! WSM6 diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 7db6c2621..393ad5292 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -334,40 +334,22 @@ intent = out 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 -[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 -[qflx] - 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 -[qflxq] +[qflx] 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 + intent = in optional = F [wspd] standard_name = wind_speed_at_lowest_model_layer From 7d7c2ca1e7b6cedcac9484af1c46fcc19bc0714f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 19 May 2020 20:56:51 -0600 Subject: [PATCH 55/90] physics/rrtmgp_lw_cloud_sampling.*, physics/rrtmgp_sw_cloud_sampling.*: add missing mandatory CCPP arguments errmsg and errflg --- physics/rrtmgp_lw_cloud_sampling.F90 | 10 +++++++++- physics/rrtmgp_lw_cloud_sampling.meta | 19 ++++++++++++++++++- physics/rrtmgp_sw_cloud_sampling.F90 | 10 +++++++++- physics/rrtmgp_sw_cloud_sampling.meta | 19 ++++++++++++++++++- 4 files changed, 54 insertions(+), 4 deletions(-) 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 From 4b5c379717ae789bbc61b63c1eb9d21e30018bfa Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 19 May 2020 20:58:35 -0600 Subject: [PATCH 56/90] Remove physics/GFS_suite_init_finalize_test.* --- physics/GFS_suite_init_finalize_test.F90 | 59 --------------------- physics/GFS_suite_init_finalize_test.meta | 64 ----------------------- 2 files changed, 123 deletions(-) delete mode 100644 physics/GFS_suite_init_finalize_test.F90 delete mode 100644 physics/GFS_suite_init_finalize_test.meta 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 From b328abb08ff2410faeae3cc31e9619ec02807873 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Wed, 20 May 2020 04:33:34 +0000 Subject: [PATCH 57/90] Merge of latest GSL drag suite with latest updates on NOAA-GSD repo, gsd/develop branch --- physics/GFS_GWD_generic.F90 | 7 +++---- physics/GFS_GWD_generic.meta | 9 --------- physics/drag_suite.F90 | 9 --------- 3 files changed, 3 insertions(+), 22 deletions(-) diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 7d3f86b00..09c969162 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -17,7 +17,7 @@ end subroutine GFS_GWD_generic_pre_init !! @{ subroutine GFS_GWD_generic_pre_run( & & im, levs, nmtvr, mntvar, & - & var, oc, oa4, clx, theta, & + & oc, oa4, clx, theta, & & varss, ocss, oa4ss, clxss, & & sigma, gamma, elvmax, lssav, ldiag3d, & & dudt, dvdt, dtdt, du3dt, dv3dt, dt3dt, dtf, & @@ -30,8 +30,8 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) real(kind=kind_phys), intent(out) :: & - & var(im), oc(im), oa4(im,4), clx(im,4), & - & varss(im), ocss(im), oa4ss(im,4), clxss(im,4), & + & 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, flag_for_gwd_generic_tend @@ -84,7 +84,6 @@ subroutine GFS_GWD_generic_pre_run( & clx(:,3) = 0.0 clx(:,4) = 0.0 elseif (nmtvr == 24) then ! GSD_drag_suite - var(:) = mntvar(:,1) oc(:) = mntvar(:,2) oa4(:,1) = mntvar(:,3) oa4(:,2) = mntvar(:,4) diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index 78f2e742d..7f987f28f 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -39,15 +39,6 @@ kind = kind_phys intent = in optional = F -[var] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [oc] standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 0eb1f3b5f..86ed514f9 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -475,15 +475,6 @@ subroutine drag_suite_run( & errflg = 0 -! Temporary line -!if (me==master) then -! print *, "Ahoj svete!: In drag suite -- cdmbgwd =", cdmbgwd(:) -! print *, "imx =", imx, " dx =", dx(1) -! print * -!end if - - -! if (me==master) print *,"Running drag suite" !-------------------------------------------------------------------- ! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME !-------------------------------------------------------------------- From d44e2e7446f9fc02c99ec02b9b2fe97a5b0aa055 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:35:36 -0600 Subject: [PATCH 58/90] Clean up use of horizontal_dimension versus horizontal_loop_extent in a large number of files --- physics/GFS_MP_generic.F90 | 8 +++---- physics/GFS_MP_generic.meta | 8 ------- physics/GFS_rrtmg_setup.meta | 4 ++-- physics/GFS_rrtmgp_pre.F90 | 4 +--- physics/GFS_rrtmgp_pre.meta | 8 ------- physics/GFS_rrtmgp_sw_post.F90 | 5 ++-- physics/GFS_rrtmgp_sw_post.meta | 2 +- physics/cires_ugwp.F90 | 2 +- physics/cnvc90.f | 6 ++--- physics/cnvc90.meta | 8 ------- physics/cs_conv.F90 | 36 ++++++++++++++-------------- physics/cs_conv.meta | 8 ------- physics/cu_gf_driver.F90 | 32 ++++++++++++------------- physics/cu_gf_driver.meta | 8 ------- physics/cu_ntiedtke.F90 | 14 +++++------ physics/cu_ntiedtke.meta | 8 ------- physics/dcyc2.f | 18 +++++++------- physics/dcyc2.meta | 8 ------- physics/drag_suite.F90 | 4 ++-- physics/drag_suite.meta | 8 ------- physics/gcm_shoc.F90 | 8 +++---- physics/gcm_shoc.meta | 8 ------- physics/gscond.f | 20 ++++++++-------- physics/gscond.meta | 8 ------- physics/gwdc.f | 12 +++++----- physics/gwdc.meta | 8 ------- physics/gwdps.f | 34 +++++++++++++------------- physics/gwdps.meta | 8 ------- physics/h2ophys.f | 14 +++++------ physics/h2ophys.meta | 8 ------- physics/m_micro.F90 | 12 +++++----- physics/m_micro.meta | 8 ------- physics/module_MYJPBL_wrapper.F90 | 6 ++--- physics/module_MYJPBL_wrapper.meta | 8 ------- physics/module_MYJSFC_wrapper.F90 | 4 ++-- physics/module_MYJSFC_wrapper.meta | 8 ------- physics/module_MYNNPBL_wrapper.F90 | 4 ++-- physics/module_MYNNPBL_wrapper.meta | 9 +------ physics/module_MYNNSFC_wrapper.F90 | 6 ++--- physics/module_MYNNSFC_wrapper.meta | 8 ------- physics/module_SGSCloud_RadPost.F90 | 4 ++-- physics/module_SGSCloud_RadPost.meta | 8 ------- physics/module_SGSCloud_RadPre.F90 | 4 ++-- physics/module_SGSCloud_RadPre.meta | 8 ------- physics/moninedmf.f | 20 +++++++--------- physics/moninedmf.meta | 8 ------- physics/moninedmf_hafs.f | 20 +++++++--------- physics/moninedmf_hafs.meta | 8 ------- physics/moninshoc.f | 12 ++++------ physics/moninshoc.meta | 8 ------- physics/mp_thompson_post.F90 | 3 +-- physics/mp_thompson_post.meta | 8 ------- physics/ozphys.f | 12 +++++----- physics/ozphys.meta | 8 ------- physics/ozphys_2015.f | 14 +++++------ physics/ozphys_2015.meta | 8 ------- physics/precpd.f | 19 +++++++-------- physics/precpd.meta | 8 ------- physics/rascnv.F90 | 15 ++++++------ physics/rascnv.meta | 8 ------- physics/rayleigh_damp.f | 24 +++++++++---------- physics/rayleigh_damp.meta | 8 ------- physics/samfdeepcnv.f | 22 ++++++++--------- physics/samfdeepcnv.meta | 8 ------- physics/samfshalcnv.f | 18 +++++++------- physics/samfshalcnv.meta | 8 ------- physics/sascnvn.F | 9 ++++--- physics/sascnvn.meta | 8 ------- physics/satmedmfvdif.F | 22 ++++++++--------- physics/satmedmfvdif.meta | 8 ------- physics/satmedmfvdifq.F | 22 ++++++++--------- physics/satmedmfvdifq.meta | 8 ------- physics/shalcnv.F | 7 +++--- physics/shalcnv.meta | 8 ------- physics/shinhongvdif.F90 | 10 ++++---- physics/shinhongvdif.meta | 8 ------- physics/ysuvdif.F90 | 10 ++++---- physics/ysuvdif.meta | 8 ------- 78 files changed, 252 insertions(+), 567 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 13f8243ed..73b26c7a3 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -92,7 +92,7 @@ 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, & + 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, & @@ -104,7 +104,7 @@ 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, qdiag3d, cplflx, cplchm @@ -112,7 +112,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt 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 @@ -224,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 diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 3ecc94c00..c4eacb758 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -155,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 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/cires_ugwp.F90 b/physics/cires_ugwp.F90 index bf2825104..df0116cd0 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -260,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, & 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 927b452cd..5c43709d1 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -68,7 +68,7 @@ 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, & @@ -97,39 +97,37 @@ 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( 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 , km ), intent(inout ) :: qci_conv - 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 + 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 -! 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 diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index d89450273..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 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 6dcc54a15..0e6a3d4b0 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -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 c7a1ddd59..dcb164369 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 9a5687bf5..fa1ef4800 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..6527adb34 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -194,7 +194,7 @@ 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, & @@ -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) diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index dfb6f64b8..22747da0a 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 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 314aa4d44..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 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 1406a99be..8d4ccc858 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 8100d0b05..bc7c7cec4 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 e6c553350..0e9cb3c4f 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -37,7 +37,7 @@ end subroutine mynnedmf_wrapper_finalize !! \htmlinclude mynnedmf_wrapper_run.html !! SUBROUTINE mynnedmf_wrapper_run( & - & ix,im,levs, & + & im,levs, & & flag_init,flag_restart,cycling, & & lssav, ldiag3d, qdiag3d, lsidea,& & delt,dtf,dx,zorl, & @@ -204,7 +204,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, & diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 393ad5292..31ebcde74 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -27,17 +27,10 @@ intent = out optional = F +##################################################################### [ccpp-arg-table] name = mynnedmf_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 diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 82cdbca76..5693c49a8 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -19,14 +19,12 @@ 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, & + & im,levs, & & itimestep,iter, & & flag_init,flag_restart,lsm, & & delt,dx, & @@ -105,7 +103,7 @@ SUBROUTINE mynnsfc_wrapper_run( & !MYNN-1D REAL :: delt - INTEGER :: im, ix, levs + INTEGER :: im, levs INTEGER :: iter, k, i, itimestep, lsm LOGICAL :: flag_init,flag_restart,lprnt INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index a58253c08..61ddb4fd0 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 diff --git a/physics/module_SGSCloud_RadPost.F90 b/physics/module_SGSCloud_RadPost.F90 index 051033a26..bedb660a6 100644 --- a/physics/module_SGSCloud_RadPost.F90 +++ b/physics/module_SGSCloud_RadPost.F90 @@ -19,7 +19,7 @@ end subroutine sgscloud_radpost_finalize !! \htmlinclude sgscloud_radpost_run.html !! subroutine sgscloud_radpost_run( & - ix,im,levs, & + im,levs, & flag_init,flag_restart, & qc,qi, & qc_save,qi_save, & @@ -32,7 +32,7 @@ subroutine sgscloud_radpost_run( & implicit none !------------------------------------------------------------------- - integer, intent(in) :: ix, im, levs + 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 diff --git a/physics/module_SGSCloud_RadPost.meta b/physics/module_SGSCloud_RadPost.meta index b3a5bce2b..da4191aad 100644 --- a/physics/module_SGSCloud_RadPost.meta +++ b/physics/module_SGSCloud_RadPost.meta @@ -1,14 +1,6 @@ [ccpp-arg-table] 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 diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index e78941d81..16ebac5d7 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -32,7 +32,7 @@ end subroutine sgscloud_radpre_finalize !>\section sgscloud_radpre GSD SGS Scheme General Algorithm !> @{ subroutine sgscloud_radpre_run( & - ix,im,levs, & + im,levs, & flag_init,flag_restart, & do_mynnedmf, & qc, qi, T3D, & @@ -57,7 +57,7 @@ subroutine sgscloud_radpre_run( & !------------------------------------------------------------------- ! Interface variables real (kind=kind_phys), parameter :: gfac=1.0e5/con_g - integer, intent(in) :: ix, im, levs, imfdeepcnv, imfdeepcnv_gf, nlay + integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, nlay 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 diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index f959e66ef..79691920d 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -11,14 +11,6 @@ [ccpp-arg-table] name = sgscloud_radpre_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/moninedmf.f b/physics/moninedmf.f index 6cab9b7ed..63edc3486 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -57,7 +57,7 @@ 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, & @@ -79,7 +79,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & 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), ntoz + integer, intent(in) :: im, km, ntrac, ntcw, kinver(im), ntoz integer, intent(out) :: kpbl(im) ! @@ -91,9 +91,9 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & 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), & @@ -102,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), & @@ -243,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 @@ -860,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) ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 313e22e17..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 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_post.F90 b/physics/mp_thompson_post.F90 index dd4a2b3f5..97b44943d 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -17,12 +17,11 @@ module mp_thompson_post !! \section arg_table_mp_thompson_post_init Argument Table !! \htmlinclude mp_thompson_post_init.html !! - 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 diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index 7a26db6f5..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 diff --git a/physics/ozphys.f b/physics/ozphys.f index 8ca13b99f..f8da58760 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -50,7 +50,7 @@ end subroutine ozphys_finalize !> \section genal_ozphys GFS ozphys_run General Algorithm !> @{ subroutine ozphys_run ( & - & ix, im, levs, ko3, dt, oz, tin, po3, & + & im, levs, ko3, dt, oz, tin, po3, & & prsl, prdout, oz_coeff, delp, ldiag3d, qdiag3d, & & ozp1, ozp2, ozp3, ozp4, con_g, me, errmsg, errflg) ! @@ -61,15 +61,15 @@ 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, qdiag3d @@ -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 = '' diff --git a/physics/ozphys.meta b/physics/ozphys.meta index 8cce5c266..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 diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index a42c74bfc..238a8fb21 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -54,7 +54,7 @@ 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, & + & im, levs, ko3, dt, oz, tin, po3, & & prsl, prdout, pl_coeff, delp, & & ldiag3d, qdiag3d, & & ozp1,ozp2,ozp3,ozp4,con_g, & @@ -66,15 +66,15 @@ 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 @@ -85,7 +85,7 @@ subroutine ozphys_2015_run ( & 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 = '' diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index eedfe3ca2..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 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/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 8ef5aa947..a56a85e8c 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -24,7 +24,7 @@ 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, & + & lsidea,IM,KM,A,B,C,U1,V1,DT,CP, & & LEVR,pgr,PRSL,PRSLRD0,ral_ts, & & ldiag3d,du3dt,dv3dt,dt3dt, & & errmsg,errflg) @@ -49,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 ! @@ -69,11 +69,11 @@ subroutine rayleigh_damp_run ( & implicit none ! logical,intent(in) :: lsidea,ldiag3d - integer,intent(in) :: im, ix, km,levr + 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(:,:) diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 2f9d81ed5..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 diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 03f5f05ef..361aadbae 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, & @@ -86,24 +86,24 @@ 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 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), & @@ -169,7 +169,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), @@ -2476,7 +2476,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 215026eb2..6f7ec3166 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 ed80a2f54..36dab1c9a 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 @@ -119,7 +119,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), @@ -1504,7 +1504,7 @@ subroutine samfshalcnv_run(im,ix,km,itc,ntc,cliq,cp,cvap, & !> - Transport aerosols if present ! 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 5189afd95..156cda581 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 f17aaa35c..f00fb3776 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -53,7 +53,7 @@ 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, & @@ -70,7 +70,7 @@ 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) ! @@ -84,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), & @@ -807,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, diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index b1c3fbfc4..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 diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index f10ed97ef..c71663dc7 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, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & @@ -74,7 +74,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & implicit none ! !---------------------------------------------------------------------- - integer, intent(in) :: ix, im, km, ntrac, ntcw, ntiw, ntke, ntoz + integer, intent(in) :: im, km, ntrac, ntcw, ntiw, ntke, ntoz integer, intent(in) :: kinver(im) integer, intent(out) :: kpbl(im) logical, intent(in) :: ldiag3d,qdiag3d @@ -86,19 +86,19 @@ 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), & - & 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(:,:), & @@ -773,13 +773,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, diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 01211b599..c0cefb632 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 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 From b3c070d72e33ce6ffd2d8dd5b52f0b3e2f9a8b31 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:36:04 -0600 Subject: [PATCH 59/90] physics/GFS_debug.F90: bugfix for conditionally allocated variables --- physics/GFS_debug.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 0d010ed76..cfd190b26 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -348,12 +348,18 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, 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_plume ', Diag%ktop_plume) From fca0786f3834f8f6993f470b01ea3bd644a6efa0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:36:28 -0600 Subject: [PATCH 60/90] physics/GFS_phys_time_vary.fv3.meta: bugfix, use correct dimensions in metadata --- physics/GFS_phys_time_vary.fv3.meta | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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 From 2354a89824f23a8eb42fa4b1a647337530347e79 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:36:40 -0600 Subject: [PATCH 61/90] physics/module_bl_mynn.F90: fix compiler warning --- physics/module_bl_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 6be141d9c..edc5d4a1e 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3105,7 +3105,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & & 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) c(k)= -dtz(k)*khdz(k+1)/rho(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 + & + & diss_heat(k)*delt*dheat_opt + & & sub_thl(k)*delt + det_thl(k)*delt ENDDO From 6d6dd49eafeb687ea23b23790937a8f2e21a898e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 11:37:18 -0600 Subject: [PATCH 62/90] physics/mp_thompson.{F90,meta}: revert workaround in mp_thompson_init; remove physics/mp_thompson.meta.backup.before.workaround --- physics/mp_thompson.F90 | 567 ++++++--------- physics/mp_thompson.meta | 304 +++++--- .../mp_thompson.meta.backup.before.workaround | 676 ------------------ 3 files changed, 399 insertions(+), 1148 deletions(-) delete mode 100644 physics/mp_thompson.meta.backup.before.workaround diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index d7a08b7ef..824c4f63c 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -23,17 +23,10 @@ module mp_thompson contains -! DH* Note. The following is a nasty modification of the mp_thompson_init -! routine to account for the fact that the initialization of the physics -! must run over all blocks concurrently. In order to pass in the arguments -! as individual Fortran arrays as before, we need to remove the dynamic -! build first and add logic to detect that an array ... - !> This subroutine is a wrapper around the actual thompson_init(). !! \section arg_table_mp_thompson_init Argument Table !! \htmlinclude mp_thompson_init.html !! -#if 0 subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & imp_physics, imp_physics_thompson, & spechum, qc, qr, qi, qs, qg, ni, nr, & @@ -41,7 +34,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & nwfa, nifa, tgrs, prsl, phil, area, & re_cloud, re_ice, re_snow, & mpicomm, mpirank, mpiroot, & - threads, blkno, errmsg, errflg) + threads, errmsg, errflg) implicit none @@ -83,7 +76,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & integer, intent(in ) :: mpiroot ! Threading/blocking information integer, intent(in ) :: threads - integer, intent(in ) :: blkno ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -105,91 +97,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 integer :: i, k -#else - subroutine mp_thompson_init(Data, ntqv, ntcw, ntrw, ntiw, ntsw, ntgl, & - ntinc, ntrnc, ntlnc, ntwa, ntia, nleffr, & - nieffr, nseffr, con_g, con_rd, & - restart, imp_physics, imp_physics_thompson, & - is_aerosol_aware, mpicomm, mpirank, mpiroot,& - threads, errmsg, errflg) - - use GFS_typedefs, only : GFS_data_type - - implicit none - - ! Interface variables - type(GFS_data_type), intent(inout) :: Data(:) - integer, intent(in ) :: ntqv - integer, intent(in ) :: ntcw - integer, intent(in ) :: ntrw - integer, intent(in ) :: ntiw - integer, intent(in ) :: ntsw - integer, intent(in ) :: ntgl - integer, intent(in ) :: ntinc - integer, intent(in ) :: ntrnc - integer, intent(in ) :: ntlnc - integer, intent(in ) :: ntwa - integer, intent(in ) :: ntia - integer, intent(in ) :: nleffr - integer, intent(in ) :: nieffr - integer, intent(in ) :: nseffr - real(kind_phys), intent(in ) :: con_g, con_rd - logical, intent(in ) :: restart - integer, intent(in ) :: imp_physics - integer, intent(in ) :: imp_physics_thompson - ! Aerosols - logical, intent(in ) :: is_aerosol_aware - ! 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/pointers - - ! Hydrometeors - real(kind_phys), dimension(:,:), allocatable :: qv_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qc_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qr_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qi_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qs_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: qg_mp !< kg kg-1 (dry mixing ratio) - real(kind_phys), dimension(:,:), allocatable :: ni_mp !< kg-1 - real(kind_phys), dimension(:,:), allocatable :: nr_mp !< kg-1 - real(kind_phys), dimension(:,:), allocatable :: nc_mp !< kg-1 - ! - real(kind_phys), dimension(:,:), allocatable :: hgt ! m - real(kind_phys), dimension(:,:), allocatable :: rho ! kg m-3 - real(kind_phys), dimension(:,:), allocatable :: orho ! m3 kg-1 - real(kind_phys), pointer :: spechum (:,:) - real(kind_phys), pointer :: qc (:,:) - real(kind_phys), pointer :: qr (:,:) - real(kind_phys), pointer :: qi (:,:) - real(kind_phys), pointer :: qs (:,:) - real(kind_phys), pointer :: qg (:,:) - real(kind_phys), pointer :: ni (:,:) - real(kind_phys), pointer :: nr (:,:) - real(kind_phys), pointer :: nc (:,:) - real(kind_phys), pointer :: nwfa (:,:) - real(kind_phys), pointer :: nifa (:,:) - real(kind_phys), pointer :: nwfa2d (:) - real(kind_phys), pointer :: nifa2d (:) - real(kind_phys), pointer :: tgrs (:,:) - real(kind_phys), pointer :: prsl (:,:) - real(kind_phys), pointer :: phil (:,:) - real(kind_phys), pointer :: area (:) - real(kind_phys), pointer :: re_cloud (:,:) - real(kind_phys), pointer :: re_ice (:,:) - real(kind_phys), pointer :: re_snow (:,:) - - ! - real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 - integer :: i, k, blkno, nblocks, ncol, nlev -#endif ! Initialize the CCPP error handling variables errmsg = '' @@ -212,298 +119,238 @@ subroutine mp_thompson_init(Data, ntqv, ntcw, ntrw, ntiw, ntsw, ntgl, & return end if - nblocks = size(Data) - block_loop: do blkno=1,nblocks - - spechum => Data(blkno)%Statein%qgrs(:,:,ntqv) - qc => Data(blkno)%Statein%qgrs(:,:,ntcw) - qr => Data(blkno)%Statein%qgrs(:,:,ntrw) - qi => Data(blkno)%Statein%qgrs(:,:,ntiw) - qs => Data(blkno)%Statein%qgrs(:,:,ntsw) - qg => Data(blkno)%Statein%qgrs(:,:,ntgl) - ni => Data(blkno)%Statein%qgrs(:,:,ntinc) - nr => Data(blkno)%Statein%qgrs(:,:,ntrnc) - if (is_aerosol_aware) then - nc => Data(blkno)%Statein%qgrs(:,:,ntlnc) - nwfa => Data(blkno)%Statein%qgrs(:,:,ntwa) - nifa => Data(blkno)%Statein%qgrs(:,:,ntia) - nwfa2d => Data(blkno)%Coupling%nwfa2d - nifa2d => Data(blkno)%Coupling%nifa2d - end if - tgrs => Data(blkno)%Statein%tgrs - prsl => Data(blkno)%Statein%prsl - phil => Data(blkno)%Statein%phil - area => Data(blkno)%Grid%area - re_cloud => Data(blkno)%Tbd%phy_f3d(:,:,nleffr) - re_ice => Data(blkno)%Tbd%phy_f3d(:,:,nieffr) - re_snow => Data(blkno)%Tbd%phy_f3d(:,:,nseffr) - - ncol = size(spechum(:,1)) - nlev = size(spechum(1,:)) - allocate(qv_mp(ncol,nlev)) - allocate(qc_mp(ncol,nlev)) - allocate(qr_mp(ncol,nlev)) - allocate(qi_mp(ncol,nlev)) - allocate(qs_mp(ncol,nlev)) - allocate(qg_mp(ncol,nlev)) - allocate(ni_mp(ncol,nlev)) - allocate(nr_mp(ncol,nlev)) - if (is_aerosol_aware) allocate(nc_mp(ncol,nlev)) - allocate(hgt (ncol,nlev)) - allocate(rho (ncol,nlev)) - allocate(orho (ncol,nlev)) - - only_for_first_block: if (blkno==1) then - - ! 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 - - end if only_for_first_block - - ! 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 + ! 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 - ! 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 + ! For restart runs, the init is done here + if (restart) then + is_initialized = .true. + return + 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 + ! 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 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 (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 - ! 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 + ! Geopotential height in m2 s-2 to height in m + hgt = phil/con_g - ! 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 + ! Density of air in kg m-3 and inverse density of air + rho = prsl/(con_rd*tgrs) + orho = 1.0/rho - !..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 + ! 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. - ! 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 + !> - 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 - else - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial CCN aerosols are present.' - if (MAXVAL(nwfa2d) .lt. eps) then + 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 .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 + !+---+-----------------------------------------------------------------+ + !..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 .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.' + !+---+-----------------------------------------------------------------+ + !..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 (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 + 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 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. + 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 - if (mpirank==mpiroot .and. blkno==1) write(*,*) ' Apparently initial IN aerosol surface emission rates are present.' + 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 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 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 - else + else - ! 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 + ! 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 + end if - ! Calculate initial cloud effective radii if requested - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = 2.49E-6 - re_ice(i,k) = 4.99E-6 - re_snow(i,k) = 9.99E-6 - end do + ! Calculate initial cloud effective radii if requested + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = 2.49E-6 + re_ice(i,k) = 4.99E-6 + re_snow(i,k) = 9.99E-6 end do - 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 + 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 + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) + re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) + re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) end do - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) - re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) - re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) - end do - 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. - re_cloud = 1.0E6*re_cloud - re_ice = 1.0E6*re_ice - re_snow = 1.0E6*re_snow - - !> - 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 + 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. + re_cloud = 1.0E6*re_cloud + re_ice = 1.0E6*re_ice + re_snow = 1.0E6*re_snow - deallocate(qv_mp) - deallocate(qc_mp) - deallocate(qr_mp) - deallocate(qi_mp) - deallocate(qs_mp) - deallocate(qg_mp) - deallocate(ni_mp) - deallocate(nr_mp) - if (is_aerosol_aware) deallocate(nc_mp) - deallocate(hgt ) - deallocate(rho ) - deallocate(orho ) - - end do block_loop + !> - 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. diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index cbaf8b801..9b26bdc23 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -1,122 +1,18 @@ [ccpp-arg-table] name = mp_thompson_init type = scheme -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type - units = DDT - dimensions = (ccpp_block_number) - type = GFS_data_type - intent = inout - optional = F -[ntqv] - standard_name = index_for_water_vapor - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntcw] - standard_name = index_for_liquid_cloud_condensate - long_name = tracer index for cloud condensate (or liquid water) - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntrw] - standard_name = index_for_rain_water - long_name = tracer index for rain water - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntiw] - standard_name = index_for_ice_cloud_condensate - long_name = tracer index for ice water - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntsw] - standard_name = index_for_snow_water - long_name = tracer index for snow water - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntgl] - standard_name = index_for_graupel - long_name = tracer index for graupel - units = index - dimensions = () - type = integer - intent = in - optional = F -[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 -[ntrnc] - standard_name = index_for_rain_number_concentration - long_name = tracer index for rain number concentration - units = index - dimensions = () - type = integer - intent = in - optional = F -[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 -[ntwa] - standard_name = index_for_water_friendly_aerosols - long_name = tracer index for water friendly aerosol - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntia] - standard_name = index_for_ice_friendly_aerosols - long_name = tracer index for ice friendly aerosol - units = index - dimensions = () - type = integer - intent = in - optional = F -[nleffr] - standard_name = index_for_cloud_liquid_water_effective_radius - long_name = the index of cloud liquid water effective radius in phy_f3d - units = - dimensions = () - type = integer - intent = in - optional = F -[nieffr] - standard_name = index_for_ice_effective_radius - long_name = the index of ice effective radius in phy_f3d - units = +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () type = integer intent = in optional = F -[nseffr] - standard_name = index_for_snow_effective_radius - long_name = the index of snow effective radius in phy_f3d - units = +[nlev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () type = integer intent = in @@ -163,6 +59,78 @@ 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 @@ -171,6 +139,116 @@ 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 + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) + 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 + active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) + optional = T +[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 = inout + optional = T +[nifa] + standard_name = ice_friendly_aerosol_number_concentration + 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 +[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 = um + 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 = um + 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 = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T [mpicomm] standard_name = mpi_comm long_name = MPI communicator @@ -374,6 +452,7 @@ type = real kind = kind_phys intent = in + active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [nifa2d] standard_name = tendency_of_ice_friendly_aerosols_at_surface @@ -383,6 +462,7 @@ type = real kind = kind_phys intent = in + active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [tgrs] standard_name = air_temperature_updated_by_physics diff --git a/physics/mp_thompson.meta.backup.before.workaround b/physics/mp_thompson.meta.backup.before.workaround deleted file mode 100644 index 0419a6c15..000000000 --- a/physics/mp_thompson.meta.backup.before.workaround +++ /dev/null @@ -1,676 +0,0 @@ -[ccpp-arg-table] - name = mp_thompson_init - type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[nlev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - 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 -[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 - units = flag - dimensions = () - 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 - 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 -[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 = inout - optional = T -[nifa] - standard_name = ice_friendly_aerosol_number_concentration - 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 -[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 = um - 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 = um - 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 = um - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[mpicomm] - standard_name = mpi_comm - long_name = MPI communicator - units = index - dimensions = () - type = integer - 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 -[threads] - standard_name = omp_threads - long_name = number of OpenMP threads available to scheme - units = count - 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 - 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 = mp_thompson_run - type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[nlev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - 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 = in - 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 = in - optional = T -[tgrs] - standard_name = air_temperature_updated_by_physics - long_name = model layer mean temperature - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - 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 -[phii] - standard_name = geopotential_at_interface - long_name = geopotential at model layer interfaces - units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[omega] - standard_name = omega - long_name = layer mean vertical velocity - units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dtp] - standard_name = time_step_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[prcp] - standard_name = lwe_thickness_of_explicit_precipitation_amount - long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[rain] - standard_name = lwe_thickness_of_explicit_rain_amount - long_name = explicit rain fall on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[graupel] - standard_name = lwe_thickness_of_graupel_amount - long_name = graupel fall on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ice] - standard_name = lwe_thickness_of_ice_amount - long_name = ice fall on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[snow] - standard_name = lwe_thickness_of_snow_amount - long_name = snow fall on physics timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[sr] - standard_name = ratio_of_snowfall_to_rainfall - long_name = ratio of snowfall to large-scale rainfall - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[refl_10cm] - standard_name = radar_reflectivity_10cm - long_name = instantaneous refl_10cm - units = dBZ - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[do_radar_ref] - standard_name = flag_for_radar_reflectivity - long_name = flag for radar reflectivity - units = flag - dimensions = () - type = logical - 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 (meter here) - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - 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) - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - 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) - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = T -[mpicomm] - standard_name = mpi_comm - long_name = MPI communicator - units = index - dimensions = () - type = integer - 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 -[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 = mp_thompson_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 From 5e5cfb35756ed9c4a60d81ed2eda58796b994139 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 27 May 2020 16:31:52 -0600 Subject: [PATCH 63/90] Minor bugfixes for handling conditionally allocated variables --- physics/mp_thompson.meta | 4 ---- 1 file changed, 4 deletions(-) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 9b26bdc23..81b2241e1 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -156,7 +156,6 @@ type = real kind = kind_phys intent = inout - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [nifa2d] standard_name = tendency_of_ice_friendly_aerosols_at_surface @@ -166,7 +165,6 @@ type = real kind = kind_phys intent = inout - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [nwfa] standard_name = water_friendly_aerosol_number_concentration @@ -452,7 +450,6 @@ type = real kind = kind_phys intent = in - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [nifa2d] standard_name = tendency_of_ice_friendly_aerosols_at_surface @@ -462,7 +459,6 @@ type = real kind = kind_phys intent = in - active = (flag_for_microphysics_scheme == flag_for_thompson_microphysics_scheme .and. flag_for_aerosol_physics) optional = T [tgrs] standard_name = air_temperature_updated_by_physics From ecd67779749491ca6d0e0ec6f71ab5e8535f8a7f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 28 May 2020 11:11:39 -0600 Subject: [PATCH 64/90] Remove legacy code in physics/module_mp_thompson.F90 --- physics/module_mp_thompson.F90 | 6 ------ 1 file changed, 6 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b5c8da161..b3ccb7412 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -418,14 +418,8 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & !..OPTIONAL variables that control application of aerosol-aware scheme -#if 0 - REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: nwfa, nifa - REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d -#else -! DH* 20200208 - change dimensions for nasty init hack REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: nwfa, nifa REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d -#endif INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot INTEGER, INTENT(IN) :: threads CHARACTER(len=*), INTENT(INOUT) :: errmsg From d9816a2d2d66fc679e5b475bee11612a17582e13 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 2 Jun 2020 07:29:12 -0600 Subject: [PATCH 65/90] physics/mp_thompson.{F90,meta}: cleanup use of optional arguments for cloud effective radii --- physics/mp_thompson.F90 | 61 +++++++++++++++++++++++----------------- physics/mp_thompson.meta | 6 ++-- 2 files changed, 38 insertions(+), 29 deletions(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 824c4f63c..3f2ee144e 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -67,9 +67,9 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & real(kind_phys), intent(in ) :: phil(:,:) real(kind_phys), intent(in ) :: area(:) ! Cloud effective radii - real(kind_phys), optional, intent(inout) :: re_cloud(:,:) - real(kind_phys), optional, intent(inout) :: re_ice(:,:) - real(kind_phys), optional, intent(inout) :: re_snow(:,:) + 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 @@ -319,31 +319,40 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & end if ! Calculate initial cloud effective radii if requested - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = 2.49E-6 - re_ice(i,k) = 4.99E-6 - re_snow(i,k) = 9.99E-6 + if (present(re_cloud) .and. present(re_ice) .and. present(re_snow)) then + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = 2.49E-6 + re_ice(i,k) = 4.99E-6 + re_snow(i,k) = 9.99E-6 + end do + end do + 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 - end do - 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 - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) - re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) - re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) + do i = 1, ncol + do k = 1, nlev + re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) + re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) + re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) + end do end do - 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. - re_cloud = 1.0E6*re_cloud - re_ice = 1.0E6*re_ice - re_snow = 1.0E6*re_snow + !! 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) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 81b2241e1..5bbd85732 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -223,7 +223,7 @@ [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 = um + units = m dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -232,7 +232,7 @@ [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 = um + units = m dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -241,7 +241,7 @@ [re_snow] standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometer - units = um + units = m dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys From a219a4750614a5457fd7b7315ea804c4adad679e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 2 Jun 2020 07:29:31 -0600 Subject: [PATCH 66/90] physics/GFS_rrtmg_pre.F90: cleanup calculation of cloud effective radii, fix bugs --- physics/GFS_rrtmg_pre.F90 | 134 ++++++++++++++++---------------------- 1 file changed, 55 insertions(+), 79 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index d2ecef895..84732e401 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -581,7 +581,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then do k=1,LMK do i=1,IM - qvs = Statein%qgrs(i,k2,1) + 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) @@ -594,7 +594,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input elseif (Model%imp_physics == Model%imp_physics_thompson) then do k=1,LMK do i=1,IM - qvs = Statein%qgrs(i,k2,1) + 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) @@ -701,76 +701,60 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo endif elseif (Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP - if(Model%kdt == 1 ) then - do k=1,lm - k1 = k + kd - do i=1,im - effrl(i,k1) = Tbd%phy_f3d(i,k,Model%nleffr) - effri(i,k1) = Tbd%phy_f3d(i,k,Model%nieffr) - effrr(i,k1) = 1000. ! rrain_def=1000. - effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) - enddo + ! + ! 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 + ! Initialize to default in units m as in module_mp_thompson.F90 + re_cloud(i,:) = 2.49E-6 + re_ice(i,:) = 4.99E-6 + re_snow(i,:) = 9.99E-6 + 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 and apply bounds + do k=1,lm + do i=1,im + 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.)) + !tgs: clduni has different limits for ice radii: 10.0-150.0 + ! it will raise the low limit from 5 to 10, but the + ! high limit will remain 125. + re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) + 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 - else ! kdt>1 - if(Model%do_mynnedmf .or. & - Model%imfdeepcnv == Model%imfdeepcnv_gf ) then - !tgs - take into account sub-grid clouds from GF or MYNN PBL - - ! Compute effective radii for QC and QI with sub-grid clouds - do k=1,lm - do i=1,im - ! make NC consistent with sub-grid clouds - 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 - ! Initialize to default in units m as in module_mp_thompson.F90 - re_cloud(i,:) = 2.49E-6 - re_ice(i,:) = 4.99E-6 - re_snow(i,:) = 9.99E-6 - 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 - do k=1,lm - do i=1,im - 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.)) - !tgs: clduni has different limits for ice radii: 10.0-150.0 - ! it will raise the low limit from 5 to 10, but the - ! high limit will remain 125. - re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) - end do - end do - - do k=1,lm - k1 = k + kd - do i=1,im - effrl(i,k1) = re_cloud (i,k) ! Tbd%phy_f3d(i,k,Model%nleffr) - effri(i,k1) = re_ice (i,k) ! Tbd%phy_f3d(i,k,Model%nieffr) - effrr(i,k1) = 1000. ! rrain_def=1000. - effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) - enddo - enddo - else ! not MYNN or not GF - do k=1,lm - k1 = k + kd - do i=1,im - effrl(i,k1) = Tbd%phy_f3d(i,k,Model%nleffr) - effri(i,k1) = Tbd%phy_f3d(i,k,Model%nieffr) - effrr(i,k1) = 1000. ! rrain_def=1000. - effrs(i,k1) = Tbd%phy_f3d(i,k,Model%nseffr) - enddo - enddo - endif ! MYNN PBL or GF conv - endif ! kdt - else ! neither of the other two cases + 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 @@ -936,14 +920,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input else ! kdt > 1 - 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 ! --- call progcld6 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) ! tgs: a short subroutine could be made of progcld5 to ! compute only total cloud fraction. From 2aa91ae97ef29195995317ee2285972c0abc1afb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 2 Jun 2020 15:04:04 -0600 Subject: [PATCH 67/90] physics/GFS_suite_interstitial.F90: update of calculation of number concentrations for Thompson MP --- physics/GFS_suite_interstitial.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 3d22cf33b..466bcbb19 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -728,7 +728,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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) = nc_mp(i,k) + max(0.0, make_DropletNumber(qc_mp(i,k) * rho_dryair(i,k), nwfa(i,k)) * (1.0/rho_dryair(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 @@ -737,7 +737,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to 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) = ni_mp(i,k) + max(0.0, make_IceNumber(qi_mp(i,k) * rho_dryair(i,k), save_tcp(i,k)) * (1.0/rho_dryair(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 From b271cf7e974a1b10c60593555e615635de98a836 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 3 Jun 2020 17:45:46 -0600 Subject: [PATCH 68/90] mp_thompson_post.F90: print statistics about tendency limiter use only in DEBUG mode --- physics/mp_thompson_post.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/physics/mp_thompson_post.F90 b/physics/mp_thompson_post.F90 index 97b44943d..cca74951d 100644 --- a/physics/mp_thompson_post.F90 +++ b/physics/mp_thompson_post.F90 @@ -76,7 +76,9 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli ! 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 = '' @@ -95,26 +97,30 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli ! 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( -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: ttendlim applied ", events, "/", nlev*ncol, & & " times at timestep ", kdt end if +#endif end subroutine mp_thompson_post_run From 56d3bda05f8f39576c1d033869f07faa8f66aafd Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Thu, 4 Jun 2020 21:25:03 +0000 Subject: [PATCH 69/90] Follow up commit for Cleanup of Thompson MP cloud effective radii calculation --- physics/GFS_rrtmg_pre.F90 | 93 +-------- physics/module_SGSCloud_RadPre.F90 | 280 ++++++++++++++++++++-------- physics/module_SGSCloud_RadPre.meta | 50 +++++ 3 files changed, 258 insertions(+), 165 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 84732e401..413b532b4 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -180,7 +180,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input 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 - logical :: clduni real(kind=kind_phys) :: qvs ! !===> ... begin here @@ -730,7 +729,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input do i=1,im 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.)) - !tgs: clduni has different limits for ice radii: 10.0-150.0 + !tgs: progclduni has different limits for ice radii: 10.0-150.0 ! it will raise the low limit from 5 to 10, but the ! high limit will remain 125. re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) @@ -888,91 +887,16 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input elseif(Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP - clduni = .true. - if(Model%do_mynnedmf .or. & Model%imfdeepcnv == Model%imfdeepcnv_gf ) then ! MYNN PBL or GF conv - ! MYNN PBL or convective GF - - if (Model%kdt == 1 ) then - ! --- call progcld6 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) at - ! --- initial time step, it takes into account subgrid PBL - ! --- clouds - call progcld6 (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(:,:,Model%nleffr), & - Tbd%phy_f3d(:,:,Model%nieffr), & - Tbd%phy_f3d(:,:,Model%nseffr), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - if (clduni) then - ! use progclduni for interaction with radiation, - ! overwrites 'clouds' from progcld6 - 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 - endif - - else ! kdt > 1 - - ! --- call progcld6 to get Xu-Randall total cloud cover (clouds(:,1:LMK,1)) - ! tgs: a short subroutine could be made of progcld5 to - ! compute only total cloud fraction. - call progcld6 (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(:,:,Model%nleffr), & - Tbd%phy_f3d(:,:,Model%nieffr), & - Tbd%phy_f3d(:,:,Model%nseffr), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - - if (Model%do_mynnedmf) then - !tgs - let's use the PBL cloud fraction for now - do k=1,lmk - do i=1,im - !if (tracer1(i,k,ntrw) > 1.0e-7 .OR. tracer1(i,k,ntsw) > 1.0e-7) then - ! ! Xu-Randall cloud fraction computed in progcld6 - ! cldcov(i,k) = clouds(i,k,1) - !else - ! MYNN sub-grid cloud fraction - cldcov(i,k) = clouds1(i,k) - clouds(i,k,1) = clouds1(i,k) - !endif - enddo - enddo - elseif (Model%imfdeepcnv == Model%imfdeepcnv_gf) then ! GF conv - do k=1,lmk - do i=1,im - ! Xu-Randall cloud fraction computed in progcld6 - cldcov(i,k) = clouds(i,k,1) - enddo + !-- 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 - endif + enddo - if (.not. clduni) then - ! --- call progcld6 for interaction with the radiation with setting - ! --- uni_cld=.true. to keep precomputed cloud - ! --- fraction - call progcld6 (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, .true., & ! Model%uni_cld - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,Model%nleffr), & - Tbd%phy_f3d(:,:,Model%nieffr), & - Tbd%phy_f3d(:,:,Model%nseffr), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - - else ! clduni ! --- 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 @@ -980,9 +904,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input IM, LMK, LMP, clouds(:,1:LMK,1), & effrl, effri, effrr, effrs, Model%effr_in , & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs - endif ! clduni - - endif ! kdt else ! MYNN PBL or GF convective are not used diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index 16ebac5d7..4fb967ab0 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -2,7 +2,8 @@ !! 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 qc, qi and cloud fraction coming from the microphysics scheme. +!! 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 @@ -17,11 +18,13 @@ 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. +!! 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 Wu-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 ! @@ -35,7 +38,7 @@ subroutine sgscloud_radpre_run( & im,levs, & flag_init,flag_restart, & do_mynnedmf, & - qc, qi, T3D, & + qc, qi, qv, T3D, P3D, & qr, qs, & qci_conv, & imfdeepcnv, imfdeepcnv_gf, & @@ -45,25 +48,34 @@ subroutine sgscloud_radpre_run( & clouds4,clouds5,slmsk, & nlay, plyr, xlat, dz,de_lgth, & cldsa,mtopa,mbota, & + imp_physics, imp_physics_gfdl,& + imp_physics_thompson, & + imp_physics_wsm6, & errmsg, errflg ) ! should be moved to inside the mynn: use machine , only : kind_phys - use physcons, only : con_g, con_pi + 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 + integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, & + & nlay, imp_physics, imp_physics_wsm6, & + & imp_physics_thompson, 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 ! 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 + 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 @@ -82,97 +94,207 @@ subroutine sgscloud_radpre_run( & 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, tem1 + 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 mynn rad pre" + !write(0,*)"in SGSCLoud_RadPre" if (flag_init .and. (.not. flag_restart)) then - !write (0,*) 'Skip MYNNrad_pre flag_init = ', flag_init - return - endif - ! 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 - - ! add boundary layer clouds - Note: now the temperature-dependent sorting of - ! ice and water subgrid-scale clouds is done inside the MYNN-EDMF - if (do_mynnedmf) 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 - clouds1(i,k) = cldfra_bl(i,k) - - !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.) + 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( 0.95, qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(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), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) endif - !calculate the ice water path using additional BL clouds - clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) + !clouds1(i,k)=(1.-exp(-coef_alph*h2oliq/ & + ! & ((1.-rhgrid)*qsat*1000.0)**coef_gamm))*(rhgrid**coef_p) + !clouds1(i,k)=max(0.0,MIN(1.,clouds1(i,k))) endif - enddo enddo - endif ! do_mynnedmf - ! add convective clouds - if (imfdeepcnv == imfdeepcnv_gf) then + else ! kdt > 1 or restart + + ! Back-up microphysics cloud information: do k = 1, levs do i = 1, im - 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.) + 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 - 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 - enddo - endif + + elseif (imp_physics /= imp_physics_gfdl) then + + ! Non-MYNN cloud fraction AND non-GFDL microphysics, since bith + ! 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( 0.95, qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(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), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + + !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( 0.95, qv(i,k)/qsat ) ) + !h2oliq=1000.0*( qc(i,k) + qi(i,k) ) ! g/kg + !clouds1(i,k)=(1.-exp(-coef_alph*h2oliq/ & + ! & ((1.-rhgrid)*qsat*1000.0)**coef_gamm))*(rhgrid**coef_p) + !clouds1(i,k)=max(0.0,MIN(1.,clouds1(i,k))) + 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 + + ! 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( 0.95, qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(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), 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 + enddo + enddo + endif ! imfdeepcnv_gf + + endif ! kdt > 1 + !> - Compute SFC/low/middle/high cloud top pressure for each cloud domain for given latitude. do i =1, im diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 79691920d..fff8013c9 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -61,6 +61,15 @@ 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 @@ -70,6 +79,15 @@ 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 @@ -298,6 +316,38 @@ 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 +[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 +[imp_physics_wsm6] + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 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 From def46ffe8f4a785444e72b28e8ec49064bb5acd3 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 4 Jun 2020 15:59:08 -0600 Subject: [PATCH 70/90] Implement option to roll back Thompson MP to WRFV3.8.1 used in RAPv5/HRRRv4 --- physics/module_mp_thompson.F90 | 187 +++++++++++++++++++++++++++++---- 1 file changed, 167 insertions(+), 20 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b3ccb7412..191070b62 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 @@ -450,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)) @@ -961,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' @@ -997,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 @@ -1019,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):: & @@ -1054,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 @@ -1160,6 +1180,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. @@ -1218,6 +1264,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 @@ -1485,6 +1532,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 @@ -1499,6 +1547,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 @@ -1735,7 +1785,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 @@ -1984,7 +2039,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) @@ -2025,7 +2083,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 @@ -2427,6 +2490,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 @@ -2633,7 +2697,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 @@ -2765,7 +2835,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 @@ -3055,7 +3130,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) @@ -3103,7 +3181,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 @@ -3342,7 +3420,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 @@ -3408,7 +3491,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 @@ -3459,6 +3547,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 @@ -3488,7 +3580,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 @@ -3539,7 +3635,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 @@ -3566,7 +3666,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 @@ -3593,7 +3697,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 @@ -3634,16 +3742,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 @@ -5124,7 +5247,14 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & 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 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)) @@ -5136,7 +5266,9 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qc) then do k = kts, kte +#ifndef WRF381 re_qc1d(k) = 2.49E-6 +#endif if (rc(k).le.R1 .or. nc(k).le.R2) CYCLE if (nc(k).lt.100) then inu_c = 15 @@ -5152,16 +5284,24 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qi) then do k = kts, kte +#ifndef WRF381 re_qi1d(k) = 2.49E-6 +#endif if (ri(k).le.R1 .or. ni(k).le.R2) CYCLE lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi +#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 +#ifndef WRF381 re_qs1d(k) = 4.99E-6 +#endif if (rs(k).le.R1) CYCLE tc0 = MIN(-0.1, t1d(k)-273.15) smob = rs(k)*oams @@ -5196,7 +5336,11 @@ 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_ +#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 @@ -5383,7 +5527,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) From 72ac01d95f651e82c5c70d51f203d1a83854ae89 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Thu, 4 Jun 2020 22:05:29 +0000 Subject: [PATCH 71/90] updating comment to provide more general meaning --- physics/module_SGSCloud_RadPre.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index 4fb967ab0..f38625509 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -140,7 +140,7 @@ subroutine sgscloud_radpre_run( & enddo enddo - else ! kdt > 1 or restart + else ! timestep > 1 or restart ! Back-up microphysics cloud information: do k = 1, levs @@ -293,7 +293,7 @@ subroutine sgscloud_radpre_run( & enddo endif ! imfdeepcnv_gf - endif ! kdt > 1 + endif ! timestep > 1 !> - Compute SFC/low/middle/high cloud top pressure for each cloud domain for given latitude. From c41d691d400fc6f4d3132602f127127cfb3f2ccc Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 4 Jun 2020 16:09:45 -0600 Subject: [PATCH 72/90] physics/module_mp_thompson.F90: add guard to prevent running Thompson MP with the untested stochastic perturbations code --- physics/module_mp_thompson.F90 | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 191070b62..ce6df30e3 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1091,6 +1091,17 @@ 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 + ! *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 From 8fd1674e67e6e60360393fbf1907c958f113ace2 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Thu, 4 Jun 2020 23:03:05 +0000 Subject: [PATCH 73/90] remove progcld6 and thompson & wsm6 flags --- physics/GFS_rrtmg_pre.F90 | 2 +- physics/module_SGSCloud_RadPre.F90 | 5 +- physics/module_SGSCloud_RadPre.meta | 16 -- physics/radiation_clouds.f | 300 +--------------------------- 4 files changed, 3 insertions(+), 320 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 413b532b4..42411c88f 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -65,7 +65,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & progcld1, progcld3, & & progcld2, & & progcld4, progcld5, & - & progcld6, progclduni + & progclduni use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, & diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index f38625509..eacfcded7 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -49,8 +49,6 @@ subroutine sgscloud_radpre_run( & nlay, plyr, xlat, dz,de_lgth, & cldsa,mtopa,mbota, & imp_physics, imp_physics_gfdl,& - imp_physics_thompson, & - imp_physics_wsm6, & errmsg, errflg ) ! should be moved to inside the mynn: @@ -67,8 +65,7 @@ subroutine sgscloud_radpre_run( & ! 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_wsm6, & - & imp_physics_thompson, imp_physics_gfdl + & 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 diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index fff8013c9..63d83d349 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -332,22 +332,6 @@ 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 -[imp_physics_wsm6] - standard_name = flag_for_wsm6_microphysics_scheme - long_name = choice of WSM6 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 diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 176219199..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, progcld6, progcld4o, gethml + & cld_init, progcld5, progcld4o, gethml ! ================= @@ -2683,304 +2683,6 @@ subroutine progcld5 & end subroutine progcld5 !................................... -!----------------------------------- -!> \ingroup module_radiation_clouds -!! This subroutine computes cloud related quantities using the Thompson -!! cloud microphysics scheme with updated microphysics-cloud-radiation -!! interaction (including subgrid clouds). Adapted from progcld5. - subroutine progcld6 & - & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk,dz,delp, & - & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & - & IX, NLAY, NLP1, & - & uni_cld, lmfshal, lmfdeep2, cldcov, & - & re_cloud,re_ice,re_snow, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: - & ) - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: progcld6 computes cloud related quantities using ! -! the Thompson cloud microphysics scheme with updated microphysics ! -! cloud-radiation interaction (including subgrid clouds). ! -! ! -! abstract: this program computes cloud fractions from cloud ! -! condensates, ! -! and computes the low, mid, high, total and boundary layer cloud ! -! fractions and the vertical indices of low, mid, and high cloud ! -! top and base. the three vertical cloud domains are set up in the ! -! initial subroutine "cld_init". ! -! ! -! usage: call progcld6 ! -! ! -! subprograms called: gethml ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! input variables: ! -! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! -! plvl (IX,NLP1) : model level pressure in mb (100Pa) ! -! tlyr (IX,NLAY) : model layer mean temperature in k ! -! tvly (IX,NLAY) : model layer virtual temperature in k ! -! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! -! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! -! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! -! clw (IX,NLAY,ntrac) : layer cloud condensate amount ! -! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! -! range, otherwise see in-line comment ! -! xlon (IX) : grid longitude in radians (not used) ! -! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! -! dz (ix,nlay) : layer thickness (km) ! -! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! -! IX : horizontal dimention ! -! NLAY,NLP1 : vertical layer/level dimensions ! -! uni_cld : logical - true for cloud fraction from shoc ! -! lmfshal : logical - true for mass flux shallow convection ! -! lmfdeep2 : logical - true for mass flux deep convection ! -! cldcov : layer cloud fraction (used when uni_cld=.true. ! -! ! -! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! -! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! -! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! -! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! -! de_lgth(ix) : clouds decorrelation length (km) ! -! ! -! module variables: ! -! ivflip : control flag of vertical index direction ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! lmfshal : mass-flux shallow conv scheme flag ! -! lmfdeep2 : scale-aware mass-flux deep conv scheme flag ! -! lcrick : control flag for eliminating CRICK ! -! =t: apply layer smoothing to eliminate CRICK ! -! =f: do not apply layer smoothing ! -! lcnorm : control flag for in-cld condensate ! -! =t: normalize cloud condensate ! -! =f: not normalize cloud condensate ! -! ! -! ==================== end of description ===================== ! -! - implicit none - -! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 - integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl - - logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 - - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, & - & re_cloud, re_ice, re_snow - - real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw - - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & - & slmsk - -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds - - real (kind=kind_phys), dimension(:,:), intent(out) :: clds - real (kind=kind_phys), dimension(:), intent(out) :: de_lgth - - integer, dimension(:,:), intent(out) :: mtop,mbot - -! --- local variables: - real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2, tem3 - - integer :: i, k, id, nf - -! --- constant values - real (kind=kind_phys), parameter :: xrc3 = 100. - -! -!===> ... begin here -! - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = 0.0 - cldcnv(i,k) = 0.0 - cwp (i,k) = 0.0 - cip (i,k) = 0.0 - crp (i,k) = 0.0 - csp (i,k) = 0.0 - rew (i,k) = re_cloud(i,k) - rei (i,k) = re_ice(i,k) - rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = re_snow(i,K) -! tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) - clwf(i,k) = 0.0 - enddo - enddo - - do k = 1, NLAY - do i = 1, IX - clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) - & + clw(i,k,ntrw) + clw(i,k,ntgl) - enddo - enddo -!> - Find top pressure for each cloud domain for given latitude. -!! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; -!! i=1,2 are low-lat (<45 degree) and pole regions) - - do i =1, IX - 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, IX - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) - enddo - enddo - -!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . - - do k = 1, NLAY - do i = 1, IX - cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) - cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) - crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) - csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * - & gfac * delp(i,k)) - enddo - enddo - - if (uni_cld) then ! use unified sgs clouds generated outside - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = cldcov(i,k) - enddo - enddo - - else - -!> - Calculate layer cloud fraction. - - clwmin = 0.0 - - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan - !if (lmfdeep2) then - ! tem1 = xrc3 / tem1 - !else - tem1 = 100.0 / tem1 - !endif -! - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - - endif ! if (uni_cld) then - - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) < climit) then - cwp(i,k) = 0.0 - cip(i,k) = 0.0 - crp(i,k) = 0.0 - csp(i,k) = 0.0 - endif - enddo - enddo - - if ( lcnorm ) then - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) >= climit) then - tem1 = 1.0 / max(climit2, cldtot(i,k)) - cwp(i,k) = cwp(i,k) * tem1 - cip(i,k) = cip(i,k) * tem1 - crp(i,k) = crp(i,k) * tem1 - csp(i,k) = csp(i,k) * tem1 - endif - enddo - enddo - endif - -! - do k = 1, NLAY - do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) ! added for Thompson - clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) ! added for Thompson - clouds(i,k,9) = res(i,k) - enddo - enddo - -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later - - if ( iovr == 3 ) then - do i = 1, ix - de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) - enddo - endif - -!> - Call gethml() to compute low,mid,high,total, and boundary layer -!! cloud fractions and clouds top/bottom layer indices for low, mid, -!! and high clouds. -! --- compute low, mid, high, total, and boundary layer cloud fractions -! and clouds top/bottom layer indices for low, mid, and high clouds. -! The three cloud domain boundaries are defined by ptopc. The cloud -! overlapping method is defined by control flag 'iovr', which may -! be different for lw and sw radiation programs. - - call gethml & -! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & - & IX,NLAY, & -! --- outputs: - & clds, mtop, mbot & - & ) - - -! - return -!................................... - end subroutine progcld6 -!................................... - !> \ingroup module_radiation_clouds !> This subroutine computes cloud related quantities using !! for unified cloud microphysics scheme. From fc9a06dda429f9908e5a136e703a75e3b5b867d7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 4 Jun 2020 21:12:53 -0600 Subject: [PATCH 74/90] Correct typos in comments in physics/module_SGSCloud_RadPre.F90 --- physics/module_SGSCloud_RadPre.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index eacfcded7..a3731c63e 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -20,7 +20,7 @@ end subroutine sgscloud_radpre_finalize !> \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 Wu-Randall (1996), +!! 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 @@ -202,7 +202,7 @@ subroutine sgscloud_radpre_run( & elseif (imp_physics /= imp_physics_gfdl) then - ! Non-MYNN cloud fraction AND non-GFDL microphysics, since bith + ! 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 = From 90c83b557752a0bbe1ffbbff32585535130fe082 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 20:02:07 +0000 Subject: [PATCH 75/90] MYNNPBL wrapper update to include all required variables for ocean coupling --- physics/module_MYNNPBL_wrapper.F90 | 74 ++++++++++--- physics/module_MYNNPBL_wrapper.meta | 164 ++++++++++++++++++++++++++-- 2 files changed, 214 insertions(+), 24 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 0e9cb3c4f..3ab44c989 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -37,9 +37,10 @@ end subroutine mynnedmf_wrapper_finalize !! \htmlinclude mynnedmf_wrapper_run.html !! SUBROUTINE mynnedmf_wrapper_run( & - & im,levs, & + & ix,im,levs, & & flag_init,flag_restart,cycling, & - & lssav, ldiag3d, qdiag3d, lsidea,& + & lssav, ldiag3d, qdiag3d, & + & lsidea, cplflx, & & delt,dtf,dx,zorl, & & phii,u,v,omega,t3d, & & qgrs_water_vapor, & @@ -50,12 +51,19 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ozone, & & qgrs_water_aer_num_conc, & & qgrs_ice_aer_num_conc, & - & prsl,exner, & + & del,prsl,exner, & & slmsk,tsurf,qsfc,ps, & - & ust,ch,hflx,qflx, & - & wspd,rb,dtsfc1,dqsfc1, & + & 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, & + & 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, & @@ -171,6 +179,8 @@ SUBROUTINE mynnedmf_wrapper_run( & integer, intent(out) :: errflg LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea, qdiag3d + LOGICAL, INTENT(IN) :: cplflx + ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & lprnt, do_mynnsfclay, cycling @@ -204,7 +214,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !MYNN-1D REAL(kind=kind_phys), intent(in) :: delt, dtf - INTEGER, intent(in) :: im, levs + INTEGER, intent(in) :: im, ix, levs LOGICAL, intent(in) :: flag_init, flag_restart INTEGER :: initflag, k, i INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & @@ -231,7 +241,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & sub_thl,sub_sqv,det_thl,det_sqv real(kind=kind_phys), dimension(im,levs), intent(in) :: & & u,v,omega,t3d, & - & exner,prsl, & + & del,exner,prsl, & & qgrs_water_vapor, & & qgrs_liquid_cloud, & & qgrs_ice_cloud, & @@ -272,17 +282,25 @@ SUBROUTINE mynnedmf_wrapper_run( & 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_plume + integer, dimension(im), intent(inout) :: & + & kpbl,nupdraft,ktop_plume + + real(kind=kind_phys), dimension(im), intent(inout) :: & + & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl + real(kind=kind_phys), dimension(im), intent(out) :: & + & 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 @@ -474,12 +492,33 @@ 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 + + ! BWG: Coupling insertion + if(cplflx) then + dusfci_cpl(i) = dusfci_diag(i) + dvsfci_cpl(i) = dvsfci_diag(i) + dtsfci_cpl(i) = dtsfci_diag(i) + dqsfci_cpl(i) = dqsfci_diag(i) + + 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 + endif znt(i)=zorl(i)*0.01 !cm -> m? if (do_mynnsfclay) then @@ -782,7 +821,8 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo endif endif - + + if (lprnt) then print* print*,"===Finished with mynn_bl_driver; output:" diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 31ebcde74..6952fd7fd 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -27,10 +27,17 @@ intent = out optional = F -##################################################################### [ccpp-arg-table] name = mynnedmf_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 @@ -101,6 +108,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 @@ -254,6 +269,15 @@ kind = kind_phys intent = in optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -327,8 +351,8 @@ intent = out optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward sensible heat flux reduced by surface roughness + 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 @@ -336,8 +360,8 @@ intent = in optional = F [qflx] - standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward latent heat flux reduced by surface roughness + 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 @@ -380,6 +404,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 @@ -398,6 +458,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 @@ -405,7 +483,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 @@ -414,7 +492,79 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = out + intent = inout + 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 From 990ffbad9219d0ef595a8d5f8f0364d88145e451 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 5 Jun 2020 14:19:47 -0600 Subject: [PATCH 76/90] Add stochastic perturbation variables to mp_thompson.F90, bugfix in module_mp_thompson.F90 --- physics/module_mp_thompson.F90 | 22 +++++++++++++++------- physics/mp_thompson.F90 | 14 ++++++++++++++ 2 files changed, 29 insertions(+), 7 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index ce6df30e3..532071a8e 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1100,6 +1100,13 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & 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. & @@ -1428,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 @@ -5366,13 +5373,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 diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 3f2ee144e..1653c825d 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -472,6 +472,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, & @@ -601,6 +607,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, & @@ -618,6 +628,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, & From 45e6b4eed472969034c3510e29102fbe051f1638 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 20:33:58 +0000 Subject: [PATCH 77/90] Removing del and ix. using the *_reduced_by_... versions of hflx and qflx. --- physics/module_MYNNPBL_wrapper.F90 | 8 ++++---- physics/module_MYNNPBL_wrapper.meta | 25 ++++--------------------- 2 files changed, 8 insertions(+), 25 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 3ab44c989..3752f632b 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -37,7 +37,7 @@ end subroutine mynnedmf_wrapper_finalize !! \htmlinclude mynnedmf_wrapper_run.html !! SUBROUTINE mynnedmf_wrapper_run( & - & ix,im,levs, & + & im,levs, & & flag_init,flag_restart,cycling, & & lssav, ldiag3d, qdiag3d, & & lsidea, cplflx, & @@ -51,7 +51,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ozone, & & qgrs_water_aer_num_conc, & & qgrs_ice_aer_num_conc, & - & del,prsl,exner, & + & prsl,exner, & & slmsk,tsurf,qsfc,ps, & & ust,ch,hflx,qflx,wspd,rb, & & dtsfc1,dqsfc1, & @@ -214,7 +214,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, & @@ -241,7 +241,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & sub_thl,sub_sqv,det_thl,det_sqv real(kind=kind_phys), dimension(im,levs), intent(in) :: & & u,v,omega,t3d, & - & del,exner,prsl, & + & exner,prsl, & & qgrs_water_vapor, & & qgrs_liquid_cloud, & & qgrs_ice_cloud, & diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 6952fd7fd..c577b2563 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -30,14 +30,6 @@ [ccpp-arg-table] name = mynnedmf_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 @@ -269,15 +261,6 @@ kind = kind_phys intent = in optional = F -[del] - standard_name = air_pressure_difference_between_midlayers - long_name = pres(k) - pres(k+1) - units = Pa - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -351,8 +334,8 @@ intent = out optional = F [hflx] - 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 @@ -360,8 +343,8 @@ intent = in optional = F [qflx] - 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 From 840f13500d01f71232276613de295a91bdc010c2 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 21:01:12 +0000 Subject: [PATCH 78/90] Removing the im dimension specification of the *_cpl arrays, and making them all inout. Note that the meta file already had them as inout. --- physics/module_MYNNPBL_wrapper.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 3752f632b..413db8b62 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -289,9 +289,9 @@ SUBROUTINE mynnedmf_wrapper_run( & integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume - real(kind=kind_phys), dimension(im), intent(inout) :: & + real(kind=kind_phys), dimension(:), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind=kind_phys), dimension(im), intent(out) :: & + real(kind=kind_phys), dimension(:), intent(inout) :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL From 755de19e649a07d6beb060b35a13946192789c90 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 21:41:13 +0000 Subject: [PATCH 79/90] Updates to MYNN-EDMF --- physics/module_bl_mynn.F90 | 309 ++++++++++++++++++++----------------- 1 file changed, 169 insertions(+), 140 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index edc5d4a1e..2c1ce9fe0 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -459,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, & @@ -476,7 +476,7 @@ SUBROUTINE mym_initialize ( & 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,& @@ -546,7 +546,7 @@ SUBROUTINE mym_initialize ( & !> - call mym_length() to calculate the master length scale. CALL mym_length ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & rmo, flt, flq, & & vt, vq, & & u, v, qke, & @@ -791,7 +791,7 @@ 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, & & u1, v1, qke, & @@ -813,7 +813,7 @@ 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, 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 @@ -1042,7 +1042,7 @@ SUBROUTINE mym_length ( & 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 + 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 @@ -1543,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, & @@ -1571,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 @@ -1632,7 +1632,7 @@ SUBROUTINE mym_turbulence ( & ! CALL mym_length ( & & kts,kte, & - & dz, zw, & + & dz, dx, zw, & & rmo, flt, flq, & & vt, vq, & & u, v, qke, & @@ -1894,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)) @@ -2701,11 +2693,11 @@ SUBROUTINE mym_condensation (kts,kte, & !CLOUD WATER AND ICE IF (q1k < 0.) THEN !unstaurated ql_water = sgm(k)*EXP(1.2*q1k-1) -! ql_ice = sgm(k)*EXP(0.9*q1k-2.6) + 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 +! 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 @@ -2889,7 +2881,7 @@ 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 @@ -2915,7 +2907,7 @@ 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,ozone2 - REAL, DIMENSION(kts:kte) :: zfac,plumeKh + 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 @@ -2940,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 @@ -2969,25 +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 + & - sub_u(k)*delt + det_u(k)*delt +! 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 + 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 + & sub_u(k)*delt + det_u(k)*delt ENDDO !! no flux at the top @@ -3009,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 @@ -3022,26 +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 + & - sub_v(k)*delt + det_v(k)*delt +! 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 + 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 + & sub_v(k)*delt + det_v(k)*delt ENDDO !! no flux at the top @@ -3063,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 @@ -3093,19 +3120,19 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - 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) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + 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)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) - 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) + 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)/rho(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) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) + & - & diss_heat(k)*delt*dheat_opt + & + & + diss_heat(k)*delt*dheat_opt + & & sub_thl(k)*delt + det_thl(k)*delt ENDDO @@ -3161,16 +3188,16 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - 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) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + 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)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) - 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) + 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)/rho(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) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) ENDDO @@ -3226,17 +3253,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - 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) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + 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)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) - 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) + 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)/rho(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) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + & & det_sqc(k)*delt ENDDO @@ -3283,17 +3310,17 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - 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) - c(k)= -dtz(k)*khdz(k+1)/rho(k) - 0.5*dtz(k)*s_aw(k+1) + 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)*khdz(k)/rho(k) + 0.5*dtz(k)*s_aw(k) - 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) + 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)/rho(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) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + & & sub_sqv(k)*delt + det_sqv(k)*delt ENDDO @@ -3348,15 +3375,15 @@ SUBROUTINE mynn_tendencies(kts,kte, & ! ENDDO !rho-weighted: - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - c(k)= -dtz(k)*khdz(k+1)/rho(k) + 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)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) - c(k)= -dtz(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) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) d(k)=sqi(k) ENDDO @@ -3398,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 @@ -3439,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 @@ -3479,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 @@ -3521,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 @@ -3562,15 +3589,15 @@ SUBROUTINE mynn_tendencies(kts,kte, & k=kts !rho-weighted: - a(k)= -dtz(k)*khdz(k)/rho(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))/rho(k) - c(k)= -dtz(k)*khdz(k+1)/rho(k) + 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)/rho(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))/rho(k) - c(k)= -dtz(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) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) d(k)=ozone(k) ENDDO @@ -4440,7 +4467,8 @@ 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, & @@ -4816,7 +4844,7 @@ SUBROUTINE mynn_bl_driver( & !More strict limits over land to reduce stable-layer mixouts if ((xland(i,j)-1.5).GE.0)THEN ! WATER - radsum=MIN(radsum,120.0) + 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 @@ -4871,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 & @@ -4908,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, & @@ -5875,7 +5904,7 @@ SUBROUTINE DMP_mf( & !w-dependency for entrainment a la Tian and Kuang (2016) !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.31/(MIN(MAX(UPW(K-1,I),wmin),1.9)*l) + 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 !Minimum background entrainment From 49b7f3ca7757efde79f8480d906f8cc4457045dd Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 5 Jun 2020 23:26:07 +0000 Subject: [PATCH 80/90] Update to MYNN sfc layer scheme --- physics/module_MYNNSFC_wrapper.F90 | 21 +- physics/module_MYNNSFC_wrapper.meta | 68 ++++ physics/module_sf_mynn.F90 | 525 ++++++++++++++++++++++++++-- 3 files changed, 574 insertions(+), 40 deletions(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 5693c49a8..b2eaed414 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -19,14 +19,19 @@ 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( & & 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, & @@ -101,6 +106,15 @@ 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, levs @@ -235,8 +249,11 @@ SUBROUTINE mynnsfc_wrapper_run( & 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,itimestep=itimestep,iter=iter, & + 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) diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 61ddb4fd0..73bf1a462 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -57,6 +57,74 @@ 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 diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 73ef5e1fb..777a3d53f 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -26,20 +26,22 @@ MODULE module_sf_mynn ! roughness lengths (defaults are recommended): ! ! LAND only: -! "iz0tlnd" namelist option is used to select the following options: +! "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: GFS - taken from sfc_diff.f, for comparison/testing ! ! WATER only: -! "isftcflx" namelist option is used to select 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: GFS - taken from sfc_diff.f, for comparison/testing ! ! SNOW/ICE only: ! Andreas (2002) snow/ice parameterization for thermal and @@ -78,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 !------------------------------------------------------------------- @@ -99,6 +104,7 @@ MODULE module_sf_mynn 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: @@ -141,6 +147,9 @@ SUBROUTINE SFCLAY_mynn( & 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) @@ -271,11 +280,18 @@ SUBROUTINE SFCLAY_mynn( & REAL, INTENT(IN) :: SVP1,SVP2,SVP3,SVPT0 REAL, INTENT(IN) :: EP1,EP2,KARMAN REAL, INTENT(IN) :: CP,G,ROVCP,R,XLV !,DX -!NAMELIST OPTIONS: +!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 !=================================== @@ -432,7 +448,11 @@ SUBROUTINE SFCLAY_mynn( & XLAND(ims,j),DX(ims,j), & CP,G,ROVCP,R,XLV,SVP1,SVP2,SVP3,SVPT0, & EP1,EP2,KARMAN, & - ISFFLX,isftcflx,iz0tlnd,itimestep,iter, & + 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) @@ -479,7 +499,11 @@ SUBROUTINE SFCLAY1D_mynn( & PSFCPA,PBLH,MAVAIL,XLAND,DX, & CP,G,ROVCP,R,XLV,SVP1,SVP2,SVP3,SVPT0, & EP1,EP2,KARMAN, & - ISFFLX,isftcflx,iz0tlnd,itimestep,iter, & + 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) @@ -529,6 +553,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 @@ -837,7 +869,7 @@ SUBROUTINE SFCLAY1D_mynn( & ! 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.16 * (max(dx(i)/5000.-1.,0.))**onethird , 0.25) + 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) !-------------------------------------------------------- @@ -968,44 +1000,41 @@ SUBROUTINE SFCLAY1D_mynn( & !-------------------------------------- ! WATER !-------------------------------------- - ! 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_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) - ELSE - !COARE 3.5 - CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) + 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_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) + ELSE + !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_ocn(i),UST_ocn(i)) + ELSEIF ( ISFTCFLX .EQ. 3 ) THEN + CALL Taylor_Yelland_2001(ZNT_ocn(i),UST_ocn(i),WSPD(i)) + ELSEIF ( ISFTCFLX .EQ. 4 ) THEN + !GFS surface layer scheme + CALL GFS_z0_ocn(ZNT_ocn(i),UST_ocn(i),WSPD(i),ZA(I),sfc_z0_type,redrag) ENDIF - ELSEIF ( ISFTCFLX .EQ. 1 .OR. ISFTCFLX .EQ. 2 ) THEN - CALL davis_etal_2008(ZNT_ocn(i),UST_ocn(i)) - ELSEIF ( ISFTCFLX .EQ. 3 ) THEN - CALL Taylor_Yelland_2001(ZNT_ocn(i),UST_ocn(i),WSPD(i)) - ELSEIF ( ISFTCFLX .EQ. 4 ) THEN + ELSE + !DEFAULT TO COARE 3.0/3.5 IF (COARE_OPT .EQ. 3.0) THEN - !COARE 3.0 (MISLEADING SUBROUTINE NAME) + !COARE 3.0 CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ELSE !COARE 3.5 CALL edson_etal_2013(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) ENDIF ENDIF - ELSE - !DEFAULT TO COARE 3.0/3.5 - IF (COARE_OPT .EQ. 3.0) THEN - !COARE 3.0 - CALL charnock_1955(ZNT_ocn(i),UST_ocn(i),WSPD(i),visc,ZA(I)) - ELSE - !COARE 3.5 - 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 @@ -1061,6 +1090,10 @@ SUBROUTINE SFCLAY1D_mynn( & 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 @@ -1089,6 +1122,10 @@ SUBROUTINE SFCLAY1D_mynn( & 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) @@ -1118,6 +1155,10 @@ SUBROUTINE SFCLAY1D_mynn( & 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 @@ -1136,7 +1177,7 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF !end land point - IF (icy(I)) THEN + IF (icy(I) .OR. snowh_lnd(i) > 50.) THEN ! add stochastic perturbaction of ZNT if (spp_pbl==1) then @@ -2423,6 +2464,414 @@ SUBROUTINE Yang_2008(Z_0,Zt,Zq,ustar,tstar,qst,Ren,visc) 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). From 43821e3e426bc12950c91e370add48743bb7e901 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Mon, 8 Jun 2020 21:19:34 +0000 Subject: [PATCH 81/90] 2 small cosmetic updates, no impact on model behavior. --- physics/module_MYNNPBL_wrapper.meta | 1 + physics/module_MYNNSFC_wrapper.F90 | 2 -- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index c577b2563..1ab7af8b4 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -27,6 +27,7 @@ intent = out optional = F +##################################################################### [ccpp-arg-table] name = mynnedmf_wrapper_run type = scheme diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index b2eaed414..d14932e07 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -19,11 +19,9 @@ 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( & & im,levs, & From 626ec0e4c8a96b3599caaf18a28691c842bb2b9d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 9 Jun 2020 08:15:53 -0600 Subject: [PATCH 82/90] Clean up of effective radii calculation for Thompson MP: move initialization and bounds into the calc_effectRad routine, use settings consistent with previous version of code --- physics/GFS_rrtmg_pre.F90 | 19 +++++++-------- physics/module_mp_thompson.F90 | 44 ++++++++++++++++++++++++---------- physics/mp_thompson.F90 | 15 +----------- 3 files changed, 40 insertions(+), 38 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 42411c88f..381fa159f 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -716,23 +716,20 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input end do ! Call Thompson's subroutine to compute effective radii do i=1,im - ! Initialize to default in units m as in module_mp_thompson.F90 - re_cloud(i,:) = 2.49E-6 - re_ice(i,:) = 4.99E-6 - re_snow(i,:) = 9.99E-6 + ! 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 and apply bounds + ! Scale Thompson's effective radii from meter to micron do k=1,lm do i=1,im - 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.)) - !tgs: progclduni has different limits for ice radii: 10.0-150.0 - ! it will raise the low limit from 5 to 10, but the - ! high limit will remain 125. - re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) + 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 diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 532071a8e..705d245ae 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -5246,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 @@ -5262,6 +5262,30 @@ 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)) @@ -5270,7 +5294,8 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & #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 + ! For ni(k) a few lines below, it is still R2. + ! Note that R2 is defined as R2 = 1.E-6 nc(k) = MAX(2., MIN(nc1d(k)*rho(k), Nt_c_max)) #endif if (.NOT. is_aerosol_aware) nc(k) = Nt_c @@ -5284,9 +5309,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qc) then do k = kts, kte -#ifndef WRF381 - re_qc1d(k) = 2.49E-6 -#endif if (rc(k).le.R1 .or. nc(k).le.R2) CYCLE if (nc(k).lt.100) then inu_c = 15 @@ -5302,12 +5324,10 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qi) then do k = kts, kte -#ifndef WRF381 - re_qi1d(k) = 2.49E-6 -#endif if (ri(k).le.R1 .or. ni(k).le.R2) CYCLE lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi -#ifdef WRF381 +#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)) @@ -5317,9 +5337,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qs) then do k = kts, kte -#ifndef WRF381 - re_qs1d(k) = 4.99E-6 -#endif if (rs(k).le.R1) CYCLE tc0 = MIN(-0.1, t1d(k)-273.15) smob = rs(k)*oams @@ -5354,7 +5371,8 @@ 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_ -#ifdef WRF381 +#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)) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 1653c825d..ec19945b0 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -320,25 +320,12 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! Calculate initial cloud effective radii if requested if (present(re_cloud) .and. present(re_ice) .and. present(re_snow)) then - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = 2.49E-6 - re_ice(i,k) = 4.99E-6 - re_snow(i,k) = 9.99E-6 - end do - end do + ! 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 - do i = 1, ncol - do k = 1, nlev - re_cloud(i,k) = MAX(2.49E-6, MIN(re_cloud(i,k), 50.E-6)) - re_ice(i,k) = MAX(4.99E-6, MIN(re_ice(i,k), 125.E-6)) - re_snow(i,k) = MAX(9.99E-6, MIN(re_snow(i,k), 999.E-6)) - end do - 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. From 4619424a2040d51cf63d2b92dde10c3a42cb02fe Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 9 Jun 2020 10:20:21 -0600 Subject: [PATCH 83/90] physics/module_mp_thompson.F90: update comment on possible bug in nc calculation --- physics/module_mp_thompson.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 705d245ae..304afc6d5 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -5295,7 +5295,9 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & ! 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 + ! 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 From e889b037948b58e7009e80e13206c7b694a14e95 Mon Sep 17 00:00:00 2001 From: Ben Green Date: Thu, 18 Jun 2020 14:17:38 +0000 Subject: [PATCH 84/90] Mods to GSL physics for fractional --- physics/module_MYNNPBL_wrapper.F90 | 79 +++++++++++++++++---- physics/module_MYNNPBL_wrapper.meta | 105 ++++++++++++++++++++++++++++ physics/module_MYNNSFC_wrapper.F90 | 6 ++ physics/module_MYNNSFC_wrapper.meta | 54 ++++++++++++++ physics/module_sf_mynn.F90 | 34 +++++++-- 5 files changed, 259 insertions(+), 19 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 413db8b62..ea507db82 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -60,6 +60,10 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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, & @@ -175,6 +179,9 @@ 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, epsln=1.0d-10 + REAL, PARAMETER :: huge=9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -279,6 +286,14 @@ SUBROUTINE mynnedmf_wrapper_run( & & 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) :: & @@ -289,9 +304,9 @@ SUBROUTINE mynnedmf_wrapper_run( & integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume - real(kind=kind_phys), dimension(:), intent(inout) :: & + real(kind=kind_phys), dimension(im), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind=kind_phys), dimension(:), intent(inout) :: & + real(kind=kind_phys), dimension(im), intent(inout) :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL @@ -508,17 +523,55 @@ SUBROUTINE mynnedmf_wrapper_run( & dvsfc_diag(i) = dvsfc_diag(i) + dvsfci_diag(i)*delt ! BWG: Coupling insertion - if(cplflx) then - dusfci_cpl(i) = dusfci_diag(i) - dvsfci_cpl(i) = dvsfci_diag(i) - dtsfci_cpl(i) = dtsfci_diag(i) - dqsfci_cpl(i) = dqsfci_diag(i) - - 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 - endif + if (cplflx) then + !do i=1,im + if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES + if (fice(i) > one - epsln) 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 + +! if(cplflx) then +! dusfci_cpl(i) = dusfci_diag(i) +! dvsfci_cpl(i) = dvsfci_diag(i) +! dtsfci_cpl(i) = dtsfci_diag(i) +! dqsfci_cpl(i) = dqsfci_diag(i) +! +! 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 +! endif znt(i)=zorl(i)*0.01 !cm -> m? if (do_mynnsfclay) then diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 1ab7af8b4..b256277a2 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -352,6 +352,111 @@ 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 +[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 +[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 +[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 +[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 [wspd] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index d14932e07..496db7580 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -48,6 +48,8 @@ SUBROUTINE mynnsfc_wrapper_run( & & 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, & @@ -149,6 +151,8 @@ SUBROUTINE mynnsfc_wrapper_run( & & 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 @@ -267,6 +271,8 @@ SUBROUTINE mynnsfc_wrapper_run( & 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, & diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 73bf1a462..54aa4ff4c 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -725,6 +725,33 @@ 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] standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux @@ -734,6 +761,33 @@ 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 [lh] standard_name = surface_latent_heat long_name = latent heating at the surface (pos = up) diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 777a3d53f..94b118521 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -166,6 +166,8 @@ SUBROUTINE SFCLAY_mynn( & 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, & @@ -360,6 +362,8 @@ SUBROUTINE SFCLAY_mynn( & & 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 @@ -468,6 +472,8 @@ SUBROUTINE SFCLAY_mynn( & 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), & @@ -519,6 +525,8 @@ SUBROUTINE SFCLAY1D_mynn( & 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, & @@ -613,6 +621,8 @@ SUBROUTINE SFCLAY1D_mynn( & & 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 @@ -1763,14 +1773,18 @@ SUBROUTINE SFCLAY1D_mynn( & 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) - QFLX(i)=QFX(i)/RHO1D(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.) - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) + ! 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 !TRANSFER COEFF FOR SOME LSMs: @@ -1801,7 +1815,9 @@ SUBROUTINE SFCLAY1D_mynn( & 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) - QFLX(i)=QFX(i)/RHO1D(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: @@ -1813,7 +1829,9 @@ SUBROUTINE SFCLAY1D_mynn( & HFX(I)=HFX(I)+RHO1D(I)*USTM(I)*USTM(I)*WSPDI(I) ENDIF ENDIF - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) + ! 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 !TRANSFER COEFF FOR SOME LSMs: @@ -1844,14 +1862,18 @@ SUBROUTINE SFCLAY1D_mynn( & 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) - QFLX(i)=QFX(i)/RHO1D(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.) - HFLX(I)=HFX(I)/(RHO1D(I)*cpm(I)) + ! 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 !TRANSFER COEFF FOR SOME LSMs: From 707dece954e8ea97211167ac42b5718230401715 Mon Sep 17 00:00:00 2001 From: Ben Green Date: Thu, 18 Jun 2020 15:45:14 +0000 Subject: [PATCH 85/90] Cosmetic changes to MYNNPBL --- physics/module_MYNNPBL_wrapper.F90 | 62 ++++++++++++------------------ 1 file changed, 25 insertions(+), 37 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index ea507db82..57d05390f 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -522,9 +522,30 @@ SUBROUTINE mynnedmf_wrapper_run( & dusfc_diag(i) = dusfc_diag(i) + dusfci_diag(i)*delt dvsfc_diag(i) = dvsfc_diag(i) + dvsfci_diag(i)*delt - ! BWG: Coupling insertion + znt(i)=zorl(i)*0.01 !cm -> m? + if (do_mynnsfclay) then + rmol(i)=recmol(i) + else + if (hfx(i) .ge. 0.)then + rmol(i)=-hfx(i)/(200.*dz(i,1)*0.5) + else + rmol(i)=ABS(rb(i))*1./(dz(i,1)*0.5) + endif + !if (rb(i) .ge. 0.)then + ! rmol(i)=rb(i)*8./(dz(i,1)*0.5) + !else + ! rmol(i)=MAX(rb(i)*5.,-10.)/(dz(i,1)*0.5) + !endif + endif + ts(i)=tsurf(i)/exner(i,1) !theta +! qsfc(i)=qss(i) +! ps(i)=pgr(i) +! wspd(i)=wind(i) + enddo + + ! BWG: Coupling insertion if (cplflx) then - !do i=1,im + do i=1,im if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES if (fice(i) > one - epsln) then ! no open water, use results from CICE dusfci_cpl(i) = dusfc_cice(i) @@ -558,41 +579,8 @@ SUBROUTINE mynnedmf_wrapper_run( & dtsfc_cpl(i) = huge dqsfc_cpl(i) = huge endif ! Ocean only, NO LAKES - !enddo - endif - -! if(cplflx) then -! dusfci_cpl(i) = dusfci_diag(i) -! dvsfci_cpl(i) = dvsfci_diag(i) -! dtsfci_cpl(i) = dtsfci_diag(i) -! dqsfci_cpl(i) = dqsfci_diag(i) -! -! 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 -! endif - - znt(i)=zorl(i)*0.01 !cm -> m? - if (do_mynnsfclay) then - rmol(i)=recmol(i) - else - if (hfx(i) .ge. 0.)then - rmol(i)=-hfx(i)/(200.*dz(i,1)*0.5) - else - rmol(i)=ABS(rb(i))*1./(dz(i,1)*0.5) - endif - !if (rb(i) .ge. 0.)then - ! rmol(i)=rb(i)*8./(dz(i,1)*0.5) - !else - ! rmol(i)=MAX(rb(i)*5.,-10.)/(dz(i,1)*0.5) - !endif - endif - ts(i)=tsurf(i)/exner(i,1) !theta -! qsfc(i)=qss(i) -! ps(i)=pgr(i) -! wspd(i)=wind(i) - enddo + enddo + endif ! End coupling insertion if (lprnt) then print* From 1315db391f793fe9072b80f2b9797b6702649152 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Thu, 18 Jun 2020 16:54:34 +0000 Subject: [PATCH 86/90] MYNN-EDMF wrapper bug fix: mis-handling ozone when using GFDL microphysics --- physics/module_MYNNPBL_wrapper.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 413db8b62..f54ae7d38 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -429,6 +429,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qni(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + ozone(i,k) = qgrs_ozone(i,k) enddo enddo else @@ -456,6 +457,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qni(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + ozone(i,k) = qgrs_ozone(i,k) enddo enddo endif From 37719daee48f16e7be2c510ab0a3425e856c1eef Mon Sep 17 00:00:00 2001 From: Ben Green Date: Thu, 18 Jun 2020 18:25:16 +0000 Subject: [PATCH 87/90] cleanup of .meta file order to match corresponding .F90 --- physics/module_MYNNPBL_wrapper.F90 | 4 +- physics/module_MYNNPBL_wrapper.meta | 210 ++++++++++++++-------------- physics/module_MYNNSFC_wrapper.meta | 108 +++++++------- 3 files changed, 161 insertions(+), 161 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 57d05390f..53561818a 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -304,9 +304,9 @@ SUBROUTINE mynnedmf_wrapper_run( & integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume - real(kind=kind_phys), dimension(im), intent(inout) :: & + real(kind=kind_phys), dimension(:), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind=kind_phys), dimension(im), intent(inout) :: & + real(kind=kind_phys), dimension(:), intent(inout) :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index b256277a2..9833f7eba 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -352,111 +352,6 @@ 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 -[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 -[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 -[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 -[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 [wspd] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -583,6 +478,111 @@ kind = kind_phys 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 diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 54aa4ff4c..cf366d3d4 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -644,6 +644,60 @@ 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 @@ -725,33 +779,6 @@ 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] standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux @@ -761,33 +788,6 @@ 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 [lh] standard_name = surface_latent_heat long_name = latent heating at the surface (pos = up) From 728c076a64f921670e8be18d1b0c0d79de6e3254 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 25 Jun 2020 09:58:45 -0600 Subject: [PATCH 88/90] physics/module_MYNNPBL_wrapper.F90: modify coupling code as suggested by @shansun6 --- physics/module_MYNNPBL_wrapper.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 1faa62889..06385b0b1 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -179,7 +179,7 @@ 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, epsln=1.0d-10 + 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 @@ -549,7 +549,7 @@ SUBROUTINE mynnedmf_wrapper_run( & if (cplflx) then do i=1,im if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES - if (fice(i) > one - epsln) then ! no open water, use results from CICE + 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) From 3e214f7bffb840235b88a2d164963397ef3ba165 Mon Sep 17 00:00:00 2001 From: Joseph Olson Date: Fri, 26 Jun 2020 23:42:20 +0000 Subject: [PATCH 89/90] Updates to module_SGSCloud_RadPre.F90 and .meta (from Tanya) --- physics/module_SGSCloud_RadPre.F90 | 72 ++++++++++++++--------------- physics/module_SGSCloud_RadPre.meta | 9 ++++ 2 files changed, 43 insertions(+), 38 deletions(-) diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index a3731c63e..5a1a2744f 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -39,7 +39,7 @@ subroutine sgscloud_radpre_run( & flag_init,flag_restart, & do_mynnedmf, & qc, qi, qv, T3D, P3D, & - qr, qs, & + qr, qs, qg, & qci_conv, & imfdeepcnv, imfdeepcnv_gf, & qc_save, qi_save, & @@ -68,7 +68,7 @@ subroutine sgscloud_radpre_run( & & 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 + 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, & @@ -117,22 +117,20 @@ subroutine sgscloud_radpre_run( & 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( 0.95, qv(i,k)/qsat ) ) - h2oliq = qc(i,k) + qi(i,k) ! g/kg + 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), 50.0 ), 0.0 ) + 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 - !clouds1(i,k)=(1.-exp(-coef_alph*h2oliq/ & - ! & ((1.-rhgrid)*qsat*1000.0)**coef_gamm))*(rhgrid**coef_p) - !clouds1(i,k)=max(0.0,MIN(1.,clouds1(i,k))) + endif enddo enddo @@ -213,27 +211,20 @@ subroutine sgscloud_radpre_run( & 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( 0.95, qv(i,k)/qsat ) ) - h2oliq = qc(i,k) + qi(i,k) ! g/kg + 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), 50.0 ), 0.0 ) + 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 - !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( 0.95, qv(i,k)/qsat ) ) - !h2oliq=1000.0*( qc(i,k) + qi(i,k) ) ! g/kg - !clouds1(i,k)=(1.-exp(-coef_alph*h2oliq/ & - ! & ((1.-rhgrid)*qsat*1000.0)**coef_gamm))*(rhgrid**coef_p) - !clouds1(i,k)=max(0.0,MIN(1.,clouds1(i,k))) endif enddo enddo @@ -265,27 +256,32 @@ subroutine sgscloud_radpre_run( & if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) endif - ! 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( 0.95, qv(i,k)/qsat ) ) - h2oliq = qc(i,k) + qi(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), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhgrid) ) - - clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + if ( do_mynnedmf .or. (imp_physics == imp_physics_gfdl) ) then + !print *,'MYNN PBL or GFDL MP cldcov used' 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 + !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 diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index 63d83d349..8a742a041 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -106,6 +106,15 @@ 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 From daddd741a3b56a25f2ca004002dac0ad5c5c8629 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 30 Jun 2020 07:48:21 -0600 Subject: [PATCH 90/90] Cleanup/revert changes after merge of gsd/develop into master --- CODEOWNERS | 2 +- physics/GFS_rrtmg_pre.F90 | 2 +- physics/GFS_surface_generic.F90 | 3 +-- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/CODEOWNERS b/CODEOWNERS index b6c597371..0d5230f89 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @DomHeinzeller +* @climbfuji @llpcarson @grantfirl @JulieSchramm # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 381fa159f..d0826eb17 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -865,7 +865,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif elseif(Model%imp_physics == 6 .or. Model%imp_physics == 15) then - if (Model%kdt == 1 ) then + if (Model%kdt == 1) then Tbd%phy_f3d(:,:,Model%nleffr) = 10. Tbd%phy_f3d(:,:,Model%nieffr) = 50. Tbd%phy_f3d(:,:,Model%nseffr) = 250. diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index bdc546ce9..d7debf1cc 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -221,8 +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, lheatstrg, z0fac, e0fac, zorl, hflx, evap, hflxq, evapq, hffac, hefac, & - errmsg, errflg) + runoff, srunoff, runof, drain, lheatstrg, z0fac, e0fac, zorl, hflx, evap, hflxq, evapq, hffac, hefac, errmsg, errflg) implicit none