From 1c6cad52ef65d4b7d01bbe9ce9fe93e71129180a Mon Sep 17 00:00:00 2001 From: hannah barnes Date: Mon, 6 Jan 2020 10:52:21 -0700 Subject: [PATCH 1/4] 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 8d5fe8c3765eddfba4a33e023c3b70dcc47d5966 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 23 Jan 2020 11:50:13 -0700 Subject: [PATCH 2/4] 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 d2f38dd0de89ab20686c3fda84cc98355403ae2a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 13 Feb 2020 11:18:49 -0700 Subject: [PATCH 3/4] 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 cebdfa40bdd3059e689fd579c9fba2c689d33f2f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 17 Feb 2020 09:47:43 -0700 Subject: [PATCH 4/4] 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