From df30cf7c01d3fcd5f5a97ea4569220d1b3da7daf Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Sun, 9 May 2021 19:32:06 +0000 Subject: [PATCH 01/32] Limit full LW flux profile adjustment to below 100hPa. --- physics/dcyc2.f | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index ad9365851..a3d7cf193 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -380,9 +380,12 @@ subroutine dcyc2t3_run & ! do k = 1, levs+1 do i = 1, im - dT = t_lev2(i,k) - t_lev(i,k) - flxlwup_adj(i,k) = flux2D_lwUP(i,k) + & - & fluxlwUP_jac(i,k)*dT + flxlwup_adj(i,k) = flux2D_lwUP(i,k) + if (p_lev(i,k) .gt. 10000.) then + dT = t_lev2(i,k) - t_lev(i,k) + flxlwup_adj(i,k) = flux2D_lwUP(i,k) + & + & fluxlwUP_jac(i,k)*dT + endif enddo enddo ! From 6961b10546035b55021132e62ce139333eed9cc0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Sun, 9 May 2021 23:50:22 +0000 Subject: [PATCH 02/32] Added more safeguards against out-of-bounds temperature to GP inputs. --- physics/GFS_rrtmgp_pre.F90 | 12 ++++++++---- physics/GFS_rrtmgp_pre.meta | 9 +++++++++ physics/dcyc2.f | 9 +++++---- physics/dcyc2.meta | 18 ++++++++++++++++++ physics/radiation_tools.F90 | 20 ++++++++++++++------ physics/rrtmgp_lw_gas_optics.F90 | 4 +++- physics/rrtmgp_lw_gas_optics.meta | 9 +++++++++ 7 files changed, 66 insertions(+), 15 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 88e534595..af7e5f1a0 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -98,8 +98,8 @@ end subroutine GFS_rrtmgp_pre_init !! subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt, & - con_epsqs, minGPpres, minGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, & - qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg) + con_epsqs, minGPpres, minGPtemp, maxGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, & + tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -112,6 +112,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f lslwr ! Call LW radiation real(kind_phys), intent(in) :: & minGPtemp, & ! Minimum temperature allowed in RRTMGP. + maxGPtemp, & ! Maximum temperature allowed in RRTMGP. minGPpres, & ! Minimum pressure allowed in RRTMGP. fhswr, & ! Frequency of SW radiation call. fhlwr ! Frequency of LW radiation call. @@ -208,11 +209,14 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f if (t_lay(iCol,iLay) .le. minGPtemp) then t_lay(iCol,iLay) = minGPtemp + epsilon(minGPtemp) endif + if (t_lay(iCol,iLay) .ge. maxGPtemp) then + t_lay(iCol,iLay) = maxGPtemp - epsilon(maxGPtemp) + endif enddo enddo ! Temperature at layer-interfaces - call cmp_tlev(nCol,nLev,minGPpres,p_lay,t_lay,p_lev,tsfc,t_lev) + call cmp_tlev(nCol,nLev,minGPpres,minGPtemp,maxGPtemp,p_lay,t_lay,p_lev,tsfc,t_lev) ! Compute a bunch of thermodynamic fields needed by the cloud microphysics schemes. ! Relative humidity, saturation mixing-ratio, vapor mixing-ratio, virtual temperature, @@ -273,7 +277,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f ! ####################################################################################### ! Setup surface ground temperature and ground/air skin temperature if required. ! ####################################################################################### - tsfg(1:NCOL) = tsfc(1:NCOL) + tsfg(1:NCOL) = t_lev(1:NCOL,iSFC) tsfa(1:NCOL) = t_lay(1:NCOL,iSFC) end subroutine GFS_rrtmgp_pre_run diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 8096aef2a..895bbc630 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -239,6 +239,15 @@ kind = kind_phys intent = in optional = F +[maxGPtemp] + standard_name = maximum_temperature_in_RRTMGP + long_name = maximum temperature allowed in RRTMGP + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/dcyc2.f b/physics/dcyc2.f index a3d7cf193..4678efa0b 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -178,7 +178,7 @@ subroutine dcyc2t3_run & & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & - & dry, icy, wet, & + & dry, icy, wet, minGPtemp, maxGPtemp, & & minGPpres, use_LW_jacobian, sfculw, fluxlwUP_jac, & & t_lay, t_lev, p_lay, p_lev, flux2D_lwUP, flux2D_lwDOWN, & & pert_radtend, do_sppt,ca_global, & @@ -216,7 +216,8 @@ subroutine dcyc2t3_run & logical, intent(in) :: use_LW_jacobian, pert_radtend logical, intent(in) :: do_sppt,ca_global real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & - & deltim, fhswr, minGPpres + & deltim, fhswr, minGPpres, & + & minGPtemp, maxGPtemp real(kind=kind_phys), dimension(:), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & @@ -372,8 +373,8 @@ subroutine dcyc2t3_run & ! ! Compute temperatute at level interfaces. ! - call cmp_tlev(im, levs, minGPpres, p_lay, t_lay, p_lev, tsfc, & - & t_lev2) + call cmp_tlev(im, levs, minGPpres, minGPtemp, maxGPtemp, p_lay,& + & t_lay, p_lev, tsfc, t_lev2) ! ! Adjust up/downward fluxes (at layer interfaces). diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index a460db7ab..25b06cc83 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -353,6 +353,24 @@ type = logical intent = in optional = F +[minGPtemp] + standard_name = minimum_temperature_in_RRTMGP + long_name = minimum temperature allowed in RRTMGP + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[maxGPtemp] + standard_name = maximum_temperature_in_RRTMGP + long_name = maximum temperature allowed in RRTMGP + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [minGPpres] standard_name = minimum_pressure_in_RRTMGP long_name = minimum pressure allowed in RRTMGP diff --git a/physics/radiation_tools.F90 b/physics/radiation_tools.F90 index c6524aab6..a8d3f5457 100644 --- a/physics/radiation_tools.F90 +++ b/physics/radiation_tools.F90 @@ -2,20 +2,16 @@ module radiation_tools use machine, only: & kind_phys ! Working type implicit none - - real(kind_phys) :: & - rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP - rrtmgp_minT ! Minimum temperature allowed in RRTMGP contains ! ######################################################################################### ! ######################################################################################### - subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev) + subroutine cmp_tlev(nCol,nLev,minP,minT,maxT,p_lay,t_lay,p_lev,tsfc,t_lev) ! Inputs integer, intent(in) :: & nCol,nLev real(kind_phys),intent(in) :: & - minP + minP,minT,maxT real(kind_phys),dimension(nCol),intent(in) :: & tsfc real(kind_phys),dimension(nCol,nLev),intent(in) :: & @@ -78,6 +74,18 @@ subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev) t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif + ! Bound temperature at layer interfaces + do iCol=1,NCOL + do iLay=1,nLev+1 + if (t_lev(iCol,iLay) .le. minT) then + t_lev(iCol,iLay) = minT + epsilon(minT) + endif + if (t_lev(iCol,iLay) .ge. maxT) then + t_lev(iCol,iLay) = maxT - epsilon(maxT) + endif + enddo + enddo + end subroutine cmp_tlev ! ######################################################################################### diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index a116ad772..d7201e026 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -76,7 +76,7 @@ module rrtmgp_lw_gas_optics !! \htmlinclude rrtmgp_lw_gas_optics_init.html !! subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, & - mpirank, mpiroot, gas_concentrations, minGPpres, minGPtemp, errmsg, errflg) + mpirank, mpiroot, gas_concentrations, minGPpres, minGPtemp, maxGPtemp, errmsg, errflg) ! Inputs type(ty_gas_concs), intent(inout) :: & @@ -96,6 +96,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom errflg ! CCPP error code real(kind_phys), intent(out) :: & minGPtemp, & ! Minimum temperature allowed by RRTMGP. + maxGPtemp, & ! Maximum temperature allowed by RRTMG. minGPpres ! Minimum pressure allowed by RRTMGP. ! Local variables @@ -450,6 +451,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom ! temperature (GFS_rrtmgp_pre.F90) minGPpres = lw_gas_props%get_press_min() minGPtemp = lw_gas_props%get_temp_min() + maxGPtemp = lw_gas_props%get_temp_max() end subroutine rrtmgp_lw_gas_optics_init diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index c92567e14..823501cfa 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -92,6 +92,15 @@ kind = kind_phys intent = out optional = F +[maxGPtemp] + standard_name = maximum_temperature_in_RRTMGP + long_name = maximum temperature allowed in RRTMGP + units = K + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F ######################################################################## [ccpp-arg-table] From 6ebe85ef4a4d51a8e8bf7921e8079d395f90d89a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 11 May 2021 18:40:02 +0000 Subject: [PATCH 03/32] Apply constant heating-rate adjustment above 100hPa --- physics/dcyc2.f | 71 ++++++++++++++++++++++++++++++------------------- 1 file changed, 44 insertions(+), 27 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 4678efa0b..368272ff1 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -254,11 +254,19 @@ subroutine dcyc2t3_run & integer, intent(out) :: errflg ! --- locals: - integer :: i, k, nstp, nstl, it, istsun(im),iSFC + integer :: i, k, nstp, nstl, it, istsun(im),iSFC,iTOA real(kind=kind_phys) :: cns, coszn, tem1, tem2, anginc, & & rstl, solang, dT real(kind=kind_phys), dimension(im,levs+1) :: flxlwup_adj, & & flxlwdn_adj, t_lev2 + real(kind=kind_phys) :: fluxlwnet_adj,fluxlwnet,c1,c2,c3,c4,c5,ku + ! Pressure limit for LW flux adjustment + real(kind=kind_phys), parameter :: & + & plim_fluxAdj_upper = 10000. + ! Scaling factor for downwelling LW Jacobian profile. + real(kind=kind_phys), parameter :: & + & c0 = 0.2 + logical :: init_lev ! !===> ... begin here ! @@ -268,9 +276,11 @@ subroutine dcyc2t3_run & ! Vertical ordering? if (p_lev(1,1) .lt. p_lev(1, levs)) then - iSFC = levs + iSFC = levs + 1 + iTOA = 1 else iSFC = 1 + iTOA = levs + 1 endif tem1 = fhswr / deltim @@ -376,34 +386,41 @@ subroutine dcyc2t3_run & call cmp_tlev(im, levs, minGPpres, minGPtemp, maxGPtemp, p_lay,& & t_lay, p_lev, tsfc, t_lev2) + ! Compute adjusted net LW flux foillowing Hogan and Bozzo 2015 (10.1002/2015MS000455) + ! Here we assume that the profile of the downwelling LW Jaconiam has the same shape + ! as the upwelling, but scaled and offset. + ! The scaling factor is 0.2 + ! The profile of the downwelling Jacobian (J) is offset so that + ! J_dn_sfc / J_up_sfc = scaling_factor + ! J_dn_toa / J_up_sfc = 0 ! - ! Adjust up/downward fluxes (at layer interfaces). - ! - do k = 1, levs+1 - do i = 1, im - flxlwup_adj(i,k) = flux2D_lwUP(i,k) - if (p_lev(i,k) .gt. 10000.) then - dT = t_lev2(i,k) - t_lev(i,k) - flxlwup_adj(i,k) = flux2D_lwUP(i,k) + & - & fluxlwUP_jac(i,k)*dT + do i = 1, im + c1 = fluxlwUP_jac(i,iSFC) + c2 = fluxlwUP_jac(i,iTOA) / c1 + c3 = t_lev2(i,iSFC) - t_lev(i,iSFC) + init_lev = .true. + do k = 1, levs + ! Only apply the Jacobian adjustment below plim_fluxAdj_upper + if (p_lev(i,k) .gt. plim_fluxAdj_upper) then + c4 = fluxlwUP_jac(i,k)/c1 + fluxlwnet = (flux2D_lwUP(i,k+1) - flux2D_lwUP(i,k) -& + & flux2D_lwDOWN(i,k+1) + flux2D_lwDOWN(i,k)) + ! (Eq. 9) + c5 = c0 * (c4 - c2) / (1 - c2) + ! (Eq. 10) + fluxlwnet_adj = fluxlwnet + c3*(c4-c5) + ! Compute adjusted heating rate + htrlw(i,k) = fluxlwnet_adj * con_g / & + & (con_cp * (p_lev(i,k+1) - p_lev(i,k))) + + ! Store vertical index for plim_fluxAdj_upper + ku = k + ! Above, offset the heating rate by he same amount as in plim_fluxAdj_upper + else + htrlw(i,k) = hlw(i,k) + (htrlw(i,ku)-hlw(i,ku)) endif - enddo - enddo - ! - ! Compute new heating rate (within each layer). - ! - do k = 1, levs - htrlw(1:im,k) = & - & (flxlwup_adj(1:im,k+1) - flxlwup_adj(1:im,k) - & - & flux2D_lwDOWN(1:im,k+1) + flux2D_lwDOWN(1:im,k)) * & - & con_g / (con_cp * (p_lev(1:im,k+1) - p_lev(1:im,k))) - enddo - ! - ! Add radiative heating rates to physics heating rate - ! - do k = 1, levs - do i = 1, im + ! Add radiative heating rates to physics heating rate dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + htrlw(i,k) enddo enddo From 230d479e58cb380de9d24e8b67778db468250ba3 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 11 May 2021 19:47:23 +0000 Subject: [PATCH 04/32] Add vetical decay to impact of flux adjustment above threshold. --- physics/dcyc2.f | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 368272ff1..f671cf1f2 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -266,7 +266,6 @@ subroutine dcyc2t3_run & ! Scaling factor for downwelling LW Jacobian profile. real(kind=kind_phys), parameter :: & & c0 = 0.2 - logical :: init_lev ! !===> ... begin here ! @@ -398,7 +397,6 @@ subroutine dcyc2t3_run & c1 = fluxlwUP_jac(i,iSFC) c2 = fluxlwUP_jac(i,iTOA) / c1 c3 = t_lev2(i,iSFC) - t_lev(i,iSFC) - init_lev = .true. do k = 1, levs ! Only apply the Jacobian adjustment below plim_fluxAdj_upper if (p_lev(i,k) .gt. plim_fluxAdj_upper) then @@ -417,7 +415,8 @@ subroutine dcyc2t3_run & ku = k ! Above, offset the heating rate by he same amount as in plim_fluxAdj_upper else - htrlw(i,k) = hlw(i,k) + (htrlw(i,ku)-hlw(i,ku)) + htrlw(i,k) = hlw(i,k)+(p_lev(i,k)/plim_fluxAdj_upper)*& + & (htrlw(i,ku)-hlw(i,ku)) endif ! Add radiative heating rates to physics heating rate From 5f7d6970b7d420601dc86c2db91d953feebe1a7b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 24 May 2021 16:56:23 +0000 Subject: [PATCH 05/32] Added logistic function to damp the LW flux adjustment with height --- physics/dcyc2.f | 64 ++++++++++++++++++++++++---------------------- physics/dcyc2.meta | 26 +++++++++++++++++++ 2 files changed, 60 insertions(+), 30 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index f671cf1f2..09c80a97e 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -178,10 +178,10 @@ subroutine dcyc2t3_run & & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & - & dry, icy, wet, minGPtemp, maxGPtemp, & - & minGPpres, use_LW_jacobian, sfculw, fluxlwUP_jac, & - & t_lay, t_lev, p_lay, p_lev, flux2D_lwUP, flux2D_lwDOWN, & - & pert_radtend, do_sppt,ca_global, & + & dry, icy, wet, minGPtemp, maxGPtemp, damp_LW_fluxadj, & + & lfnc_k_grad, lfnc_p0, minGPpres, use_LW_jacobian, sfculw, & + & fluxlwUP_jac, t_lay, t_lev, p_lay, p_lev, flux2D_lwUP, & + & flux2D_lwDOWN, pert_radtend, do_sppt,ca_global, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: & dtdt,dtdtnp,htrlw, & @@ -213,11 +213,12 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(:), intent(in) :: dry, icy, wet - logical, intent(in) :: use_LW_jacobian, pert_radtend + logical, intent(in) :: use_LW_jacobian, damp_LW_fluxadj, & + & pert_radtend logical, intent(in) :: do_sppt,ca_global real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & - & deltim, fhswr, minGPpres, & - & minGPtemp, maxGPtemp + & deltim, fhswr, minGPpres, minGPtemp, maxGPtemp, lfnc_k_grad, & + & lfnc_p0 real(kind=kind_phys), dimension(:), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & @@ -259,10 +260,11 @@ subroutine dcyc2t3_run & & rstl, solang, dT real(kind=kind_phys), dimension(im,levs+1) :: flxlwup_adj, & & flxlwdn_adj, t_lev2 - real(kind=kind_phys) :: fluxlwnet_adj,fluxlwnet,c1,c2,c3,c4,c5,ku - ! Pressure limit for LW flux adjustment + real(kind=kind_phys) :: fluxlwnet_adj,fluxlwnet,c1,c2,c3,c4,c5, & + & dP,lfnc + ! Length scale for flux-adjustment scaling real(kind=kind_phys), parameter :: & - & plim_fluxAdj_upper = 10000. + & L = 1. ! Scaling factor for downwelling LW Jacobian profile. real(kind=kind_phys), parameter :: & & c0 = 0.2 @@ -393,34 +395,36 @@ subroutine dcyc2t3_run & ! J_dn_sfc / J_up_sfc = scaling_factor ! J_dn_toa / J_up_sfc = 0 ! + ! Optionally, the flux adjustment can be damped with height using a logistic function + ! fx ~ L / (1 + exp(-k*dp)), where dp = p - p0 + ! L = 1, fix scale between 0-1. + ! k (steepness) and p0 (midpoint) are controlled via namelist do i = 1, im c1 = fluxlwUP_jac(i,iSFC) c2 = fluxlwUP_jac(i,iTOA) / c1 c3 = t_lev2(i,iSFC) - t_lev(i,iSFC) do k = 1, levs ! Only apply the Jacobian adjustment below plim_fluxAdj_upper - if (p_lev(i,k) .gt. plim_fluxAdj_upper) then - c4 = fluxlwUP_jac(i,k)/c1 - fluxlwnet = (flux2D_lwUP(i,k+1) - flux2D_lwUP(i,k) -& - & flux2D_lwDOWN(i,k+1) + flux2D_lwDOWN(i,k)) - ! (Eq. 9) - c5 = c0 * (c4 - c2) / (1 - c2) - ! (Eq. 10) - fluxlwnet_adj = fluxlwnet + c3*(c4-c5) - ! Compute adjusted heating rate - htrlw(i,k) = fluxlwnet_adj * con_g / & - & (con_cp * (p_lev(i,k+1) - p_lev(i,k))) - - ! Store vertical index for plim_fluxAdj_upper - ku = k - ! Above, offset the heating rate by he same amount as in plim_fluxAdj_upper + c4 = fluxlwUP_jac(i,k)/c1 + fluxlwnet = (flux2D_lwUP(i,k+1) - flux2D_lwUP(i,k) - & + & flux2D_lwDOWN(i,k+1) + flux2D_lwDOWN(i,k)) + ! (Eq. 9) + c5 = c0 * (c4 - c2) / (1 - c2) + ! (Eq. 10) + fluxlwnet_adj = fluxlwnet + c3*(c4-c5) + ! Compute adjusted heating rate + htrlw(i,k) = fluxlwnet_adj * con_g / & + & (con_cp * (p_lev(i,k+1) - p_lev(i,k))) + + ! Add radiative heating rates to physics heating rate. Optionally, scaled w/ height + ! using a logistic function + if (damp_LW_fluxadj) then + dp = p_lev(i,k) - lfnc_p0 + lfnc = L / (1+exp(-lfnc_k_grad*exp(1.)*dp/lfnc_p0)) else - htrlw(i,k) = hlw(i,k)+(p_lev(i,k)/plim_fluxAdj_upper)*& - & (htrlw(i,ku)-hlw(i,ku)) + lfnc = 1. endif - - ! Add radiative heating rates to physics heating rate - dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + htrlw(i,k) + dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + htrlw(i,k)*lfnc enddo enddo else diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 25b06cc83..dceb9ce77 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -388,6 +388,32 @@ type = logical intent = in optional = F +[damp_LW_fluxadj] + standard_name = flag_to_damp_RRTMGP_LW_jacobian_flux_adjustment + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lfnc_k_grad] + standard_name = steepness_of_flux_damping + long_name = steepness of logistic function for damping the LW flux adjustment + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lfnc_p0] + standard_name = midpoint_used_for_flux_damping + long_name = midpoint for damping the LW flux adjustment + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [sfculw] standard_name = surface_upwelling_longwave_flux_on_radiation_time_step long_name = total sky sfc upward lw flux From e9bdebdf6ae4bb0bae6ddeb0b0487de59fda01eb Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Mon, 24 May 2021 17:10:53 +0000 Subject: [PATCH 06/32] Add 3D diagnostics from thompson --- physics/module_mp_thompson.F90 | 19 ++++++++++++++++--- physics/mp_thompson.F90 | 11 +++++++---- physics/mp_thompson.meta | 13 +++++++++++++ 3 files changed, 36 insertions(+), 7 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index dfe31f375..af09ab58f 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1018,7 +1018,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims - errmsg, errflg, reset) + errmsg, errflg, reset, vts1) implicit none @@ -1028,6 +1028,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & its,ite, jts,jte, kts,kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & qv, qc, qr, qi, qs, qg, ni, nr + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: vts1 + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & tt, th REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(IN):: & @@ -1067,6 +1069,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, & t1d, p1d, w1d, dz1d, rho, dBZ + REAL, DIMENSION(kts:kte):: vtsk1 + REAL, DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d #if ( WRF_CHEM == 1 ) REAL, DIMENSION(kts:kte):: & @@ -1260,6 +1264,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ni1d(k) = ni(i,k,j) nr1d(k) = nr(i,k,j) rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) + vtsk1(k) = 0. + vts1(i,k,j) = 0. enddo if (is_aerosol_aware) then do k = kts, kte @@ -1283,7 +1289,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & rainprod1d, evapprod1d, & #endif rand1, rand2, rand3, & - kts, kte, dt, i, j) + kts, kte, dt, i, j, vtsk1) pcp_ra(i,j) = pptrain pcp_sn(i,j) = pptsnow @@ -1337,6 +1343,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qg(i,k,j) = qg1d(k) ni(i,k,j) = ni1d(k) nr(i,k,j) = nr1d(k) + vts1(i,k,j) = vtsk1(k) if (present(tt)) then; tt(i,k,j) = t1d(k) else @@ -1550,7 +1557,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rainprod, evapprod, & #endif rand1, rand2, rand3, & - kts, kte, dt, ii, jj) + kts, kte, dt, ii, jj, vtsk1) #ifdef MPI use mpi #endif @@ -1565,6 +1572,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice REAL, INTENT(IN):: dt REAL, INTENT(IN):: rand1, rand2, rand3 + REAL, DIMENSION(kts:kte), INTENT(OUT):: vtsk1 #if ( WRF_CHEM == 1 ) REAL, DIMENSION(kts:kte), INTENT(INOUT):: & @@ -3362,6 +3370,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & vtgk(k) = 0. vtck(k) = 0. vtnck(k) = 0. + vtsk1(k) = 0. enddo if (ANY(L_qr .eqv. .true.)) then @@ -3469,6 +3478,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nstep = 0 do k = kte, kts, -1 vts = 0. + vtsk1(k)=0. if (rs(k).gt. R1) then xDs = smoc(k) / smob(k) @@ -3487,11 +3497,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ! & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) SR = rs(k)/(rs(k)+rr(k)) vtsk(k) = vts*SR + (1.-SR)*vtrk(k) + vtsk1(k)=vtsk(k) else vtsk(k) = vts*vts_boost(k) + vtsk1(k)=vtsk(k) endif else vtsk(k) = vtsk(k+1) + vtsk1(k)=0 endif if (vtsk(k) .gt. 1.E-3) then diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 1ad4b2d4b..4767dfd2a 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -333,7 +333,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & refl_10cm, reset, do_radar_ref, & re_cloud, re_ice, re_snow, & mpicomm, mpirank, mpiroot, & - errmsg, errflg) + errmsg, errflg,naux3d, aux3d) implicit none @@ -390,6 +390,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg + ! Auxillary output + integer, intent(in) :: naux3d + real(kind_phys), intent(inout) :: aux3d(:,:,:) ! Local variables @@ -606,7 +609,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & @@ -624,7 +627,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1) end if end if if (errflg/=0) return @@ -655,7 +658,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ice = ice + max(0.0, delta_ice_mp/1000.0_kind_phys) snow = snow + max(0.0, delta_snow_mp/1000.0_kind_phys) rain = rain + max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys) - + aux3d(:,:,1) = vts1 end subroutine mp_thompson_run !>@} diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 237890024..38b3b8dce 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -319,6 +319,19 @@ type = integer intent = out optional = F +[naux3d] + standard_name = number_of_3d_auxiliary_arrays + long_name = number of 3d auxiliary arrays to output (for debugging) + units = count + dimensions = () + type = integer +[aux3d] + standard_name = auxiliary_3d_arrays + long_name = auxiliary 3d arrays to output (for debugging) + units = none + dimensions = (horizontal_dimension,vertical_dimension,number_of_3d_auxiliary_arrays) + type = real + kind = kind_phys ######################################################################## [ccpp-arg-table] From 2f6e70814fdaae4ba33b00c7d5c7ec421a8e69e8 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 24 May 2021 17:37:55 +0000 Subject: [PATCH 07/32] Reorganized RRTMGP aerosol optics. --- ...tics.F90 => GFS_rrtmgp_aerosol_optics.F90} | 66 ++++--- ...cs.meta => GFS_rrtmgp_aerosol_optics.meta} | 50 ++--- physics/rrtmgp_lw_aerosol_optics.meta | 173 ------------------ physics/rrtmgp_sw_aerosol_optics.F90 | 119 ------------ 4 files changed, 73 insertions(+), 335 deletions(-) rename physics/{rrtmgp_lw_aerosol_optics.F90 => GFS_rrtmgp_aerosol_optics.F90} (59%) rename physics/{rrtmgp_sw_aerosol_optics.meta => GFS_rrtmgp_aerosol_optics.meta} (91%) delete mode 100644 physics/rrtmgp_lw_aerosol_optics.meta delete mode 100644 physics/rrtmgp_sw_aerosol_optics.F90 diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/GFS_rrtmgp_aerosol_optics.F90 similarity index 59% rename from physics/rrtmgp_lw_aerosol_optics.F90 rename to physics/GFS_rrtmgp_aerosol_optics.F90 index df0e77163..194c33ba1 100644 --- a/physics/rrtmgp_lw_aerosol_optics.F90 +++ b/physics/GFS_rrtmgp_aerosol_optics.F90 @@ -1,8 +1,8 @@ -module rrtmgp_lw_aerosol_optics +module GFS_rrtmgp_aerosol_optics use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl - use radiation_tools, only: check_error_msg + use mo_optical_props, only: ty_optical_props_1scl,ty_optical_props_2str + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_lw_gas_optics, only: lw_gas_props use module_radiation_aerosols, only: & @@ -14,34 +14,37 @@ module rrtmgp_lw_aerosol_optics implicit none - public rrtmgp_lw_aerosol_optics_init, rrtmgp_lw_aerosol_optics_run, rrtmgp_lw_aerosol_optics_finalize + public GFS_rrtmgp_aerosol_optics_init, GFS_rrtmgp_aerosol_optics_run, GFS_rrtmgp_aerosol_optics_finalize contains ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_aerosol_optics_init() + ! SUBROUTINE GFS_rrtmgp_aerosol_optics_init() ! ######################################################################################### - subroutine rrtmgp_lw_aerosol_optics_init() - end subroutine rrtmgp_lw_aerosol_optics_init + subroutine GFS_rrtmgp_aerosol_optics_init() + end subroutine GFS_rrtmgp_aerosol_optics_init ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_aerosol_optics_run() + ! SUBROUTINE GFS_rrtmgp_aerosol_optics_run() ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_aerosol_optics_run -!! \htmlinclude rrtmgp_lw_aerosol_optics.html +!! \section arg_table_GFS_rrtmgp_aerosol_optics_run +!! \htmlinclude GFS_rrtmgp_aerosol_optics.html !! - subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer,& - p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - aerodp, lw_optical_props_aerosol, errmsg, errflg) + subroutine GFS_rrtmgp_aerosol_optics_run(doLWrad, nCol, nLev, nDay, nTracer, nTracerAer, & + idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + aerodp, lw_optical_props_aerosol, sw_optical_props_aerosol, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad ! Logical flag for longwave radiation call integer, intent(in) :: & nCol, & ! Number of horizontal grid points + nDay, & ! Number of daylit points nLev, & ! Number of vertical layers nTracer, & ! Number of tracers nTracerAer ! Number of aerosol tracers + integer,intent(in),dimension(:) :: & + idxday ! Daylit point indices real(kind_phys), dimension(:), intent(in) :: & lon, & ! Longitude lat, & ! Latitude @@ -63,6 +66,8 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer aerodp ! Vertical integrated optical depth for various aerosol species type(ty_optical_props_1scl),intent(inout) :: & lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_aerosol ! RRTMGP DDT: Shortwave aerosol optical properties (tau,ssa,omega) integer, intent(out) :: & errflg ! CCPP error flag character(len=*), intent(out) :: & @@ -82,23 +87,40 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer if (.not. doLWrad) return ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile - call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, ncol, nLev, & - nLev+1, .true., .true., aerosolssw, aerosolslw, aerodp) + call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, & + lat, ncol, nLev, nLev+1, .true., .true., aerosolssw, aerosolslw, aerodp) - ! Copy aerosol optical information to RRTMGP DDT + ! Copy aerosol optical information to RRTMGP DDTs + ! + ! LW + ! lw_optical_props_aerosol%tau = aerosolslw(:,:,:,1) * (1. - aerosolslw(:,:,:,2)) - lw_optical_props_aerosol%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() do iBand=1,lw_gas_props%get_nband() lw_optical_props_aerosol%band2gpt(1:2,iBand) = iBand lw_optical_props_aerosol%gpt2band(iBand) = iBand end do + ! + ! SW + ! + if (nDay .gt. 0) then + ! Allocate RRTMGP DDT + call check_error_msg('rrtmgp_sw_aerosol_optics_run',sw_optical_props_aerosol%alloc_2str( & + nDay, nlev, sw_gas_props%get_band_lims_wavenumber())) + ! Copy + sw_optical_props_aerosol%tau(:,:,1) = aerosolssw(idxday(1:nDay),:,sw_gas_props%get_nband(), 1) + sw_optical_props_aerosol%tau(:,:,2:sw_gas_props%get_nband()-1) = aerosolssw(idxday(1:nDay),:,1:sw_gas_props%get_nband()-1,1) + sw_optical_props_aerosol%ssa(:,:,1) = aerosolssw(idxday(1:nDay),:,sw_gas_props%get_nband(), 2) + sw_optical_props_aerosol%ssa(:,:,2:sw_gas_props%get_nband()-1) = aerosolssw(idxday(1:nDay),:,1:sw_gas_props%get_nband()-1,2) + sw_optical_props_aerosol%g(:,:,1) = aerosolssw(idxday(1:nDay),:,sw_gas_props%get_nband(), 3) + sw_optical_props_aerosol%g(:,:,2:sw_gas_props%get_nband()-1) = aerosolssw(idxday(1:nDay),:,1:sw_gas_props%get_nband()-1,3) + endif - end subroutine rrtmgp_lw_aerosol_optics_run + end subroutine GFS_rrtmgp_aerosol_optics_run ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_aerosol_optics_finalize() + ! SUBROUTINE GFS_rrtmgp_aerosol_optics_finalize() ! ######################################################################################### - subroutine rrtmgp_lw_aerosol_optics_finalize() - end subroutine rrtmgp_lw_aerosol_optics_finalize -end module rrtmgp_lw_aerosol_optics + subroutine GFS_rrtmgp_aerosol_optics_finalize() + end subroutine GFS_rrtmgp_aerosol_optics_finalize +end module GFS_rrtmgp_aerosol_optics diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/GFS_rrtmgp_aerosol_optics.meta similarity index 91% rename from physics/rrtmgp_sw_aerosol_optics.meta rename to physics/GFS_rrtmgp_aerosol_optics.meta index f4909c794..aa7f6d4a5 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/GFS_rrtmgp_aerosol_optics.meta @@ -1,15 +1,15 @@ [ccpp-table-properties] - name = rrtmgp_sw_aerosol_optics + name = GFS_rrtmgp_aerosol_optics type = scheme dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radiation_tools.F90 ######################################################################## [ccpp-arg-table] - name = rrtmgp_sw_aerosol_optics_run + name = GFS_rrtmgp_aerosol_optics_run type = scheme -[doSWrad] - standard_name = flag_to_calc_sw - long_name = logical flags for sw radiation calls +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls units = flag dimensions = () type = logical @@ -23,6 +23,22 @@ type = integer intent = in optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F [nLev] standard_name = vertical_dimension long_name = number of vertical levels @@ -47,22 +63,6 @@ type = integer intent = in optional = F -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation @@ -162,6 +162,14 @@ kind = kind_phys intent = inout optional = F +[lw_optical_props_aerosol] + standard_name = longwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = inout + optional = F [sw_optical_props_aerosol] standard_name = shortwave_optical_properties_for_aerosols long_name = Fortran DDT containing RRTMGP optical properties diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta deleted file mode 100644 index ad68fd546..000000000 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ /dev/null @@ -1,173 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_aerosol_optics - type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radiation_tools.F90 - -######################################################################## -[ccpp-arg-table] - name = rrtmgp_lw_aerosol_optics_run - type = scheme -[doLWrad] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - 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 -[nTracer] - standard_name = number_of_tracers - long_name = number of tracers - units = count - dimensions = () - type = integer - intent = in - optional = F -[nTracerAer] - standard_name = number_of_aerosol_tracers_MG - long_name = number of aerosol tracers for Morrison Gettelman MP - units = count - dimensions = () - type = integer - intent = in - optional = F -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa - long_name = air pressure at vertical interface for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure at vertical layer for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[p_lk] - standard_name = dimensionless_exner_function_at_model_layers - long_name = dimensionless Exner function at model layer centers - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[relhum] - standard_name = relative_humidity - long_name = layer relative humidity - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[lsmask] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tracer] - standard_name = chemical_tracers - long_name = chemical tracers - units = g g-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in - optional = F -[aerfld] - standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology - long_name = GOCART aerosol climatology number concentration - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_aerosol_tracers_MG) - type = real - kind = kind_phys - intent = in - optional = F -[lon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[lat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[aerodp] - standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles - long_name = vertical integrated optical depth for various aerosol species - units = none - dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) - type = real - kind = kind_phys - intent = inout - optional = F -[lw_optical_props_aerosol] - standard_name = longwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - intent = inout - 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/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 deleted file mode 100644 index 3a74771b7..000000000 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ /dev/null @@ -1,119 +0,0 @@ -module rrtmgp_sw_aerosol_optics - use machine, only: kind_phys - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_2str - use radiation_tools, only: check_error_msg - use rrtmgp_sw_gas_optics, only: sw_gas_props - use rrtmgp_lw_gas_optics, only: lw_gas_props - use module_radiation_aerosols, only: & - NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) - NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) - setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) - NSPC1 ! Number of species for vertically integrated aerosol optical-depth - use netcdf - - implicit none - - public rrtmgp_sw_aerosol_optics_init, rrtmgp_sw_aerosol_optics_run, rrtmgp_sw_aerosol_optics_finalize - -contains - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_aerosol_optics_init() - ! ######################################################################################### - subroutine rrtmgp_sw_aerosol_optics_init() - end subroutine rrtmgp_sw_aerosol_optics_init - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_aerosol_optics_run() - ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_aerosol_optics_run -!! \htmlinclude rrtmgp_sw_aerosol_optics_run.html -!! - subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer, nDay, & - idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - aerodp, sw_optical_props_aerosol, errmsg, errflg ) - - ! Inputs - logical, intent(in) :: & - doSWrad ! Logical flag for shortwave radiation call - integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nDay, & ! Number of daylit points - nLev, & ! Number of vertical layers - nTracer, & ! Number of tracers - nTracerAer ! Number of aerosol tracers - integer,intent(in),dimension(:) :: & - idxday ! Indices for daylit points. - real(kind_phys), dimension(:), intent(in) :: & - lon, & ! Longitude - lat, & ! Latitude - lsmask ! Land/sea/sea-ice mask - real(kind_phys), dimension(:,:),intent(in) :: & - p_lay, & ! Pressure @ layer-centers (Pa) - tv_lay, & ! Virtual-temperature @ layer-centers (K) - relhum, & ! Relative-humidity @ layer-centers - p_lk ! Exner function @ layer-centers (1) - real(kind_phys), dimension(:, :,:),intent(in) :: & - tracer ! trace gas concentrations - real(kind_phys), dimension(:, :,:),intent(in) :: & - aerfld ! aerosol input concentrations - real(kind_phys), dimension(:,:),intent(in) :: & - p_lev ! Pressure @ layer-interfaces (Pa) - - ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: & - aerodp ! Vertical integrated optical depth for various aerosol species - type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) - integer, intent(out) :: & - errflg ! CCPP error flag - character(len=*), intent(out) :: & - errmsg ! CCPP error message - - ! Local variables - real(kind_phys), dimension(nCol, nLev, lw_gas_props%get_nband(), NF_AELW) :: & - aerosolslw ! - real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & - aerosolssw, aerosolssw2 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doSWrad) return - if (nDay .gt. 0) then - - ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile - call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & - nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) - - ! Store aerosol optical properties - ! SW. - ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the - ! band ordering was [nIR -> UV -> IR(band)] - aerosolssw(1:nCol,:,1,1) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),1) - aerosolssw(1:nCol,:,1,2) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),2) - aerosolssw(1:nCol,:,1,3) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),3) - aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),1) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,1) - aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),2) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,2) - aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),3) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,3) - - ! Allocate RRTMGP DDT: Aerosol optics [nCol,nlev,nBands] - call check_error_msg('rrtmgp_sw_aerosol_optics_run',sw_optical_props_aerosol%alloc_2str( & - nDay, nlev, sw_gas_props%get_band_lims_wavenumber())) - - ! Copy aerosol optical information to RRTMGP DDT - sw_optical_props_aerosol%tau = aerosolssw(idxday(1:nday),:,:,1) - sw_optical_props_aerosol%ssa = aerosolssw(idxday(1:nday),:,:,2) - sw_optical_props_aerosol%g = aerosolssw(idxday(1:nday),:,:,3) - endif - - end subroutine rrtmgp_sw_aerosol_optics_run - - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_aerosol_optics_finalize() - ! ######################################################################################### - subroutine rrtmgp_sw_aerosol_optics_finalize() - end subroutine rrtmgp_sw_aerosol_optics_finalize -end module rrtmgp_sw_aerosol_optics From 3932db1b37fd04f86bc8552b13f999298e2e919a Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Tue, 25 May 2021 13:34:09 +0000 Subject: [PATCH 08/32] correction: add vts to additional calls and aux,naux to correct place in meta file --- physics/mp_thompson.F90 | 7 +++++-- physics/mp_thompson.meta | 26 +++++++++++++------------- 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 4767dfd2a..ab9f49049 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -431,6 +431,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + !Auxillary fields + real(kind_phys) :: vts1(1:ncol,1:nlev) + ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -569,7 +572,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & @@ -588,7 +591,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1) end if else if (do_effective_radii) then diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 38b3b8dce..a6810e203 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -319,19 +319,6 @@ type = integer intent = out optional = F -[naux3d] - standard_name = number_of_3d_auxiliary_arrays - long_name = number of 3d auxiliary arrays to output (for debugging) - units = count - dimensions = () - type = integer -[aux3d] - standard_name = auxiliary_3d_arrays - long_name = auxiliary 3d arrays to output (for debugging) - units = none - dimensions = (horizontal_dimension,vertical_dimension,number_of_3d_auxiliary_arrays) - type = real - kind = kind_phys ######################################################################## [ccpp-arg-table] @@ -705,6 +692,19 @@ type = integer intent = out optional = F +[naux3d] + standard_name = number_of_3d_auxiliary_arrays + long_name = number of 3d auxiliary arrays to output (for debugging) + units = count + dimensions = () + type = integer +[aux3d] + standard_name = auxiliary_3d_arrays + long_name = auxiliary 3d arrays to output (for debugging) + units = none + dimensions = (horizontal_dimension,vertical_dimension,number_of_3d_auxiliary_arrays) + type = real + kind = kind_phys ######################################################################## [ccpp-arg-table] From 7bc877dd5e69cf0f171b1267cf0776fa33d6fb48 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 25 May 2021 16:47:28 +0000 Subject: [PATCH 09/32] Revert "Reorganized RRTMGP aerosol optics." This reverts commit 2f6e70814fdaae4ba33b00c7d5c7ec421a8e69e8. --- ...ptics.F90 => rrtmgp_lw_aerosol_optics.F90} | 66 +++---- physics/rrtmgp_lw_aerosol_optics.meta | 173 ++++++++++++++++++ physics/rrtmgp_sw_aerosol_optics.F90 | 119 ++++++++++++ ...ics.meta => rrtmgp_sw_aerosol_optics.meta} | 50 +++-- 4 files changed, 335 insertions(+), 73 deletions(-) rename physics/{GFS_rrtmgp_aerosol_optics.F90 => rrtmgp_lw_aerosol_optics.F90} (59%) create mode 100644 physics/rrtmgp_lw_aerosol_optics.meta create mode 100644 physics/rrtmgp_sw_aerosol_optics.F90 rename physics/{GFS_rrtmgp_aerosol_optics.meta => rrtmgp_sw_aerosol_optics.meta} (91%) diff --git a/physics/GFS_rrtmgp_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 similarity index 59% rename from physics/GFS_rrtmgp_aerosol_optics.F90 rename to physics/rrtmgp_lw_aerosol_optics.F90 index 194c33ba1..df0e77163 100644 --- a/physics/GFS_rrtmgp_aerosol_optics.F90 +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -1,8 +1,8 @@ -module GFS_rrtmgp_aerosol_optics +module rrtmgp_lw_aerosol_optics use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl,ty_optical_props_2str - use radiation_tools, only: check_error_msg + use mo_optical_props, only: ty_optical_props_1scl + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_lw_gas_optics, only: lw_gas_props use module_radiation_aerosols, only: & @@ -14,37 +14,34 @@ module GFS_rrtmgp_aerosol_optics implicit none - public GFS_rrtmgp_aerosol_optics_init, GFS_rrtmgp_aerosol_optics_run, GFS_rrtmgp_aerosol_optics_finalize + public rrtmgp_lw_aerosol_optics_init, rrtmgp_lw_aerosol_optics_run, rrtmgp_lw_aerosol_optics_finalize contains ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_aerosol_optics_init() + ! SUBROUTINE rrtmgp_lw_aerosol_optics_init() ! ######################################################################################### - subroutine GFS_rrtmgp_aerosol_optics_init() - end subroutine GFS_rrtmgp_aerosol_optics_init + subroutine rrtmgp_lw_aerosol_optics_init() + end subroutine rrtmgp_lw_aerosol_optics_init ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_aerosol_optics_run() + ! SUBROUTINE rrtmgp_lw_aerosol_optics_run() ! ######################################################################################### -!! \section arg_table_GFS_rrtmgp_aerosol_optics_run -!! \htmlinclude GFS_rrtmgp_aerosol_optics.html +!! \section arg_table_rrtmgp_lw_aerosol_optics_run +!! \htmlinclude rrtmgp_lw_aerosol_optics.html !! - subroutine GFS_rrtmgp_aerosol_optics_run(doLWrad, nCol, nLev, nDay, nTracer, nTracerAer, & - idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - aerodp, lw_optical_props_aerosol, sw_optical_props_aerosol, errmsg, errflg) + subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer,& + p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + aerodp, lw_optical_props_aerosol, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad ! Logical flag for longwave radiation call integer, intent(in) :: & nCol, & ! Number of horizontal grid points - nDay, & ! Number of daylit points nLev, & ! Number of vertical layers nTracer, & ! Number of tracers nTracerAer ! Number of aerosol tracers - integer,intent(in),dimension(:) :: & - idxday ! Daylit point indices real(kind_phys), dimension(:), intent(in) :: & lon, & ! Longitude lat, & ! Latitude @@ -66,8 +63,6 @@ subroutine GFS_rrtmgp_aerosol_optics_run(doLWrad, nCol, nLev, nDay, nTracer, nTr aerodp ! Vertical integrated optical depth for various aerosol species type(ty_optical_props_1scl),intent(inout) :: & lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) - type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_aerosol ! RRTMGP DDT: Shortwave aerosol optical properties (tau,ssa,omega) integer, intent(out) :: & errflg ! CCPP error flag character(len=*), intent(out) :: & @@ -87,40 +82,23 @@ subroutine GFS_rrtmgp_aerosol_optics_run(doLWrad, nCol, nLev, nDay, nTracer, nTr if (.not. doLWrad) return ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile - call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, & - lat, ncol, nLev, nLev+1, .true., .true., aerosolssw, aerosolslw, aerodp) + call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, ncol, nLev, & + nLev+1, .true., .true., aerosolssw, aerosolslw, aerodp) - ! Copy aerosol optical information to RRTMGP DDTs - ! - ! LW - ! + ! Copy aerosol optical information to RRTMGP DDT lw_optical_props_aerosol%tau = aerosolslw(:,:,:,1) * (1. - aerosolslw(:,:,:,2)) + lw_optical_props_aerosol%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() do iBand=1,lw_gas_props%get_nband() lw_optical_props_aerosol%band2gpt(1:2,iBand) = iBand lw_optical_props_aerosol%gpt2band(iBand) = iBand end do - ! - ! SW - ! - if (nDay .gt. 0) then - ! Allocate RRTMGP DDT - call check_error_msg('rrtmgp_sw_aerosol_optics_run',sw_optical_props_aerosol%alloc_2str( & - nDay, nlev, sw_gas_props%get_band_lims_wavenumber())) - ! Copy - sw_optical_props_aerosol%tau(:,:,1) = aerosolssw(idxday(1:nDay),:,sw_gas_props%get_nband(), 1) - sw_optical_props_aerosol%tau(:,:,2:sw_gas_props%get_nband()-1) = aerosolssw(idxday(1:nDay),:,1:sw_gas_props%get_nband()-1,1) - sw_optical_props_aerosol%ssa(:,:,1) = aerosolssw(idxday(1:nDay),:,sw_gas_props%get_nband(), 2) - sw_optical_props_aerosol%ssa(:,:,2:sw_gas_props%get_nband()-1) = aerosolssw(idxday(1:nDay),:,1:sw_gas_props%get_nband()-1,2) - sw_optical_props_aerosol%g(:,:,1) = aerosolssw(idxday(1:nDay),:,sw_gas_props%get_nband(), 3) - sw_optical_props_aerosol%g(:,:,2:sw_gas_props%get_nband()-1) = aerosolssw(idxday(1:nDay),:,1:sw_gas_props%get_nband()-1,3) - endif - end subroutine GFS_rrtmgp_aerosol_optics_run + end subroutine rrtmgp_lw_aerosol_optics_run ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_aerosol_optics_finalize() + ! SUBROUTINE rrtmgp_lw_aerosol_optics_finalize() ! ######################################################################################### - subroutine GFS_rrtmgp_aerosol_optics_finalize() - end subroutine GFS_rrtmgp_aerosol_optics_finalize -end module GFS_rrtmgp_aerosol_optics + subroutine rrtmgp_lw_aerosol_optics_finalize() + end subroutine rrtmgp_lw_aerosol_optics_finalize +end module rrtmgp_lw_aerosol_optics diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta new file mode 100644 index 000000000..ad68fd546 --- /dev/null +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -0,0 +1,173 @@ +[ccpp-table-properties] + name = rrtmgp_lw_aerosol_optics + type = scheme + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radiation_tools.F90 + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lw_aerosol_optics_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + 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 +[nTracer] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracerAer] + standard_name = number_of_aerosol_tracers_MG + long_name = number of aerosol tracers for Morrison Gettelman MP + units = count + dimensions = () + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[aerfld] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = inout + optional = F +[lw_optical_props_aerosol] + standard_name = longwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = inout + 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/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 new file mode 100644 index 000000000..3a74771b7 --- /dev/null +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -0,0 +1,119 @@ +module rrtmgp_sw_aerosol_optics + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_optical_props, only: ty_optical_props_2str + use radiation_tools, only: check_error_msg + use rrtmgp_sw_gas_optics, only: sw_gas_props + use rrtmgp_lw_gas_optics, only: lw_gas_props + use module_radiation_aerosols, only: & + NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) + NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) + setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) + NSPC1 ! Number of species for vertically integrated aerosol optical-depth + use netcdf + + implicit none + + public rrtmgp_sw_aerosol_optics_init, rrtmgp_sw_aerosol_optics_run, rrtmgp_sw_aerosol_optics_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_init() + ! ######################################################################################### + subroutine rrtmgp_sw_aerosol_optics_init() + end subroutine rrtmgp_sw_aerosol_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_aerosol_optics_run +!! \htmlinclude rrtmgp_sw_aerosol_optics_run.html +!! + subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer, nDay, & + idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + aerodp, sw_optical_props_aerosol, errmsg, errflg ) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nDay, & ! Number of daylit points + nLev, & ! Number of vertical layers + nTracer, & ! Number of tracers + nTracerAer ! Number of aerosol tracers + integer,intent(in),dimension(:) :: & + idxday ! Indices for daylit points. + real(kind_phys), dimension(:), intent(in) :: & + lon, & ! Longitude + lat, & ! Latitude + lsmask ! Land/sea/sea-ice mask + real(kind_phys), dimension(:,:),intent(in) :: & + p_lay, & ! Pressure @ layer-centers (Pa) + tv_lay, & ! Virtual-temperature @ layer-centers (K) + relhum, & ! Relative-humidity @ layer-centers + p_lk ! Exner function @ layer-centers (1) + real(kind_phys), dimension(:, :,:),intent(in) :: & + tracer ! trace gas concentrations + real(kind_phys), dimension(:, :,:),intent(in) :: & + aerfld ! aerosol input concentrations + real(kind_phys), dimension(:,:),intent(in) :: & + p_lev ! Pressure @ layer-interfaces (Pa) + + ! Outputs + real(kind_phys), dimension(:,:), intent(inout) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) + integer, intent(out) :: & + errflg ! CCPP error flag + character(len=*), intent(out) :: & + errmsg ! CCPP error message + + ! Local variables + real(kind_phys), dimension(nCol, nLev, lw_gas_props%get_nband(), NF_AELW) :: & + aerosolslw ! + real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & + aerosolssw, aerosolssw2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + if (nDay .gt. 0) then + + ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile + call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & + nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) + + ! Store aerosol optical properties + ! SW. + ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the + ! band ordering was [nIR -> UV -> IR(band)] + aerosolssw(1:nCol,:,1,1) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),1) + aerosolssw(1:nCol,:,1,2) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),2) + aerosolssw(1:nCol,:,1,3) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),3) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),1) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,1) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),2) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,2) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),3) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,3) + + ! Allocate RRTMGP DDT: Aerosol optics [nCol,nlev,nBands] + call check_error_msg('rrtmgp_sw_aerosol_optics_run',sw_optical_props_aerosol%alloc_2str( & + nDay, nlev, sw_gas_props%get_band_lims_wavenumber())) + + ! Copy aerosol optical information to RRTMGP DDT + sw_optical_props_aerosol%tau = aerosolssw(idxday(1:nday),:,:,1) + sw_optical_props_aerosol%ssa = aerosolssw(idxday(1:nday),:,:,2) + sw_optical_props_aerosol%g = aerosolssw(idxday(1:nday),:,:,3) + endif + + end subroutine rrtmgp_sw_aerosol_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_aerosol_optics_finalize() + end subroutine rrtmgp_sw_aerosol_optics_finalize +end module rrtmgp_sw_aerosol_optics diff --git a/physics/GFS_rrtmgp_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta similarity index 91% rename from physics/GFS_rrtmgp_aerosol_optics.meta rename to physics/rrtmgp_sw_aerosol_optics.meta index aa7f6d4a5..f4909c794 100644 --- a/physics/GFS_rrtmgp_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -1,15 +1,15 @@ [ccpp-table-properties] - name = GFS_rrtmgp_aerosol_optics + name = rrtmgp_sw_aerosol_optics type = scheme dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radiation_tools.F90 ######################################################################## [ccpp-arg-table] - name = GFS_rrtmgp_aerosol_optics_run + name = rrtmgp_sw_aerosol_optics_run type = scheme -[doLWrad] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls units = flag dimensions = () type = logical @@ -23,22 +23,6 @@ type = integer intent = in optional = F -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F [nLev] standard_name = vertical_dimension long_name = number of vertical levels @@ -63,6 +47,22 @@ type = integer intent = in optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation @@ -162,14 +162,6 @@ kind = kind_phys intent = inout optional = F -[lw_optical_props_aerosol] - standard_name = longwave_optical_properties_for_aerosols - long_name = Fortran DDT containing RRTMGP optical properties - units = DDT - dimensions = () - type = ty_optical_props_1scl - intent = inout - optional = F [sw_optical_props_aerosol] standard_name = shortwave_optical_properties_for_aerosols long_name = Fortran DDT containing RRTMGP optical properties From 36b6487983d45ac68b6401c4401a02214c369b16 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Tue, 25 May 2021 17:54:48 +0000 Subject: [PATCH 10/32] fix bug by adding a comma and add condensation/evap --- physics/module_mp_thompson.F90 | 33 ++++++++++++++++++++++++++------- physics/mp_thompson.F90 | 17 ++++++++++++----- 2 files changed, 38 insertions(+), 12 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index af09ab58f..5f2125557 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1018,7 +1018,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims - errmsg, errflg, reset, vts1) + errmsg, errflg, reset, vts1, prw_vcdc, & + prw_vcde) implicit none @@ -1028,7 +1029,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & its,ite, jts,jte, kts,kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & qv, qc, qr, qi, qs, qg, ni, nr - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: vts1 + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & + vts1,prw_vcdc,prw_vcde REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & tt, th @@ -1069,7 +1071,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, & t1d, p1d, w1d, dz1d, rho, dBZ - REAL, DIMENSION(kts:kte):: vtsk1 + REAL, DIMENSION(kts:kte):: vtsk1,prw_vcdc1,prw_vcde1 REAL, DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d #if ( WRF_CHEM == 1 ) @@ -1266,6 +1268,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) vtsk1(k) = 0. vts1(i,k,j) = 0. + prw_vcdc1(k) = 0. + prw_vcdc(i,k,j) = 0. + prw_vcde1(k) = 0. + prw_vcde(i,k,j) = 0. enddo if (is_aerosol_aware) then do k = kts, kte @@ -1289,7 +1295,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & rainprod1d, evapprod1d, & #endif rand1, rand2, rand3, & - kts, kte, dt, i, j, vtsk1) + kts, kte, dt, i, j, vtsk1, prw_vcdc1, prw_vcde1) pcp_ra(i,j) = pptrain pcp_sn(i,j) = pptsnow @@ -1343,7 +1349,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qg(i,k,j) = qg1d(k) ni(i,k,j) = ni1d(k) nr(i,k,j) = nr1d(k) - vts1(i,k,j) = vtsk1(k) + vts1(i,k,j) = vtsk1(k) + prw_vcdc(i,k,j) = prw_vcdc1(k) + prw_vcde(i,k,j) = prw_vcde1(k) + if (present(tt)) then; tt(i,k,j) = t1d(k) else @@ -1557,7 +1566,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rainprod, evapprod, & #endif rand1, rand2, rand3, & - kts, kte, dt, ii, jj, vtsk1) + kts, kte, dt, ii, jj, vtsk1, prw_vcdc1, prw_vcde1) #ifdef MPI use mpi #endif @@ -1572,7 +1581,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice REAL, INTENT(IN):: dt REAL, INTENT(IN):: rand1, rand2, rand3 - REAL, DIMENSION(kts:kte), INTENT(OUT):: vtsk1 + REAL, DIMENSION(kts:kte), INTENT(OUT):: vtsk1,prw_vcdc1,prw_vcde1 #if ( WRF_CHEM == 1 ) REAL, DIMENSION(kts:kte), INTENT(INOUT):: & @@ -3371,6 +3380,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & vtck(k) = 0. vtnck(k) = 0. vtsk1(k) = 0. + prw_vcdc1(k) = 0. + prw_vcde1(k) = 0. enddo if (ANY(L_qr .eqv. .true.)) then @@ -3790,6 +3801,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qg1d(k) = qg1d(k) + qgten(k)*DT if (qg1d(k) .le. R1) qg1d(k) = 0.0 enddo +! Diagnostics + do k = kts, kte + if(prw_vcd(k).gt.0)then + prw_vcdc1(k) = prw_vcd(k)*dt + elseif(prw_vcd(k).lt.0)then + prw_vcde1(k) = -1*prw_vcd(k)*dt + endif + enddo end subroutine mp_thompson !>@} diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index ab9f49049..4444abca7 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -432,7 +432,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & its,ite, jts,jte, kts,kte !Auxillary fields - real(kind_phys) :: vts1(1:ncol,1:nlev) + real(kind_phys) :: vts1(1:ncol,1:nlev),prw_vcdc(1:ncol,1:nlev),prw_vcde(1:ncol,1:nlev) ! Initialize the CCPP error handling variables errmsg = '' @@ -572,7 +572,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1, & + prw_vcdc=prw_vcdc, prw_vcde=prw_vcde) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & @@ -591,7 +592,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1, & + prw_vcdc=prw_vcdc, prw_vcde=prw_vcde) end if else if (do_effective_radii) then @@ -612,7 +614,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1, & + prw_vcdc=prw_vcdc, prw_vcde=prw_vcde) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & @@ -630,7 +633,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1, & + prw_vcdc=prw_vcdc, prw_vcde=prw_vcde) end if end if if (errflg/=0) return @@ -661,7 +665,10 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ice = ice + max(0.0, delta_ice_mp/1000.0_kind_phys) snow = snow + max(0.0, delta_snow_mp/1000.0_kind_phys) rain = rain + max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys) +!Diagnostics aux3d(:,:,1) = vts1 + aux3d(:,:,2) = aux3d(:,:,2) + prw_vcdc + aux3d(:,:,3) = aux3d(:,:,3) + prw_vcde end subroutine mp_thompson_run !>@} From eb7837d7f32e83fb6a151dbae50172bda5fd83db Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 25 May 2021 20:05:16 +0000 Subject: [PATCH 11/32] Bug fix. Add transition to HR adjustment. --- physics/dcyc2.f | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 09c80a97e..8e2f86e5a 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -424,7 +424,8 @@ subroutine dcyc2t3_run & else lfnc = 1. endif - dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + htrlw(i,k)*lfnc + dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + & + & htrlw(i,k)*lfnc + (1.-lfnc)*hlw(i,k) enddo enddo else From c55797d86461beed73dc75c6ce8cd480ffe22263 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 25 May 2021 15:57:36 -0600 Subject: [PATCH 12/32] Optimize use of auxiliary arrays --- physics/module_mp_thompson.F90 | 7 ++----- physics/mp_thompson.F90 | 24 +++++++++--------------- 2 files changed, 11 insertions(+), 20 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 5f2125557..c0e40971a 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1267,11 +1267,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nr1d(k) = nr(i,k,j) rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) vtsk1(k) = 0. - vts1(i,k,j) = 0. prw_vcdc1(k) = 0. - prw_vcdc(i,k,j) = 0. prw_vcde1(k) = 0. - prw_vcde(i,k,j) = 0. enddo if (is_aerosol_aware) then do k = kts, kte @@ -1350,8 +1347,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ni(i,k,j) = ni1d(k) nr(i,k,j) = nr1d(k) vts1(i,k,j) = vtsk1(k) - prw_vcdc(i,k,j) = prw_vcdc1(k) - prw_vcde(i,k,j) = prw_vcde1(k) + prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) + prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) if (present(tt)) then; tt(i,k,j) = t1d(k) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 4444abca7..daa492aa9 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -431,9 +431,6 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte - !Auxillary fields - real(kind_phys) :: vts1(1:ncol,1:nlev),prw_vcdc(1:ncol,1:nlev),prw_vcde(1:ncol,1:nlev) - ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -572,8 +569,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1, & - prw_vcdc=prw_vcdc, prw_vcde=prw_vcde) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=aux3d(:,:,1), & + prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3)) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & @@ -592,8 +589,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1, & - prw_vcdc=prw_vcdc, prw_vcde=prw_vcde) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=aux3d(:,:,1), & + prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3)) end if else if (do_effective_radii) then @@ -614,8 +611,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1, & - prw_vcdc=prw_vcdc, prw_vcde=prw_vcde) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=aux3d(:,:,1), & + prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3)) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & @@ -633,8 +630,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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, & - errmsg=errmsg, errflg=errflg, reset=reset, vts1=vts1, & - prw_vcdc=prw_vcdc, prw_vcde=prw_vcde) + errmsg=errmsg, errflg=errflg, reset=reset, vts1=aux3d(:,:,1), & + prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3)) end if end if if (errflg/=0) return @@ -665,10 +662,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ice = ice + max(0.0, delta_ice_mp/1000.0_kind_phys) snow = snow + max(0.0, delta_snow_mp/1000.0_kind_phys) rain = rain + max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys) -!Diagnostics - aux3d(:,:,1) = vts1 - aux3d(:,:,2) = aux3d(:,:,2) + prw_vcdc - aux3d(:,:,3) = aux3d(:,:,3) + prw_vcde + end subroutine mp_thompson_run !>@} From f2d55708f4f8d1162284145707e0c53a2677e8f8 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 26 May 2021 10:33:24 +0000 Subject: [PATCH 13/32] Removed exp(1) from scaling --- physics/dcyc2.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 8e2f86e5a..796c36f12 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -420,7 +420,7 @@ subroutine dcyc2t3_run & ! using a logistic function if (damp_LW_fluxadj) then dp = p_lev(i,k) - lfnc_p0 - lfnc = L / (1+exp(-lfnc_k_grad*exp(1.)*dp/lfnc_p0)) + lfnc = L / (1+exp(-lfnc_k_grad*dp/lfnc_p0)) else lfnc = 1. endif From ea0113929c9ec254e15275ab55f094360d0ffb55 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 26 May 2021 11:18:19 +0000 Subject: [PATCH 14/32] Housekeeping. Added comments. --- physics/dcyc2.f | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 796c36f12..cfe7c75a8 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -260,14 +260,14 @@ subroutine dcyc2t3_run & & rstl, solang, dT real(kind=kind_phys), dimension(im,levs+1) :: flxlwup_adj, & & flxlwdn_adj, t_lev2 - real(kind=kind_phys) :: fluxlwnet_adj,fluxlwnet,c1,c2,c3,c4,c5, & - & dP,lfnc + real(kind=kind_phys) :: fluxlwnet_adj,fluxlwnet,dT_sfc, & + &fluxlwDOWN_jac,dP,lfnc,c1 ! Length scale for flux-adjustment scaling real(kind=kind_phys), parameter :: & & L = 1. ! Scaling factor for downwelling LW Jacobian profile. real(kind=kind_phys), parameter :: & - & c0 = 0.2 + & gamma = 0.2 ! !===> ... begin here ! @@ -400,19 +400,21 @@ subroutine dcyc2t3_run & ! L = 1, fix scale between 0-1. ! k (steepness) and p0 (midpoint) are controlled via namelist do i = 1, im - c1 = fluxlwUP_jac(i,iSFC) - c2 = fluxlwUP_jac(i,iTOA) / c1 - c3 = t_lev2(i,iSFC) - t_lev(i,iSFC) + c1 = fluxlwUP_jac(i,iTOA) / fluxlwUP_jac(i,iSFC) + dT_sfc = t_lev2(i,iSFC) - t_lev(i,iSFC) do k = 1, levs - ! Only apply the Jacobian adjustment below plim_fluxAdj_upper - c4 = fluxlwUP_jac(i,k)/c1 - fluxlwnet = (flux2D_lwUP(i,k+1) - flux2D_lwUP(i,k) - & - & flux2D_lwDOWN(i,k+1) + flux2D_lwDOWN(i,k)) - ! (Eq. 9) - c5 = c0 * (c4 - c2) / (1 - c2) - ! (Eq. 10) - fluxlwnet_adj = fluxlwnet + c3*(c4-c5) - ! Compute adjusted heating rate + ! LW net flux + fluxlwnet = (flux2D_lwUP(i, k+1) - flux2D_lwUP(i, k) - & + & flux2D_lwDOWN(i,k+1) + flux2D_lwDOWN(i,k)) + ! Downward LW Jacobian (Eq. 9) + fluxlwDOWN_jac = gamma * & + & (fluxlwUP_jac(i,k)/fluxlwUP_jac(i,iSFC) - c1) / & + & (1 - c1) + ! Adjusted LW net flux(Eq. 10) + fluxlwnet_adj = fluxlwnet + dT_sfc* & + & (fluxlwUP_jac(i,k)/fluxlwUP_jac(i,iSFC) - & + & fluxlwDOWN_jac) + ! Adjusted LW heating rate htrlw(i,k) = fluxlwnet_adj * con_g / & & (con_cp * (p_lev(i,k+1) - p_lev(i,k))) @@ -420,7 +422,7 @@ subroutine dcyc2t3_run & ! using a logistic function if (damp_LW_fluxadj) then dp = p_lev(i,k) - lfnc_p0 - lfnc = L / (1+exp(-lfnc_k_grad*dp/lfnc_p0)) + lfnc = L / (1+exp(-(lfnc_k_grad/lfnc_p0)*dp)) else lfnc = 1. endif From d93adbeb519a58e0aedbbe92a840186ee312cb54 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 26 May 2021 22:00:59 +0000 Subject: [PATCH 15/32] Further cleanup of dcyc2 --- physics/dcyc2.f | 14 +++++++------- physics/dcyc2.meta | 12 ++++++------ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index cfe7c75a8..8700e2bfb 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -179,7 +179,7 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, minGPtemp, maxGPtemp, damp_LW_fluxadj, & - & lfnc_k_grad, lfnc_p0, minGPpres, use_LW_jacobian, sfculw, & + & lfnc_k, lfnc_p0, minGPpres, use_LW_jacobian, sfculw, & & fluxlwUP_jac, t_lay, t_lev, p_lay, p_lev, flux2D_lwUP, & & flux2D_lwDOWN, pert_radtend, do_sppt,ca_global, & ! & dry, icy, wet, lprnt, ipr, & @@ -217,7 +217,7 @@ subroutine dcyc2t3_run & & pert_radtend logical, intent(in) :: do_sppt,ca_global real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & - & deltim, fhswr, minGPpres, minGPtemp, maxGPtemp, lfnc_k_grad, & + & deltim, fhswr, minGPpres, minGPtemp, maxGPtemp, lfnc_k, & & lfnc_p0 real(kind=kind_phys), dimension(:), intent(in) :: & @@ -261,7 +261,7 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(im,levs+1) :: flxlwup_adj, & & flxlwdn_adj, t_lev2 real(kind=kind_phys) :: fluxlwnet_adj,fluxlwnet,dT_sfc, & - &fluxlwDOWN_jac,dP,lfnc,c1 + &fluxlwDOWN_jac,lfnc,c1 ! Length scale for flux-adjustment scaling real(kind=kind_phys), parameter :: & & L = 1. @@ -397,8 +397,9 @@ subroutine dcyc2t3_run & ! ! Optionally, the flux adjustment can be damped with height using a logistic function ! fx ~ L / (1 + exp(-k*dp)), where dp = p - p0 - ! L = 1, fix scale between 0-1. - ! k (steepness) and p0 (midpoint) are controlled via namelist + ! L = 1, fix scale between 0-1. - Fixed + ! k = 1 / pressure decay length (Pa) - Controlled by namelist + ! p0 = Transition pressure (Pa) - Controlled by namelsit do i = 1, im c1 = fluxlwUP_jac(i,iTOA) / fluxlwUP_jac(i,iSFC) dT_sfc = t_lev2(i,iSFC) - t_lev(i,iSFC) @@ -421,8 +422,7 @@ subroutine dcyc2t3_run & ! Add radiative heating rates to physics heating rate. Optionally, scaled w/ height ! using a logistic function if (damp_LW_fluxadj) then - dp = p_lev(i,k) - lfnc_p0 - lfnc = L / (1+exp(-(lfnc_k_grad/lfnc_p0)*dp)) + lfnc = L / (1+exp(-lfnc_k*(p_lev(i,k) - lfnc_p0))) else lfnc = 1. endif diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index dceb9ce77..5ba718c2e 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -396,18 +396,18 @@ type = logical intent = in optional = F -[lfnc_k_grad] - standard_name = steepness_of_flux_damping - long_name = steepness of logistic function for damping the LW flux adjustment - units = none +[lfnc_k] + standard_name = transition_pressure_length_scale_for_flux_damping + long_name = depth of transition layer in logistic function for LW flux adjustment damping + units = Pa dimensions = () type = real kind = kind_phys intent = in optional = F [lfnc_p0] - standard_name = midpoint_used_for_flux_damping - long_name = midpoint for damping the LW flux adjustment + standard_name = transition_pressure_for_flux_damping + long_name = transition pressure for LW flux adjustment damping units = Pa dimensions = () type = real From fe44d62031c77b4232f331ce27661aef7847fe96 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 26 May 2021 22:04:26 +0000 Subject: [PATCH 16/32] Revert "Added more safeguards against out-of-bounds temperature to GP inputs." This reverts commit 6961b10546035b55021132e62ce139333eed9cc0. --- physics/GFS_rrtmgp_pre.F90 | 12 ++++-------- physics/GFS_rrtmgp_pre.meta | 9 --------- physics/dcyc2.f | 15 +++++++-------- physics/dcyc2.meta | 18 ------------------ physics/radiation_tools.F90 | 20 ++++++-------------- physics/rrtmgp_lw_gas_optics.F90 | 4 +--- physics/rrtmgp_lw_gas_optics.meta | 9 --------- 7 files changed, 18 insertions(+), 69 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index af7e5f1a0..88e534595 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -98,8 +98,8 @@ end subroutine GFS_rrtmgp_pre_init !! subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt, & - con_epsqs, minGPpres, minGPtemp, maxGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, & - tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg) + con_epsqs, minGPpres, minGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, & + qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -112,7 +112,6 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f lslwr ! Call LW radiation real(kind_phys), intent(in) :: & minGPtemp, & ! Minimum temperature allowed in RRTMGP. - maxGPtemp, & ! Maximum temperature allowed in RRTMGP. minGPpres, & ! Minimum pressure allowed in RRTMGP. fhswr, & ! Frequency of SW radiation call. fhlwr ! Frequency of LW radiation call. @@ -209,14 +208,11 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f if (t_lay(iCol,iLay) .le. minGPtemp) then t_lay(iCol,iLay) = minGPtemp + epsilon(minGPtemp) endif - if (t_lay(iCol,iLay) .ge. maxGPtemp) then - t_lay(iCol,iLay) = maxGPtemp - epsilon(maxGPtemp) - endif enddo enddo ! Temperature at layer-interfaces - call cmp_tlev(nCol,nLev,minGPpres,minGPtemp,maxGPtemp,p_lay,t_lay,p_lev,tsfc,t_lev) + call cmp_tlev(nCol,nLev,minGPpres,p_lay,t_lay,p_lev,tsfc,t_lev) ! Compute a bunch of thermodynamic fields needed by the cloud microphysics schemes. ! Relative humidity, saturation mixing-ratio, vapor mixing-ratio, virtual temperature, @@ -277,7 +273,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f ! ####################################################################################### ! Setup surface ground temperature and ground/air skin temperature if required. ! ####################################################################################### - tsfg(1:NCOL) = t_lev(1:NCOL,iSFC) + tsfg(1:NCOL) = tsfc(1:NCOL) tsfa(1:NCOL) = t_lay(1:NCOL,iSFC) end subroutine GFS_rrtmgp_pre_run diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 895bbc630..8096aef2a 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -239,15 +239,6 @@ kind = kind_phys intent = in optional = F -[maxGPtemp] - standard_name = maximum_temperature_in_RRTMGP - long_name = maximum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 8700e2bfb..6247f360f 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -178,10 +178,10 @@ subroutine dcyc2t3_run & & sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & - & dry, icy, wet, minGPtemp, maxGPtemp, damp_LW_fluxadj, & - & lfnc_k, lfnc_p0, minGPpres, use_LW_jacobian, sfculw, & - & fluxlwUP_jac, t_lay, t_lev, p_lay, p_lev, flux2D_lwUP, & - & flux2D_lwDOWN, pert_radtend, do_sppt,ca_global, & + & dry, icy, wet, damp_LW_fluxadj, lfnc_k, lfnc_p0, & + & minGPpres, use_LW_jacobian, sfculw, fluxlwUP_jac, & + & t_lay, t_lev, p_lay, p_lev, flux2D_lwUP, flux2D_lwDOWN, & + & pert_radtend, do_sppt,ca_global, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: & dtdt,dtdtnp,htrlw, & @@ -217,8 +217,7 @@ subroutine dcyc2t3_run & & pert_radtend logical, intent(in) :: do_sppt,ca_global real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & - & deltim, fhswr, minGPpres, minGPtemp, maxGPtemp, lfnc_k, & - & lfnc_p0 + & deltim, fhswr, minGPpres, minGPtemp, lfnc_k, lfnc_p0 real(kind=kind_phys), dimension(:), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & @@ -384,8 +383,8 @@ subroutine dcyc2t3_run & ! ! Compute temperatute at level interfaces. ! - call cmp_tlev(im, levs, minGPpres, minGPtemp, maxGPtemp, p_lay,& - & t_lay, p_lev, tsfc, t_lev2) + call cmp_tlev(im, levs, minGPpres, p_lay, t_lay, p_lev, tsfc, & + & t_lev2) ! Compute adjusted net LW flux foillowing Hogan and Bozzo 2015 (10.1002/2015MS000455) ! Here we assume that the profile of the downwelling LW Jaconiam has the same shape diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 5ba718c2e..91e01a2d2 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -353,24 +353,6 @@ type = logical intent = in optional = F -[minGPtemp] - standard_name = minimum_temperature_in_RRTMGP - long_name = minimum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[maxGPtemp] - standard_name = maximum_temperature_in_RRTMGP - long_name = maximum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [minGPpres] standard_name = minimum_pressure_in_RRTMGP long_name = minimum pressure allowed in RRTMGP diff --git a/physics/radiation_tools.F90 b/physics/radiation_tools.F90 index a8d3f5457..c6524aab6 100644 --- a/physics/radiation_tools.F90 +++ b/physics/radiation_tools.F90 @@ -2,16 +2,20 @@ module radiation_tools use machine, only: & kind_phys ! Working type implicit none + + real(kind_phys) :: & + rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP + rrtmgp_minT ! Minimum temperature allowed in RRTMGP contains ! ######################################################################################### ! ######################################################################################### - subroutine cmp_tlev(nCol,nLev,minP,minT,maxT,p_lay,t_lay,p_lev,tsfc,t_lev) + subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev) ! Inputs integer, intent(in) :: & nCol,nLev real(kind_phys),intent(in) :: & - minP,minT,maxT + minP real(kind_phys),dimension(nCol),intent(in) :: & tsfc real(kind_phys),dimension(nCol,nLev),intent(in) :: & @@ -74,18 +78,6 @@ subroutine cmp_tlev(nCol,nLev,minP,minT,maxT,p_lay,t_lay,p_lev,tsfc,t_lev) t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif - ! Bound temperature at layer interfaces - do iCol=1,NCOL - do iLay=1,nLev+1 - if (t_lev(iCol,iLay) .le. minT) then - t_lev(iCol,iLay) = minT + epsilon(minT) - endif - if (t_lev(iCol,iLay) .ge. maxT) then - t_lev(iCol,iLay) = maxT - epsilon(maxT) - endif - enddo - enddo - end subroutine cmp_tlev ! ######################################################################################### diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index d7201e026..a116ad772 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -76,7 +76,7 @@ module rrtmgp_lw_gas_optics !! \htmlinclude rrtmgp_lw_gas_optics_init.html !! subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, & - mpirank, mpiroot, gas_concentrations, minGPpres, minGPtemp, maxGPtemp, errmsg, errflg) + mpirank, mpiroot, gas_concentrations, minGPpres, minGPtemp, errmsg, errflg) ! Inputs type(ty_gas_concs), intent(inout) :: & @@ -96,7 +96,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom errflg ! CCPP error code real(kind_phys), intent(out) :: & minGPtemp, & ! Minimum temperature allowed by RRTMGP. - maxGPtemp, & ! Maximum temperature allowed by RRTMG. minGPpres ! Minimum pressure allowed by RRTMGP. ! Local variables @@ -451,7 +450,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom ! temperature (GFS_rrtmgp_pre.F90) minGPpres = lw_gas_props%get_press_min() minGPtemp = lw_gas_props%get_temp_min() - maxGPtemp = lw_gas_props%get_temp_max() end subroutine rrtmgp_lw_gas_optics_init diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 823501cfa..c92567e14 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -92,15 +92,6 @@ kind = kind_phys intent = out optional = F -[maxGPtemp] - standard_name = maximum_temperature_in_RRTMGP - long_name = maximum temperature allowed in RRTMGP - units = K - dimensions = () - type = real - kind = kind_phys - intent = out - optional = F ######################################################################## [ccpp-arg-table] From 6762adbcf2fafed1590624256e7410c225636e8c Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Thu, 27 May 2021 13:59:07 +0000 Subject: [PATCH 17/32] temperature tendency diagnostics added --- physics/module_mp_thompson.F90 | 147 ++++++++++++++++++++++++++++++--- 1 file changed, 136 insertions(+), 11 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index c0e40971a..b66bdc44a 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1019,7 +1019,12 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims errmsg, errflg, reset, vts1, prw_vcdc, & - prw_vcde) + prw_vcde, tpri_inu, tpri_ide, tprs_ide, & + tprs_sde, tprg_gde, tpri_iha, tpri_wfz, & + tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & + tprs_scw, tprg_rcs, tprs_rcs, tprr_rci, & + tprg_rcg, tprw_vcd, tprr_sml, tprr_gml, & + tprr_rcg, tprr_rcs, tprv_rev, txri,txrc) implicit none @@ -1030,7 +1035,12 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & qv, qc, qr, qi, qs, qg, ni, nr REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & - vts1,prw_vcdc,prw_vcde + vts1,prw_vcdc,prw_vcde, & + tpri_inu,tpri_ide,tprs_ide,tprs_sde,tprg_gde, & + tpri_iha,tpri_wfz,tpri_rfz,tprg_rfz,tprs_scw, & + tprg_scw,tprs_scw,tprg_rcs,tprs_rcs,tprr_rci, & + tprg_rcg,tprw_vcd,tprr_sml,tprr_gml,tprr_rcg, & + tprr_rcs,tprv_rev,txri,txrc REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & tt, th @@ -1071,7 +1081,12 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, & t1d, p1d, w1d, dz1d, rho, dBZ - REAL, DIMENSION(kts:kte):: vtsk1,prw_vcdc1,prw_vcde1 + REAL, DIMENSION(kts:kte):: vtsk1,prw_vcdc1,prw_vcde1, & + tpri_inu1,tpri_ide1,tprs_ide1,tprs_sde1,tprg_gde1, & + tpri_iha1,tpri_wfz1,tpri_rfz1,tprg_rfz1,tprs_scw1, & + tprg_scw1,tprs_scw1,tprg_rcs1,tprs_rcs1,tprr_rci1, & + tprg_rcg1,tprw_vcd1,tprr_sml1,tprr_gml1,tprr_rcg1, & + tprr_rcs1,tprv_rev1,txri1,txrc1 REAL, DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d #if ( WRF_CHEM == 1 ) @@ -1269,6 +1284,29 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & vtsk1(k) = 0. prw_vcdc1(k) = 0. prw_vcde1(k) = 0. + tpri_inu(k) = 0. + tpri_ide(k) = 0. + tprs_ide(k) = 0. + tprs_sde(k) = 0. + tprg_gde(k) = 0. + tpri_iha(k) = 0. + tpri_wfz(k) = 0. + tpri_rfz(k) = 0. + tprg_rfz(k) = 0. + tprs_scw(k) = 0. + tprg_scw(k) = 0. + tprs_scw(k) = 0. + tprg_rcs(k) = 0. + tprs_rcs(k) = 0. + tprr_rci(k) = 0. + tprg_rcg(k) = 0. + tprw_vcd(k) = 0. + tprr_sml(k) = 0. + tprr_gml(k) = 0. + tprr_rcg(k) = 0. + tprr_rcs(k) = 0. + tprv_rev(k) = 0. + enddo if (is_aerosol_aware) then do k = kts, kte @@ -1292,7 +1330,12 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & rainprod1d, evapprod1d, & #endif rand1, rand2, rand3, & - kts, kte, dt, i, j, vtsk1, prw_vcdc1, prw_vcde1) + kts, kte, dt, i, j, vtsk1, prw_vcdc1, prw_vcde1, & + tpri_inu1,tpri_ide1,tprs_ide1,tprs_sde1,tprg_gde1, & + tpri_iha1,tpri_wfz1,tpri_rfz1,tprg_rfz1,tprs_scw1, & + tprg_scw1,tprs_scw1,tprg_rcs1,tprs_rcs1,tprr_rci1, & + tprg_rcg1,tprw_vcd1,tprr_sml1,tprr_gml1,tprr_rcg1, & + tprr_rcs1,tprv_rev1,txri1,txrc1) pcp_ra(i,j) = pptrain pcp_sn(i,j) = pptsnow @@ -1349,7 +1392,30 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & vts1(i,k,j) = vtsk1(k) prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) - + tpri_inu(i,k,j) = tpri_inu(i,k,j) + tpri_inu1(k) + tpri_ide(i,k,j) = tpri_ide(i,k,j) + tpri_ide1(k) + tprs_ide(i,k,j) = tprs_ide(i,k,j) + tprs_ide1(k) + tprs_sde(i,k,j) = tprs_sde(i,k,j) + tprs_sde1(k) + tprg_gde(i,k,j) = tprg_gde(i,k,j) + tprg_gde1(k) + tpri_iha(i,k,j) = tpri_iha(i,k,j) + tpri_iha1(k) + tpri_wfz(i,k,j) = tpri_wfz(i,k,j) + tpri_wfz1(k) + tpri_rfz(i,k,j) = tpri_rfz(i,k,j) + tpri_rfz1(k) + tprg_rfz(i,k,j) = tprg_rfz(i,k,j) + tprg_rfz1(k) + tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) + tprg_scw(i,k,j) = tprg_scw(i,k,j) + tprg_scw1(k) + tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) + tprg_rcs(i,k,j) = tprg_rcs(i,k,j) + tprg_rcs1(k) + tprs_rcs(i,k,j) = tprs_rcs(i,k,j) + tprs_rcs1(k) + tprr_rci(i,k,j) = tprr_rci(i,k,j) + tprr_rci1(k) + tprg_rcg(i,k,j) = tprg_rcg(i,k,j) + tprg_rcg1(k) + tprw_vcd(i,k,j) = tprw_vcd(i,k,j) + tprw_vcd1(k) + tprr_sml(i,k,j) = tprr_sml(i,k,j) + tprr_sml1(k) + tprr_gml(i,k,j) = tprr_gml(i,k,j) + tprr_gml1(k) + tprr_rcg(i,k,j) = tprr_rcg(i,k,j) + tprr_rcg1(k) + tprr_rcs(i,k,j) = tprr_rcs(i,k,j) + tprr_rcs1(k) + tprv_rev(i,k,j) = tprv_rev(i,k,j) + tprv_rev1(k) + txri(i,k,j) = txri(i,k,j) + txri1(k) + txrc(i,k,j) = txrc(i,k,j) + txrc1(k) if (present(tt)) then; tt(i,k,j) = t1d(k) else @@ -1563,7 +1629,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rainprod, evapprod, & #endif rand1, rand2, rand3, & - kts, kte, dt, ii, jj, vtsk1, prw_vcdc1, prw_vcde1) + kts, kte, dt, ii, jj, vtsk1, prw_vcdc1, prw_vcde1,& + tpri_inu1,tpri_ide1,tprs_ide1,tprs_sde1,tprg_gde1, & + tpri_iha1,tpri_wfz1,tpri_rfz1,tprg_rfz1,tprs_scw1, & + tprg_scw1,tprs_scw1,tprg_rcs1,tprs_rcs1,tprr_rci1, & + tprg_rcg1,tprw_vcd1,tprr_sml1,tprr_gml1,tprr_rcg1, & + tprr_rcs1,tprv_rev1,txri1,txrc1) #ifdef MPI use mpi #endif @@ -1578,8 +1649,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice REAL, INTENT(IN):: dt REAL, INTENT(IN):: rand1, rand2, rand3 - REAL, DIMENSION(kts:kte), INTENT(OUT):: vtsk1,prw_vcdc1,prw_vcde1 - + REAL, DIMENSION(kts:kte), INTENT(OUT):: vtsk1,prw_vcdc1,prw_vcde1, & + tpri_inu1,tpri_ide1,tprs_ide1,tprs_sde1,tprg_gde1, & + tpri_iha1,tpri_wfz1,tpri_rfz1,tprg_rfz1,tprs_scw1, & + tprg_scw1,tprs_scw1,tprg_rcs1,tprs_rcs1,tprr_rci1, & + tprg_rcg1,tprw_vcd1,tprr_sml1,tprr_gml1,tprr_rcg1, & + tprr_rcs1,tprv_rev1,txri1,txrc1 #if ( WRF_CHEM == 1 ) REAL, DIMENSION(kts:kte), INTENT(INOUT):: & rainprod, evapprod @@ -1780,6 +1855,31 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pnd_rcd(k) = 0. pnd_scd(k) = 0. pnd_gcd(k) = 0. +!Diagnostics + prw_vcdc1(k) = 0. + prw_vcde1(k) = 0. + tpri_inu1(k) = 0. + tpri_ide1(k) = 0. + tprs_ide1(k) = 0. + tprs_sde1(k) = 0. + tprg_gde1(k) = 0. + tpri_iha1(k) = 0. + tpri_wfz1(k) = 0. + tpri_rfz1(k) = 0. + tprg_rfz1(k) = 0. + tprs_scw1(k) = 0. + tprg_scw1(k) = 0. + tprs_scw1(k) = 0. + tprg_rcs1(k) = 0. + tprs_rcs1(k) = 0. + tprr_rci1(k) = 0. + tprg_rcg1(k) = 0. + tprw_vcd1(k) = 0. + tprr_sml1(k) = 0. + tprr_gml1(k) = 0. + tprr_rcg1(k) = 0. + tprr_rcs1(k) = 0. + tprv_rev1(k) = 0. enddo #if ( WRF_CHEM == 1 ) do k = kts, kte @@ -3377,8 +3477,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & vtck(k) = 0. vtnck(k) = 0. vtsk1(k) = 0. - prw_vcdc1(k) = 0. - prw_vcde1(k) = 0. enddo if (ANY(L_qr .eqv. .true.)) then @@ -3710,6 +3808,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qiten(k) = qiten(k) - xri*odt niten(k) = -ni1d(k)*odt tten(k) = tten(k) - lfus*ocp(k)*xri*odt*(1-IFDRY) +!diag + txri1(k) = lfus*ocp(k)*xri*odt*(1-IFDRY) endif xrc = MAX(0.0, qc1d(k) + qcten(k)*DT) @@ -3721,6 +3821,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qcten(k) = qcten(k) - xrc*odt ncten(k) = ncten(k) - xnc*odt tten(k) = tten(k) + lfus2*ocp(k)*xrc*odt*(1-IFDRY) +!diag + txrc1(k) = lfus2*ocp(k)*xrc*odt*(1-IFDRY)*DT endif enddo endif @@ -3805,8 +3907,31 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & elseif(prw_vcd(k).lt.0)then prw_vcde1(k) = -1*prw_vcd(k)*dt endif +!heating terms + tpri_inu1(k) = pri_inu(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + tpri_ide1(k) = pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + tprs_ide1(k) = prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + tprs_sde1(k) = prs_sde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + tprg_gde1(k) = prg_gde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + tpri_iha1(k) = pri_iha(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + tpri_wfz1(k) = pri_wfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tpri_rfz1(k) = pri_rfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprg_rfz1(k) = prg_rfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprs_scw1(k) = prs_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprg_scw1(k) = prg_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprs_scw1(k) = prs_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprg_rcs1(k) = prg_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprs_rcs1(k) = prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprr_rci1(k) = prr_rci(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprg_rcg1(k) = prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprw_vcd1(k) = lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)*DT +! cooling terms + tprr_sml1(k) = prr_sml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + tprr_gml1(k) = prr_gml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + tprr_rcg1(k) = prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + tprr_rcs1(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + tprv_rev1(k) = lvap(k)*ocp(k)*prv_rev(k)*(1-IFDRY)*DT enddo - end subroutine mp_thompson !>@} From 6a0e904eadd35bd201e9848f68d025a3b8b7db51 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 27 May 2021 15:13:38 +0000 Subject: [PATCH 18/32] Omission from previous revert. --- physics/dcyc2.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 6247f360f..0e3a4db42 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -217,7 +217,7 @@ subroutine dcyc2t3_run & & pert_radtend logical, intent(in) :: do_sppt,ca_global real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & - & deltim, fhswr, minGPpres, minGPtemp, lfnc_k, lfnc_p0 + & deltim, fhswr, minGPpres, lfnc_k, lfnc_p0 real(kind=kind_phys), dimension(:), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & From 41782f1170b332a8c5e0c9324c83df48fb6df1b2 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 27 May 2021 17:03:13 +0000 Subject: [PATCH 19/32] Change from PR review. --- physics/dcyc2.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 0e3a4db42..dfa9f02ed 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -421,7 +421,7 @@ subroutine dcyc2t3_run & ! Add radiative heating rates to physics heating rate. Optionally, scaled w/ height ! using a logistic function if (damp_LW_fluxadj) then - lfnc = L / (1+exp(-lfnc_k*(p_lev(i,k) - lfnc_p0))) + lfnc = L / (1+exp(-(p_lev(i,k) - lfnc_p0)/lfnc_k)) else lfnc = 1. endif From bed383fe6b65ef564c539f82c21c0e76e27a4f64 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Fri, 28 May 2021 23:28:03 +0000 Subject: [PATCH 20/32] additional thompson diagnostics coded up --- physics/module_mp_thompson.F90 | 395 +++++++++++++++++++++++---------- physics/mp_thompson.F90 | 92 +++++++- 2 files changed, 363 insertions(+), 124 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b66bdc44a..592a82c62 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1019,12 +1019,19 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims errmsg, errflg, reset, vts1, prw_vcdc, & - prw_vcde, tpri_inu, tpri_ide, tprs_ide, & - tprs_sde, tprg_gde, tpri_iha, tpri_wfz, & + prw_vcde, tpri_inu, tpri_ide_d, & + tpri_ide_s, tprs_ide_d, tprs_ide_s, & + tprs_sde_d, tprs_sde_s, tprg_gde_d, & + tprg_gde_s, tpri_iha, tpri_wfz, & tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & - tprs_scw, tprg_rcs, tprs_rcs, tprr_rci, & - tprg_rcg, tprw_vcd, tprr_sml, tprr_gml, & - tprr_rcg, tprr_rcs, tprv_rev, txri,txrc) + tprg_rcs, tprs_rcs_s, tprs_rcs_r, & + tprr_rci, tprg_rcg_g, tprg_rcg_r, & + tprw_vcd_c, tprw_vcd_e, tprr_sml, & + tprr_gml, tprr_rcg_r, tprr_rcg_g, & + tprr_rcs_r, tprr_rcs_s, tprv_rev, txri, & + txrc, tten3, qvten3, qrten3, qsten3, & + qgten3, qiten3, niten3, nrten3, ncten3, & + qcten3) implicit none @@ -1035,13 +1042,20 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & qv, qc, qr, qi, qs, qg, ni, nr REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & - vts1,prw_vcdc,prw_vcde, & - tpri_inu,tpri_ide,tprs_ide,tprs_sde,tprg_gde, & - tpri_iha,tpri_wfz,tpri_rfz,tprg_rfz,tprs_scw, & - tprg_scw,tprs_scw,tprg_rcs,tprs_rcs,tprr_rci, & - tprg_rcg,tprw_vcd,tprr_sml,tprr_gml,tprr_rcg, & - tprr_rcs,tprv_rev,txri,txrc - + vts1, prw_vcdc, & + prw_vcde, tpri_inu, tpri_ide_d, & + tpri_ide_s, tprs_ide_d, tprs_ide_s, & + tprs_sde_d, tprs_sde_s, tprg_gde_d, & + tprg_gde_s, tpri_iha, tpri_wfz, & + tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & + tprg_rcs, tprs_rcs_s, tprs_rcs_r, & + tprr_rci, tprg_rcg_g, tprg_rcg_r, & + tprw_vcd_c, tprw_vcd_e, tprr_sml, & + tprr_gml, tprr_rcg_r, tprr_rcg_g, & + tprr_rcs_r, tprr_rcs_s, tprv_rev, txri, & + txrc, tten3, qvten3, qrten3, qsten3, & + qgten3, qiten3, niten3, nrten3, ncten3, & + qcten3 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & tt, th REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(IN):: & @@ -1081,12 +1095,21 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, & t1d, p1d, w1d, dz1d, rho, dBZ - REAL, DIMENSION(kts:kte):: vtsk1,prw_vcdc1,prw_vcde1, & - tpri_inu1,tpri_ide1,tprs_ide1,tprs_sde1,tprg_gde1, & - tpri_iha1,tpri_wfz1,tpri_rfz1,tprg_rfz1,tprs_scw1, & - tprg_scw1,tprs_scw1,tprg_rcs1,tprs_rcs1,tprr_rci1, & - tprg_rcg1,tprw_vcd1,tprr_sml1,tprr_gml1,tprr_rcg1, & - tprr_rcs1,tprv_rev1,txri1,txrc1 + REAL, DIMENSION(kts:kte):: & + vtsk1, prw_vcdc1, & + prw_vcde1, tpri_inu1, tpri_ide1_d, & + tpri_ide1_s, tprs_ide1_d, tprs_ide1_s, & + tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & + tprg_gde1_s, tpri_iha1, tpri_wfz1, & + tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& + tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, & + tprr_rci1, tprg_rcg1_g, tprg_rcg1_r, & + tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & + tprr_gml1, tprr_rcg1_r, tprr_rcg1_g, & + tprr_rcs1_r, tprr_rcs1_s, tprv_rev1, txri1,& + txrc1, tten1, qvten1, qrten1, qsten1, & + qgten1, qiten1, niten1, nrten1, ncten1, & + qcten1 REAL, DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d #if ( WRF_CHEM == 1 ) @@ -1281,32 +1304,52 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ni1d(k) = ni(i,k,j) nr1d(k) = nr(i,k,j) rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) + vtsk1(k) = 0. prw_vcdc1(k) = 0. prw_vcde1(k) = 0. - tpri_inu(k) = 0. - tpri_ide(k) = 0. - tprs_ide(k) = 0. - tprs_sde(k) = 0. - tprg_gde(k) = 0. - tpri_iha(k) = 0. - tpri_wfz(k) = 0. - tpri_rfz(k) = 0. - tprg_rfz(k) = 0. - tprs_scw(k) = 0. - tprg_scw(k) = 0. - tprs_scw(k) = 0. - tprg_rcs(k) = 0. - tprs_rcs(k) = 0. - tprr_rci(k) = 0. - tprg_rcg(k) = 0. - tprw_vcd(k) = 0. - tprr_sml(k) = 0. - tprr_gml(k) = 0. - tprr_rcg(k) = 0. - tprr_rcs(k) = 0. - tprv_rev(k) = 0. - + tpri_inu1(k) = 0. + tpri_ide1_d(k) = 0. + tpri_ide1_s(k) = 0. + tprs_ide1_d(k) = 0. + tprs_ide1_s(k) = 0. + tprs_sde1_d(k) = 0. + tprs_sde1_s(k) = 0. + tprg_gde1_d(k) = 0. + tprg_gde1_s(k) = 0. + tpri_iha1(k) = 0. + tpri_wfz1(k) = 0. + tpri_rfz1(k) = 0. + tprg_rfz1(k) = 0. + tprg_scw1(k) = 0. + tprs_scw1(k) = 0. + tprg_rcs1(k) = 0. + tprs_rcs1_s(k) = 0. + tprs_rcs1_r(k) = 0. + tprr_rci1(k) = 0. + tprg_rcg1_g(k) = 0. + tprg_rcg1_r(k) = 0. + tprw_vcd1_c(k) = 0. + tprw_vcd1_e(k) = 0. + tprr_sml1(k) = 0. + tprr_gml1(k) = 0. + tprr_rcg1_r(k) = 0. + tprr_rcg1_g(k) = 0. + tprr_rcs1_r(k) = 0. + tprr_rcs1_s(k) = 0. + tprv_rev1(k) = 0. + txrc1(k) = 0. + txri1(k) = 0. + tten1(k) = 0. + qvten1(k) = 0. + qrten1(k) = 0. + qsten1(k) = 0. + qgten1(k) = 0. + qiten1(k) = 0. + niten1(k) = 0. + nrten1(k) = 0. + ncten1(k) = 0. + qcten1(k) = 0. enddo if (is_aerosol_aware) then do k = kts, kte @@ -1331,11 +1374,16 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & #endif rand1, rand2, rand3, & kts, kte, dt, i, j, vtsk1, prw_vcdc1, prw_vcde1, & - tpri_inu1,tpri_ide1,tprs_ide1,tprs_sde1,tprg_gde1, & - tpri_iha1,tpri_wfz1,tpri_rfz1,tprg_rfz1,tprs_scw1, & - tprg_scw1,tprs_scw1,tprg_rcs1,tprs_rcs1,tprr_rci1, & - tprg_rcg1,tprw_vcd1,tprr_sml1,tprr_gml1,tprr_rcg1, & - tprr_rcs1,tprv_rev1,txri1,txrc1) + tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1_d,& + tprs_ide1_s, tprs_sde1_d, tprs_sde1_s, & + tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & + tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1, & + tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, tprr_rci1, & + tprg_rcg1_g, tprg_rcg1_r, tprw_vcd1_c, & + tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1_r, & + tprr_rcg1_g, tprr_rcs1_r, tprr_rcs1_s, tprv_rev1,& + txri1, txrc1, tten1, qvten1, qrten1, qsten1, & + qgten1, qiten1, niten1, nrten1, ncten1, qcten1) pcp_ra(i,j) = pptrain pcp_sn(i,j) = pptsnow @@ -1389,33 +1437,48 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qg(i,k,j) = qg1d(k) ni(i,k,j) = ni1d(k) nr(i,k,j) = nr1d(k) - vts1(i,k,j) = vtsk1(k) - prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) - prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) - tpri_inu(i,k,j) = tpri_inu(i,k,j) + tpri_inu1(k) - tpri_ide(i,k,j) = tpri_ide(i,k,j) + tpri_ide1(k) - tprs_ide(i,k,j) = tprs_ide(i,k,j) + tprs_ide1(k) - tprs_sde(i,k,j) = tprs_sde(i,k,j) + tprs_sde1(k) - tprg_gde(i,k,j) = tprg_gde(i,k,j) + tprg_gde1(k) - tpri_iha(i,k,j) = tpri_iha(i,k,j) + tpri_iha1(k) - tpri_wfz(i,k,j) = tpri_wfz(i,k,j) + tpri_wfz1(k) - tpri_rfz(i,k,j) = tpri_rfz(i,k,j) + tpri_rfz1(k) - tprg_rfz(i,k,j) = tprg_rfz(i,k,j) + tprg_rfz1(k) - tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) - tprg_scw(i,k,j) = tprg_scw(i,k,j) + tprg_scw1(k) - tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) - tprg_rcs(i,k,j) = tprg_rcs(i,k,j) + tprg_rcs1(k) - tprs_rcs(i,k,j) = tprs_rcs(i,k,j) + tprs_rcs1(k) - tprr_rci(i,k,j) = tprr_rci(i,k,j) + tprr_rci1(k) - tprg_rcg(i,k,j) = tprg_rcg(i,k,j) + tprg_rcg1(k) - tprw_vcd(i,k,j) = tprw_vcd(i,k,j) + tprw_vcd1(k) - tprr_sml(i,k,j) = tprr_sml(i,k,j) + tprr_sml1(k) - tprr_gml(i,k,j) = tprr_gml(i,k,j) + tprr_gml1(k) - tprr_rcg(i,k,j) = tprr_rcg(i,k,j) + tprr_rcg1(k) - tprr_rcs(i,k,j) = tprr_rcs(i,k,j) + tprr_rcs1(k) - tprv_rev(i,k,j) = tprv_rev(i,k,j) + tprv_rev1(k) - txri(i,k,j) = txri(i,k,j) + txri1(k) - txrc(i,k,j) = txrc(i,k,j) + txrc1(k) + vts1(i,k,j) = vtsk1(k) + prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) + prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) + tpri_inu(i,k,j) = tpri_inu(i,k,j) + tpri_inu1(k) + tpri_ide_s(i,k,j) = tpri_ide_s(i,k,j) + tpri_ide1_s(k) + tprs_ide_d(i,k,j) = tprs_ide_d(i,k,j) + tprs_ide1_d(k) + tprs_sde_s(i,k,j) = tprs_sde_s(i,k,j) + tprs_sde1_s(k) + tprs_sde_d(i,k,j) = tprs_sde_d(i,k,j) + tprs_sde1_d(k) + tprg_gde_s(i,k,j) = tprg_gde_s(i,k,j) + tprg_gde1_s(k) + tpri_iha(i,k,j) = tpri_iha(i,k,j) + tpri_iha1(k) + tpri_wfz(i,k,j) = tpri_wfz(i,k,j) + tpri_wfz1(k) + tpri_rfz(i,k,j) = tpri_rfz(i,k,j) + tpri_rfz1(k) + tprg_rfz(i,k,j) = tprg_rfz(i,k,j) + tprg_rfz1(k) + tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) + tprg_scw(i,k,j) = tprg_scw(i,k,j) + tprg_scw1(k) + tprg_rcs(i,k,j) = tprg_rcs(i,k,j) + tprg_rcs1(k) + tprs_rcs_s(i,k,j) = tprs_rcs_s(i,k,j) + tprs_rcs1_s(k) + tprs_rcs_r(i,k,j) = tprs_rcs_r(i,k,j) + tprs_rcs1_r(k) + tprr_rci(i,k,j) = tprr_rci(i,k,j) + tprr_rci1(k) + tprg_rcg_g(i,k,j) = tprg_rcg_g(i,k,j) + tprg_rcg1_g(k) + tprg_rcg_r(i,k,j) = tprg_rcg_r(i,k,j) + tprg_rcg1_r(k) + tprw_vcd_c(i,k,j) = tprw_vcd_c(i,k,j) + tprw_vcd1_c(k) + tprw_vcd_e(i,k,j) = tprw_vcd_e(i,k,j) + tprw_vcd1_e(k) + tprr_sml(i,k,j) = tprr_sml(i,k,j) + tprr_sml1(k) + tprr_gml(i,k,j) = tprr_gml(i,k,j) + tprr_gml1(k) + tprr_rcg_r(i,k,j) = tprr_rcg_r(i,k,j) + tprr_rcg1_r(k) + tprr_rcg_g(i,k,j) = tprr_rcg_g(i,k,j) + tprr_rcg1_g(k) + tprr_rcs_r(i,k,j) = tprr_rcs_r(i,k,j) + tprr_rcs1_r(k) + tprr_rcs_s(i,k,j) = tprr_rcs_s(i,k,j) + tprr_rcs1_s(k) + tprv_rev(i,k,j) = tprv_rev(i,k,j) + tprv_rev1(k) + txri(i,k,j) = txri(i,k,j) + txri1(k) + txrc(i,k,j) = txrc(i,k,j) + txrc1(k) + tten3(i,k,j) = tten3(i,k,j) + tten1(k) + qvten3(i,k,j) = qvten3(i,k,j) + qvten1(k) + qrten3(i,k,j) = qrten3(i,k,j) + qrten1(k) + qsten3(i,k,j) = qsten3(i,k,j) + qsten1(k) + qgten3(i,k,j) = qgten3(i,k,j) + qgten1(k) + qiten3(i,k,j) = qiten3(i,k,j) + qiten1(k) + niten3(i,k,j) = niten3(i,k,j) + niten1(k) + nrten3(i,k,j) = nrten3(i,k,j) + nrten1(k) + ncten3(i,k,j) = ncten3(i,k,j) + ncten1(k) + qcten3(i,k,j) = qcten3(i,k,j) + qcten1(k) if (present(tt)) then; tt(i,k,j) = t1d(k) else @@ -1629,12 +1692,17 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rainprod, evapprod, & #endif rand1, rand2, rand3, & - kts, kte, dt, ii, jj, vtsk1, prw_vcdc1, prw_vcde1,& - tpri_inu1,tpri_ide1,tprs_ide1,tprs_sde1,tprg_gde1, & - tpri_iha1,tpri_wfz1,tpri_rfz1,tprg_rfz1,tprs_scw1, & - tprg_scw1,tprs_scw1,tprg_rcs1,tprs_rcs1,tprr_rci1, & - tprg_rcg1,tprw_vcd1,tprr_sml1,tprr_gml1,tprr_rcg1, & - tprr_rcs1,tprv_rev1,txri1,txrc1) + kts, kte, dt, ii, jj,vtsk1, prw_vcdc1, prw_vcde1, & + tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1_d,& + tprs_ide1_s, tprs_sde1_d, tprs_sde1_s, & + tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & + tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1, & + tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, tprr_rci1, & + tprg_rcg1_g, tprg_rcg1_r, tprw_vcd1_c, & + tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1_r, & + tprr_rcg1_g, tprr_rcs1_r, tprr_rcs1_s, tprv_rev1,& + txri1, txrc1, tten1, qvten1, qrten1, qsten1, & + qgten1, qiten1, niten1, nrten1, ncten1, qcten1) #ifdef MPI use mpi #endif @@ -1649,12 +1717,21 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice REAL, INTENT(IN):: dt REAL, INTENT(IN):: rand1, rand2, rand3 - REAL, DIMENSION(kts:kte), INTENT(OUT):: vtsk1,prw_vcdc1,prw_vcde1, & - tpri_inu1,tpri_ide1,tprs_ide1,tprs_sde1,tprg_gde1, & - tpri_iha1,tpri_wfz1,tpri_rfz1,tprg_rfz1,tprs_scw1, & - tprg_scw1,tprs_scw1,tprg_rcs1,tprs_rcs1,tprr_rci1, & - tprg_rcg1,tprw_vcd1,tprr_sml1,tprr_gml1,tprr_rcg1, & - tprr_rcs1,tprv_rev1,txri1,txrc1 + REAL, DIMENSION(kts:kte), INTENT(OUT):: & + vtsk1, prw_vcdc1, & + prw_vcde1, tpri_inu1, tpri_ide1_d, & + tpri_ide1_s, tprs_ide1_d, tprs_ide1_s, & + tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & + tprg_gde1_s, tpri_iha1, tpri_wfz1, & + tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& + tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, & + tprr_rci1, tprg_rcg1_g, tprg_rcg1_r, & + tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & + tprr_gml1, tprr_rcg1_r, tprr_rcg1_g, & + tprr_rcs1_r, tprr_rcs1_s, tprv_rev1, txri1,& + txrc1, tten1, qvten1, qrten1, qsten1, & + qgten1, qiten1, niten1, nrten1, ncten1, & + qcten1 #if ( WRF_CHEM == 1 ) REAL, DIMENSION(kts:kte), INTENT(INOUT):: & rainprod, evapprod @@ -1856,30 +1933,51 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pnd_scd(k) = 0. pnd_gcd(k) = 0. !Diagnostics - prw_vcdc1(k) = 0. - prw_vcde1(k) = 0. - tpri_inu1(k) = 0. - tpri_ide1(k) = 0. - tprs_ide1(k) = 0. - tprs_sde1(k) = 0. - tprg_gde1(k) = 0. - tpri_iha1(k) = 0. - tpri_wfz1(k) = 0. - tpri_rfz1(k) = 0. - tprg_rfz1(k) = 0. - tprs_scw1(k) = 0. - tprg_scw1(k) = 0. - tprs_scw1(k) = 0. - tprg_rcs1(k) = 0. - tprs_rcs1(k) = 0. - tprr_rci1(k) = 0. - tprg_rcg1(k) = 0. - tprw_vcd1(k) = 0. - tprr_sml1(k) = 0. - tprr_gml1(k) = 0. - tprr_rcg1(k) = 0. - tprr_rcs1(k) = 0. - tprv_rev1(k) = 0. + vtsk1(k) = 0. + prw_vcdc1(k) = 0. + prw_vcde1(k) = 0. + tpri_inu1(k) = 0. + tpri_ide1_d(k) = 0. + tpri_ide1_s(k) = 0. + tprs_ide1_d(k) = 0. + tprs_ide1_s(k) = 0. + tprs_sde1_d(k) = 0. + tprs_sde1_s(k) = 0. + tprg_gde1_d(k) = 0. + tprg_gde1_s(k) = 0. + tpri_iha1(k) = 0. + tpri_wfz1(k) = 0. + tpri_rfz1(k) = 0. + tprg_rfz1(k) = 0. + tprg_scw1(k) = 0. + tprs_scw1(k) = 0. + tprg_rcs1(k) = 0. + tprs_rcs1_s(k) = 0. + tprs_rcs1_r(k) = 0. + tprr_rci1(k) = 0. + tprg_rcg1_g(k) = 0. + tprg_rcg1_r(k) = 0. + tprw_vcd1_c(k) = 0. + tprw_vcd1_e(k) = 0. + tprr_sml1(k) = 0. + tprr_gml1(k) = 0. + tprr_rcg1_r(k) = 0. + tprr_rcg1_g(k) = 0. + tprr_rcs1_r(k) = 0. + tprr_rcs1_s(k) = 0. + tprv_rev1(k) = 0. + txrc1(k) = 0. + txri1(k) = 0. + tten1(k) = 0. + qvten1(k) = 0. + qrten1(k) = 0. + qsten1(k) = 0. + qgten1(k) = 0. + qiten1(k) = 0. + niten1(k) = 0. + nrten1(k) = 0. + ncten1(k) = 0. + qcten1(k) = 0. enddo #if ( WRF_CHEM == 1 ) do k = kts, kte @@ -3907,30 +4005,87 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & elseif(prw_vcd(k).lt.0)then prw_vcde1(k) = -1*prw_vcd(k)*dt endif -!heating terms +!heating/cooling diagnostics tpri_inu1(k) = pri_inu(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - tpri_ide1(k) = pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - tprs_ide1(k) = prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - tprs_sde1(k) = prs_sde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - tprg_gde1(k) = prg_gde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + + if(pri_ide(k).gt.0)then + tpri_ide1_d(k) = pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + else + tpri_ide1_s(k) = -pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + endif + + if(prs_ide(k).gt.0)then + tprs_ide1_d(k) = prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + else + tprs_ide1_s(k) = -prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + endif + + if(prs_sde(k).gt.0)then + tprs_sde1_d(k) = prs_sde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + else + tprs_sde1_s(k) = -prs_sde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + endif + + if(prg_gde(k).gt.0)then + tprg_gde1_d(k) = prg_gde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + else + tprg_gde1_s(k) = -prg_gde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + endif + tpri_iha1(k) = pri_iha(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT tpri_wfz1(k) = pri_wfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT tpri_rfz1(k) = pri_rfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT tprg_rfz1(k) = prg_rfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT tprs_scw1(k) = prs_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT tprg_scw1(k) = prg_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tprs_scw1(k) = prs_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT tprg_rcs1(k) = prg_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tprs_rcs1(k) = prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + + if(prs_rcs(k).gt.0)then + tprs_rcs1_s(k) = prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + else + tprs_rcs1_r(k) = -prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + endif + tprr_rci1(k) = prr_rci(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tprg_rcg1(k) = prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tprw_vcd1(k) = lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)*DT + + if(prg_rcg(k).gt.0)then + tprg_rcg1_g(k) = prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + else + tprg_rcg1_r(k) = -prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + endif + + if(prw_vcd(k).gt.0)then + tprw_vcd1_c(k) = lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)*DT + else + tprw_vcd1_e(k) = -lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)*DT + endif + ! cooling terms tprr_sml1(k) = prr_sml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT tprr_gml1(k) = prr_gml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - tprr_rcg1(k) = prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - tprr_rcs1(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + + if(prr_rcg(k).gt.0)then + tprr_rcg1_r(k) = prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + else + tprr_rcg1_g(k) = -prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + endif + + if(prr_rcs(k).gt.0)then + tprr_rcs1_r(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + else + tprr_rcs1_s(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + endif + tprv_rev1(k) = lvap(k)*ocp(k)*prv_rev(k)*(1-IFDRY)*DT + tten1(k) = tten(k)*DT + qvten1(k) = qvten(k)*DT + qrten1(k) = qrten(k)*DT + qsten1(k) = qsten(k)*DT + qgten1(k) = qgten(k)*DT + niten1(k) = niten1(k)*DT + nrten1(k) = nrten1(k)*DT + ncten1(k) = ncten1(k)*DT + qcten1(k) = qcten1(k)*DT enddo end subroutine mp_thompson !>@} diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index daa492aa9..ddb0c900d 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -570,7 +570,28 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & errmsg=errmsg, errflg=errflg, reset=reset, vts1=aux3d(:,:,1), & - prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3)) + prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & + tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & + tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & + tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & + tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & + tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & + tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & + tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & + tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & + tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & + tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & + tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & + tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & + tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & + tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & + tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & + txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & + qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & + qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & + qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & + nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & + qcten3=aux3d(:,:,45)) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & @@ -590,7 +611,28 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & errmsg=errmsg, errflg=errflg, reset=reset, vts1=aux3d(:,:,1), & - prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3)) + prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & + tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & + tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & + tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & + tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & + tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & + tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & + tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & + tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & + tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & + tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & + tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & + tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & + tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & + tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & + tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & + txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & + qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & + qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & + qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & + nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & + qcten3=aux3d(:,:,45)) end if else if (do_effective_radii) then @@ -612,7 +654,28 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & errmsg=errmsg, errflg=errflg, reset=reset, vts1=aux3d(:,:,1), & - prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3)) + prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & + tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & + tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & + tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & + tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & + tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & + tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & + tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & + tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & + tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & + tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & + tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & + tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & + tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & + tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & + tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & + txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & + qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & + qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & + qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & + nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & + qcten3=aux3d(:,:,45)) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & @@ -631,7 +694,28 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & errmsg=errmsg, errflg=errflg, reset=reset, vts1=aux3d(:,:,1), & - prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3)) + prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & + tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & + tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & + tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & + tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & + tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & + tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & + tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & + tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & + tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & + tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & + tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & + tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & + tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & + tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & + tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & + txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & + qvten3=aux3d(:,:,37), qrten3=aux3d(:,:,38), & + qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & + qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & + nrten3=aux3d(:,:,43), ncten3=aux3d(:,:,44), & + qcten3=aux3d(:,:,45)) end if end if if (errflg/=0) return From 094e7dbc9442f9502a9a7210472539bec24e74e6 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Fri, 28 May 2021 23:40:27 +0000 Subject: [PATCH 21/32] fix bug with some diagnostics --- physics/module_mp_thompson.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 592a82c62..4609849e7 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -4082,10 +4082,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qrten1(k) = qrten(k)*DT qsten1(k) = qsten(k)*DT qgten1(k) = qgten(k)*DT - niten1(k) = niten1(k)*DT - nrten1(k) = nrten1(k)*DT - ncten1(k) = ncten1(k)*DT - qcten1(k) = qcten1(k)*DT + niten1(k) = niten(k)*DT + nrten1(k) = nrten(k)*DT + ncten1(k) = ncten(k)*DT + qcten1(k) = qcten(k)*DT enddo end subroutine mp_thompson !>@} From 0e3bb76df4c61d947e4227b4c230510589cb6cac Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 22 Jun 2021 08:31:06 -0600 Subject: [PATCH 22/32] Update Thompson extended diagnostics code --- physics/module_mp_thompson.F90 | 453 +++++++++++++++++++++------------ physics/mp_thompson.F90 | 335 +++++++++++++++++------- physics/mp_thompson.meta | 47 +++- 3 files changed, 566 insertions(+), 269 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index cd4d84d8d..0996349a4 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1,3 +1,4 @@ + !>\file module_mp_thompson.F90 !! This file contains the entity of GSD Thompson MP scheme. @@ -988,7 +989,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims reset_dBZ, istep, nsteps, & - errmsg, errflg, vts1, prw_vcdc, & + errmsg, errflg, & + ! Extended diagnostics, array pointers + ! only associated if ext_diag flag is .true. + ext_diag, vts1, prw_vcdc, & prw_vcde, tpri_inu, tpri_ide_d, & tpri_ide_s, tprs_ide_d, tprs_ide_s, & tprs_sde_d, tprs_sde_s, tprg_gde_d, & @@ -1011,21 +1015,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & its,ite, jts,jte, kts,kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & qv, qc, qr, qi, qs, qg, ni, nr - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & - vts1, prw_vcdc, & - prw_vcde, tpri_inu, tpri_ide_d, & - tpri_ide_s, tprs_ide_d, tprs_ide_s, & - tprs_sde_d, tprs_sde_s, tprg_gde_d, & - tprg_gde_s, tpri_iha, tpri_wfz, & - tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & - tprg_rcs, tprs_rcs_s, tprs_rcs_r, & - tprr_rci, tprg_rcg_g, tprg_rcg_r, & - tprw_vcd_c, tprw_vcd_e, tprr_sml, & - tprr_gml, tprr_rcg_r, tprr_rcg_g, & - tprr_rcs_r, tprr_rcs_s, tprv_rev, txri, & - txrc, tten3, qvten3, qrten3, qsten3, & - qgten3, qiten3, niten3, nrten3, ncten3, & - qcten3 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & tt, th REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(IN):: & @@ -1061,27 +1050,45 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ! To support subcycling: current step and maximum number of steps INTEGER, INTENT (IN) :: istep, nsteps LOGICAL, INTENT (IN) :: reset_dBZ + ! Extended diagnostics, array pointers only associated if ext_diag flag is .true. + LOGICAL, INTENT (IN) :: ext_diag + REAL, DIMENSION(:,:,:), INTENT(INOUT):: & + vts1, prw_vcdc, & + prw_vcde, tpri_inu, tpri_ide_d, & + tpri_ide_s, tprs_ide_d, tprs_ide_s, & + tprs_sde_d, tprs_sde_s, tprg_gde_d, & + tprg_gde_s, tpri_iha, tpri_wfz, & + tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & + tprg_rcs, tprs_rcs_s, tprs_rcs_r, & + tprr_rci, tprg_rcg_g, tprg_rcg_r, & + tprw_vcd_c, tprw_vcd_e, tprr_sml, & + tprr_gml, tprr_rcg_r, tprr_rcg_g, & + tprr_rcs_r, tprr_rcs_s, tprv_rev, txri, & + txrc, tten3, qvten3, qrten3, qsten3, & + qgten3, qiten3, niten3, nrten3, ncten3, & + qcten3 !..Local variables REAL, DIMENSION(kts:kte):: & - qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & - nr1d, nc1d, nwfa1d, nifa1d, & + qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & + nr1d, nc1d, nwfa1d, nifa1d, & t1d, p1d, w1d, dz1d, rho, dBZ - REAL, DIMENSION(kts:kte):: & - vtsk1, prw_vcdc1, & - prw_vcde1, tpri_inu1, tpri_ide1_d, & - tpri_ide1_s, tprs_ide1_d, tprs_ide1_s, & - tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & - tprg_gde1_s, tpri_iha1, tpri_wfz1, & - tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& - tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, & - tprr_rci1, tprg_rcg1_g, tprg_rcg1_r, & - tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & - tprr_gml1, tprr_rcg1_r, tprr_rcg1_g, & - tprr_rcs1_r, tprr_rcs1_s, tprv_rev1, txri1,& - txrc1, tten1, qvten1, qrten1, qsten1, & - qgten1, qiten1, niten1, nrten1, ncten1, & - qcten1 +!..Extended diagnostics, single column arrays + REAL, DIMENSION(:), ALLOCATABLE:: & + vtsk1, prw_vcdc1, & + prw_vcde1, tpri_inu1, tpri_ide1_d, & + tpri_ide1_s, tprs_ide1_d, tprs_ide1_s, & + tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & + tprg_gde1_s, tpri_iha1, tpri_wfz1, & + tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& + tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, & + tprr_rci1, tprg_rcg1_g, tprg_rcg1_r, & + tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & + tprr_gml1, tprr_rcg1_r, tprr_rcg1_g, & + tprr_rcs1_r, tprr_rcs1_s, tprv_rev1, txri1,& + txrc1, tten1, qvten1, qrten1, qsten1, & + qgten1, qiten1, niten1, nrten1, ncten1, & + qcten1 REAL, DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d #if ( WRF_CHEM == 1 ) @@ -1170,6 +1177,59 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & end if end if test_only_once + allocate_extended_diagnostics: if (ext_diag) then + allocate (vtsk1(kts:kte)) + allocate (prw_vcdc1(kts:kte)) + allocate (prw_vcde1(kts:kte)) + allocate (tpri_inu1(kts:kte)) + allocate (tpri_ide1_d(kts:kte)) + allocate (tpri_ide1_s(kts:kte)) + allocate (tprs_ide1_d(kts:kte)) + allocate (tprs_ide1_s(kts:kte)) + allocate (tprs_sde1_d(kts:kte)) + allocate (tprs_sde1_s(kts:kte)) + allocate (tprg_gde1_d(kts:kte)) + allocate (tprg_gde1_s(kts:kte)) + allocate (tpri_iha1(kts:kte)) + allocate (tpri_wfz1(kts:kte)) + allocate (tpri_rfz1(kts:kte)) + allocate (tprg_rfz1(kts:kte)) + allocate (tprs_scw1(kts:kte)) + allocate (tprg_scw1,(kts:kte)) + allocate (tprg_rcs1(kts:kte)) + allocate (tprs_rcs1_s(kts:kte)) + allocate (tprs_rcs1_r(kts:kte)) + allocate (tprr_rci1(kts:kte)) + allocate (tprg_rcg1_g(kts:kte)) + allocate (tprg_rcg1_r(kts:kte)) + allocate (tprw_vcd1_c(kts:kte)) + allocate (tprw_vcd1_e(kts:kte)) + allocate (tprr_sml1(kts:kte)) + allocate (tprr_gml1(kts:kte)) + allocate (tprr_rcg1_r(kts:kte)) + allocate (tprr_rcg1_g(kts:kte)) + allocate (tprr_rcs1_r(kts:kte)) + allocate (tprr_rcs1_s(kts:kte)) + allocate (tprv_rev1(kts:kte)) + allocate (txri1,(kts:kte)) + allocate (txrc1(kts:kte)) + allocate (tten1(kts:kte)) + allocate (qvten1(kts:kte)) + allocate (qrten1(kts:kte)) + allocate (qsten1(kts:kte)) + allocate (qgten1(kts:kte)) + allocate (qiten1(kts:kte)) + allocate (niten1(kts:kte)) + allocate (nrten1(kts:kte)) + allocate (ncten1(kts:kte)) + allocate (qcten1(kts:kte)) + else + ! These must be allocated always + allocate (vtsk1(kts:kte)) + allocate (txri1(kts:kte)) + allocate (txrc1(kts:kte)) + end if allocate_extended_diagnostics + !+---+ i_start = its j_start = jts @@ -1279,52 +1339,59 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ni1d(k) = ni(i,k,j) nr1d(k) = nr(i,k,j) rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) - - vtsk1(k) = 0. - prw_vcdc1(k) = 0. - prw_vcde1(k) = 0. - tpri_inu1(k) = 0. - tpri_ide1_d(k) = 0. - tpri_ide1_s(k) = 0. - tprs_ide1_d(k) = 0. - tprs_ide1_s(k) = 0. - tprs_sde1_d(k) = 0. - tprs_sde1_s(k) = 0. - tprg_gde1_d(k) = 0. - tprg_gde1_s(k) = 0. - tpri_iha1(k) = 0. - tpri_wfz1(k) = 0. - tpri_rfz1(k) = 0. - tprg_rfz1(k) = 0. - tprg_scw1(k) = 0. - tprs_scw1(k) = 0. - tprg_rcs1(k) = 0. - tprs_rcs1_s(k) = 0. - tprs_rcs1_r(k) = 0. - tprr_rci1(k) = 0. - tprg_rcg1_g(k) = 0. - tprg_rcg1_r(k) = 0. - tprw_vcd1_c(k) = 0. - tprw_vcd1_e(k) = 0. - tprr_sml1(k) = 0. - tprr_gml1(k) = 0. - tprr_rcg1_r(k) = 0. - tprr_rcg1_g(k) = 0. - tprr_rcs1_r(k) = 0. - tprr_rcs1_s(k) = 0. - tprv_rev1(k) = 0. - txrc1(k) = 0. - txri1(k) = 0. - tten1(k) = 0. - qvten1(k) = 0. - qrten1(k) = 0. - qsten1(k) = 0. - qgten1(k) = 0. - qiten1(k) = 0. - niten1(k) = 0. - nrten1(k) = 0. - ncten1(k) = 0. - qcten1(k) = 0. + + initialize_extended_diagnostics: if (ext_diag) then + vtsk1(k) = 0. + prw_vcdc1(k) = 0. + prw_vcde1(k) = 0. + tpri_inu1(k) = 0. + tpri_ide1_d(k) = 0. + tpri_ide1_s(k) = 0. + tprs_ide1_d(k) = 0. + tprs_ide1_s(k) = 0. + tprs_sde1_d(k) = 0. + tprs_sde1_s(k) = 0. + tprg_gde1_d(k) = 0. + tprg_gde1_s(k) = 0. + tpri_iha1(k) = 0. + tpri_wfz1(k) = 0. + tpri_rfz1(k) = 0. + tprg_rfz1(k) = 0. + tprg_scw1(k) = 0. + tprs_scw1(k) = 0. + tprg_rcs1(k) = 0. + tprs_rcs1_s(k) = 0. + tprs_rcs1_r(k) = 0. + tprr_rci1(k) = 0. + tprg_rcg1_g(k) = 0. + tprg_rcg1_r(k) = 0. + tprw_vcd1_c(k) = 0. + tprw_vcd1_e(k) = 0. + tprr_sml1(k) = 0. + tprr_gml1(k) = 0. + tprr_rcg1_r(k) = 0. + tprr_rcg1_g(k) = 0. + tprr_rcs1_r(k) = 0. + tprr_rcs1_s(k) = 0. + tprv_rev1(k) = 0. + txrc1(k) = 0. + txri1(k) = 0. + tten1(k) = 0. + qvten1(k) = 0. + qrten1(k) = 0. + qsten1(k) = 0. + qgten1(k) = 0. + qiten1(k) = 0. + niten1(k) = 0. + nrten1(k) = 0. + ncten1(k) = 0. + qcten1(k) = 0. + else + ! These arrays are always allocated and must be initialized + vtsk1(k) = 0. + txrc1(k) = 0. + txri1(k) = 0. + endif enddo if (is_aerosol_aware) then do k = kts, kte @@ -1412,48 +1479,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qg(i,k,j) = qg1d(k) ni(i,k,j) = ni1d(k) nr(i,k,j) = nr1d(k) - vts1(i,k,j) = vtsk1(k) - prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) - prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) - tpri_inu(i,k,j) = tpri_inu(i,k,j) + tpri_inu1(k) - tpri_ide_s(i,k,j) = tpri_ide_s(i,k,j) + tpri_ide1_s(k) - tprs_ide_d(i,k,j) = tprs_ide_d(i,k,j) + tprs_ide1_d(k) - tprs_sde_s(i,k,j) = tprs_sde_s(i,k,j) + tprs_sde1_s(k) - tprs_sde_d(i,k,j) = tprs_sde_d(i,k,j) + tprs_sde1_d(k) - tprg_gde_s(i,k,j) = tprg_gde_s(i,k,j) + tprg_gde1_s(k) - tpri_iha(i,k,j) = tpri_iha(i,k,j) + tpri_iha1(k) - tpri_wfz(i,k,j) = tpri_wfz(i,k,j) + tpri_wfz1(k) - tpri_rfz(i,k,j) = tpri_rfz(i,k,j) + tpri_rfz1(k) - tprg_rfz(i,k,j) = tprg_rfz(i,k,j) + tprg_rfz1(k) - tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) - tprg_scw(i,k,j) = tprg_scw(i,k,j) + tprg_scw1(k) - tprg_rcs(i,k,j) = tprg_rcs(i,k,j) + tprg_rcs1(k) - tprs_rcs_s(i,k,j) = tprs_rcs_s(i,k,j) + tprs_rcs1_s(k) - tprs_rcs_r(i,k,j) = tprs_rcs_r(i,k,j) + tprs_rcs1_r(k) - tprr_rci(i,k,j) = tprr_rci(i,k,j) + tprr_rci1(k) - tprg_rcg_g(i,k,j) = tprg_rcg_g(i,k,j) + tprg_rcg1_g(k) - tprg_rcg_r(i,k,j) = tprg_rcg_r(i,k,j) + tprg_rcg1_r(k) - tprw_vcd_c(i,k,j) = tprw_vcd_c(i,k,j) + tprw_vcd1_c(k) - tprw_vcd_e(i,k,j) = tprw_vcd_e(i,k,j) + tprw_vcd1_e(k) - tprr_sml(i,k,j) = tprr_sml(i,k,j) + tprr_sml1(k) - tprr_gml(i,k,j) = tprr_gml(i,k,j) + tprr_gml1(k) - tprr_rcg_r(i,k,j) = tprr_rcg_r(i,k,j) + tprr_rcg1_r(k) - tprr_rcg_g(i,k,j) = tprr_rcg_g(i,k,j) + tprr_rcg1_g(k) - tprr_rcs_r(i,k,j) = tprr_rcs_r(i,k,j) + tprr_rcs1_r(k) - tprr_rcs_s(i,k,j) = tprr_rcs_s(i,k,j) + tprr_rcs1_s(k) - tprv_rev(i,k,j) = tprv_rev(i,k,j) + tprv_rev1(k) - txri(i,k,j) = txri(i,k,j) + txri1(k) - txrc(i,k,j) = txrc(i,k,j) + txrc1(k) - tten3(i,k,j) = tten3(i,k,j) + tten1(k) - qvten3(i,k,j) = qvten3(i,k,j) + qvten1(k) - qrten3(i,k,j) = qrten3(i,k,j) + qrten1(k) - qsten3(i,k,j) = qsten3(i,k,j) + qsten1(k) - qgten3(i,k,j) = qgten3(i,k,j) + qgten1(k) - qiten3(i,k,j) = qiten3(i,k,j) + qiten1(k) - niten3(i,k,j) = niten3(i,k,j) + niten1(k) - nrten3(i,k,j) = nrten3(i,k,j) + nrten1(k) - ncten3(i,k,j) = ncten3(i,k,j) + ncten1(k) - qcten3(i,k,j) = qcten3(i,k,j) + qcten1(k) if (present(tt)) then; tt(i,k,j) = t1d(k) else @@ -1538,6 +1563,53 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & endif enddo + assign_extended_diagnostics: if (ext_diag) then + do k=kts,kte + vts1(i,k,j) = vtsk1(k) + prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) + prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) + tpri_inu(i,k,j) = tpri_inu(i,k,j) + tpri_inu1(k) + tpri_ide_s(i,k,j) = tpri_ide_s(i,k,j) + tpri_ide1_s(k) + tprs_ide_d(i,k,j) = tprs_ide_d(i,k,j) + tprs_ide1_d(k) + tprs_sde_s(i,k,j) = tprs_sde_s(i,k,j) + tprs_sde1_s(k) + tprs_sde_d(i,k,j) = tprs_sde_d(i,k,j) + tprs_sde1_d(k) + tprg_gde_s(i,k,j) = tprg_gde_s(i,k,j) + tprg_gde1_s(k) + tpri_iha(i,k,j) = tpri_iha(i,k,j) + tpri_iha1(k) + tpri_wfz(i,k,j) = tpri_wfz(i,k,j) + tpri_wfz1(k) + tpri_rfz(i,k,j) = tpri_rfz(i,k,j) + tpri_rfz1(k) + tprg_rfz(i,k,j) = tprg_rfz(i,k,j) + tprg_rfz1(k) + tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) + tprg_scw(i,k,j) = tprg_scw(i,k,j) + tprg_scw1(k) + tprg_rcs(i,k,j) = tprg_rcs(i,k,j) + tprg_rcs1(k) + tprs_rcs_s(i,k,j) = tprs_rcs_s(i,k,j) + tprs_rcs1_s(k) + tprs_rcs_r(i,k,j) = tprs_rcs_r(i,k,j) + tprs_rcs1_r(k) + tprr_rci(i,k,j) = tprr_rci(i,k,j) + tprr_rci1(k) + tprg_rcg_g(i,k,j) = tprg_rcg_g(i,k,j) + tprg_rcg1_g(k) + tprg_rcg_r(i,k,j) = tprg_rcg_r(i,k,j) + tprg_rcg1_r(k) + tprw_vcd_c(i,k,j) = tprw_vcd_c(i,k,j) + tprw_vcd1_c(k) + tprw_vcd_e(i,k,j) = tprw_vcd_e(i,k,j) + tprw_vcd1_e(k) + tprr_sml(i,k,j) = tprr_sml(i,k,j) + tprr_sml1(k) + tprr_gml(i,k,j) = tprr_gml(i,k,j) + tprr_gml1(k) + tprr_rcg_r(i,k,j) = tprr_rcg_r(i,k,j) + tprr_rcg1_r(k) + tprr_rcg_g(i,k,j) = tprr_rcg_g(i,k,j) + tprr_rcg1_g(k) + tprr_rcs_r(i,k,j) = tprr_rcs_r(i,k,j) + tprr_rcs1_r(k) + tprr_rcs_s(i,k,j) = tprr_rcs_s(i,k,j) + tprr_rcs1_s(k) + tprv_rev(i,k,j) = tprv_rev(i,k,j) + tprv_rev1(k) + txri(i,k,j) = txri(i,k,j) + txri1(k) + txrc(i,k,j) = txrc(i,k,j) + txrc1(k) + tten3(i,k,j) = tten3(i,k,j) + tten1(k) + qvten3(i,k,j) = qvten3(i,k,j) + qvten1(k) + qrten3(i,k,j) = qrten3(i,k,j) + qrten1(k) + qsten3(i,k,j) = qsten3(i,k,j) + qsten1(k) + qgten3(i,k,j) = qgten3(i,k,j) + qgten1(k) + qiten3(i,k,j) = qiten3(i,k,j) + qiten1(k) + niten3(i,k,j) = niten3(i,k,j) + niten1(k) + nrten3(i,k,j) = nrten3(i,k,j) + nrten1(k) + ncten3(i,k,j) = ncten3(i,k,j) + ncten1(k) + qcten3(i,k,j) = qcten3(i,k,j) + qcten1(k) + enddo + endif assign_extended_diagnostics + ! Diagnostic calculations only for last step ! if Thompson MP is called multiple times last_step_only: IF (istep == nsteps) THEN @@ -1601,6 +1673,59 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ! 'nr: ', nr_max, '(', imax_nr, ',', jmax_nr, ',', kmax_nr, ')' ! END DEBUG - GT + deallocate_extended_diagnostics: if (ext_diag) then + deallocate (vtsk1) + deallocate (prw_vcdc1) + deallocate (prw_vcde1) + deallocate (tpri_inu1) + deallocate (tpri_ide1_d) + deallocate (tpri_ide1_s) + deallocate (tprs_ide1_d) + deallocate (tprs_ide1_s) + deallocate (tprs_sde1_d) + deallocate (tprs_sde1_s) + deallocate (tprg_gde1_d) + deallocate (tprg_gde1_s) + deallocate (tpri_iha1) + deallocate (tpri_wfz1) + deallocate (tpri_rfz1) + deallocate (tprg_rfz1) + deallocate (tprs_scw1) + deallocate (tprg_scw1,) + deallocate (tprg_rcs1) + deallocate (tprs_rcs1_s) + deallocate (tprs_rcs1_r) + deallocate (tprr_rci1) + deallocate (tprg_rcg1_g) + deallocate (tprg_rcg1_r) + deallocate (tprw_vcd1_c) + deallocate (tprw_vcd1_e) + deallocate (tprr_sml1) + deallocate (tprr_gml1) + deallocate (tprr_rcg1_r) + deallocate (tprr_rcg1_g) + deallocate (tprr_rcs1_r) + deallocate (tprr_rcs1_s) + deallocate (tprv_rev1) + deallocate (txri1,) + deallocate (txrc1) + deallocate (tten1) + deallocate (qvten1) + deallocate (qrten1) + deallocate (qsten1) + deallocate (qgten1) + deallocate (qiten1) + deallocate (niten1) + deallocate (nrten1) + deallocate (ncten1) + deallocate (qcten1) + else + ! These are always allocated + deallocate (vtsk1) + deallocate (txri1) + deallocate (txrc1) + end if deallocate_extended_diagnostics + END SUBROUTINE mp_gt_driver !> @} @@ -1665,24 +1790,27 @@ END SUBROUTINE thompson_finalize !! Thompson et al. (2004, 2008)\cite Thompson_2004 \cite Thompson_2008. !>\section gen_mp_thompson mp_thompson General Algorithm !> @{ - subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & - nr1d, nc1d, nwfa1d, nifa1d, t1d, p1d, w1d, dzq, & - pptrain, pptsnow, pptgraul, pptice, & + subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & + nr1d, nc1d, nwfa1d, nifa1d, t1d, p1d, w1d, dzq, & + pptrain, pptsnow, pptgraul, pptice, & #if ( WRF_CHEM == 1 ) - rainprod, evapprod, & + rainprod, evapprod, & #endif - rand1, rand2, rand3, & - kts, kte, dt, ii, jj,vtsk1, prw_vcdc1, prw_vcde1, & - tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1_d,& - tprs_ide1_s, tprs_sde1_d, tprs_sde1_s, & - tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & - tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1, & - tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, tprr_rci1, & - tprg_rcg1_g, tprg_rcg1_r, tprw_vcd1_c, & - tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1_r, & - tprr_rcg1_g, tprr_rcs1_r, tprr_rcs1_s, tprv_rev1,& - txri1, txrc1, tten1, qvten1, qrten1, qsten1, & - qgten1, qiten1, niten1, nrten1, ncten1, qcten1) + rand1, rand2, rand3, & + kts, kte, dt, ii, jj, & + ! Extended diagnostics, most arrays only + ! allocated if ext_diag flag is .true. + ext_diag, vtsk1, prw_vcdc1, prw_vcde1, & + tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1_d,& + tprs_ide1_s, tprs_sde1_d, tprs_sde1_s, & + tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & + tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1, & + tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, tprr_rci1, & + tprg_rcg1_g, tprg_rcg1_r, tprw_vcd1_c, & + tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1_r, & + tprr_rcg1_g, tprr_rcs1_r, tprr_rcs1_s, tprv_rev1,& + txri1, txrc1, tten1, qvten1, qrten1, qsten1, & + qgten1, qiten1, niten1, nrten1, ncten1, qcten1) #ifdef MPI use mpi #endif @@ -1697,21 +1825,23 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice REAL, INTENT(IN):: dt REAL, INTENT(IN):: rand1, rand2, rand3 - REAL, DIMENSION(kts:kte), INTENT(OUT):: & - vtsk1, prw_vcdc1, & - prw_vcde1, tpri_inu1, tpri_ide1_d, & - tpri_ide1_s, tprs_ide1_d, tprs_ide1_s, & - tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & - tprg_gde1_s, tpri_iha1, tpri_wfz1, & - tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& - tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, & - tprr_rci1, tprg_rcg1_g, tprg_rcg1_r, & - tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & - tprr_gml1, tprr_rcg1_r, tprr_rcg1_g, & - tprr_rcs1_r, tprr_rcs1_s, tprv_rev1, txri1,& - txrc1, tten1, qvten1, qrten1, qsten1, & - qgten1, qiten1, niten1, nrten1, ncten1, & - qcten1 + ! Extended diagnostics, most arrays only allocated if ext_diag is true + LOGICAL, INTENT(IN) :: ext_diag + REAL, DIMENSION(:), INTENT(OUT):: & + vtsk1, prw_vcdc1, & + prw_vcde1, tpri_inu1, tpri_ide1_d, & + tpri_ide1_s, tprs_ide1_d, tprs_ide1_s, & + tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & + tprg_gde1_s, tpri_iha1, tpri_wfz1, & + tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& + tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, & + tprr_rci1, tprg_rcg1_g, tprg_rcg1_r, & + tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & + tprr_gml1, tprr_rcg1_r, tprr_rcg1_g, & + tprr_rcs1_r, tprr_rcs1_s, tprv_rev1, txri1,& + txrc1, tten1, qvten1, qrten1, qsten1, & + qgten1, qiten1, niten1, nrten1, ncten1, & + qcten1 #if ( WRF_CHEM == 1 ) REAL, DIMENSION(kts:kte), INTENT(INOUT):: & rainprod, evapprod @@ -1912,7 +2042,17 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pnd_rcd(k) = 0. pnd_scd(k) = 0. pnd_gcd(k) = 0. + enddo +#if ( WRF_CHEM == 1 ) + do k = kts, kte + rainprod(k) = 0. + evapprod(k) = 0. + enddo +#endif + !Diagnostics + if (ext_diag) then + do k = kts, kte vtsk1(k) = 0. prw_vcdc1(k) = 0. prw_vcde1(k) = 0. @@ -1958,13 +2098,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nrten1(k) = 0. ncten1(k) = 0. qcten1(k) = 0. - enddo -#if ( WRF_CHEM == 1 ) - do k = kts, kte - rainprod(k) = 0. - evapprod(k) = 0. - enddo -#endif + enddo + endif !..Bug fix (2016Jun15), prevent use of uninitialized value(s) of snow moments. do k = kts, kte diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 1a74b6758..8bdde0479 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -22,6 +22,8 @@ module mp_thompson logical :: is_initialized = .False. + integer, parameter :: ext_ndiag3d = 45 + contains !> This subroutine is a wrapper around the actual thompson_init(). @@ -36,7 +38,8 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & nwfa, nifa, tgrs, prsl, phil, area, & re_cloud, re_ice, re_snow, & mpicomm, mpirank, mpiroot, & - threads, errmsg, errflg) + threads, ext_diag, ext_ndiag3d_in, & + errmsg, errflg) implicit none @@ -79,6 +82,9 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & integer, intent(in ) :: mpiroot ! Threading/blocking information integer, intent(in ) :: threads + ! Extended diagnostics + logical, intent(in ) :: ext_diag + integer, intent(in ) :: ext_ndiag3d_in ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -106,6 +112,12 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & return end if + if (ext_diag and ext_ndiag3d_in /= ext_ndiag3d) then + write(errmsg,'(*(a))') "Logic error: number of diagnostic 3d arrays from model does not match requirements" + errflg = 1 + return + end if + ! Call Thompson init call thompson_init(is_aerosol_aware_in=is_aerosol_aware, mpicomm=mpicomm, & mpirank=mpirank, mpiroot=mpiroot, threads=threads, & @@ -326,7 +338,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & refl_10cm, reset_dBZ, do_radar_ref, & re_cloud, re_ice, re_snow, & mpicomm, mpirank, mpiroot, & - blkno, errmsg, errflg, naux3d, aux3d) + blkno, ext_diag, diag3d, & + errmsg, errflg) implicit none @@ -383,12 +396,13 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & integer, intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot + ! Extended diagnostic output + logical, intent(in) :: ext_diag + real(kind_phys), intent(inout) :: diag3d(:,:,:) + ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg - ! Auxillary output - integer, intent(in) :: naux3d - real(kind_phys), intent(inout) :: aux3d(:,:,:) ! Local variables @@ -428,6 +442,52 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & integer :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + ! Pointer arrays for extended diagnostics + real(kind_phys), dimension(:,:), pointer :: vts1 => null() + real(kind_phys), dimension(:,:), pointer :: prw_vcdc => null() + real(kind_phys), dimension(:,:), pointer :: prw_vcde => null() + real(kind_phys), dimension(:,:), pointer :: tpri_inu => null() + real(kind_phys), dimension(:,:), pointer :: tpri_ide_d => null() + real(kind_phys), dimension(:,:), pointer :: tpri_ide_s => null() + real(kind_phys), dimension(:,:), pointer :: tprs_ide_d => null() + real(kind_phys), dimension(:,:), pointer :: tprs_ide_s => null() + real(kind_phys), dimension(:,:), pointer :: tprs_sde_d => null() + real(kind_phys), dimension(:,:), pointer :: tprs_sde_s => null() + real(kind_phys), dimension(:,:), pointer :: tprg_gde_d => null() + real(kind_phys), dimension(:,:), pointer :: tprg_gde_s => null() + real(kind_phys), dimension(:,:), pointer :: tpri_iha => null() + real(kind_phys), dimension(:,:), pointer :: tpri_wfz => null() + real(kind_phys), dimension(:,:), pointer :: tpri_rfz => null() + real(kind_phys), dimension(:,:), pointer :: tprg_rfz => null() + real(kind_phys), dimension(:,:), pointer :: tprs_scw => null() + real(kind_phys), dimension(:,:), pointer :: tprg_scw => null() + real(kind_phys), dimension(:,:), pointer :: tprg_rcs => null() + real(kind_phys), dimension(:,:), pointer :: tprs_rcs_s => null() + real(kind_phys), dimension(:,:), pointer :: tprs_rcs_r => null() + real(kind_phys), dimension(:,:), pointer :: tprr_rci => null() + real(kind_phys), dimension(:,:), pointer :: tprg_rcg_g => null() + real(kind_phys), dimension(:,:), pointer :: tprg_rcg_r => null() + real(kind_phys), dimension(:,:), pointer :: tprw_vcd_c => null() + real(kind_phys), dimension(:,:), pointer :: tprw_vcd_e => null() + real(kind_phys), dimension(:,:), pointer :: tprr_sml => null() + real(kind_phys), dimension(:,:), pointer :: tprr_gml => null() + real(kind_phys), dimension(:,:), pointer :: tprr_rcg_r => null() + real(kind_phys), dimension(:,:), pointer :: tprr_rcg_g => null() + real(kind_phys), dimension(:,:), pointer :: tprr_rcs_r => null() + real(kind_phys), dimension(:,:), pointer :: tprr_rcs_s => null() + real(kind_phys), dimension(:,:), pointer :: tprv_rev => null() + real(kind_phys), dimension(:,:), pointer :: txri => null() + real(kind_phys), dimension(:,:), pointer :: txrc => null() + real(kind_phys), dimension(:,:), pointer :: tten3 => null() + real(kind_phys), dimension(:,:), pointer :: qvten3 => null() + real(kind_phys), dimension(:,:), pointer :: qrten3 => null() + real(kind_phys), dimension(:,:), pointer :: qsten3 => null() + real(kind_phys), dimension(:,:), pointer :: qgten3 => null() + real(kind_phys), dimension(:,:), pointer :: qiten3 => null() + real(kind_phys), dimension(:,:), pointer :: niten3 => null() + real(kind_phys), dimension(:,:), pointer :: nrten3 => null() + real(kind_phys), dimension(:,:), pointer :: ncten3 => null() + real(kind_phys), dimension(:,:), pointer :: qcten3 => null() ! Initialize the CCPP error handling variables errmsg = '' @@ -563,6 +623,55 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & kme = nlev kte = nlev + ! Set pointers for extended diagnostics + set_extended_diagnostic_pointers: if (ext_diag) then + vts1 => diag3d(:,:,1) + prw_vcdc => diag3d(:,:,2) + prw_vcde => diag3d(:,:,3) + tpri_inu => diag3d(:,:,4) + tpri_ide_d => diag3d(:,:,5) + tpri_ide_s => diag3d(:,:,6) + tprs_ide_d => diag3d(:,:,7) + tprs_ide_s => diag3d(:,:,8) + tprs_sde_d => diag3d(:,:,9) + tprs_sde_s => diag3d(:,:,10) + tprg_gde_d => diag3d(:,:,11) + tprg_gde_s => diag3d(:,:,12) + tpri_iha => diag3d(:,:,13) + tpri_wfz => diag3d(:,:,14) + tpri_rfz => diag3d(:,:,15) + tprg_rfz => diag3d(:,:,16) + tprs_scw => diag3d(:,:,17) + tprg_scw => diag3d(:,:,18) + tprg_rcs => diag3d(:,:,19) + tprs_rcs_s => diag3d(:,:,20) + tprs_rcs_r => diag3d(:,:,21) + tprr_rci => diag3d(:,:,22) + tprg_rcg_g => diag3d(:,:,23) + tprg_rcg_r => diag3d(:,:,24) + tprw_vcd_c => diag3d(:,:,25) + tprw_vcd_e => diag3d(:,:,26) + tprr_sml => diag3d(:,:,27) + tprr_gml => diag3d(:,:,28) + tprr_rcg_r => diag3d(:,:,29) + tprr_rcg_g => diag3d(:,:,30) + tprr_rcs_r => diag3d(:,:,31) + tprr_rcs_s => diag3d(:,:,32) + tprv_rev => diag3d(:,:,33) + txri => diag3d(:,:,34) + txrc => diag3d(:,:,35) + tten3 => diag3d(:,:,36) + qvten3 => diag3d(:,:,37) + qrten3 => diag3d(:,:,38) + qsten3 => diag3d(:,:,39) + qgten3 => diag3d(:,:,40) + qiten3 => diag3d(:,:,41) + niten3 => diag3d(:,:,42) + nrten3 => diag3d(:,:,43) + ncten3 => diag3d(:,:,44) + qcten3 => diag3d(:,:,45) + end if set_extended_diagnostic_pointers + !> - Call mp_gt_driver() with or without aerosols if (is_aerosol_aware) then if (do_effective_radii) then @@ -586,29 +695,25 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & - vts1=aux3d(:,:,1), & - prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & - tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & - tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & - tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & - tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & - tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & - tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & - tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & - tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & - tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & - tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & - tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & - tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & - tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & - tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & - tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & - txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & - qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & - qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & - qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & - nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & - qcten3=aux3d(:,:,45)) + ! Extended diagnostics + ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide_d=tprs_ide_d, & + tprs_ide_s=tprs_ide_s, tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs_s=tprs_rcs_s, tprs_rcs_r=tprs_rcs_r, & + tprr_rci=tprr_rci, tprg_rcg_g=tprg_rcg_g, & + tprg_rcg_r=tprg_rcg_r, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg_r=tprr_rcg_r, tprr_rcg_g=tprr_rcg_g, & + tprr_rcs_r=tprr_rcs_r, tprr_rcs_s=tprr_rcs_s, & + tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3)) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & @@ -629,29 +734,25 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & - vts1=aux3d(:,:,1), & - prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & - tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & - tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & - tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & - tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & - tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & - tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & - tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & - tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & - tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & - tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & - tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & - tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & - tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & - tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & - tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & - txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & - qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & - qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & - qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & - nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & - qcten3=aux3d(:,:,45)) + ! Extended diagnostics + ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide_d=tprs_ide_d, & + tprs_ide_s=tprs_ide_s, tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs_s=tprs_rcs_s, tprs_rcs_r=tprs_rcs_r, & + tprr_rci=tprr_rci, tprg_rcg_g=tprg_rcg_g, & + tprg_rcg_r=tprg_rcg_r, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg_r=tprr_rcg_r, tprr_rcg_g=tprr_rcg_g, & + tprr_rcs_r=tprr_rcs_r, tprr_rcs_s=tprr_rcs_s, & + tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3)) end if else if (do_effective_radii) then @@ -674,29 +775,25 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & - vts1=aux3d(:,:,1), & - prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & - tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & - tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & - tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & - tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & - tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & - tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & - tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & - tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & - tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & - tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & - tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & - tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & - tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & - tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & - tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & - txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & - qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & - qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & - qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & - nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & - qcten3=aux3d(:,:,45)) + ! Extended diagnostics + ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide_d=tprs_ide_d, & + tprs_ide_s=tprs_ide_s, tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs_s=tprs_rcs_s, tprs_rcs_r=tprs_rcs_r, & + tprr_rci=tprr_rci, tprg_rcg_g=tprg_rcg_g, & + tprg_rcg_r=tprg_rcg_r, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg_r=tprr_rcg_r, tprr_rcg_g=tprr_rcg_g, & + tprr_rcs_r=tprr_rcs_r, tprr_rcs_s=tprr_rcs_s, & + tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3)) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & @@ -716,29 +813,25 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & - vts1=aux3d(:,:,1), & - prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & - tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & - tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & - tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & - tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & - tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & - tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & - tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & - tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & - tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & - tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & - tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & - tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & - tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & - tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & - tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & - txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & - qvten3=aux3d(:,:,37), qrten3=aux3d(:,:,38), & - qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & - qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & - nrten3=aux3d(:,:,43), ncten3=aux3d(:,:,44), & - qcten3=aux3d(:,:,45)) + ! Extended diagnostics + ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide_d=tprs_ide_d, & + tprs_ide_s=tprs_ide_s, tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs_s=tprs_rcs_s, tprs_rcs_r=tprs_rcs_r, & + tprr_rci=tprr_rci, tprg_rcg_g=tprg_rcg_g, & + tprg_rcg_r=tprg_rcg_r, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg_r=tprr_rcg_r, tprr_rcg_g=tprr_rcg_g, & + tprr_rcs_r=tprr_rcs_r, tprr_rcs_s=tprr_rcs_s, & + tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3)) end if end if if (errflg/=0) return @@ -781,6 +874,54 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & sr = (snow + graupel + ice)/(rain + snow + graupel + ice +1.e-12) end if + unset_extended_diagnostic_pointers: if (ext_diag) then + vts1 => null() + prw_vcdc => null() + prw_vcde => null() + tpri_inu => null() + tpri_ide_d => null() + tpri_ide_s => null() + tprs_ide_d => null() + tprs_ide_s => null() + tprs_sde_d => null() + tprs_sde_s => null() + tprg_gde_d => null() + tprg_gde_s => null() + tpri_iha => null() + tpri_wfz => null() + tpri_rfz => null() + tprg_rfz => null() + tprs_scw => null() + tprg_scw => null() + tprg_rcs => null() + tprs_rcs_s => null() + tprs_rcs_r => null() + tprr_rci => null() + tprg_rcg_g => null() + tprg_rcg_r => null() + tprw_vcd_c => null() + tprw_vcd_e => null() + tprr_sml => null() + tprr_gml => null() + tprr_rcg_r => null() + tprr_rcg_g => null() + tprr_rcs_r => null() + tprr_rcs_s => null() + tprv_rev => null() + txri => null() + txrc => null() + tten3 => null() + qvten3 => null() + qrten3 => null() + qsten3 => null() + qgten3 => null() + qiten3 => null() + niten3 => null() + nrten3 => null() + ncten3 => null() + qcten3 => null() + end if unset_extended_diagnostic_pointers + end subroutine mp_thompson_run !>@} diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index f06f92d50..9843550e0 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -302,6 +302,22 @@ type = integer intent = in optional = F +[ext_diag] + standard_name = flag_for_extended_diagnostic_output_from_thompson_microphysics + long_name = flag for extended diagnostic output from thompson microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ext_ndiag3d] + standard_name = number_of_3d_arrays_for_extended_diagnostic_output_from_thompson_microphysics + long_name = number of 3d arrays for extended diagnostic output from thompson microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -707,6 +723,24 @@ type = integer intent = in optional = F +[ext_diag] + standard_name = flag_for_extended_diagnostic_output_from_thompson_microphysics + long_name = flag for extended diagnostic output from thompson microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[diag3d] + standard_name = extended_diagnostics_output_from_thompson_microphysics + long_name = set of 3d arrays for extended diagnostics output from thompson microphysics + units = none + dimensions = (horizontal_dimension,vertical_dimension,number_of_3d_diagnostic_output_arrays_from_thompson_microphysics) + type = real + kind = kind_phys + intent = in + optional = F + [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -724,19 +758,6 @@ type = integer intent = out optional = F -[naux3d] - standard_name = number_of_3d_auxiliary_arrays - long_name = number of 3d auxiliary arrays to output (for debugging) - units = count - dimensions = () - type = integer -[aux3d] - standard_name = auxiliary_3d_arrays - long_name = auxiliary 3d arrays to output (for debugging) - units = none - dimensions = (horizontal_dimension,vertical_dimension,number_of_3d_auxiliary_arrays) - type = real - kind = kind_phys ######################################################################## [ccpp-arg-table] From ed4a9de4f428db0caa5c03cd44fd63dc3e22cbcb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 22 Jun 2021 14:02:00 -0600 Subject: [PATCH 23/32] Bugfixes for updated Thompson diagnostics code --- physics/module_mp_thompson.F90 | 166 ++++++++++++++------------- physics/mp_thompson.F90 | 204 +++++++++++++++++---------------- physics/mp_thompson.meta | 18 +-- 3 files changed, 197 insertions(+), 191 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 0996349a4..041771b78 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1195,7 +1195,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & allocate (tpri_rfz1(kts:kte)) allocate (tprg_rfz1(kts:kte)) allocate (tprs_scw1(kts:kte)) - allocate (tprg_scw1,(kts:kte)) + allocate (tprg_scw1(kts:kte)) allocate (tprg_rcs1(kts:kte)) allocate (tprs_rcs1_s(kts:kte)) allocate (tprs_rcs1_r(kts:kte)) @@ -1211,7 +1211,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & allocate (tprr_rcs1_r(kts:kte)) allocate (tprr_rcs1_s(kts:kte)) allocate (tprv_rev1(kts:kte)) - allocate (txri1,(kts:kte)) + allocate (txri1(kts:kte)) allocate (txrc1(kts:kte)) allocate (tten1(kts:kte)) allocate (qvten1(kts:kte)) @@ -1391,7 +1391,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & vtsk1(k) = 0. txrc1(k) = 0. txri1(k) = 0. - endif + endif initialize_extended_diagnostics enddo if (is_aerosol_aware) then do k = kts, kte @@ -1415,7 +1415,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & rainprod1d, evapprod1d, & #endif rand1, rand2, rand3, & - kts, kte, dt, i, j, vtsk1, prw_vcdc1, prw_vcde1, & + kts, kte, dt, i, j, & + ext_diag, vtsk1, prw_vcdc1, prw_vcde1, & tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1_d,& tprs_ide1_s, tprs_sde1_d, tprs_sde1_s, & tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & @@ -1691,7 +1692,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & deallocate (tpri_rfz1) deallocate (tprg_rfz1) deallocate (tprs_scw1) - deallocate (tprg_scw1,) + deallocate (tprg_scw1) deallocate (tprg_rcs1) deallocate (tprs_rcs1_s) deallocate (tprs_rcs1_r) @@ -1707,7 +1708,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & deallocate (tprr_rcs1_r) deallocate (tprr_rcs1_s) deallocate (tprv_rev1) - deallocate (txri1,) + deallocate (txri1) deallocate (txrc1) deallocate (tten1) deallocate (qvten1) @@ -3689,7 +3690,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & vtgk(k) = 0. vtck(k) = 0. vtnck(k) = 0. - vtsk1(k) = 0. enddo if (ANY(L_qr .eqv. .true.)) then @@ -4113,95 +4113,99 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qg1d(k) = qg1d(k) + qgten(k)*DT if (qg1d(k) .le. R1) qg1d(k) = 0.0 enddo + ! Diagnostics - do k = kts, kte - if(prw_vcd(k).gt.0)then - prw_vcdc1(k) = prw_vcd(k)*dt - elseif(prw_vcd(k).lt.0)then - prw_vcde1(k) = -1*prw_vcd(k)*dt - endif -!heating/cooling diagnostics - tpri_inu1(k) = pri_inu(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + calculate_extended_diagnostics: if (ext_diag) then + do k = kts, kte + if(prw_vcd(k).gt.0)then + prw_vcdc1(k) = prw_vcd(k)*dt + elseif(prw_vcd(k).lt.0)then + prw_vcde1(k) = -1*prw_vcd(k)*dt + endif +!heating/cooling diagnostics + tpri_inu1(k) = pri_inu(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - if(pri_ide(k).gt.0)then - tpri_ide1_d(k) = pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - else - tpri_ide1_s(k) = -pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - endif + if(pri_ide(k).gt.0)then + tpri_ide1_d(k) = pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + else + tpri_ide1_s(k) = -pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + endif - if(prs_ide(k).gt.0)then - tprs_ide1_d(k) = prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - else - tprs_ide1_s(k) = -prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - endif + if(prs_ide(k).gt.0)then + tprs_ide1_d(k) = prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + else + tprs_ide1_s(k) = -prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + endif - if(prs_sde(k).gt.0)then - tprs_sde1_d(k) = prs_sde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - else - tprs_sde1_s(k) = -prs_sde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - endif + if(prs_sde(k).gt.0)then + tprs_sde1_d(k) = prs_sde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + else + tprs_sde1_s(k) = -prs_sde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + endif - if(prg_gde(k).gt.0)then - tprg_gde1_d(k) = prg_gde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - else - tprg_gde1_s(k) = -prg_gde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - endif + if(prg_gde(k).gt.0)then + tprg_gde1_d(k) = prg_gde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + else + tprg_gde1_s(k) = -prg_gde(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + endif - tpri_iha1(k) = pri_iha(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - tpri_wfz1(k) = pri_wfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tpri_rfz1(k) = pri_rfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tprg_rfz1(k) = prg_rfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tprs_scw1(k) = prs_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tprg_scw1(k) = prg_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - tprg_rcs1(k) = prg_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tpri_iha1(k) = pri_iha(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + tpri_wfz1(k) = pri_wfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tpri_rfz1(k) = pri_rfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprg_rfz1(k) = prg_rfz(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprs_scw1(k) = prs_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprg_scw1(k) = prg_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprg_rcs1(k) = prg_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - if(prs_rcs(k).gt.0)then - tprs_rcs1_s(k) = prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - else - tprs_rcs1_r(k) = -prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - endif + if(prs_rcs(k).gt.0)then + tprs_rcs1_s(k) = prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + else + tprs_rcs1_r(k) = -prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + endif - tprr_rci1(k) = prr_rci(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + tprr_rci1(k) = prr_rci(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - if(prg_rcg(k).gt.0)then - tprg_rcg1_g(k) = prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - else - tprg_rcg1_r(k) = -prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - endif + if(prg_rcg(k).gt.0)then + tprg_rcg1_g(k) = prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + else + tprg_rcg1_r(k) = -prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + endif - if(prw_vcd(k).gt.0)then - tprw_vcd1_c(k) = lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)*DT - else - tprw_vcd1_e(k) = -lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)*DT - endif + if(prw_vcd(k).gt.0)then + tprw_vcd1_c(k) = lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)*DT + else + tprw_vcd1_e(k) = -lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY)*DT + endif ! cooling terms - tprr_sml1(k) = prr_sml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - tprr_gml1(k) = prr_gml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + tprr_sml1(k) = prr_sml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + tprr_gml1(k) = prr_gml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - if(prr_rcg(k).gt.0)then - tprr_rcg1_r(k) = prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - else - tprr_rcg1_g(k) = -prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - endif + if(prr_rcg(k).gt.0)then + tprr_rcg1_r(k) = prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + else + tprr_rcg1_g(k) = -prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + endif - if(prr_rcs(k).gt.0)then - tprr_rcs1_r(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - else - tprr_rcs1_s(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - endif + if(prr_rcs(k).gt.0)then + tprr_rcs1_r(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + else + tprr_rcs1_s(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + endif + + tprv_rev1(k) = lvap(k)*ocp(k)*prv_rev(k)*(1-IFDRY)*DT + tten1(k) = tten(k)*DT + qvten1(k) = qvten(k)*DT + qrten1(k) = qrten(k)*DT + qsten1(k) = qsten(k)*DT + qgten1(k) = qgten(k)*DT + niten1(k) = niten(k)*DT + nrten1(k) = nrten(k)*DT + ncten1(k) = ncten(k)*DT + qcten1(k) = qcten(k)*DT + enddo + endif calculate_extended_diagnostics - tprv_rev1(k) = lvap(k)*ocp(k)*prv_rev(k)*(1-IFDRY)*DT - tten1(k) = tten(k)*DT - qvten1(k) = qvten(k)*DT - qrten1(k) = qrten(k)*DT - qsten1(k) = qsten(k)*DT - qgten1(k) = qgten(k)*DT - niten1(k) = niten(k)*DT - nrten1(k) = nrten(k)*DT - ncten1(k) = ncten(k)*DT - qcten1(k) = qcten(k)*DT - enddo end subroutine mp_thompson !>@} diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 8bdde0479..0c04f7de5 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -38,7 +38,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & nwfa, nifa, tgrs, prsl, phil, area, & re_cloud, re_ice, re_snow, & mpicomm, mpirank, mpiroot, & - threads, ext_diag, ext_ndiag3d_in, & + threads, ext_diag, diag3d, & errmsg, errflg) implicit none @@ -84,7 +84,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & integer, intent(in ) :: threads ! Extended diagnostics logical, intent(in ) :: ext_diag - integer, intent(in ) :: ext_ndiag3d_in + real(kind_phys), intent(in ) :: diag3d(:,:,:) ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -112,10 +112,12 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & return end if - if (ext_diag and ext_ndiag3d_in /= ext_ndiag3d) then - write(errmsg,'(*(a))') "Logic error: number of diagnostic 3d arrays from model does not match requirements" - errflg = 1 - return + if (ext_diag) then + if (size(diag3d,dim=3) /= ext_ndiag3d) then + write(errmsg,'(*(a))') "Logic error: number of diagnostic 3d arrays from model does not match requirements" + errflg = 1 + return + end if end if ! Call Thompson init @@ -398,7 +400,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & integer, intent(in) :: mpiroot ! Extended diagnostic output logical, intent(in) :: ext_diag - real(kind_phys), intent(inout) :: diag3d(:,:,:) + real(kind_phys), target, intent(inout) :: diag3d(:,:,:) ! CCPP error handling character(len=*), intent( out) :: errmsg @@ -443,51 +445,51 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ! Pointer arrays for extended diagnostics - real(kind_phys), dimension(:,:), pointer :: vts1 => null() - real(kind_phys), dimension(:,:), pointer :: prw_vcdc => null() - real(kind_phys), dimension(:,:), pointer :: prw_vcde => null() - real(kind_phys), dimension(:,:), pointer :: tpri_inu => null() - real(kind_phys), dimension(:,:), pointer :: tpri_ide_d => null() - real(kind_phys), dimension(:,:), pointer :: tpri_ide_s => null() - real(kind_phys), dimension(:,:), pointer :: tprs_ide_d => null() - real(kind_phys), dimension(:,:), pointer :: tprs_ide_s => null() - real(kind_phys), dimension(:,:), pointer :: tprs_sde_d => null() - real(kind_phys), dimension(:,:), pointer :: tprs_sde_s => null() - real(kind_phys), dimension(:,:), pointer :: tprg_gde_d => null() - real(kind_phys), dimension(:,:), pointer :: tprg_gde_s => null() - real(kind_phys), dimension(:,:), pointer :: tpri_iha => null() - real(kind_phys), dimension(:,:), pointer :: tpri_wfz => null() - real(kind_phys), dimension(:,:), pointer :: tpri_rfz => null() - real(kind_phys), dimension(:,:), pointer :: tprg_rfz => null() - real(kind_phys), dimension(:,:), pointer :: tprs_scw => null() - real(kind_phys), dimension(:,:), pointer :: tprg_scw => null() - real(kind_phys), dimension(:,:), pointer :: tprg_rcs => null() - real(kind_phys), dimension(:,:), pointer :: tprs_rcs_s => null() - real(kind_phys), dimension(:,:), pointer :: tprs_rcs_r => null() - real(kind_phys), dimension(:,:), pointer :: tprr_rci => null() - real(kind_phys), dimension(:,:), pointer :: tprg_rcg_g => null() - real(kind_phys), dimension(:,:), pointer :: tprg_rcg_r => null() - real(kind_phys), dimension(:,:), pointer :: tprw_vcd_c => null() - real(kind_phys), dimension(:,:), pointer :: tprw_vcd_e => null() - real(kind_phys), dimension(:,:), pointer :: tprr_sml => null() - real(kind_phys), dimension(:,:), pointer :: tprr_gml => null() - real(kind_phys), dimension(:,:), pointer :: tprr_rcg_r => null() - real(kind_phys), dimension(:,:), pointer :: tprr_rcg_g => null() - real(kind_phys), dimension(:,:), pointer :: tprr_rcs_r => null() - real(kind_phys), dimension(:,:), pointer :: tprr_rcs_s => null() - real(kind_phys), dimension(:,:), pointer :: tprv_rev => null() - real(kind_phys), dimension(:,:), pointer :: txri => null() - real(kind_phys), dimension(:,:), pointer :: txrc => null() - real(kind_phys), dimension(:,:), pointer :: tten3 => null() - real(kind_phys), dimension(:,:), pointer :: qvten3 => null() - real(kind_phys), dimension(:,:), pointer :: qrten3 => null() - real(kind_phys), dimension(:,:), pointer :: qsten3 => null() - real(kind_phys), dimension(:,:), pointer :: qgten3 => null() - real(kind_phys), dimension(:,:), pointer :: qiten3 => null() - real(kind_phys), dimension(:,:), pointer :: niten3 => null() - real(kind_phys), dimension(:,:), pointer :: nrten3 => null() - real(kind_phys), dimension(:,:), pointer :: ncten3 => null() - real(kind_phys), dimension(:,:), pointer :: qcten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: vts1 => null() + real(kind_phys), dimension(:,:,:), pointer :: prw_vcdc => null() + real(kind_phys), dimension(:,:,:), pointer :: prw_vcde => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_inu => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_ide_d => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_ide_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_ide_d => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_ide_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_sde_d => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_sde_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_gde_d => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_gde_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_iha => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_wfz => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_rfz => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_rfz => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_scw => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_scw => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_rcs => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_rcs_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_rcs_r => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_rci => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_rcg_g => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_rcg_r => null() + real(kind_phys), dimension(:,:,:), pointer :: tprw_vcd_c => null() + real(kind_phys), dimension(:,:,:), pointer :: tprw_vcd_e => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_sml => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_gml => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_rcg_r => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_rcg_g => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_rcs_r => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_rcs_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tprv_rev => null() + real(kind_phys), dimension(:,:,:), pointer :: txri => null() + real(kind_phys), dimension(:,:,:), pointer :: txrc => null() + real(kind_phys), dimension(:,:,:), pointer :: tten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qvten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qrten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qsten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qgten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qiten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: niten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: nrten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: ncten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qcten3 => null() ! Initialize the CCPP error handling variables errmsg = '' @@ -625,51 +627,51 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! Set pointers for extended diagnostics set_extended_diagnostic_pointers: if (ext_diag) then - vts1 => diag3d(:,:,1) - prw_vcdc => diag3d(:,:,2) - prw_vcde => diag3d(:,:,3) - tpri_inu => diag3d(:,:,4) - tpri_ide_d => diag3d(:,:,5) - tpri_ide_s => diag3d(:,:,6) - tprs_ide_d => diag3d(:,:,7) - tprs_ide_s => diag3d(:,:,8) - tprs_sde_d => diag3d(:,:,9) - tprs_sde_s => diag3d(:,:,10) - tprg_gde_d => diag3d(:,:,11) - tprg_gde_s => diag3d(:,:,12) - tpri_iha => diag3d(:,:,13) - tpri_wfz => diag3d(:,:,14) - tpri_rfz => diag3d(:,:,15) - tprg_rfz => diag3d(:,:,16) - tprs_scw => diag3d(:,:,17) - tprg_scw => diag3d(:,:,18) - tprg_rcs => diag3d(:,:,19) - tprs_rcs_s => diag3d(:,:,20) - tprs_rcs_r => diag3d(:,:,21) - tprr_rci => diag3d(:,:,22) - tprg_rcg_g => diag3d(:,:,23) - tprg_rcg_r => diag3d(:,:,24) - tprw_vcd_c => diag3d(:,:,25) - tprw_vcd_e => diag3d(:,:,26) - tprr_sml => diag3d(:,:,27) - tprr_gml => diag3d(:,:,28) - tprr_rcg_r => diag3d(:,:,29) - tprr_rcg_g => diag3d(:,:,30) - tprr_rcs_r => diag3d(:,:,31) - tprr_rcs_s => diag3d(:,:,32) - tprv_rev => diag3d(:,:,33) - txri => diag3d(:,:,34) - txrc => diag3d(:,:,35) - tten3 => diag3d(:,:,36) - qvten3 => diag3d(:,:,37) - qrten3 => diag3d(:,:,38) - qsten3 => diag3d(:,:,39) - qgten3 => diag3d(:,:,40) - qiten3 => diag3d(:,:,41) - niten3 => diag3d(:,:,42) - nrten3 => diag3d(:,:,43) - ncten3 => diag3d(:,:,44) - qcten3 => diag3d(:,:,45) + vts1 => diag3d(:,:,1:1) + prw_vcdc => diag3d(:,:,2:2) + prw_vcde => diag3d(:,:,3:3) + tpri_inu => diag3d(:,:,4:4) + tpri_ide_d => diag3d(:,:,5:5) + tpri_ide_s => diag3d(:,:,6:6) + tprs_ide_d => diag3d(:,:,7:7) + tprs_ide_s => diag3d(:,:,8:8) + tprs_sde_d => diag3d(:,:,9:9) + tprs_sde_s => diag3d(:,:,10:10) + tprg_gde_d => diag3d(:,:,11:11) + tprg_gde_s => diag3d(:,:,12:12) + tpri_iha => diag3d(:,:,13:13) + tpri_wfz => diag3d(:,:,14:14) + tpri_rfz => diag3d(:,:,15:15) + tprg_rfz => diag3d(:,:,16:16) + tprs_scw => diag3d(:,:,17:17) + tprg_scw => diag3d(:,:,18:18) + tprg_rcs => diag3d(:,:,19:19) + tprs_rcs_s => diag3d(:,:,20:20) + tprs_rcs_r => diag3d(:,:,21:21) + tprr_rci => diag3d(:,:,22:22) + tprg_rcg_g => diag3d(:,:,23:23) + tprg_rcg_r => diag3d(:,:,24:24) + tprw_vcd_c => diag3d(:,:,25:25) + tprw_vcd_e => diag3d(:,:,26:26) + tprr_sml => diag3d(:,:,27:27) + tprr_gml => diag3d(:,:,28:28) + tprr_rcg_r => diag3d(:,:,29:29) + tprr_rcg_g => diag3d(:,:,30:30) + tprr_rcs_r => diag3d(:,:,31:31) + tprr_rcs_s => diag3d(:,:,32:32) + tprv_rev => diag3d(:,:,33:33) + txri => diag3d(:,:,34:34) + txrc => diag3d(:,:,35:35) + tten3 => diag3d(:,:,36:36) + qvten3 => diag3d(:,:,37:37) + qrten3 => diag3d(:,:,38:38) + qsten3 => diag3d(:,:,39:39) + qgten3 => diag3d(:,:,40:40) + qiten3 => diag3d(:,:,41:41) + niten3 => diag3d(:,:,42:42) + nrten3 => diag3d(:,:,43:43) + ncten3 => diag3d(:,:,44:44) + qcten3 => diag3d(:,:,45:45) end if set_extended_diagnostic_pointers !> - Call mp_gt_driver() with or without aerosols @@ -713,7 +715,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - qcten3=qcten3)) + qcten3=qcten3) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & @@ -752,7 +754,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - qcten3=qcten3)) + qcten3=qcten3) end if else if (do_effective_radii) then @@ -793,7 +795,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - qcten3=qcten3)) + qcten3=qcten3) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & @@ -831,7 +833,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - qcten3=qcten3)) + qcten3=qcten3) end if end if if (errflg/=0) return diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 9843550e0..85c9f9413 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -310,12 +310,13 @@ type = logical intent = in optional = F -[ext_ndiag3d] - standard_name = number_of_3d_arrays_for_extended_diagnostic_output_from_thompson_microphysics - long_name = number of 3d arrays for extended diagnostic output from thompson microphysics - units = count - dimensions = () - type = integer +[diag3d] + standard_name = extended_diagnostics_output_from_thompson_microphysics + long_name = set of 3d arrays for extended diagnostics output from thompson microphysics + units = none + dimensions = (horizontal_dimension,vertical_dimension,number_of_3d_diagnostic_output_arrays_from_thompson_microphysics) + type = real + kind = kind_phys intent = in optional = F [errmsg] @@ -735,12 +736,11 @@ standard_name = extended_diagnostics_output_from_thompson_microphysics long_name = set of 3d arrays for extended diagnostics output from thompson microphysics units = none - dimensions = (horizontal_dimension,vertical_dimension,number_of_3d_diagnostic_output_arrays_from_thompson_microphysics) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_3d_diagnostic_output_arrays_from_thompson_microphysics) type = real kind = kind_phys - intent = in + intent = inout optional = F - [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 4e39a44fa7913c04aaad705714a8e34f11c3bded Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 22 Jun 2021 15:42:21 -0600 Subject: [PATCH 24/32] Remove blank line at the top of physics/module_mp_thompson.F90 --- physics/module_mp_thompson.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 041771b78..cc0da1f81 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1,4 +1,3 @@ - !>\file module_mp_thompson.F90 !! This file contains the entity of GSD Thompson MP scheme. From 2a61a8ded1567a7ef4024e4b888bc56c05f27795 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Wed, 23 Jun 2021 14:22:38 +0000 Subject: [PATCH 25/32] Fix bugs in diagnostics and dimension for aux3d array in meta file --- physics/module_mp_thompson.F90 | 143 +++++++++++++---------------- physics/mp_thompson.F90 | 160 ++++++++++++++++----------------- physics/mp_thompson.meta | 2 +- 3 files changed, 142 insertions(+), 163 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index cd4d84d8d..78ccafa17 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -990,15 +990,15 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & reset_dBZ, istep, nsteps, & errmsg, errflg, vts1, prw_vcdc, & prw_vcde, tpri_inu, tpri_ide_d, & - tpri_ide_s, tprs_ide_d, tprs_ide_s, & - tprs_sde_d, tprs_sde_s, tprg_gde_d, & + tpri_ide_s, tprs_ide,tprs_sde_d, & + tprs_sde_s, tprg_gde_d, & tprg_gde_s, tpri_iha, tpri_wfz, & tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & - tprg_rcs, tprs_rcs_s, tprs_rcs_r, & - tprr_rci, tprg_rcg_g, tprg_rcg_r, & + tprg_rcs, tprs_rcs, & + tprr_rci, tprg_rcg, & tprw_vcd_c, tprw_vcd_e, tprr_sml, & - tprr_gml, tprr_rcg_r, tprr_rcg_g, & - tprr_rcs_r, tprr_rcs_s, tprv_rev, txri, & + tprr_gml, tprr_rcg, & + tprr_rcs, tprv_rev, txri, & txrc, tten3, qvten3, qrten3, qsten3, & qgten3, qiten3, niten3, nrten3, ncten3, & qcten3) @@ -1014,15 +1014,15 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & vts1, prw_vcdc, & prw_vcde, tpri_inu, tpri_ide_d, & - tpri_ide_s, tprs_ide_d, tprs_ide_s, & + tpri_ide_s, tprs_ide, & tprs_sde_d, tprs_sde_s, tprg_gde_d, & tprg_gde_s, tpri_iha, tpri_wfz, & tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & - tprg_rcs, tprs_rcs_s, tprs_rcs_r, & - tprr_rci, tprg_rcg_g, tprg_rcg_r, & + tprg_rcs, tprs_rcs, & + tprr_rci, tprg_rcg, & tprw_vcd_c, tprw_vcd_e, tprr_sml, & - tprr_gml, tprr_rcg_r, tprr_rcg_g, & - tprr_rcs_r, tprr_rcs_s, tprv_rev, txri, & + tprr_gml, tprr_rcg, & + tprr_rcs, tprv_rev, txri, & txrc, tten3, qvten3, qrten3, qsten3, & qgten3, qiten3, niten3, nrten3, ncten3, & qcten3 @@ -1070,15 +1070,15 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL, DIMENSION(kts:kte):: & vtsk1, prw_vcdc1, & prw_vcde1, tpri_inu1, tpri_ide1_d, & - tpri_ide1_s, tprs_ide1_d, tprs_ide1_s, & + tpri_ide1_s, tprs_ide1, & tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & tprg_gde1_s, tpri_iha1, tpri_wfz1, & tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& - tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, & - tprr_rci1, tprg_rcg1_g, tprg_rcg1_r, & + tprg_rcs1, tprs_rcs1, & + tprr_rci1, tprg_rcg1, & tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & - tprr_gml1, tprr_rcg1_r, tprr_rcg1_g, & - tprr_rcs1_r, tprr_rcs1_s, tprv_rev1, txri1,& + tprr_gml1, tprr_rcg1, & + tprr_rcs1, tprv_rev1, txri1,& txrc1, tten1, qvten1, qrten1, qsten1, & qgten1, qiten1, niten1, nrten1, ncten1, & qcten1 @@ -1286,8 +1286,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tpri_inu1(k) = 0. tpri_ide1_d(k) = 0. tpri_ide1_s(k) = 0. - tprs_ide1_d(k) = 0. - tprs_ide1_s(k) = 0. + tprs_ide1(k) = 0. tprs_sde1_d(k) = 0. tprs_sde1_s(k) = 0. tprg_gde1_d(k) = 0. @@ -1299,19 +1298,15 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprg_scw1(k) = 0. tprs_scw1(k) = 0. tprg_rcs1(k) = 0. - tprs_rcs1_s(k) = 0. - tprs_rcs1_r(k) = 0. + tprs_rcs1(k) = 0. tprr_rci1(k) = 0. - tprg_rcg1_g(k) = 0. - tprg_rcg1_r(k) = 0. + tprg_rcg1(k) = 0. tprw_vcd1_c(k) = 0. tprw_vcd1_e(k) = 0. tprr_sml1(k) = 0. tprr_gml1(k) = 0. - tprr_rcg1_r(k) = 0. - tprr_rcg1_g(k) = 0. - tprr_rcs1_r(k) = 0. - tprr_rcs1_s(k) = 0. + tprr_rcg1(k) = 0. + tprr_rcs1(k) = 0. tprv_rev1(k) = 0. txrc1(k) = 0. txri1(k) = 0. @@ -1349,14 +1344,14 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & #endif rand1, rand2, rand3, & kts, kte, dt, i, j, vtsk1, prw_vcdc1, prw_vcde1, & - tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1_d,& - tprs_ide1_s, tprs_sde1_d, tprs_sde1_s, & + tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1,& + tprs_sde1_d, tprs_sde1_s, & tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1, & - tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, tprr_rci1, & - tprg_rcg1_g, tprg_rcg1_r, tprw_vcd1_c, & - tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1_r, & - tprr_rcg1_g, tprr_rcs1_r, tprr_rcs1_s, tprv_rev1,& + tprg_rcs1, tprs_rcs1, tprr_rci1, & + tprg_rcg1, tprw_vcd1_c, & + tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1, & + tprr_rcs1, tprv_rev1,& txri1, txrc1, tten1, qvten1, qrten1, qsten1, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1) @@ -1416,10 +1411,12 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) tpri_inu(i,k,j) = tpri_inu(i,k,j) + tpri_inu1(k) + tpri_ide_d(i,k,j) = tpri_ide_d(i,k,j) + tpri_ide1_d(k) tpri_ide_s(i,k,j) = tpri_ide_s(i,k,j) + tpri_ide1_s(k) - tprs_ide_d(i,k,j) = tprs_ide_d(i,k,j) + tprs_ide1_d(k) + tprs_ide(i,k,j) = tprs_ide(i,k,j) + tprs_ide1(k) tprs_sde_s(i,k,j) = tprs_sde_s(i,k,j) + tprs_sde1_s(k) tprs_sde_d(i,k,j) = tprs_sde_d(i,k,j) + tprs_sde1_d(k) + tprg_gde_d(i,k,j) = tprg_gde_d(i,k,j) + tprg_gde1_d(k) tprg_gde_s(i,k,j) = tprg_gde_s(i,k,j) + tprg_gde1_s(k) tpri_iha(i,k,j) = tpri_iha(i,k,j) + tpri_iha1(k) tpri_wfz(i,k,j) = tpri_wfz(i,k,j) + tpri_wfz1(k) @@ -1428,19 +1425,15 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) tprg_scw(i,k,j) = tprg_scw(i,k,j) + tprg_scw1(k) tprg_rcs(i,k,j) = tprg_rcs(i,k,j) + tprg_rcs1(k) - tprs_rcs_s(i,k,j) = tprs_rcs_s(i,k,j) + tprs_rcs1_s(k) - tprs_rcs_r(i,k,j) = tprs_rcs_r(i,k,j) + tprs_rcs1_r(k) + tprs_rcs(i,k,j) = tprs_rcs(i,k,j) + tprs_rcs1(k) tprr_rci(i,k,j) = tprr_rci(i,k,j) + tprr_rci1(k) - tprg_rcg_g(i,k,j) = tprg_rcg_g(i,k,j) + tprg_rcg1_g(k) - tprg_rcg_r(i,k,j) = tprg_rcg_r(i,k,j) + tprg_rcg1_r(k) + tprg_rcg(i,k,j) = tprg_rcg(i,k,j) + tprg_rcg1(k) tprw_vcd_c(i,k,j) = tprw_vcd_c(i,k,j) + tprw_vcd1_c(k) tprw_vcd_e(i,k,j) = tprw_vcd_e(i,k,j) + tprw_vcd1_e(k) tprr_sml(i,k,j) = tprr_sml(i,k,j) + tprr_sml1(k) tprr_gml(i,k,j) = tprr_gml(i,k,j) + tprr_gml1(k) - tprr_rcg_r(i,k,j) = tprr_rcg_r(i,k,j) + tprr_rcg1_r(k) - tprr_rcg_g(i,k,j) = tprr_rcg_g(i,k,j) + tprr_rcg1_g(k) - tprr_rcs_r(i,k,j) = tprr_rcs_r(i,k,j) + tprr_rcs1_r(k) - tprr_rcs_s(i,k,j) = tprr_rcs_s(i,k,j) + tprr_rcs1_s(k) + tprr_rcg(i,k,j) = tprr_rcg(i,k,j) + tprr_rcg1(k) + tprr_rcs(i,k,j) = tprr_rcs(i,k,j) + tprr_rcs1(k) tprv_rev(i,k,j) = tprv_rev(i,k,j) + tprv_rev1(k) txri(i,k,j) = txri(i,k,j) + txri1(k) txrc(i,k,j) = txrc(i,k,j) + txrc1(k) @@ -1673,14 +1666,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & #endif rand1, rand2, rand3, & kts, kte, dt, ii, jj,vtsk1, prw_vcdc1, prw_vcde1, & - tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1_d,& - tprs_ide1_s, tprs_sde1_d, tprs_sde1_s, & + tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1, & + tprs_sde1_d, tprs_sde1_s, & tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1, & - tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, tprr_rci1, & - tprg_rcg1_g, tprg_rcg1_r, tprw_vcd1_c, & - tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1_r, & - tprr_rcg1_g, tprr_rcs1_r, tprr_rcs1_s, tprv_rev1,& + tprg_rcs1, tprs_rcs1, tprr_rci1, & + tprg_rcg1, tprw_vcd1_c, & + tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1, & + tprr_rcs1, tprv_rev1,& txri1, txrc1, tten1, qvten1, qrten1, qsten1, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1) #ifdef MPI @@ -1700,15 +1693,15 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, DIMENSION(kts:kte), INTENT(OUT):: & vtsk1, prw_vcdc1, & prw_vcde1, tpri_inu1, tpri_ide1_d, & - tpri_ide1_s, tprs_ide1_d, tprs_ide1_s, & + tpri_ide1_s, tprs_ide1, & tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & tprg_gde1_s, tpri_iha1, tpri_wfz1, & tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& - tprg_rcs1, tprs_rcs1_s, tprs_rcs1_r, & - tprr_rci1, tprg_rcg1_g, tprg_rcg1_r, & + tprg_rcs1, tprs_rcs1, & + tprr_rci1, tprg_rcg1, & tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & - tprr_gml1, tprr_rcg1_r, tprr_rcg1_g, & - tprr_rcs1_r, tprr_rcs1_s, tprv_rev1, txri1,& + tprr_gml1, tprr_rcg1, & + tprr_rcs1, tprv_rev1, txri1,& txrc1, tten1, qvten1, qrten1, qsten1, & qgten1, qiten1, niten1, nrten1, ncten1, & qcten1 @@ -1919,8 +1912,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tpri_inu1(k) = 0. tpri_ide1_d(k) = 0. tpri_ide1_s(k) = 0. - tprs_ide1_d(k) = 0. - tprs_ide1_s(k) = 0. + tprs_ide1(k) = 0. tprs_sde1_d(k) = 0. tprs_sde1_s(k) = 0. tprg_gde1_d(k) = 0. @@ -1932,19 +1924,15 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tprg_scw1(k) = 0. tprs_scw1(k) = 0. tprg_rcs1(k) = 0. - tprs_rcs1_s(k) = 0. - tprs_rcs1_r(k) = 0. + tprs_rcs1(k) = 0. tprr_rci1(k) = 0. - tprg_rcg1_g(k) = 0. - tprg_rcg1_r(k) = 0. + tprg_rcg1(k) = 0. tprw_vcd1_c(k) = 0. tprw_vcd1_e(k) = 0. tprr_sml1(k) = 0. tprr_gml1(k) = 0. - tprr_rcg1_r(k) = 0. - tprr_rcg1_g(k) = 0. - tprr_rcs1_r(k) = 0. - tprr_rcs1_s(k) = 0. + tprr_rcg1(k) = 0. + tprr_rcs1(k) = 0. tprv_rev1(k) = 0. txrc1(k) = 0. txri1(k) = 0. @@ -3994,10 +3982,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tpri_ide1_s(k) = -pri_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT endif - if(prs_ide(k).gt.0)then - tprs_ide1_d(k) = prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT - else - tprs_ide1_s(k) = -prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT + if(temp(k).lt.T_0)then + tprs_ide1(k) = prs_ide(k)*lsub*ocp(k)*orho * (1-IFDRY)*DT endif if(prs_sde(k).gt.0)then @@ -4020,18 +4006,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tprg_scw1(k) = prg_scw(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT tprg_rcs1(k) = prg_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - if(prs_rcs(k).gt.0)then - tprs_rcs1_s(k) = prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - else - tprs_rcs1_r(k) = -prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + if(temp(k).lt.T_0)then + tprs_rcs1(k) = prs_rcs(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT endif tprr_rci1(k) = prr_rci(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - if(prg_rcg(k).gt.0)then - tprg_rcg1_g(k) = prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT - else - tprg_rcg1_r(k) = -prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT + if(temp(k).lt.T_0)then + tprg_rcg1(k) = prg_rcg(k)*lfus2*ocp(k)*orho * (1-IFDRY)*DT endif if(prw_vcd(k).gt.0)then @@ -4044,21 +4026,18 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tprr_sml1(k) = prr_sml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT tprr_gml1(k) = prr_gml(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - if(prr_rcg(k).gt.0)then - tprr_rcg1_r(k) = prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - else - tprr_rcg1_g(k) = -prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + if(temp(k).ge.T_0)then + tprr_rcg1(k) = -prr_rcg(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT endif - if(prr_rcs(k).gt.0)then - tprr_rcs1_r(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT - else - tprr_rcs1_s(k) = prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT + if(temp(k).ge.T_0)then + tprr_rcs1(k) = -prr_rcs(k)*lfus*ocp(k)*orho * (1-IFDRY)*DT endif tprv_rev1(k) = lvap(k)*ocp(k)*prv_rev(k)*(1-IFDRY)*DT tten1(k) = tten(k)*DT qvten1(k) = qvten(k)*DT + qiten1(k) = qiten(k)*DT qrten1(k) = qrten(k)*DT qsten1(k) = qsten(k)*DT qgten1(k) = qgten(k)*DT diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 1a74b6758..93e4d866c 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -589,26 +589,26 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & vts1=aux3d(:,:,1), & prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & - tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & - tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & - tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & - tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & - tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & - tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & - tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & - tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & - tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & - tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & - tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & - tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & - tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & - tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & - txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & - qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & - qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & - qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & - nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & - qcten3=aux3d(:,:,45)) + tpri_ide_s=aux3d(:,:,6), tprs_ide=aux3d(:,:,7), & + tprs_sde_d=aux3d(:,:,8), & + tprs_sde_s=aux3d(:,:,9), tprg_gde_d=aux3d(:,:,10), & + tprg_gde_s=aux3d(:,:,11), tpri_iha=aux3d(:,:,12), & + tpri_wfz=aux3d(:,:,13), tpri_rfz=aux3d(:,:,14), & + tprg_rfz=aux3d(:,:,15), tprs_scw=aux3d(:,:,16), & + tprg_scw=aux3d(:,:,17), tprg_rcs=aux3d(:,:,18), & + tprs_rcs=aux3d(:,:,19), & + tprr_rci=aux3d(:,:,20), tprg_rcg=aux3d(:,:,21), & + tprw_vcd_c=aux3d(:,:,22), & + tprw_vcd_e=aux3d(:,:,23), tprr_sml=aux3d(:,:,24), & + tprr_gml=aux3d(:,:,25), tprr_rcg=aux3d(:,:,26), & + tprr_rcs=aux3d(:,:,27), & + tprv_rev=aux3d(:,:,28), & + txri=aux3d(:,:,29), txrc=aux3d(:,:,30), tten3=aux3d(:,:,31), & + qvten3=aux3d(:,:,32) ,qrten3=aux3d(:,:,33), & + qsten3=aux3d(:,:,34), qgten3=aux3d(:,:,35), & + qiten3=aux3d(:,:,36), niten3=aux3d(:,:,37), & + nrten3=aux3d(:,:,38) ,ncten3=aux3d(:,:,39), & + qcten3=aux3d(:,:,40)) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & @@ -632,26 +632,26 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & vts1=aux3d(:,:,1), & prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & - tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & - tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & - tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & - tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & - tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & - tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & - tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & - tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & - tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & - tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & - tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & - tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & - tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & - tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & - txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & - qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & - qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & - qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & - nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & - qcten3=aux3d(:,:,45)) + tpri_ide_s=aux3d(:,:,6), tprs_ide=aux3d(:,:,7), & + tprs_sde_d=aux3d(:,:,8), & + tprs_sde_s=aux3d(:,:,9), tprg_gde_d=aux3d(:,:,10), & + tprg_gde_s=aux3d(:,:,11), tpri_iha=aux3d(:,:,12), & + tpri_wfz=aux3d(:,:,13), tpri_rfz=aux3d(:,:,14), & + tprg_rfz=aux3d(:,:,15), tprs_scw=aux3d(:,:,16), & + tprg_scw=aux3d(:,:,17), tprg_rcs=aux3d(:,:,18), & + tprs_rcs=aux3d(:,:,19), & + tprr_rci=aux3d(:,:,20), tprg_rcg=aux3d(:,:,21), & + tprw_vcd_c=aux3d(:,:,22), & + tprw_vcd_e=aux3d(:,:,23), tprr_sml=aux3d(:,:,24), & + tprr_gml=aux3d(:,:,25), tprr_rcg=aux3d(:,:,26), & + tprr_rcs=aux3d(:,:,27), & + tprv_rev=aux3d(:,:,28), & + txri=aux3d(:,:,29), txrc=aux3d(:,:,30), tten3=aux3d(:,:,31), & + qvten3=aux3d(:,:,32) ,qrten3=aux3d(:,:,33), & + qsten3=aux3d(:,:,34), qgten3=aux3d(:,:,35), & + qiten3=aux3d(:,:,36), niten3=aux3d(:,:,37), & + nrten3=aux3d(:,:,38) ,ncten3=aux3d(:,:,39), & + qcten3=aux3d(:,:,40)) end if else if (do_effective_radii) then @@ -677,26 +677,26 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & vts1=aux3d(:,:,1), & prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & - tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & - tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & - tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & - tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & - tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & - tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & - tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & - tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & - tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & - tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & - tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & - tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & - tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & - tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & - txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & - qvten3=aux3d(:,:,37) ,qrten3=aux3d(:,:,38), & - qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & - qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & - nrten3=aux3d(:,:,43) ,ncten3=aux3d(:,:,44), & - qcten3=aux3d(:,:,45)) + tpri_ide_s=aux3d(:,:,6), tprs_ide=aux3d(:,:,7), & + tprs_sde_d=aux3d(:,:,8), & + tprs_sde_s=aux3d(:,:,9), tprg_gde_d=aux3d(:,:,10), & + tprg_gde_s=aux3d(:,:,11), tpri_iha=aux3d(:,:,12), & + tpri_wfz=aux3d(:,:,13), tpri_rfz=aux3d(:,:,14), & + tprg_rfz=aux3d(:,:,15), tprs_scw=aux3d(:,:,16), & + tprg_scw=aux3d(:,:,17), tprg_rcs=aux3d(:,:,18), & + tprs_rcs=aux3d(:,:,19), & + tprr_rci=aux3d(:,:,20), tprg_rcg=aux3d(:,:,21), & + tprw_vcd_c=aux3d(:,:,22), & + tprw_vcd_e=aux3d(:,:,23), tprr_sml=aux3d(:,:,24), & + tprr_gml=aux3d(:,:,25), tprr_rcg=aux3d(:,:,26), & + tprr_rcs=aux3d(:,:,27), & + tprv_rev=aux3d(:,:,28), & + txri=aux3d(:,:,29), txrc=aux3d(:,:,30), tten3=aux3d(:,:,31), & + qvten3=aux3d(:,:,32) ,qrten3=aux3d(:,:,33), & + qsten3=aux3d(:,:,34), qgten3=aux3d(:,:,35), & + qiten3=aux3d(:,:,36), niten3=aux3d(:,:,37), & + nrten3=aux3d(:,:,38) ,ncten3=aux3d(:,:,39), & + qcten3=aux3d(:,:,40)) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & @@ -719,26 +719,26 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & vts1=aux3d(:,:,1), & prw_vcdc=aux3d(:,:,2), prw_vcde=aux3d(:,:,3), & tpri_inu=aux3d(:,:,4), tpri_ide_d=aux3d(:,:,5), & - tpri_ide_s=aux3d(:,:,6), tprs_ide_d=aux3d(:,:,7), & - tprs_ide_s=aux3d(:,:,8), tprs_sde_d=aux3d(:,:,9), & - tprs_sde_s=aux3d(:,:,10), tprg_gde_d=aux3d(:,:,11), & - tprg_gde_s=aux3d(:,:,12), tpri_iha=aux3d(:,:,13), & - tpri_wfz=aux3d(:,:,14), tpri_rfz=aux3d(:,:,15), & - tprg_rfz=aux3d(:,:,16), tprs_scw=aux3d(:,:,17), & - tprg_scw=aux3d(:,:,18), tprg_rcs=aux3d(:,:,19), & - tprs_rcs_s=aux3d(:,:,20), tprs_rcs_r=aux3d(:,:,21), & - tprr_rci=aux3d(:,:,22), tprg_rcg_g=aux3d(:,:,23), & - tprg_rcg_r=aux3d(:,:,24), tprw_vcd_c=aux3d(:,:,25), & - tprw_vcd_e=aux3d(:,:,26), tprr_sml=aux3d(:,:,27), & - tprr_gml=aux3d(:,:,28), tprr_rcg_r=aux3d(:,:,29), & - tprr_rcg_g=aux3d(:,:,30), tprr_rcs_r=aux3d(:,:,31), & - tprr_rcs_s=aux3d(:,:,32), tprv_rev=aux3d(:,:,33), & - txri=aux3d(:,:,34), txrc=aux3d(:,:,35), tten3=aux3d(:,:,36), & - qvten3=aux3d(:,:,37), qrten3=aux3d(:,:,38), & - qsten3=aux3d(:,:,39), qgten3=aux3d(:,:,40), & - qiten3=aux3d(:,:,41), niten3=aux3d(:,:,42), & - nrten3=aux3d(:,:,43), ncten3=aux3d(:,:,44), & - qcten3=aux3d(:,:,45)) + tpri_ide_s=aux3d(:,:,6), tprs_ide=aux3d(:,:,7), & + tprs_sde_d=aux3d(:,:,8), & + tprs_sde_s=aux3d(:,:,9), tprg_gde_d=aux3d(:,:,10), & + tprg_gde_s=aux3d(:,:,11), tpri_iha=aux3d(:,:,12), & + tpri_wfz=aux3d(:,:,13), tpri_rfz=aux3d(:,:,14), & + tprg_rfz=aux3d(:,:,15), tprs_scw=aux3d(:,:,16), & + tprg_scw=aux3d(:,:,17), tprg_rcs=aux3d(:,:,18), & + tprs_rcs=aux3d(:,:,19), & + tprr_rci=aux3d(:,:,20), tprg_rcg=aux3d(:,:,21), & + tprw_vcd_c=aux3d(:,:,22), & + tprw_vcd_e=aux3d(:,:,23), tprr_sml=aux3d(:,:,24), & + tprr_gml=aux3d(:,:,25), tprr_rcg=aux3d(:,:,26), & + tprr_rcs=aux3d(:,:,27), & + tprv_rev=aux3d(:,:,28), & + txri=aux3d(:,:,29), txrc=aux3d(:,:,30), tten3=aux3d(:,:,31), & + qvten3=aux3d(:,:,32) ,qrten3=aux3d(:,:,33), & + qsten3=aux3d(:,:,34), qgten3=aux3d(:,:,35), & + qiten3=aux3d(:,:,36), niten3=aux3d(:,:,37), & + nrten3=aux3d(:,:,38) ,ncten3=aux3d(:,:,39), & + qcten3=aux3d(:,:,40)) end if end if if (errflg/=0) return diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index f06f92d50..efa819ca2 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -734,7 +734,7 @@ standard_name = auxiliary_3d_arrays long_name = auxiliary 3d arrays to output (for debugging) units = none - dimensions = (horizontal_dimension,vertical_dimension,number_of_3d_auxiliary_arrays) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_3d_auxiliary_arrays) type = real kind = kind_phys From 1a0bf7bf8e6ed2667c318cbd9005b1aba895f66b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 23 Jun 2021 14:23:31 -0600 Subject: [PATCH 26/32] Fix bug in physics/m_micro.F90: arrays on interfaces should start at 0 --- physics/m_micro.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 7624d7e3e..53ba82392 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -180,7 +180,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & real (kind=kind_phys), dimension(:,:),intent(in) :: & & prsl_i,u_i,v_i,phil, omega_i, QLLS_i,QILS_i, & & lwheat_i,swheat_i - real (kind=kind_phys), dimension(:,:),intent(in):: prsi_i, phii + real (kind=kind_phys), dimension(:,0:),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 ! using assumed shape. From 7eba0956d8cec959aa25c3bc95d061014307dea3 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 23 Jun 2021 14:30:17 -0600 Subject: [PATCH 27/32] Add logic to reset extended diagnostics for Thompson MP based on reset flag for maximum hourly fields --- physics/mp_thompson.F90 | 10 +++++++--- physics/mp_thompson.meta | 8 ++++++++ 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 87971e66c..7d8042893 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -22,7 +22,7 @@ module mp_thompson logical :: is_initialized = .False. - integer, parameter :: ext_ndiag3d = 45 + integer, parameter :: ext_ndiag3d = 40 contains @@ -339,8 +339,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & prcp, rain, graupel, ice, snow, sr, & refl_10cm, reset_dBZ, do_radar_ref, & re_cloud, re_ice, re_snow, & - mpicomm, mpirank, mpiroot, & - blkno, ext_diag, diag3d, & + mpicomm, mpirank, mpiroot, blkno, & + ext_diag, diag3d, reset_diag3d, & errmsg, errflg) implicit none @@ -401,6 +401,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! Extended diagnostic output logical, intent(in) :: ext_diag real(kind_phys), target, intent(inout) :: diag3d(:,:,:) + logical, intent(in) :: reset_diag3d ! CCPP error handling character(len=*), intent( out) :: errmsg @@ -622,6 +623,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! Set pointers for extended diagnostics set_extended_diagnostic_pointers: if (ext_diag) then + if (reset_diag3d) then + diag3d = 0.0 + end if vts1 => diag3d(:,:,1:1) prw_vcdc => diag3d(:,:,2:2) prw_vcde => diag3d(:,:,3:3) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 85c9f9413..194400d5b 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -741,6 +741,14 @@ kind = kind_phys intent = inout optional = F +[reset_diag3d] + standard_name = flag_reset_maximum_hourly_fields + long_name = flag for resetting maximum hourly fields + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 1c69f76869a990cb014c52272b0d9bad5426413d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 23 Jun 2021 15:37:26 -0600 Subject: [PATCH 28/32] Use separate flag for resetting extended diagnostics for Thompson MP --- physics/mp_thompson.meta | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 194400d5b..1ab496c25 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -742,8 +742,8 @@ intent = inout optional = F [reset_diag3d] - standard_name = flag_reset_maximum_hourly_fields - long_name = flag for resetting maximum hourly fields + standard_name = flag_reset_extended_diagnostics_output_arrays_from_thompson_microphysics + long_name = flag for resetting extended diagnostics output arrays from thompson microphysics units = flag dimensions = () type = logical From 55398eab58a1d5ae63dc5ce3da39a6c175848ced Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 23 Jun 2021 17:26:14 -0600 Subject: [PATCH 29/32] Reenable commented-out code in physics/mp_thompson.F90 --- physics/mp_thompson.F90 | 226 +++++++++++++++++++--------------------- 1 file changed, 109 insertions(+), 117 deletions(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 7d8042893..9548d0920 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -701,133 +701,125 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & tprs_rcs=tprs_rcs, & - tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, & - tprw_vcd_c=tprw_vcd_c, & + tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & - tprr_rcg=tprr_rcg, & - tprr_rcs=tprr_rcs, & + tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3) else - !!! call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - !!! nc=nc, 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, & - !!! snownc=snow_mp, snowncv=delta_snow_mp, & - !!! icenc=ice_mp, icencv=delta_ice_mp, & - !!! graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & - !!! refl_10cm=refl_10cm, & - !!! diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & - !!! 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, & - !!! reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & - !!! first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & - !!! ! Extended diagnostics - !!! ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & - !!! prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & - !!! tpri_ide_s=tpri_ide_s, tprs_ide_d=tprs_ide_d, & - !!! tprs_ide_s=tprs_ide_s, tprs_sde_d=tprs_sde_d, & - !!! tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & - !!! tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & - !!! tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & - !!! tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & - !!! tprs_rcs_s=tprs_rcs_s, tprs_rcs_r=tprs_rcs_r, & - !!! tprr_rci=tprr_rci, tprg_rcg_g=tprg_rcg_g, & - !!! tprg_rcg_r=tprg_rcg_r, tprw_vcd_c=tprw_vcd_c, & - !!! tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & - !!! tprr_rcg_r=tprr_rcg_r, tprr_rcg_g=tprr_rcg_g, & - !!! tprr_rcs_r=tprr_rcs_r, tprr_rcs_s=tprr_rcs_s, & - !!! tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & - !!! qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & - !!! qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - !!! qcten3=qcten3) + call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + nc=nc, 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, & + snownc=snow_mp, snowncv=delta_snow_mp, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + 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, & + reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & + tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs=tprs_rcs, & + tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & + tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3) end if else if (do_effective_radii) then - !!!call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - !!! 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, & - !!! icenc=ice_mp, icencv=delta_ice_mp, & - !!! graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & - !!! refl_10cm=refl_10cm, & - !!! 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, & - !!! reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & - !!! first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & - !!! ! Extended diagnostics - !!! ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & - !!! prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & - !!! tpri_ide_s=tpri_ide_s, tprs_ide_d=tprs_ide_d, & - !!! tprs_ide_s=tprs_ide_s, tprs_sde_d=tprs_sde_d, & - !!! tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & - !!! tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & - !!! tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & - !!! tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & - !!! tprs_rcs_s=tprs_rcs_s, tprs_rcs_r=tprs_rcs_r, & - !!! tprr_rci=tprr_rci, tprg_rcg_g=tprg_rcg_g, & - !!! tprg_rcg_r=tprg_rcg_r, tprw_vcd_c=tprw_vcd_c, & - !!! tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & - !!! tprr_rcg_r=tprr_rcg_r, tprr_rcg_g=tprr_rcg_g, & - !!! tprr_rcs_r=tprr_rcs_r, tprr_rcs_s=tprr_rcs_s, & - !!! tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & - !!! qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & - !!! qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - !!! qcten3=qcten3) + call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + 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, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + 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, & + reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & + tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs=tprs_rcs, & + tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & + tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3) else - !!!call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & - !!! 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, & - !!! icenc=ice_mp, icencv=delta_ice_mp, & - !!! graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & - !!! refl_10cm=refl_10cm, & - !!! diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & - !!! 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, & - !!! reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & - !!! first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & - !!! ! Extended diagnostics - !!! ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & - !!! prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & - !!! tpri_ide_s=tpri_ide_s, tprs_ide_d=tprs_ide_d, & - !!! tprs_ide_s=tprs_ide_s, tprs_sde_d=tprs_sde_d, & - !!! tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & - !!! tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & - !!! tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & - !!! tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & - !!! tprs_rcs_s=tprs_rcs_s, tprs_rcs_r=tprs_rcs_r, & - !!! tprr_rci=tprr_rci, tprg_rcg_g=tprg_rcg_g, & - !!! tprg_rcg_r=tprg_rcg_r, tprw_vcd_c=tprw_vcd_c, & - !!! tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & - !!! tprr_rcg_r=tprr_rcg_r, tprr_rcg_g=tprr_rcg_g, & - !!! tprr_rcs_r=tprr_rcs_r, tprr_rcs_s=tprr_rcs_s, & - !!! tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & - !!! qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & - !!! qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - !!! qcten3=qcten3) + call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + 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, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + 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, & + reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & + tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs=tprs_rcs, & + tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & + tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3) end if end if if (errflg/=0) return From 28650fbd76e01858a81889be2436d06b8ec8d5a3 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 1 Jul 2021 10:52:07 -0600 Subject: [PATCH 30/32] Remove old comment from physics/m_micro.F90, revert whitespace changes in physics/module_mp_thompson.F90 --- physics/m_micro.F90 | 6 ------ physics/module_mp_thompson.F90 | 4 ++-- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 53ba82392..5b4a5f994 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -181,9 +181,6 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & prsl_i,u_i,v_i,phil, omega_i, QLLS_i,QILS_i, & & lwheat_i,swheat_i real (kind=kind_phys), dimension(:,0:),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 -! using assumed shape. real (kind=kind_phys), dimension(:,:), intent(in) :: & & CNV_DQLDT_i, CLCN_i, QLCN_i, QICN_i, & & CNV_MFD_i, cf_upi, CNV_FICE_i, CNV_NDROP_i, & @@ -210,9 +207,6 @@ subroutine m_micro_run( im, lm, flipv, dt_i & integer, dimension(:), intent(inout):: KCBL real (kind=kind_phys),dimension(:,:),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 -! using assumed shape. real (kind=kind_phys),dimension(:,:),intent(inout):: rnw_io,snw_io,& & ncpr_io, ncps_io, & & qgl_io, ncgl_io diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index bf3685076..69aaef58c 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1069,8 +1069,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & !..Local variables REAL, DIMENSION(kts:kte):: & - qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & - nr1d, nc1d, nwfa1d, nifa1d, & + qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & + nr1d, nc1d, nwfa1d, nifa1d, & t1d, p1d, w1d, dz1d, rho, dBZ !..Extended diagnostics, single column arrays REAL, DIMENSION(:), ALLOCATABLE:: & From 5c0ea2da1f431674916e3679df977a687a823f2e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 2 Jul 2021 12:05:50 -0600 Subject: [PATCH 31/32] Comment out extended diagnostics vts1, txri, txrc --- physics/module_mp_thompson.F90 | 187 ++++++++++++++++----------------- physics/mp_thompson.F90 | 118 +++++++++++---------- 2 files changed, 153 insertions(+), 152 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 69aaef58c..b1301d744 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -991,7 +991,9 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & errmsg, errflg, & ! Extended diagnostics, array pointers ! only associated if ext_diag flag is .true. - ext_diag, vts1, prw_vcdc, & + ext_diag, & + !vts1, txri, txrc, & + prw_vcdc, & prw_vcde, tpri_inu, tpri_ide_d, & tpri_ide_s, tprs_ide, tprs_sde_d, & tprs_sde_s, tprg_gde_d, & @@ -1001,10 +1003,9 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprr_rci, tprg_rcg, & tprw_vcd_c, tprw_vcd_e, tprr_sml, & tprr_gml, tprr_rcg, & - tprr_rcs, tprv_rev, txri, & - txrc, tten3, qvten3, qrten3, qsten3, & - qgten3, qiten3, niten3, nrten3, ncten3, & - qcten3) + tprr_rcs, tprv_rev, tten3, qvten3, & + qrten3, qsten3, qgten3, qiten3, niten3, & + nrten3, ncten3, qcten3) implicit none @@ -1052,7 +1053,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ! Extended diagnostics, array pointers only associated if ext_diag flag is .true. LOGICAL, INTENT (IN) :: ext_diag REAL, DIMENSION(:,:,:), INTENT(INOUT):: & - vts1, prw_vcdc, & + !vts1, txri, txrc, & + prw_vcdc, & prw_vcde, tpri_inu, tpri_ide_d, & tpri_ide_s, tprs_ide, & tprs_sde_d, tprs_sde_s, tprg_gde_d, & @@ -1062,10 +1064,9 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprr_rci, tprg_rcg, & tprw_vcd_c, tprw_vcd_e, tprr_sml, & tprr_gml, tprr_rcg, & - tprr_rcs, tprv_rev, txri, & - txrc, tten3, qvten3, qrten3, qsten3, & - qgten3, qiten3, niten3, nrten3, ncten3, & - qcten3 + tprr_rcs, tprv_rev, tten3, qvten3, & + qrten3, qsten3, qgten3, qiten3, niten3, & + nrten3, ncten3, qcten3 !..Local variables REAL, DIMENSION(kts:kte):: & @@ -1074,7 +1075,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & t1d, p1d, w1d, dz1d, rho, dBZ !..Extended diagnostics, single column arrays REAL, DIMENSION(:), ALLOCATABLE:: & - vtsk1, prw_vcdc1, & + !vtsk1, txri1, txrc1, & + prw_vcdc1, & prw_vcde1, tpri_inu1, tpri_ide1_d, & tpri_ide1_s, tprs_ide1, & tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & @@ -1084,10 +1086,9 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprr_rci1, tprg_rcg1, & tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & tprr_gml1, tprr_rcg1, & - tprr_rcs1, tprv_rev1, txri1, & - txrc1, tten1, qvten1, qrten1, qsten1, & - qgten1, qiten1, niten1, nrten1, ncten1, & - qcten1 + tprr_rcs1, tprv_rev1, tten1, qvten1, & + qrten1, qsten1, qgten1, qiten1, niten1, & + nrten1, ncten1, qcten1 REAL, DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d #if ( WRF_CHEM == 1 ) @@ -1176,8 +1177,11 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & end if end if test_only_once + ! These must be alwyas allocated + !allocate (vtsk1(kts:kte)) + !allocate (txri1(kts:kte)) + !allocate (txrc1(kts:kte)) allocate_extended_diagnostics: if (ext_diag) then - allocate (vtsk1(kts:kte)) allocate (prw_vcdc1(kts:kte)) allocate (prw_vcde1(kts:kte)) allocate (tpri_inu1(kts:kte)) @@ -1205,8 +1209,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & allocate (tprr_rcg1(kts:kte)) allocate (tprr_rcs1(kts:kte)) allocate (tprv_rev1(kts:kte)) - allocate (txri1(kts:kte)) - allocate (txrc1(kts:kte)) allocate (tten1(kts:kte)) allocate (qvten1(kts:kte)) allocate (qrten1(kts:kte)) @@ -1217,11 +1219,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & allocate (nrten1(kts:kte)) allocate (ncten1(kts:kte)) allocate (qcten1(kts:kte)) - else - ! These must be allocated always - allocate (vtsk1(kts:kte)) - allocate (txri1(kts:kte)) - allocate (txrc1(kts:kte)) end if allocate_extended_diagnostics !+---+ @@ -1334,52 +1331,48 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nr1d(k) = nr(i,k,j) rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) + ! These arrays are always allocated and must be initialized + !vtsk1(k) = 0. + !txrc1(k) = 0. + !txri1(k) = 0. initialize_extended_diagnostics: if (ext_diag) then - vtsk1 = 0. - prw_vcdc1 = 0. - prw_vcde1 = 0. - tpri_inu1 = 0. - tpri_ide1_d = 0. - tpri_ide1_s = 0. - tprs_ide1 = 0. - tprs_sde1_d = 0. - tprs_sde1_s = 0. - tprg_gde1_d = 0. - tprg_gde1_s = 0. - tpri_iha1 = 0. - tpri_wfz1 = 0. - tpri_rfz1 = 0. - tprg_rfz1 = 0. - tprs_scw1 = 0. - tprg_scw1 = 0. - tprg_rcs1 = 0. - tprs_rcs1 = 0. - tprr_rci1 = 0. - tprg_rcg1 = 0. - tprw_vcd1_c = 0. - tprw_vcd1_e = 0. - tprr_sml1 = 0. - tprr_gml1 = 0. - tprr_rcg1 = 0. - tprr_rcs1 = 0. - tprv_rev1 = 0. - txri1 = 0. - txrc1 = 0. - tten1 = 0. - qvten1 = 0. - qrten1 = 0. - qsten1 = 0. - qgten1 = 0. - qiten1 = 0. - niten1 = 0. - nrten1 = 0. - ncten1 = 0. - qcten1 = 0. - else - ! These arrays are always allocated and must be initialized - vtsk1(k) = 0. - txrc1(k) = 0. - txri1(k) = 0. + prw_vcdc1(k) = 0. + prw_vcde1(k) = 0. + tpri_inu1(k) = 0. + tpri_ide1_d(k) = 0. + tpri_ide1_s(k) = 0. + tprs_ide1(k) = 0. + tprs_sde1_d(k) = 0. + tprs_sde1_s(k) = 0. + tprg_gde1_d(k) = 0. + tprg_gde1_s(k) = 0. + tpri_iha1(k) = 0. + tpri_wfz1(k) = 0. + tpri_rfz1(k) = 0. + tprg_rfz1(k) = 0. + tprs_scw1(k) = 0. + tprg_scw1(k) = 0. + tprg_rcs1(k) = 0. + tprs_rcs1(k) = 0. + tprr_rci1(k) = 0. + tprg_rcg1(k) = 0. + tprw_vcd1_c(k) = 0. + tprw_vcd1_e(k) = 0. + tprr_sml1(k) = 0. + tprr_gml1(k) = 0. + tprr_rcg1(k) = 0. + tprr_rcs1(k) = 0. + tprv_rev1(k) = 0. + tten1(k) = 0. + qvten1(k) = 0. + qrten1(k) = 0. + qsten1(k) = 0. + qgten1(k) = 0. + qiten1(k) = 0. + niten1(k) = 0. + nrten1(k) = 0. + ncten1(k) = 0. + qcten1(k) = 0. endif initialize_extended_diagnostics enddo if (is_aerosol_aware) then @@ -1405,7 +1398,9 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & #endif rand1, rand2, rand3, & kts, kte, dt, i, j, & - ext_diag, vtsk1, prw_vcdc1, prw_vcde1, & + ext_diag, & + !vtsk1, txri1, txrc1, & + prw_vcdc1, prw_vcde1, & tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1, & tprs_sde1_d, tprs_sde1_s, & tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & @@ -1414,7 +1409,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprg_rcg1, tprw_vcd1_c, & tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1, & tprr_rcs1, tprv_rev1, & - txri1, txrc1, tten1, qvten1, qrten1, qsten1, & + tten1, qvten1, qrten1, qsten1, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1) pcp_ra(i,j) = pptrain @@ -1555,7 +1550,9 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & assign_extended_diagnostics: if (ext_diag) then do k=kts,kte - vts1(i,k,j) = vtsk1(k) + !vts1(i,k,j) = vtsk1(k) + !txri(i,k,j) = txri(i,k,j) + txri1(k) + !txrc(i,k,j) = txrc(i,k,j) + txrc1(k) prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) tpri_inu(i,k,j) = tpri_inu(i,k,j) + tpri_inu1(k) @@ -1583,8 +1580,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprr_rcg(i,k,j) = tprr_rcg(i,k,j) + tprr_rcg1(k) tprr_rcs(i,k,j) = tprr_rcs(i,k,j) + tprr_rcs1(k) tprv_rev(i,k,j) = tprv_rev(i,k,j) + tprv_rev1(k) - txri(i,k,j) = txri(i,k,j) + txri1(k) - txrc(i,k,j) = txrc(i,k,j) + txrc1(k) tten3(i,k,j) = tten3(i,k,j) + tten1(k) qvten3(i,k,j) = qvten3(i,k,j) + qvten1(k) qrten3(i,k,j) = qrten3(i,k,j) + qrten1(k) @@ -1662,8 +1657,11 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ! 'nr: ', nr_max, '(', imax_nr, ',', jmax_nr, ',', kmax_nr, ')' ! END DEBUG - GT + ! These are always allocated + !deallocate (vtsk1) + !deallocate (txri1) + !deallocate (txrc1) deallocate_extended_diagnostics: if (ext_diag) then - deallocate (vtsk1) deallocate (prw_vcdc1) deallocate (prw_vcde1) deallocate (tpri_inu1) @@ -1691,8 +1689,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & deallocate (tprr_rcg1) deallocate (tprr_rcs1) deallocate (tprv_rev1) - deallocate (txri1) - deallocate (txrc1) deallocate (tten1) deallocate (qvten1) deallocate (qrten1) @@ -1703,11 +1699,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & deallocate (nrten1) deallocate (ncten1) deallocate (qcten1) - else - ! These are always allocated - deallocate (vtsk1) - deallocate (txri1) - deallocate (txrc1) end if deallocate_extended_diagnostics END SUBROUTINE mp_gt_driver @@ -1784,7 +1775,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & kts, kte, dt, ii, jj, & ! Extended diagnostics, most arrays only ! allocated if ext_diag flag is .true. - ext_diag, vtsk1, prw_vcdc1, prw_vcde1, & + ext_diag, & + !vtsk1, txri1, txrc1, & + prw_vcdc1, prw_vcde1, & tpri_inu1, tpri_ide1_d, tpri_ide1_s, tprs_ide1, & tprs_sde1_d, tprs_sde1_s, & tprg_gde1_d, tprg_gde1_s, tpri_iha1, tpri_wfz1, & @@ -1793,7 +1786,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tprg_rcg1, tprw_vcd1_c, & tprw_vcd1_e, tprr_sml1, tprr_gml1, tprr_rcg1, & tprr_rcs1, tprv_rev1, & - txri1, txrc1, tten1, qvten1, qrten1, qsten1, & + tten1, qvten1, qrten1, qsten1, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1) #ifdef MPI @@ -1813,7 +1806,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ! Extended diagnostics, most arrays only allocated if ext_diag is true LOGICAL, INTENT(IN) :: ext_diag REAL, DIMENSION(:), INTENT(OUT):: & - vtsk1, prw_vcdc1, & + !vtsk1, txri1, txrc1, & + prw_vcdc1, & prw_vcde1, tpri_inu1, tpri_ide1_d, & tpri_ide1_s, tprs_ide1, & tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & @@ -1823,10 +1817,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tprr_rci1, tprg_rcg1, & tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & tprr_gml1, tprr_rcg1, & - tprr_rcs1, tprv_rev1, txri1, & - txrc1, tten1, qvten1, qrten1, qsten1, & - qgten1, qiten1, niten1, nrten1, ncten1, & - qcten1 + tprr_rcs1, tprv_rev1, tten1, qvten1, & + qrten1, qsten1, qgten1, qiten1, niten1, & + nrten1, ncten1, qcten1 #if ( WRF_CHEM == 1 ) REAL, DIMENSION(kts:kte), INTENT(INOUT):: & @@ -2039,7 +2032,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !Diagnostics if (ext_diag) then do k = kts, kte - vtsk1(k) = 0. + !vtsk1(k) = 0. + !txrc1(k) = 0. + !txri1(k) = 0. prw_vcdc1(k) = 0. prw_vcde1(k) = 0. tpri_inu1(k) = 0. @@ -2067,8 +2062,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tprr_rcg1(k) = 0. tprr_rcs1(k) = 0. tprv_rev1(k) = 0. - txrc1(k) = 0. - txri1(k) = 0. tten1(k) = 0. qvten1(k) = 0. qrten1(k) = 0. @@ -3777,7 +3770,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nstep = 0 do k = kte, kts, -1 vts = 0. - vtsk1(k)=0. + !vtsk1(k)=0. if (rs(k).gt. R1) then xDs = smoc(k) / smob(k) @@ -3796,14 +3789,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ! & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) SR = rs(k)/(rs(k)+rr(k)) vtsk(k) = vts*SR + (1.-SR)*vtrk(k) - vtsk1(k)=vtsk(k) + !vtsk1(k)=vtsk(k) else vtsk(k) = vts*vts_boost(k) - vtsk1(k)=vtsk(k) + !vtsk1(k)=vtsk(k) endif else vtsk(k) = vtsk(k+1) - vtsk1(k)=0 + !vtsk1(k)=0 endif if (vtsk(k) .gt. 1.E-3) then @@ -4002,7 +3995,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & niten(k) = -ni1d(k)*odt tten(k) = tten(k) - lfus*ocp(k)*xri*odt*(1-IFDRY) !diag - txri1(k) = lfus*ocp(k)*xri*odt*(1-IFDRY) + !txri1(k) = lfus*ocp(k)*xri*odt*(1-IFDRY) endif xrc = MAX(0.0, qc1d(k) + qcten(k)*DT) @@ -4015,7 +4008,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ncten(k) = ncten(k) - xnc*odt tten(k) = tten(k) + lfus2*ocp(k)*xrc*odt*(1-IFDRY) !diag - txrc1(k) = lfus2*ocp(k)*xrc*odt*(1-IFDRY)*DT + !txrc1(k) = lfus2*ocp(k)*xrc*odt*(1-IFDRY)*DT endif enddo endif diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 9548d0920..6fb039b9d 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -22,7 +22,7 @@ module mp_thompson logical :: is_initialized = .False. - integer, parameter :: ext_ndiag3d = 40 + integer, parameter :: ext_ndiag3d = 37 contains @@ -446,7 +446,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ! Pointer arrays for extended diagnostics - real(kind_phys), dimension(:,:,:), pointer :: vts1 => null() + !real(kind_phys), dimension(:,:,:), pointer :: vts1 => null() + !real(kind_phys), dimension(:,:,:), pointer :: txri => null() + !real(kind_phys), dimension(:,:,:), pointer :: txrc => null() real(kind_phys), dimension(:,:,:), pointer :: prw_vcdc => null() real(kind_phys), dimension(:,:,:), pointer :: prw_vcde => null() real(kind_phys), dimension(:,:,:), pointer :: tpri_inu => null() @@ -474,8 +476,6 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), dimension(:,:,:), pointer :: tprr_rcg => null() real(kind_phys), dimension(:,:,:), pointer :: tprr_rcs => null() real(kind_phys), dimension(:,:,:), pointer :: tprv_rev => null() - real(kind_phys), dimension(:,:,:), pointer :: txri => null() - real(kind_phys), dimension(:,:,:), pointer :: txrc => null() real(kind_phys), dimension(:,:,:), pointer :: tten3 => null() real(kind_phys), dimension(:,:,:), pointer :: qvten3 => null() real(kind_phys), dimension(:,:,:), pointer :: qrten3 => null() @@ -626,46 +626,46 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & if (reset_diag3d) then diag3d = 0.0 end if - vts1 => diag3d(:,:,1:1) - prw_vcdc => diag3d(:,:,2:2) - prw_vcde => diag3d(:,:,3:3) - tpri_inu => diag3d(:,:,4:4) - tpri_ide_d => diag3d(:,:,5:5) - tpri_ide_s => diag3d(:,:,6:6) - tprs_ide => diag3d(:,:,7:7) - tprs_sde_d => diag3d(:,:,8:8) - tprs_sde_s => diag3d(:,:,9:9) - tprg_gde_d => diag3d(:,:,10:10) - tprg_gde_s => diag3d(:,:,11:11) - tpri_iha => diag3d(:,:,12:12) - tpri_wfz => diag3d(:,:,13:13) - tpri_rfz => diag3d(:,:,14:14) - tprg_rfz => diag3d(:,:,15:15) - tprs_scw => diag3d(:,:,16:16) - tprg_scw => diag3d(:,:,17:17) - tprg_rcs => diag3d(:,:,18:18) - tprs_rcs => diag3d(:,:,19:19) - tprr_rci => diag3d(:,:,20:20) - tprg_rcg => diag3d(:,:,21:21) - tprw_vcd_c => diag3d(:,:,22:22) - tprw_vcd_e => diag3d(:,:,23:23) - tprr_sml => diag3d(:,:,24:24) - tprr_gml => diag3d(:,:,25:25) - tprr_rcg => diag3d(:,:,26:26) - tprr_rcs => diag3d(:,:,27:27) - tprv_rev => diag3d(:,:,28:28) - txri => diag3d(:,:,29:29) - txrc => diag3d(:,:,30:30) - tten3 => diag3d(:,:,31:31) - qvten3 => diag3d(:,:,32:32) - qrten3 => diag3d(:,:,33:33) - qsten3 => diag3d(:,:,34:34) - qgten3 => diag3d(:,:,35:35) - qiten3 => diag3d(:,:,36:36) - niten3 => diag3d(:,:,37:37) - nrten3 => diag3d(:,:,38:38) - ncten3 => diag3d(:,:,39:39) - qcten3 => diag3d(:,:,40:40) + !vts1 => diag3d(:,:,X:X) + !txri => diag3d(:,:,X:X) + !txrc => diag3d(:,:,X:X) + prw_vcdc => diag3d(:,:,1:1) + prw_vcde => diag3d(:,:,2:2) + tpri_inu => diag3d(:,:,3:3) + tpri_ide_d => diag3d(:,:,4:4) + tpri_ide_s => diag3d(:,:,5:5) + tprs_ide => diag3d(:,:,6:6) + tprs_sde_d => diag3d(:,:,7:7) + tprs_sde_s => diag3d(:,:,8:8) + tprg_gde_d => diag3d(:,:,9:9) + tprg_gde_s => diag3d(:,:,10:10) + tpri_iha => diag3d(:,:,11:11) + tpri_wfz => diag3d(:,:,12:12) + tpri_rfz => diag3d(:,:,13:13) + tprg_rfz => diag3d(:,:,14:14) + tprs_scw => diag3d(:,:,15:15) + tprg_scw => diag3d(:,:,16:16) + tprg_rcs => diag3d(:,:,17:17) + tprs_rcs => diag3d(:,:,18:18) + tprr_rci => diag3d(:,:,19:19) + tprg_rcg => diag3d(:,:,20:20) + tprw_vcd_c => diag3d(:,:,21:21) + tprw_vcd_e => diag3d(:,:,22:22) + tprr_sml => diag3d(:,:,23:23) + tprr_gml => diag3d(:,:,24:24) + tprr_rcg => diag3d(:,:,25:25) + tprr_rcs => diag3d(:,:,26:26) + tprv_rev => diag3d(:,:,27:27) + tten3 => diag3d(:,:,28:28) + qvten3 => diag3d(:,:,29:29) + qrten3 => diag3d(:,:,30:30) + qsten3 => diag3d(:,:,31:31) + qgten3 => diag3d(:,:,32:32) + qiten3 => diag3d(:,:,33:33) + niten3 => diag3d(:,:,34:34) + nrten3 => diag3d(:,:,35:35) + ncten3 => diag3d(:,:,36:36) + qcten3 => diag3d(:,:,37:37) end if set_extended_diagnostic_pointers !> - Call mp_gt_driver() with or without aerosols @@ -692,7 +692,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & ! Extended diagnostics - ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + ext_diag=ext_diag, & + ! vts1=vts1, txri=txri, txrc=txrc, & + prw_vcdc=prw_vcdc, & prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & tprs_sde_d=tprs_sde_d, & @@ -704,7 +706,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & - tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + tprv_rev=tprv_rev, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3) @@ -729,7 +731,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & ! Extended diagnostics - ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + ext_diag=ext_diag, & + ! vts1=vts1, txri=txri, txrc=txrc, & + prw_vcdc=prw_vcdc, & prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & tprs_sde_d=tprs_sde_d, & @@ -741,7 +745,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & - tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + tprv_rev=tprv_rev, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3) @@ -768,7 +772,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & ! Extended diagnostics - ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + ext_diag=ext_diag, & + ! vts1=vts1, txri=txri, txrc=txrc, & + prw_vcdc=prw_vcdc, & prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & tprs_sde_d=tprs_sde_d, & @@ -780,7 +786,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & - tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + tprv_rev=tprv_rev, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3) @@ -804,7 +810,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & reset_dBZ=reset_dBZ, istep=istep, nsteps=nsteps, & first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & ! Extended diagnostics - ext_diag=ext_diag, vts1=vts1, prw_vcdc=prw_vcdc, & + ext_diag=ext_diag, & + ! vts1=vts1, txri=txri, txrc=txrc, & + prw_vcdc=prw_vcdc, & prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & tprs_sde_d=tprs_sde_d, & @@ -816,7 +824,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & - tprv_rev=tprv_rev, txri=txri, txrc=txrc, tten3=tten3, & + tprv_rev=tprv_rev, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3) @@ -863,7 +871,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & end if unset_extended_diagnostic_pointers: if (ext_diag) then - vts1 => null() + !vts1 => null() + !txri => null() + !txrc => null() prw_vcdc => null() prw_vcde => null() tpri_inu => null() @@ -891,8 +901,6 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprr_rcg => null() tprr_rcs => null() tprv_rev => null() - txri => null() - txrc => null() tten3 => null() qvten3 => null() qrten3 => null() From f38d9a16f171561a726dd7421bc3e2404466e0f8 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 2 Jul 2021 17:40:58 -0600 Subject: [PATCH 32/32] Yet another index-related bugfix in physics/m_micro.F90 --- physics/m_micro.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 5b4a5f994..f9b793239 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -436,7 +436,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & END DO END DO DO K=0, LM - ll = lm-k+1 + ll = lm-k DO I = 1,IM PLE(i,k) = prsi_i(i,ll) * 0.01_kp ! interface pressure in hPa zet(i,k+1) = phii(i,ll) * onebg