From d2900143f7de8c3fe79e8135a0bab5f3267267b9 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 10 Jan 2023 15:31:25 -0700 Subject: [PATCH 001/132] add sfc_land and allow sbs along with fully coupled --- CODEOWNERS | 2 + physics/noahmpdrv.F90 | 12 ++- physics/noahmpdrv.meta | 14 ++++ physics/sfc_land.f | 146 ++++++++++++++++++++++++++++++++ physics/sfc_land.meta | 186 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 358 insertions(+), 2 deletions(-) create mode 100644 physics/sfc_land.f create mode 100644 physics/sfc_land.meta diff --git a/CODEOWNERS b/CODEOWNERS index cf7a886aa..19e0eb2a5 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -126,6 +126,8 @@ physics/h2ophys.* @AlexBelochitski-NOAA physics/sfc_sice.* @wd20xw @climbfuji @SamuelTrahanNOAA @grantfirl @mzhangw @panll @mkavulich @ChunxiZhang-NOAA physics/sfc_cice.* @wd20xw @climbfuji @SamuelTrahanNOAA @grantfirl @mzhangw @panll @mkavulich @ChunxiZhang-NOAA +physics/sfc_land.* @uturuncoglu @barlage + ######################################################################## # Lines starting with '#' are comments. diff --git a/physics/noahmpdrv.F90 b/physics/noahmpdrv.F90 index fed823ead..d15a9e82a 100644 --- a/physics/noahmpdrv.F90 +++ b/physics/noahmpdrv.F90 @@ -140,7 +140,7 @@ subroutine noahmpdrv_run & iopt_stc, iopt_trs,xlatin, xcoszin, iyrlen, julian, garea, & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, & con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - con_fvirt, con_rd, con_hfus, thsfc_loc, & + con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm,& ! --- in/outs: weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & @@ -274,6 +274,9 @@ subroutine noahmpdrv_run & logical , intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + logical , intent(in) :: cpllnd ! Flag for land coupling (atm->lnd) + logical , intent(in) :: cpllnd2atm ! Flag for land coupling (lnd->atm) + real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm] real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K] @@ -601,7 +604,12 @@ subroutine noahmpdrv_run & errmsg = '' errflg = 0 -do i = 1, im +! +! --- Just return if external land component is activated for two-way interaction +! + if (cpllnd .and. cpllnd2atm) return + + do i = 1, im if (flag_iter(i) .and. dry(i)) then diff --git a/physics/noahmpdrv.meta b/physics/noahmpdrv.meta index 3235b7c90..643987d98 100644 --- a/physics/noahmpdrv.meta +++ b/physics/noahmpdrv.meta @@ -611,6 +611,20 @@ dimensions = () type = logical intent = in +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[cpllnd2atm] + standard_name = flag_for_one_way_land_coupling_to_atmosphere + long_name = flag controlling land coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in [weasd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land diff --git a/physics/sfc_land.f b/physics/sfc_land.f new file mode 100644 index 000000000..0c3130bbe --- /dev/null +++ b/physics/sfc_land.f @@ -0,0 +1,146 @@ +!> \file sfc_land.f +!! This file contains the code for coupling to land component + +!> This module contains the CCPP-compliant GFS land post +!! interstitial codes, which returns updated surface +!! properties such as latent heat and sensible heat +!! provided by the component version of land model + +!> This module contains the CCPP-compliant GFS land scheme. + module sfc_land + + contains + +!> \defgroup sfc_land for coupling to land +!! @{ +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication +!! +!> \brief Brief description of the subroutine +!! +!! \section arg_table_sfc_land_run Arguments +!! \htmlinclude sfc_land_run.html +!! + +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + + +!! use physcons, only : hvap => con_hvap, cp => con_cp, & +!! & rvrdm1 => con_fvirt, rd => con_rd +! +!----------------------------------- + subroutine sfc_land_run & +! --- inputs: + & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & + & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & + & ep_lnd, t2mmp_lnd, q2mp_lnd, & +! --- outputs: + & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & + & errmsg, errflg, naux2d, aux2d + & ) + +! ===================================================================== ! +! description: ! +! Dec 2022 -- Ufuk Turuncoglu created for coupling to land ! +! ! +! usage: ! +! ! +! call sfc_land ! +! inputs: ! +! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! +! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! +! ep_lnd, t2mmp_lnd, q2mp_lnd, ! +! outputs: ! +! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! +! errmsg, errflg) ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: +! im - integer, horiz dimension +! cpllnd - logical, flag for land coupling +! cpllnd2atm - logical, flag for land coupling (lnd->atm) +! flag_iter - logical, flag for iteration +! dry - logical, eq T if a point with any land +! sncovr1_lnd - real , surface snow area fraction +! qsurf_lnd - real , specific humidity at sfc +! evap_lnd - real , evaporation from latent heat +! hflx_lnd - real , sensible heat +! ep_lnd - real , surface upward potential latent heat flux +! t2mmp_lnd - real , 2m temperature +! q2mp_lnd - real , 2m specific humidity +! outputs: +! sncovr1 - real , snow cover over land +! qsurf - real , specific humidity at sfc +! evap - real , evaporation from latent heat +! hflx - real , sensible heat +! ep - real , potential evaporation +! t2mmp - real , temperature at 2m +! q2mp - real , specific humidity at 2m +! ==================== end of description ===================== ! +! +! + use machine , only : kind_phys + implicit none + +! --- inputs: + integer, intent(in) :: im + logical, intent(in) :: cpllnd, cpllnd2atm + logical, dimension(:), intent(in) :: flag_iter + logical, dimension(:), intent(in) :: dry + + real (kind=kind_phys), dimension(:), intent(in) :: & + & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & + & t2mmp_lnd, q2mp_lnd + +! --- outputs: + real (kind=kind_phys), dimension(:), intent(out) :: & + & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp +! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer, intent(in) :: naux2d + real(kind_phys), intent(out) :: aux2d(:,:) + +! --- locals: + + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! + if (.not. cpllnd2atm) return +! + do i = 1, im + !if (flag_iter(i) .and. dry(i)) then + !if (dry(i)) then + sncovr1(i) = sncovr1_lnd(i) + qsurf(i) = qsurf_lnd(i) + hflx(i) = hflx_lnd(i) + evap(i) = evap_lnd(i) + ep(i) = ep_lnd(i) + t2mmp(i) = t2mmp_lnd(i) + q2mp(i) = q2mp_lnd(i) + !end if + enddo + + aux2d(:,1) = dry(:) !sncovr1(:) + aux2d(:,2) = qsurf(:) + aux2d(:,3) = hflx(:) + aux2d(:,4) = evap(:) + aux2d(:,5) = ep(:) + aux2d(:,6) = qsurf_lnd(:) !t2mmp(:) + aux2d(:,7) = q2mp(:) + + return +!----------------------------------- + end subroutine sfc_land_run +!----------------------------------- + +!> @} + end module sfc_land diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta new file mode 100644 index 000000000..f31d779ae --- /dev/null +++ b/physics/sfc_land.meta @@ -0,0 +1,186 @@ +[ccpp-table-properties] + name = sfc_land + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = sfc_land_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[cpllnd2atm] + standard_name = flag_for_one_way_land_coupling_to_atmosphere + long_name = flag controlling land coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[sncovr1_lnd] + standard_name = surface_snow_area_fraction_over_land_from_land + long_name = surface snow area fraction over land for coupling + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[qsurf_lnd] + standard_name = surface_specific_humidity_over_land_from_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[evap_lnd] + standard_name = surface_upward_latent_heat_flux_over_land_from_land + long_name = sfc latent heat flux input over land for coupling + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[hflx_lnd] + standard_name = surface_upward_sensible_heat_flux_over_land_from_land + long_name = sfc sensible heat flux input over land for coupling + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ep_lnd] + standard_name = surface_upward_potential_latent_heat_flux_over_land_from_land + long_name = surface upward potential latent heat flux over land for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[t2mmp_lnd] + standard_name = temperature_at_2m_over_land_from_land + long_name = 2 meter temperature over land for coupling + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[q2mp_lnd] + standard_name = specific_humidity_at_2m_over_land_from_land + long_name = 2 meter specific humidity over land for coupling + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sncovr1] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[t2mmp] + standard_name = temperature_at_2m_from_noahmp + long_name = 2 meter temperature from noahmp + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[q2mp] + standard_name = specific_humidity_at_2m_from_noahmp + long_name = 2 meter specific humidity from noahmp + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[naux2d] + standard_name = number_of_xy_dimensioned_auxiliary_arrays + long_name = number of 2d auxiliary arrays to output (for debugging) + units = count + dimensions = () + type = integer + intent = in +[aux2d] + standard_name = auxiliary_2d_arrays + long_name = auxiliary 2d arrays to output (for debugging) + units = none + dimensions = (horizontal_loop_extent,number_of_xy_dimensioned_auxiliary_arrays) + type = real + kind = kind_phys + intent = out From 7e2954615d03ee085c2cbc91d6326ee2ecac88cb Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 7 Feb 2023 15:12:09 -0700 Subject: [PATCH 002/132] update sfc_land --- physics/sfc_land.f | 39 +++++++++++++++++++++------------------ physics/sfc_land.meta | 16 ++++++++++++++++ 2 files changed, 37 insertions(+), 18 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index 0c3130bbe..ab0691251 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -36,9 +36,10 @@ subroutine sfc_land_run & ! --- inputs: & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & - & ep_lnd, t2mmp_lnd, q2mp_lnd, & + & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & + & gflux, & & errmsg, errflg, naux2d, aux2d & ) @@ -52,9 +53,10 @@ subroutine sfc_land_run & ! inputs: ! ! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! ! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! -! ep_lnd, t2mmp_lnd, q2mp_lnd, ! +! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! ! outputs: ! ! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! +! gflux, ! ! errmsg, errflg) ! ! ! ! ==================== defination of variables ==================== ! @@ -71,7 +73,8 @@ subroutine sfc_land_run & ! hflx_lnd - real , sensible heat ! ep_lnd - real , surface upward potential latent heat flux ! t2mmp_lnd - real , 2m temperature -! q2mp_lnd - real , 2m specific humidity +! q2mp_lnd - real , 2m specific humidity +! gflux_lnd - real , soil heat flux over land ! outputs: ! sncovr1 - real , snow cover over land ! qsurf - real , specific humidity at sfc @@ -79,7 +82,8 @@ subroutine sfc_land_run & ! hflx - real , sensible heat ! ep - real , potential evaporation ! t2mmp - real , temperature at 2m -! q2mp - real , specific humidity at 2m +! q2mp - real , specific humidity at 2m +! gflux - real , soil heat flux over land ! ==================== end of description ===================== ! ! ! @@ -94,11 +98,11 @@ subroutine sfc_land_run & real (kind=kind_phys), dimension(:), intent(in) :: & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & - & t2mmp_lnd, q2mp_lnd + & t2mmp_lnd, q2mp_lnd, gflux_lnd ! --- outputs: real (kind=kind_phys), dimension(:), intent(out) :: & - & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp + & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -117,25 +121,24 @@ subroutine sfc_land_run & if (.not. cpllnd2atm) return ! do i = 1, im - !if (flag_iter(i) .and. dry(i)) then - !if (dry(i)) then - sncovr1(i) = sncovr1_lnd(i) - qsurf(i) = qsurf_lnd(i) - hflx(i) = hflx_lnd(i) - evap(i) = evap_lnd(i) - ep(i) = ep_lnd(i) - t2mmp(i) = t2mmp_lnd(i) - q2mp(i) = q2mp_lnd(i) - !end if + sncovr1(i) = sncovr1_lnd(i) + qsurf(i) = qsurf_lnd(i) + hflx(i) = hflx_lnd(i) + evap(i) = evap_lnd(i) + ep(i) = ep_lnd(i) + t2mmp(i) = t2mmp_lnd(i) + q2mp(i) = q2mp_lnd(i) + gflux(i) = gflux_lnd(i) enddo - aux2d(:,1) = dry(:) !sncovr1(:) + aux2d(:,1) = sncovr1(:) aux2d(:,2) = qsurf(:) aux2d(:,3) = hflx(:) aux2d(:,4) = evap(:) aux2d(:,5) = ep(:) - aux2d(:,6) = qsurf_lnd(:) !t2mmp(:) + aux2d(:,6) = t2mmp(:) aux2d(:,7) = q2mp(:) + aux2d(:,8) = gflux(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index f31d779ae..50ddecd46 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -98,6 +98,14 @@ type = real kind = kind_phys intent = in +[gflux_lnd] + standard_name = upward_heat_flux_in_soil_over_land_from_land + long_name = soil heat flux over land for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -154,6 +162,14 @@ type = real kind = kind_phys intent = out +[gflux] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 40e092d0d92d0c78848acc47ae83629908375a6c Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Thu, 23 Feb 2023 14:28:26 -0700 Subject: [PATCH 003/132] add runoff and drain to land coupling --- physics/sfc_land.f | 19 +++++++++++++++---- physics/sfc_land.meta | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+), 4 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index ab0691251..f7aebe171 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -37,9 +37,10 @@ subroutine sfc_land_run & & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & + & runoff_lnd, drain_lnd, ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & - & gflux, & + & gflux, runoff, drain, & & errmsg, errflg, naux2d, aux2d & ) @@ -54,9 +55,10 @@ subroutine sfc_land_run & ! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! ! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! ! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! +! runoff_lnd, drain_lnd, ! ! outputs: ! ! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! -! gflux, ! +! gflux, runoff, drain, ! ! errmsg, errflg) ! ! ! ! ==================== defination of variables ==================== ! @@ -75,6 +77,8 @@ subroutine sfc_land_run & ! t2mmp_lnd - real , 2m temperature ! q2mp_lnd - real , 2m specific humidity ! gflux_lnd - real , soil heat flux over land +! runoff_lnd - real , surface runoff +! drain_lnd - real , subsurface runoff ! outputs: ! sncovr1 - real , snow cover over land ! qsurf - real , specific humidity at sfc @@ -84,6 +88,8 @@ subroutine sfc_land_run & ! t2mmp - real , temperature at 2m ! q2mp - real , specific humidity at 2m ! gflux - real , soil heat flux over land +! runoff - real , surface runoff +! drain - real , subsurface runoff ! ==================== end of description ===================== ! ! ! @@ -98,11 +104,12 @@ subroutine sfc_land_run & real (kind=kind_phys), dimension(:), intent(in) :: & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & - & t2mmp_lnd, q2mp_lnd, gflux_lnd + & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd ! --- outputs: real (kind=kind_phys), dimension(:), intent(out) :: & - & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux + & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & + & runoff, drain ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -129,6 +136,8 @@ subroutine sfc_land_run & t2mmp(i) = t2mmp_lnd(i) q2mp(i) = q2mp_lnd(i) gflux(i) = gflux_lnd(i) + drain(i) = drain_lnd(i) + runoff(i) = runoff_lnd(i) enddo aux2d(:,1) = sncovr1(:) @@ -139,6 +148,8 @@ subroutine sfc_land_run & aux2d(:,6) = t2mmp(:) aux2d(:,7) = q2mp(:) aux2d(:,8) = gflux(:) + aux2d(:,9) = drain(:) + aux2d(:,10) = runoff(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index 50ddecd46..60a853b89 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -106,6 +106,22 @@ type = real kind = kind_phys intent = in +[runoff_lnd] + standard_name = surface_runoff_flux_from_land + long_name = surface runoff flux over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[drain_lnd] + standard_name = subsurface_runoff_flux_from_land + long_name = subsurface runoff flux over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -170,6 +186,22 @@ type = real kind = kind_phys intent = out +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 64fdd5aa53672132bf1295701a9d7844232f336b Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 7 Mar 2023 11:00:00 -0700 Subject: [PATCH 004/132] add exchange coefficents --- physics/sfc_land.f | 23 ++++++++++++++++------- physics/sfc_land.meta | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 7 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index f7aebe171..0436519a5 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -37,10 +37,10 @@ subroutine sfc_land_run & & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & - & runoff_lnd, drain_lnd, + & runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & - & gflux, runoff, drain, & + & gflux, runoff, drain, cmm, chh, & & errmsg, errflg, naux2d, aux2d & ) @@ -55,10 +55,10 @@ subroutine sfc_land_run & ! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! ! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! ! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! -! runoff_lnd, drain_lnd, ! +! runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, ! ! outputs: ! ! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! -! gflux, runoff, drain, ! +! gflux, runoff, drain, cmm, chh, ! ! errmsg, errflg) ! ! ! ! ==================== defination of variables ==================== ! @@ -79,6 +79,8 @@ subroutine sfc_land_run & ! gflux_lnd - real , soil heat flux over land ! runoff_lnd - real , surface runoff ! drain_lnd - real , subsurface runoff +! cmm_lnd - real , surface drag wind speed for momentum +! chh_lnd - real , surface drag mass flux for heat and moisture ! outputs: ! sncovr1 - real , snow cover over land ! qsurf - real , specific humidity at sfc @@ -89,7 +91,9 @@ subroutine sfc_land_run & ! q2mp - real , specific humidity at 2m ! gflux - real , soil heat flux over land ! runoff - real , surface runoff -! drain - real , subsurface runoff +! drain - real , subsurface runoff +! cmm - real , surface drag wind speed for momentum +! chh - real , surface drag mass flux for heat and moisture ! ==================== end of description ===================== ! ! ! @@ -104,12 +108,13 @@ subroutine sfc_land_run & real (kind=kind_phys), dimension(:), intent(in) :: & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & - & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd + & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd, & + & cmm_lnd, chh_lnd ! --- outputs: real (kind=kind_phys), dimension(:), intent(out) :: & & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & - & runoff, drain + & runoff, drain, cmm, chh ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -138,6 +143,8 @@ subroutine sfc_land_run & gflux(i) = gflux_lnd(i) drain(i) = drain_lnd(i) runoff(i) = runoff_lnd(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) enddo aux2d(:,1) = sncovr1(:) @@ -150,6 +157,8 @@ subroutine sfc_land_run & aux2d(:,8) = gflux(:) aux2d(:,9) = drain(:) aux2d(:,10) = runoff(:) + aux2d(:,11) = cmm(:) + aux2d(:,12) = chh(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index 60a853b89..99a795c65 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -122,6 +122,22 @@ type = real kind = kind_phys intent = in +[cmm_lnd] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land_from_land + long_name = momentum exchange coefficient over land for coupling + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[chh_lnd] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land_from_land + long_name = thermal exchange coefficient over land for coupling + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -202,6 +218,22 @@ type = real kind = kind_phys intent = out +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 91a9b44eac42dfaf047cfc79718fa0332db0979d Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Tue, 7 Mar 2023 22:40:41 -0700 Subject: [PATCH 005/132] add zvfun to land coupling --- physics/sfc_land.f | 15 ++++++++++----- physics/sfc_land.meta | 16 ++++++++++++++++ 2 files changed, 26 insertions(+), 5 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index 0436519a5..44a9b5a06 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -37,10 +37,10 @@ subroutine sfc_land_run & & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & - & runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, + & runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & - & gflux, runoff, drain, cmm, chh, & + & gflux, runoff, drain, cmm, chh, zvfun, & & errmsg, errflg, naux2d, aux2d & ) @@ -56,9 +56,10 @@ subroutine sfc_land_run & ! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! ! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! ! runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, ! +! zvfun_lnd, ! ! outputs: ! ! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! -! gflux, runoff, drain, cmm, chh, ! +! gflux, runoff, drain, cmm, chh, zvfun, ! ! errmsg, errflg) ! ! ! ! ==================== defination of variables ==================== ! @@ -81,6 +82,7 @@ subroutine sfc_land_run & ! drain_lnd - real , subsurface runoff ! cmm_lnd - real , surface drag wind speed for momentum ! chh_lnd - real , surface drag mass flux for heat and moisture +! zvfun_lnd - real , function of surface roughness length and green vegetation fraction ! outputs: ! sncovr1 - real , snow cover over land ! qsurf - real , specific humidity at sfc @@ -94,6 +96,7 @@ subroutine sfc_land_run & ! drain - real , subsurface runoff ! cmm - real , surface drag wind speed for momentum ! chh - real , surface drag mass flux for heat and moisture +! zvfun - real , function of surface roughness length and green vegetation fraction ! ==================== end of description ===================== ! ! ! @@ -109,12 +112,12 @@ subroutine sfc_land_run & real (kind=kind_phys), dimension(:), intent(in) :: & & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd, & - & cmm_lnd, chh_lnd + & cmm_lnd, chh_lnd, zvfun_lnd ! --- outputs: real (kind=kind_phys), dimension(:), intent(out) :: & & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & - & runoff, drain, cmm, chh + & runoff, drain, cmm, chh, zvfun ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -145,6 +148,7 @@ subroutine sfc_land_run & runoff(i) = runoff_lnd(i) cmm(i) = cmm_lnd(i) chh(i) = chh_lnd(i) + zvfun(i) = zvfun_lnd(i) enddo aux2d(:,1) = sncovr1(:) @@ -159,6 +163,7 @@ subroutine sfc_land_run & aux2d(:,10) = runoff(:) aux2d(:,11) = cmm(:) aux2d(:,12) = chh(:) + aux2d(:,13) = zvfun(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index 99a795c65..a146dec3a 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -138,6 +138,14 @@ type = real kind = kind_phys intent = in +[zvfun_lnd] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction_from_land + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -234,6 +242,14 @@ type = real kind = kind_phys intent = out +[zvfun] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 8442a202769b4082d548c4d0d0b5d0c1cb7a80c1 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Wed, 5 Apr 2023 15:49:56 -0600 Subject: [PATCH 006/132] clean sfc_land --- physics/sfc_land.f | 22 +--------------------- physics/sfc_land.meta | 15 --------------- 2 files changed, 1 insertion(+), 36 deletions(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index 44a9b5a06..aec47ff77 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -27,9 +27,6 @@ module sfc_land !! \section detailed Detailed Algorithm !! @{ - -!! use physcons, only : hvap => con_hvap, cp => con_cp, & -!! & rvrdm1 => con_fvirt, rd => con_rd ! !----------------------------------- subroutine sfc_land_run & @@ -41,7 +38,7 @@ subroutine sfc_land_run & ! --- outputs: & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & & gflux, runoff, drain, cmm, chh, zvfun, & - & errmsg, errflg, naux2d, aux2d + & errmsg, errflg & ) ! ===================================================================== ! @@ -122,9 +119,6 @@ subroutine sfc_land_run & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - integer, intent(in) :: naux2d - real(kind_phys), intent(out) :: aux2d(:,:) - ! --- locals: integer :: i @@ -150,20 +144,6 @@ subroutine sfc_land_run & chh(i) = chh_lnd(i) zvfun(i) = zvfun_lnd(i) enddo - - aux2d(:,1) = sncovr1(:) - aux2d(:,2) = qsurf(:) - aux2d(:,3) = hflx(:) - aux2d(:,4) = evap(:) - aux2d(:,5) = ep(:) - aux2d(:,6) = t2mmp(:) - aux2d(:,7) = q2mp(:) - aux2d(:,8) = gflux(:) - aux2d(:,9) = drain(:) - aux2d(:,10) = runoff(:) - aux2d(:,11) = cmm(:) - aux2d(:,12) = chh(:) - aux2d(:,13) = zvfun(:) return !----------------------------------- diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index a146dec3a..979cca377 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -265,18 +265,3 @@ dimensions = () type = integer intent = out -[naux2d] - standard_name = number_of_xy_dimensioned_auxiliary_arrays - long_name = number of 2d auxiliary arrays to output (for debugging) - units = count - dimensions = () - type = integer - intent = in -[aux2d] - standard_name = auxiliary_2d_arrays - long_name = auxiliary 2d arrays to output (for debugging) - units = none - dimensions = (horizontal_loop_extent,number_of_xy_dimensioned_auxiliary_arrays) - type = real - kind = kind_phys - intent = out From 0a71797cac0a52a9b50bd28ab39baae5dfb79772 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Mon, 10 Apr 2023 13:21:54 -0500 Subject: [PATCH 007/132] Adds support for 3-moment rain/graupel/hail in NSSL microphysics scheme Also other various bug fixes etc. --- physics/module_mp_nssl_2mom.F90 | 4774 +++++++++++++++++++++++++++---- physics/mp_nssl.F90 | 78 +- physics/mp_nssl.meta | 38 + 3 files changed, 4371 insertions(+), 519 deletions(-) diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/module_mp_nssl_2mom.F90 index d190e94b4..f2f9707fb 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/module_mp_nssl_2mom.F90 @@ -1,7 +1,14 @@ !> \file module_mp_nssl_2mom.F90 + + + + + + + !--------------------------------------------------------------------- -! code snapshot: "Feb 24 2022" at "14:27:57" +! code snapshot: "Apr 10 2023" at "13:17:29" !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! IMPORTANT: Best results are attained using the 5th-order WENO (Weighted Essentially Non-Oscillatory) advection option (4) for scalars: @@ -19,17 +26,14 @@ ! WENO references: Jiang and Shu, 1996, J. Comp. Phys. v. 126, 202-223; Shu 2003, Int. J. Comp. Fluid Dyn. v. 17 107-118; ! !>\ingroup mod_mp_nssl2m -!! This module provides a 2-moment bulk microphysics scheme described by -!! Mansell, Zeigler, and Bruning (2010, JAS) -!! -!! This module provides a 2-moment bulk microphysics scheme based on a combination of -!! Straka and Mansell (2005, JAM) and Zeigler (1985, JAS) and modified/upgraded in -!! in Mansell, Zeigler, and Bruning (2010, JAS). Two-moment adaptive sedimentation +!! This module provides a 1/2/3-moment bulk microphysics scheme based on a combination of +!! Straka and Mansell (2005, JAM) and Zeigler (1985, JAS) and modified/upgraded in +!! in Mansell, Zeigler, and Bruning (2010, JAS). Two-moment adaptive sedimentation !! follows Mansell (2010, JAS), using parameter infall = 4. !! !! Added info on graupel density and soaking is in Mansell and Ziegler (2013, JAS) !! -!! Average graupel particle density is predicted, which affects fall speed as well. +!! Average graupel particle density is predicted, which affects fall speed as well. !! Hail density prediction is by default disabled in this version, but may be enabled !! at some point if there is interest. !! @@ -37,19 +41,19 @@ !! !! Microphysics References: !! -!! Mansell, E. R., C. L. Ziegler, and E. C. Bruning, 2010: Simulated electrification of a small +!! Mansell, E. R., C. L. Ziegler, and E. C. Bruning, 2010: Simulated electrification of a small !! thunderstorm with two-moment bulk microphysics. J. Atmos. Sci., 67, 171-194, doi:10. 1175/2009JAS2965.1. !! -!! Mansell, E. R. and C. L. Ziegler, 2013: Aerosol effects on simulated storm electrification and -!! precipitation in a two-moment bulk microphysics model. J. Atmos. Sci., 70 (7), 2032-2050, +!! Mansell, E. R. and C. L. Ziegler, 2013: Aerosol effects on simulated storm electrification and +!! precipitation in a two-moment bulk microphysics model. J. Atmos. Sci., 70 (7), 2032-2050, !! doi:10.1175/JAS-D-12-0264.1. !! -!! Ziegler, C. L., 1985: Retrieval of thermal and microphysical variables in observed convective storms. +!! Ziegler, C. L., 1985: Retrieval of thermal and microphysical variables in observed convective storms. !! Part I: Model development and preliminary testing. J. Atmos. Sci., 42, 1487-1509. !! !! Sedimentation reference: !! -!! Mansell, E. R., 2010: On sedimentation and advection in multimoment bulk microphysics. +!! Mansell, E. R., 2010: On sedimentation and advection in multimoment bulk microphysics. !! J. Atmos. Sci., 67, 3084-3094, doi:10.1175/2010JAS3341.1. ! ! Possible parameters to adjust: @@ -63,9 +67,9 @@ ! Fierro, A. O., E.R. Mansell, C. Ziegler and D. R. MacGorman 2013: The ! implementation of an explicit charging and discharge lightning scheme ! within the WRF-ARW model: Benchmark simulations of a continental squall line, a -! tropical cyclone and a winter storm. Monthly Weather Review, Volume 141, 2390-2415 +! tropical cyclone and a winter storm. Monthly Weather Review, Volume 141, 2390-2415 ! -! Mansell et al. 2005: Charge structure and lightning sensitivity in a simulated +! Mansell et al. 2005: Charge structure and lightning sensitivity in a simulated ! multicell thunderstorm. J. Geophys. Res., 110, D12101, doi:10.1029/2004JD005287 ! ! Note: Some parameters below apply to unreleased features. @@ -74,7 +78,7 @@ !--------------------------------------------------------------------- ! Sept. 2021: ! Fixes: -! Restored previous formulation of snow reflectivity, as it was realized that the last change incorrectly assumed a fixed +! Restored previous formulation of snow reflectivity, as it was realized that the last change incorrectly assumed a fixed ! density independent of size. Generally lower snow reflectivity values as a result (no effect on microphysics) ! Other: ! Generic fall speed coeffecients (axx,bxx) to accomodate future frozen drops category (no effect) @@ -234,8 +238,9 @@ MODULE module_mp_nssl_2mom real , private :: qcmincwrn = 2.0e-3 ! qc threshold for autonconversion (LFO; for 10ICE use qminrncw for ircnw != 5) real , private :: cwdiap = 20.0e-6 ! threshold diameter of cloud drops (Ferrier 1994 autoconversion) real , private :: cwdisp = 0.15 ! assume droplet dispersion parameter (can be 0.3 for maritime) - real , private :: ccn = 0.6e+09 ! set in namelist!! Central plains CCN value - real , public :: qccn ! ccn "mixing ratio" + real , private :: ccn = 0.6e+09 ! set in namelist!! Central plains CCN value + real , private :: ccnuf = 0 ! set in namelist!! Central plains CCN value + real , public :: qccn, qccnuf ! ccn "mixing ratio" real , private :: old_qccn = -1.0 integer, private :: iauttim = 1 ! 10-ice rain delay flag real , private :: auttim = 300. ! 10-ice rain delay time @@ -245,12 +250,17 @@ MODULE module_mp_nssl_2mom ! NMM WRF core does not have special boundary conditions for CCN, therefore set invertccn to true logical, parameter :: invertccn = .true. ! =true for base state of ccn=0, =false for ccn initialized in the base state #else - logical, parameter :: invertccn = .false. ! =true for base state of ccn=0, =false for ccn initialized in the base state + logical, private :: invertccn = .false. ! =true for base state of ccn=0, =false for ccn initialized in the base state #endif logical :: switchccn = .false. real :: old_cccn = -1.0 logical :: restoreccn = .true. ! whether or not to nudge CCN back to base state (qccn) (only applies if CCNA is NOT predicted) real :: ccntimeconst = 3600. ! time constant for CCN restore (either for CCNA or when restoreccn = true) + real, private :: restoreccnfrac = 1.0 ! fraction of evaporated droplets that restore CCN + real :: ufccntimeconst = 6.*3600. ! time constant for UFCCN decay (Blossey et al. 2018) + real :: ufbackground = 0.1e9 ! background ccnuf value (Blossey et al.) + logical :: decayufccn = .false. + integer :: i_uf_or_ccn = 0 ! 0 = ship adds UF; 1 = treat UF as regular ccn (add to qccn) ! sedimentation flags ! itfall -> 0 = 1st order fallout (other options removed) @@ -259,6 +269,7 @@ MODULE module_mp_nssl_2mom integer, private :: itfall = 0 integer, private :: iscfall = 1 integer, private :: irfall = -1 + integer, private :: isfall = 2 ! default limit with method II (more restrictive) logical, private :: do_accurate_sedimentation = .true. ! if true, recalculate fall speeds on sub time steps; (more expensive) ! if false, reuse fall speeds on multiple steps (can have a noticeable speedup) ! Mainly is an issue for small dz near the surface. @@ -269,6 +280,7 @@ MODULE module_mp_nssl_2mom ! 3 -> uses number-wgt for N and Z-weighted correction for N (Method I in Mansell, 2010 JAS) ! 4 -> Hybrid of 2 and 3: Uses minimum N from each method (z-wgt and m-wgt corrections) (Method I+II in Mansell, 2010 JAS) ! 5 -> uses number-wgt for N and uses average of N-wgt and q-wgt instead of Max. + integer :: imydiagalpha = 0 ! apply MY diagnostic shape parameter for fall speeds (1=for fall speed only; 2=also for microphysics rates) real, private :: rainfallfac = 1.0 ! factor to adjust rain fall speed (single moment only) real, private :: icefallfac = 1.5 ! factor to adjust ice fall speed real, private :: snowfallfac = 1.25 ! factor to adjust snow fall speed @@ -277,6 +289,9 @@ MODULE module_mp_nssl_2mom integer, private :: icefallopt = 3 ! 1= default, 2 = Ferrier ice fall speed; 3 = adjusted Ferrier (slightly high Vt) integer, private :: icdx = 3 ! (graupel) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. integer, private :: icdxhl = 3 ! (hail) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + real :: axh = 75.7149, bxh = 0.5 + real :: axf = 75.7149, bxf = 0.5 + real :: axhl = 206.984, bxhl = 0.6384 real , private :: cdhmin = 0.45, cdhmax = 0.8 ! defaults for graupel (icdx=4) real , private :: cdhdnmin = 500., cdhdnmax = 800.0 ! defaults for graupel (icdx=4) real , private :: cdhlmin = 0.45, cdhlmax = 0.6 ! defaults for hail (icdx=4) @@ -310,7 +325,7 @@ MODULE module_mp_nssl_2mom integer, private :: irimtim = 0 ! future use ! integer, private :: infdo = 1 ! 1 = calculate number-weighted fall speeds - integer, private :: irimdenopt = 1 ! = 1 for default Macklin; = 2 for experimental Cober and List (1993) + integer, private :: irimdenopt = 1 ! = 1 for default Heymsfield and Pflaum (1985); = 2 for experimental Cober and List (1993); = 3 Macklin real , private :: rimc1 = 300.0, rimc2 = 0.44 ! rime density coeff. and power (Default Heymsfield and Pflaum, 1985) real , private :: rimc3 = 170.0 ! minimum rime density real :: rimc4 = 900.0 ! maximum rime density @@ -347,6 +362,7 @@ MODULE module_mp_nssl_2mom ! 0,2, 5.00e-10, 1, 0, 0, 0 : itype1,itype2,cimas0,icfn,ihrn,ibfc,iacr integer, private :: itype1 = 0, itype2 = 2 ! controls Hallett-Mossop process + integer, private :: in_freeze_rain_first = 0 ! =1 use IN to freezed rain drops (if none, then freeze droplets) integer, private :: icenucopt = 1 ! =1 Meyers/Ferrier primary ice nucleation; =2 Thompson/Cooper, =3 Phillips (Meyers/Demott), =4 DeMott (2010) real, private :: naer = 1.0e6 ! background large aerosol conc. for DeMott integer, private :: icfn = 2 ! contact freezing: 0 = off; 1 = hack (ok for single moment); 2 = full Cotton/Meyers version @@ -357,7 +373,9 @@ MODULE module_mp_nssl_2mom integer, private :: iremoveqwfrz = 1 ! Whether to remove (=1) or not (=0) the newly-frozen cloud droplets (ibfc=1) from the CWC used for charge separation integer, private :: iacr = 2 ! Flag for drop contact freezing with crytals ! (0=off; 1=drops > 500micron diameter; 2 = > 300micron) + integer, private :: icrcev = 1 ! 1 = old crcev; 2 = crcev scaled by vtrain ratio (num/mass); 3 = set to zero integer, private :: icracr = 1 ! Flag to turn rain self-collection on/off (=0 to turn off) + integer, private :: icracrthresh = 1 ! For rain self-coll. thresh. use: 1 = mean diam of 2mm; 2 = rain median volume diam of 1.9mm integer, private :: ibfr = 2 ! Flag for Bigg freezing conversion of freezing drops to graupel ! (1=min graupel size is vr1mm; 2=use min size of dfrz, 5= as for 2 and apply dbz conservation) integer, private :: ibiggopt = 2 ! 1 = old Bigg; 2 = experimental Bigg (only for imurain = 1, however) @@ -413,11 +431,14 @@ MODULE module_mp_nssl_2mom ! set eii1 = 0 to get a constant value of eii0 real , private :: eii0hl = 0.2 ,eii1hl = 0.0 ! hail-crystal coll. eff. parameters: eii0hl*exp(eii1hl*min(temcg(mgs),0.0)) ! set eii1hl = 0 to get a constant value of eii0hl + real, private :: ewi_dcmin = 15.0e-06 ! minimum droplet diameter for nonzero ewi + real, private :: ewi_dimin = 30.0e-06 ! minimum ice crystal diameter for nonzero ewi real , private :: eri0 = 0.1 ! rain efficiency to collect ice crystals real , private :: eri_cimin = 10.e-6 ! minimum ice crystal diameter for collection by rain real , private :: esi0 = 0.1 ! linear factor in snow-ice collection efficiency real , private :: ehs0 = 0.1, ehs1 = 0.1 ! graupel-snow coll. eff. parameters: ehs0*exp(ehs1*min(temcg(mgs),0.0)) ! set ehs1 = 0 to get a constant value of ehs0 + integer :: iessopt = 1 ! 1 = Original (no factor); 2 = factor based on wvel; 3 = factor based on SSI real , private :: ess0 = 0.5, ess1 = 0.05 ! snow aggregation coefficients: ess0*exp(ess1*min(temcg(mgs),0.0)) ! set ess1 = 0 to get a constant value of ess0 real , private :: esstem1 = -15. ! lower temperature where snow aggregation turns on @@ -452,11 +473,13 @@ MODULE module_mp_nssl_2mom ! 0 = no condensation on rain; 1 = bulk condensation on rain integer, parameter, private :: icond = 1 ! (Z only) icond = 1 calculates ice deposition (crystals and snow) BEFORE droplet condensation ! icond = 2 does not work (intended to calc. dep in loop with droplet cond.) + integer, private :: iqis0 = 2 ! = 1 for normal qis; = 2 to set qis to use T = 0C when T > 0C real , private :: dfrz = 0.15e-3 ! 0.25e-3 ! minimum diameter of frozen drops from Bigg freezing (used for vfrz) for iacr > 1 ! and for ciacrf for iacr=4 real , private :: dmlt = 3.0e-3 ! maximum diameter for rain melting from graupel and hail real , private :: dshd = 1.0e-3 ! nominal diameter for rain drops shed from graupel/hail + integer, private :: ivshdgs = 1 ! 0 = use 1mm for all shedding (non-mixedphase); 1 = use vshdgs with sheddiam integer, private :: ished2cld = 0 ! 1: Send shed liquid (from wet growth) to cloud droplets integer, private :: ihmlt = 2 ! 1=old melting with vmlt; 2=new melting using mean volume diam of graupel/hail @@ -480,6 +503,7 @@ MODULE module_mp_nssl_2mom real, private :: qhdpvdn = -1. real, private :: qhacidn = -1. + integer, private :: iraintypes = 0 logical, private :: mixedphase = .false. ! .false.=off, true=on to include mixed phase graupel integer, private :: imixedphase = 0 logical, private :: qsdenmod = .false. ! true = modify snow density by linear interpolation of snow and rain density @@ -514,14 +538,19 @@ MODULE module_mp_nssl_2mom integer, private :: ihlcnh = 1 ! which graupel -> hail conversion to use ! 1 = Milbrandt and Yau (2005) using Ziegler 1985 wet growth diameter ! 2 = Straka and Mansell (2005) conversion using size threshold + ! 3 = Conversion using wet growth diameter real, private :: hlcnhdia = 1.e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 1 option. real, private :: hlcnhqmin = 0.1e-3 ! minimum graupel mass content for graupel -> hail conversion (ihlcnh = 1) real , private :: hldia1 = 20.0e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 2 option. + integer :: incwet = 0 ! flag to do wet growth only on D > D_wet integer, private :: iusedw = 0 ! flag to use experimental wet growth ice diameter for gr -> hl conversion (=1 turns on) - real , private :: dwmin = 0.0 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwmin = 5.0e-3 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwetmin = 5.0e-3 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) real , private :: dwtempmin = 242. ! lowest temperature to allow wet growth conversion to hail real , private :: dwehwmin = 0. ! Minimum ehw to use to find wet growth diameter (if > ehw0, then wet growth diam becomes smaller) real , private :: dg0thresh = 0.15 ! graupel wet growth diameter above which we say do not bother + integer :: ifddenfac = 0 ! = 1 to use density threshold to count FD as GR when converting to HL + real :: fddenthresh = 500. ! if ifddenfac > 0, then hail from FD with lower density are considered to come from graupel integer :: icvhl2h = 0 ! allow conversion of hail back to graupel when hail density gets close to minimum allowed integer, private :: imurain = 1 ! 3 for gamma-volume, 1 for gamma-diameter DSD for rain. @@ -538,6 +567,8 @@ MODULE module_mp_nssl_2mom ! = 1 use mean diameter for breakup ! = 2 use maximum mass diameter for breakup ! = 3 use mass-weighted diameter for breakup + integer :: iraintailbreak = 0 ! 1 = on + real :: draintail = 8.e-3 ! starting size for rain breakup integer, private :: dmrauto = 0 ! = -1 no limiter on crcnw ! = 0 limit crcnw when qr > 1.2*L (Cohard-Pinty 2002) @@ -595,9 +626,12 @@ MODULE module_mp_nssl_2mom integer, private :: ibinnum = 2 ! number of bins for melting of smaller ice (for ibinhmlr = 1) integer, private :: iqhacrmlr = 1 ! turn on/off qhacrmlr integer, private :: iqhlacrmlr = 1 ! turn on/off qhlacrmlr + integer, private :: iqhacwshr = 1 ! turn on/off qhacw for T > 0 + integer, private :: iqhlacwshr = 1 ! turn on/off qhlacw for T > 0 real, private :: binmlrmxdia = 40.e-3 ! threshold diameter (graupel/hail) to switch bin-bulk melting to use standard chmlr real, private :: binmlrzrrfac = 1.0 ! factor for reflectivity change ice that sheds while melting real, private :: snowmeltdia = 0 ! If nonzero, sets the size of rain drops from melting snow. + real, private :: alphasmlr0 = 14.0 ! shape parameter for drops formed from melting/shedding snow real, private :: delta_alphamlr = 0.5 ! offset from alphamax at which melting does not further collapse the shape parameter integer :: iqvsopt = 0 ! =0 use old default for tabqvs; =1 use Bolton formulation (Rogers and Yau) @@ -739,6 +773,7 @@ MODULE module_mp_nssl_2mom real da1 (lc:lqmx) ! collection coefficients from Seifert 2005 real bb (lc:lqmx) + ! put ipelec here for now.... integer :: ipelec = 0 integer :: isaund = 0 @@ -764,7 +799,7 @@ MODULE module_mp_nssl_2mom double precision, parameter :: dgam = 0.01, dgami = 100. double precision gmoi(0:ngm0) ! ,gmod(0:ngm1,0:ngm2),gmdi(0:ngm1,0:ngm2) - integer, parameter :: nqiacralpha = 240 !480 ! 240 ! 120 ! 15 + integer, parameter :: nqiacralpha = 300 !480 ! 240 ! 120 ! 15 integer, parameter :: nqiacrratio = 100 ! 500 !50 ! 25 ! real, parameter :: maxratiolu = 25. real, parameter :: maxratiolu = 100. ! 25. @@ -782,6 +817,10 @@ MODULE module_mp_nssl_2mom ! real :: ziacrratio(0:nqiacrratio,0:nqiacralpha) ! double precision :: gamxinflu(0:nqiacrratio,0:nqiacralpha,12,2) ! last index for graupel (1) or hail (2) +! for 3-moment collection coefficients + real, save :: dab0lu(ialpstart:nqiacralpha,ialpstart:nqiacralpha,lc:lqmx,lc:lqmx) ! collection coefficients from Seifert 2005 + real, save :: dab1lu(ialpstart:nqiacralpha,ialpstart:nqiacralpha,lc:lqmx,lc:lqmx) ! collection coefficients from Seifert 2005 + integer, parameter :: ngdnmm = 9 real :: mmgraupvt(ngdnmm,3) ! Milbrandt and Morrison (2013) fall speed coefficients for graupel/hail @@ -914,6 +953,7 @@ MODULE module_mp_nssl_2mom real :: tfrcbw real :: tfrcbi real :: rovcp + real, public :: rdorv = 0.622 real, parameter :: poo = 1.0e+05 real, parameter :: advisc0 = 1.832e-05 ! reference dynamic viscosity (SMT; see Beard & Pruppacher 71) @@ -955,7 +995,7 @@ MODULE module_mp_nssl_2mom ! Note to users: Many of these options are for development and not guaranteed to perform well. ! Some may not be functional depending on the version of the code. -! Some may be useful for ensemble physics diversity. Feel free to contact me if you have questions +! Some may be useful for ensemble physics diversity. Feel free to contact Ted Mansell if you have questions ! in that regard. NAMELIST /nssl_mp_params/ & ndebug, ncdebug,& @@ -965,7 +1005,7 @@ MODULE module_mp_nssl_2mom idbzci, & vtmaxsed, & itfall,iscfall, & - infall, & + infall,irfall,isfall, & rssflg, & sssflg, & hssflg, & @@ -976,13 +1016,15 @@ MODULE module_mp_nssl_2mom icnuclimit, & irenuc, & restoreccn, ccntimeconst, cck, & + decayufccn, ufccntimeconst, & switchccn, old_cccn, & ciintmx, & itype1, itype2, & - icenucopt, & + icenucopt, in_freeze_rain_first, & naer, & icfn, & ibfc, iacr, icracr, & + icracrthresh, & cwfrz2snowfrac, cwfrz2snowratio, & ibfr, & ibiggopt, & @@ -998,7 +1040,7 @@ MODULE module_mp_nssl_2mom eri_cimin, & eii0hl, eii1hl, & ehs0, ehs1, & - ess0, ess1, & + ess0, ess1, iessopt, & esstem1,esstem2, & ircnw, qminrncw,& ! single-moment only iglcnvi, & @@ -1024,6 +1066,7 @@ MODULE module_mp_nssl_2mom hailfallfac, & icefallopt, & icdx,icdxhl, & + axh,bxh,axf,bxf,axhl,bxhl, & cdhmin, cdhmax, & cdhdnmin, cdhdnmax, & cdhlmin, cdhlmax, & @@ -1133,12 +1176,12 @@ SUBROUTINE nssl_2mom_init_const( & real, intent(in) :: con_g, con_rd, con_cp, con_rv, & con_t0c, con_cliq, con_csol, con_eps - cp608 = con_eps ! 0.608 ! constant used in conversion of T to Tv gr = con_g tfr = con_t0c cp = con_cp rd = con_rd rw = con_rv + rdorv = con_eps cpl = con_cliq ! 4190.0 cpigb = con_csol ! 2106.0 cpi = 1./cp @@ -1157,6 +1200,7 @@ END SUBROUTINE nssl_2mom_init_const !! NSSL MP setup routine (sets local options and array indices) SUBROUTINE nssl_2mom_init( & & ims,ime, jms,jme, kms,kme, nssl_params, ipctmp, mixphase,ihvol,idoniconlytmp, & + & igvol, & & nssl_graupelfallfac, & & nssl_hailfallfac, & & nssl_ehw0, & @@ -1165,7 +1209,13 @@ SUBROUTINE nssl_2mom_init( & & nssl_icdxhl, & & nssl_icefallfac, & & nssl_snowfallfac, & + & nssl_cccn, & + & nssl_ufccn, & + & nssl_alphah, & + & nssl_alphahl, & + & nssl_alphar, & & errmsg, errflg, & + & infileunit, & & myrank, mpiroot & ) @@ -1177,22 +1227,30 @@ SUBROUTINE nssl_2mom_init( & & nssl_ehw0, & & nssl_ehlw0, & & nssl_icefallfac, & - & nssl_snowfallfac + & nssl_snowfallfac, & + & nssl_cccn, & + & nssl_alphah, & + & nssl_alphahl, & + & nssl_alphar integer, intent(in), optional :: & - & nssl_icdx, & - & nssl_icdxhl, myrank, mpiroot + & nssl_icdx, igvol, & + & nssl_icdxhl, myrank, mpiroot, & + & nssl_ufccn + + integer, intent(in),optional :: infileunit ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg - integer, intent(in) :: ims,ime, jms,jme, kms,kme - real, intent(in), dimension(20) :: nssl_params + integer, intent(in), optional :: ims,ime, jms,jme, kms,kme + real, intent(in), dimension(20), optional :: nssl_params integer, intent(in) :: ipctmp,mixphase,ihvol logical, optional, intent(in) :: idoniconlytmp + integer :: igvol_local = 1 logical :: wrote_namelist = .false. logical :: wrf_dm_on_monitor @@ -1202,22 +1260,31 @@ SUBROUTINE nssl_2mom_init( & integer :: i,il,j,l integer :: ltmp integer :: isub - real :: bxh,bxhl + real :: bxh1,bxhl1 real :: alp,ratio double precision :: x,y,y2,y7 logical :: turn_on_ccna, turn_on_cina + integer :: iufccn = 0 integer :: istat + + real :: alpjj, alpii, xnuii, xnujj + integer :: ii, jj errmsg = '' errflg = 0 turn_on_ccna = .false. turn_on_cina = .false. + + IF ( present( igvol ) ) THEN + igvol_local = igvol + ENDIF ! ! set some global values from namelist input ! + IF ( present( nssl_params ) ) THEN ccn = Abs( nssl_params(1) ) alphah = nssl_params(2) alphahl = nssl_params(3) @@ -1228,8 +1295,16 @@ SUBROUTINE nssl_2mom_init( & rho_qh = nssl_params(8) rho_qhl = nssl_params(9) rho_qs = nssl_params(10) - alphar = nssl_params(14) - + IF ( Nint(nssl_params(13)) == 1 ) THEN + ! hack to switch CCN field to CCNA (activated ccn) +! invertccn = .true. + turn_on_ccna = .true. + irenuc = 7 + ENDIF + ccnuf = Abs( nssl_params(14) ) + IF ( present(nssl_ufccn) ) iufccn = nssl_ufccn + + ENDIF ! ipelec = Nint(nssl_params(11)) ! isaund = Nint(nssl_params(12)) IF ( present(nssl_graupelfallfac) ) graupelfallfac = nssl_graupelfallfac @@ -1240,14 +1315,12 @@ SUBROUTINE nssl_2mom_init( & IF ( present(nssl_icdxhl) ) icdxhl = nssl_icdxhl IF ( present(nssl_icefallfac) ) icefallfac = nssl_icefallfac IF ( present(nssl_snowfallfac) ) snowfallfac = nssl_snowfallfac + IF ( present(nssl_cccn) ) ccn = nssl_cccn + IF ( present(nssl_alphah) ) alphah = nssl_alphah + IF ( present(nssl_alphahl) ) alphahl = nssl_alphahl + IF ( present(nssl_alphar) ) alphar = nssl_alphar - IF ( Nint(nssl_params(13)) == 1 ) THEN - ! hack to switch CCN field to CCNA (activated ccn) -! invertccn = .true. - turn_on_ccna = .true. - irenuc = 7 - ENDIF @@ -1275,6 +1348,15 @@ SUBROUTINE nssl_2mom_init( & + IF ( iufccn > 0 ) THEN ! make sure to use option that uses UF ccn + irenuc = 7 + IF ( ccnuf <= 0.0 ) decayufccn = .true. ! assume surface emission and need decay + IF ( i_uf_or_ccn > 0 ) THEN + ufbackground = 0.0 + ccntimeconst = ufccntimeconst + ENDIF + ENDIF + IF ( irenuc >= 5 ) THEN turn_on_ccna = .true. ENDIF @@ -1300,7 +1382,7 @@ SUBROUTINE nssl_2mom_init( & ! dfrz = Max( dfrz, 0.5e-3 ) ENDIF IF ( ihvol == -2 .or. ihvol == 2 ) THEN ! ice crystals are turned off - ! a value of -3 means to turn off ice crystals but turn on hail + ! a value of 2? means to turn off ice crystals but turn on hail renucfrac = 1.0 ffrzs = 1.0 ! idoci = 0 ! try this later @@ -1335,29 +1417,42 @@ SUBROUTINE nssl_2mom_init( & bx(lr) = 0.85 ax(lr) = 1647.81 fx(lr) = 135.477 + IF ( icdx == 6 ) THEN bx(lh) = 0.6 ! Milbrandt and Morrison (2013) for density of 550. ax(lh) = 157.71 - ELSEIF ( icdx > 0 ) THEN +! ELSEIF ( icdx == 1 ) THEN +! bx(lh) = bxh +! ax(lh) = axh + ELSEIF ( icdx > 1 ) THEN bx(lh) = 0.5 ax(lh) = 75.7149 - ELSE - bx(lh) = 0.37 ! 0.6 ! Ferrier 1994 + ELSEIF ( icdx == 0 ) THEN + bx(lh) = 0.37 ! 0.6 ! Ferrier 1994 graupel ax(lh) = 19.3 + ELSE ! icdx < 0 +! ax(lh) = 206.984 ! Ferrier 1994 hail/frozen drops +! bx(lh) = 0.6384 + bx(lh) = bxh + ax(lh) = axh ENDIF + ! bx(lh) = 0.6 IF ( lhl .gt. 1 ) THEN IF ( icdxhl == 6 ) THEN bx(lhl) = 0.593 ! Milbrandt and Morrison (2013) for density of 750. ax(lhl) = 179.36 + ELSEIF (icdxhl == 0 ) THEN + ax(lhl) = 206.984 ! Ferrier 1994 + bx(lhl) = 0.6384 ELSEIF (icdxhl > 0 ) THEN - bx(lhl) = 0.5 - ax(lhl) = 75.7149 + bx(lhl) = 0.5 + ax(lhl) = 75.7149 ELSE - ax(lhl) = 206.984 ! Ferrier 1994 - bx(lhl) = 0.6384 + bx(lhl) = bxhl + ax(lhl) = axhl ENDIF ENDIF @@ -1373,8 +1468,8 @@ SUBROUTINE nssl_2mom_init( & ! Uses incomplete gamma functions ! The terms with bxh or bxhl will be off if the actual bxh or bxhl is different from the base value (icdx=6 option) - bxh = bx(lh) - bxhl = bx(Max(lh,lhl)) + bxh1 = bx(lh) + bxhl1 = bx(Max(lh,lhl)) ! DO j = 0,nqiacralpha DO j = ialpstart,nqiacralpha @@ -1390,9 +1485,9 @@ SUBROUTINE nssl_2mom_init( & ! graupel (.,.,.,1) gamxinflu(i,j,1,1) = x/y gamxinflu(i,j,2,1) = gamxinfdp( 2.0+alp, ratio )/y - gamxinflu(i,j,3,1) = gamxinfdp( 2.5+alp+0.5*bxh, ratio )/y + gamxinflu(i,j,3,1) = gamxinfdp( 2.5+alp+0.5*bxh1, ratio )/y gamxinflu(i,j,5,1) = (gamma_dpr(5.0+alp) - gamxinfdp( 5.0+alp, ratio ))/y - gamxinflu(i,j,6,1) = (gamma_dpr(5.5+alp+0.5*bxh) - gamxinfdp( 5.5+alp+0.5*bxh, ratio ))/y + gamxinflu(i,j,6,1) = (gamma_dpr(5.5+alp+0.5*bxh1) - gamxinfdp( 5.5+alp+0.5*bxh1, ratio ))/y gamxinflu(i,j,9,1) = gamxinfdp( 1.0+alp, ratio )/y gamxinflu(i,j,10,1)= gamxinfdp( 4.0+alp, ratio )/y @@ -1401,9 +1496,9 @@ SUBROUTINE nssl_2mom_init( & ! hail (.,.,.,2) gamxinflu(i,j,1,2) = gamxinflu(i,j,1,1) gamxinflu(i,j,2,2) = gamxinflu(i,j,2,1) - gamxinflu(i,j,3,2) = gamxinfdp( 2.5+alp+0.5*bxhl, ratio )/y + gamxinflu(i,j,3,2) = gamxinfdp( 2.5+alp+0.5*bxhl1, ratio )/y gamxinflu(i,j,5,2) = gamxinflu(i,j,5,1) - gamxinflu(i,j,6,2) = (gamma_dpr(5.5+alp+0.5*bxhl) - gamxinfdp( 5.5+alp+0.5*bxhl, ratio ))/y + gamxinflu(i,j,6,2) = (gamma_dpr(5.5+alp+0.5*bxhl1) - gamxinfdp( 5.5+alp+0.5*bxhl1, ratio ))/y gamxinflu(i,j,9,2) = gamxinflu(i,j,9,1) gamxinflu(i,j,10,2)= gamxinflu(i,j,10,1) @@ -1411,16 +1506,16 @@ SUBROUTINE nssl_2mom_init( & ! gamxinflu(i,j,7,1) = gamxinfdp( alp - 1., ratio )/y gamxinflu(i,j,7,1) = (gamma_dpr(alp - 1.) - gamxinfdp( alp - 1., ratio ))/y ! gamxinflu(i,j,8,1) = gamxinfdp( alp - 0.5 + 0.5*bxh, ratio )/y - gamxinflu(i,j,8,1) = (gamma_dpr(alp - 0.5 + 0.5*bxh) - gamxinfdp( alp - 0.5 + 0.5*bxh, ratio ))/y -! gamxinflu(i,j,8,2) = gamxinfdp( alp - 0.5 + 0.5*bxhl, ratio )/y - gamxinflu(i,j,8,2) = (gamma_dpr(alp - 0.5 + 0.5*bxhl) - gamxinfdp( alp - 0.5 + 0.5*bxhl, ratio ))/y + gamxinflu(i,j,8,1) = (gamma_dpr(alp - 0.5 + 0.5*bxh1) - gamxinfdp( alp - 0.5 + 0.5*bxh1, ratio ))/y +! gamxinflu(i,j,8,2) = gamxinfdp( alp - 0.5 + 0.5*bxhl1, ratio )/y + gamxinflu(i,j,8,2) = (gamma_dpr(alp - 0.5 + 0.5*bxhl1) - gamxinfdp( alp - 0.5 + 0.5*bxhl1, ratio ))/y ELSE ! gamxinflu(i,j,7,1) = gamxinfdp( .1, ratio )/y gamxinflu(i,j,7,1) = (gamma_dpr(0.1) - gamxinfdp( 0.1, ratio ) )/y -! gamxinflu(i,j,8,1) = gamxinfdp( 1.1 - 0.5 + 0.5*bxh, ratio )/y -! gamxinflu(i,j,8,2) = gamxinfdp( 1.1 - 0.5 + 0.5*bxhl, ratio )/y - gamxinflu(i,j,8,1) = (gamma_dpr(1.1 - 0.5 + 0.5*bxh) - gamxinfdp( 1.1 - 0.5 + 0.5*bxh, ratio ) )/y - gamxinflu(i,j,8,2) = (gamma_dpr(1.1 - 0.5 + 0.5*bxhl) - gamxinfdp( 1.1 - 0.5 + 0.5*bxhl, ratio ) )/y +! gamxinflu(i,j,8,1) = gamxinfdp( 1.1 - 0.5 + 0.5*bxh1, ratio )/y +! gamxinflu(i,j,8,2) = gamxinfdp( 1.1 - 0.5 + 0.5*bxhl1, ratio )/y + gamxinflu(i,j,8,1) = (gamma_dpr(1.1 - 0.5 + 0.5*bxh1) - gamxinfdp( 1.1 - 0.5 + 0.5*bxh1, ratio ) )/y + gamxinflu(i,j,8,2) = (gamma_dpr(1.1 - 0.5 + 0.5*bxhl1) - gamxinfdp( 1.1 - 0.5 + 0.5*bxhl1, ratio ) )/y ENDIF gamxinflu(i,j,7,2) = gamxinflu(i,j,7,1) @@ -1457,6 +1552,7 @@ SUBROUTINE nssl_2mom_init( & isub = Min( 0, Max(-1,ihvol) ) ! is -1 or 0 lccn = 0 + lccnuf = 0 lccna = 0 lnc = 0 lnr = 0 @@ -1490,21 +1586,29 @@ SUBROUTINE nssl_2mom_init( & lhl = 0 ENDIF ELSEIF ( ipconc == 5 ) THEN - lccn = lhab+1 ! 9 - lnc = lhab+2 ! 10 - lnr = lhab+3 ! 11 - lni = lhab+4 !12 - lns = lhab+5 !13 - lnh = lhab+6 !14 + ltmp = lhab + IF ( iufccn > 0 ) THEN + ltmp = ltmp+1 + lccnuf = ltmp + denscale(lccnuf) = 1 + ENDIF + lccn= ltmp+1 ! 9 + lnc = ltmp+2 ! 10 + lnr = ltmp+3 ! 11 + lni = ltmp+4 !12 + lns = ltmp+5 !13 + lnh = ltmp+6 !14 ltmp = lnh IF ( ihvol >= 0 ) THEN ltmp = ltmp + 1 lnhl = ltmp ! lhab+7 ! 15 ENDIF + IF ( igvol_local >= 1 ) THEN ltmp = ltmp + 1 lvh = ltmp ! lhab+8 + isub ! 16 + isub ! isub adjusts to 15 if hail is off ! ltmp = lvh - denscale(lccn:lvh) = 1 + ENDIF + denscale(lccn:ltmp) = 1 IF ( ihvol >= 1 ) THEN ltmp = ltmp + 1 lvhl = ltmp @@ -1523,24 +1627,30 @@ SUBROUTINE nssl_2mom_init( & ! ltmp = lhlw ENDIF ELSEIF ( ipconc >= 6 ) THEN - errmsg = 'NSSL microphysics has not been compiled for 3-moment. Sorry.' - errflg = 1 - return - lccn = lhab+1 ! 9 - lnc = lhab+2 ! 10 - lnr = lhab+3 ! 11 - lni = lhab+4 !12 - lns = lhab+5 !13 - lnh = lhab+6 !14 + ltmp = lhab + IF ( iufccn > 0 ) THEN + ltmp = ltmp+1 + lccnuf = ltmp + denscale(lccnuf) = 1 + ENDIF + write(0,*) 'nsslwrf: lccnuf = ',lccnuf + lccn= ltmp+1 ! 9 + lnc = ltmp+2 ! 10 + lnr = ltmp+3 ! 11 + lni = ltmp+4 !12 + lns = ltmp+5 !13 + lnh = ltmp+6 !14 ltmp = lnh IF ( lhl > 0 ) THEN ltmp = ltmp + 1 lnhl = ltmp ! lhab+7 ! 15 ENDIF + IF ( igvol_local >= 1 ) THEN ltmp = ltmp + 1 lvh = ltmp ! lhab+8 + isub ! 16 + isub ! isub adjusts to 15 if hail is off + ENDIF ! ltmp = lvh - denscale(lccn:lvh) = 1 + denscale(lccn:ltmp) = 1 IF ( ihvol >= 1 ) THEN ltmp = ltmp + 1 lvhl = ltmp @@ -1825,9 +1935,11 @@ SUBROUTINE nssl_2mom_init( & IF ( lhl .gt. 1 ) ido(lhl) = idohl IF ( irfall .lt. 0 ) irfall = infall + IF ( isfall .lt. 0 ) isfall = infall IF ( lzr > 0 ) irfall = 0 qccn = ccn/rho00 + qccnuf = ccnuf/rho00 IF ( old_cccn > 0.0 ) THEN old_qccn = old_cccn/rho00 ELSE @@ -1981,6 +2093,33 @@ SUBROUTINE nssl_2mom_init( & ENDDO ENDDO + dab0lu(:,:,:,:) = 0.0 + dab1lu(:,:,:,:) = 0.0 + + IF ( ipconc >= 6 ) THEN + DO il = lc,lhab ! collector + DO j = lc,lhab ! collected + IF ( il .ne. j ) THEN + + DO jj = ialpstart,nqiacralpha + alpjj = float(jj)*dqiacralpha + xnujj = (alpjj - 2.)/3. + DO ii = ialpstart,nqiacralpha + alpii = float(ii)*dqiacralpha + xnuii = (alpii - 2.)/3. + + dab0lu(ii,jj,il,j) = delabk(bb(il), bb(j), xnuii, xnujj, xmu(il), xmu(j), 0) + dab1lu(ii,jj,il,j) = delabk(bb(il), bb(j), xnuii, xnujj, xmu(il), xmu(j), 1) + + ENDDO + ENDDO +! write(0,*) 'il, j, dab0, dab1 = ',il, j, dab0(il,j), dab1(il,j) + ENDIF + ENDDO + ENDDO + + ENDIF + gf4br = gamma_sp(4.0+br) gf4ds = gamma_sp(4.0+ds) gf4p5 = gamma_sp(4.0+0.5) @@ -2029,10 +2168,12 @@ END SUBROUTINE nssl_2mom_init !>\ingroup mod_nsslmp !! Driver subroutine that copies state data to local 2D arrays for microphysics calls SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw, chl, & - cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, & - zrw, zhw, zhl, & + cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, & + cnuf, f_cnuf, & + zrw, zhw, zhl, f_zrw, f_zhw, f_zhl, f_vhw, f_vhl, & qsw, qhw, qhlw, & tt, th, pii, p, w, dn, dz, dtp, itimestep, & + ntmul, ntcnt, lastloop, & RAINNC,RAINNCV, & dx, dy, & axtra, & @@ -2091,7 +2232,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw zrw, zhw, zhl, & qsw, qhw, qhlw, & qi,qhl,ccw,crw,cci,csw,chw,chl,vhw,vhl - real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: dbz, vzf, cn, cna, cni + logical, optional, intent(in) :: f_zrw, f_zhw, f_zhl, f_vhw, f_vhl ! not used yet + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: dbz, vzf, cn, cna, cni, cnuf real, dimension(ims:ime, jms:jme), optional, intent(inout):: compdbz real, dimension(ims:ime, jms:jme), optional, intent(inout):: rscghis_2d, & ! 2D accumulation arrays for vertically-integrated charging rate rscghis_2dp, & ! 2D accumulation arrays for vertically-integrated charging rate (positive only) @@ -2102,8 +2244,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw scr,scw,sci,scs,sch,schl,sciona,sctot ! space charge real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & induc,noninduc,noninducp,noninducn ! charging rates: inductive, noninductive (all, positive, negative to graupel) - real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: elecz ! elecsave = Ez - real, dimension(ims:ime, kms:kme, jms:jme,2),optional, intent(inout) :: scion + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: elecz ! elecsave = Ez + real, dimension(ims:ime, kms:kme, jms:jme,2),optional, intent(inout) :: scion real, dimension(ims:ime, kms:kme, jms:jme), intent(in):: p,w,dz,dn real, dimension(ims:ime, kms:kme, jms:jme), intent(in):: pii @@ -2139,7 +2281,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, optional, intent(in) :: dx,dy real, intent(in):: dtp integer, intent(in):: itimestep !, ccntype - logical, optional, intent(in) :: diagflag, f_cna, f_cn, f_cina + integer, intent(in), optional :: ntmul, ntcnt + logical, optional, intent(in) :: lastloop + logical, optional, intent(in) :: diagflag, f_cna, f_cn, f_cina, f_cnuf integer, optional, intent(in) :: ipelectmp, ke_diag ! CCPP error handling @@ -2151,6 +2295,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional,INTENT(INOUT):: qndrop LOGICAL :: flag_qndrop ! wrf-chem LOGICAL :: flag_qnifa , flag_qnwfa + logical :: flag_cnuf = .false. logical :: flag real :: cinchange, t7max,testmax,wmax @@ -2223,6 +2368,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real :: fach(kts:kte) logical, parameter :: debugdriver = .false. + + integer :: loopcnt, loopmax, outerloopcnt + logical :: lastlooptmp #ifdef MPI @@ -2246,12 +2394,21 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw flag_qndrop = .false. flag_qnifa = .false. flag_qnwfa = .false. + flag_cnuf = .false. IF ( PRESENT ( nssl_progn ) ) flag_qndrop = nssl_progn + IF ( present ( f_cnuf ) ) flag_cnuf = f_cnuf - - + loopmax = 1 + outerloopcnt = 1 + lastlooptmp = .true. + IF ( present( ntmul ) .and. present( ntcnt ) .and. present( lastloop ) ) THEN + loopmax = ntmul + outerloopcnt = ntcnt + lastlooptmp = lastloop + ENDIF + ! --- IF ( present( f_cna ) ) THEN @@ -2365,6 +2522,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ancuten(its:ite,1,kts:kte,:) = 0.0 thproclocal(:,:) = 0.0 + DO jy = jts,jye xfall(:,:,:) = 0.0 @@ -2408,6 +2566,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ELSE an(ix,1,kz,lccn) = cn(ix,kz,jy) ENDIF + IF ( i_uf_or_ccn > 0 .and. lccnuf > 1 ) THEN ! UF ccn are extra regular ccn + an(ix,1,kz,lccn) = an(ix,1,kz,lccn) + cnuf(ix,kz,jy) + ENDIF ELSE IF ( lccna == 0 .and. ( .not. f_cnatmp ) ) THEN an(ix,1,kz,lccn) = qccn - ccw(ix,kz,jy) @@ -2418,6 +2579,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDIF + IF ( lccnuf > 0 .and. flag_cnuf ) THEN + IF ( i_uf_or_ccn == 0 ) THEN ! UF are UF + an(ix,1,kz,lccnuf) = Max(0.0, cnuf(ix,kz,jy) ) + ELSE ! UF were added to lccn + an(ix,1,kz,lccnuf) = 0.0 + ENDIF + ENDIF + IF ( lccna > 1 ) THEN IF ( present( cna ) .and. f_cnatmp ) THEN an(ix,1,kz,lccna) = cna(ix,kz,jy) @@ -2448,9 +2617,19 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lvh > 0 ) an(ix,1,kz,lvh) = vhw(ix,kz,jy) IF ( lvhl > 0 .and. present( vhl ) ) an(ix,1,kz,lvhl) = vhl(ix,kz,jy) + IF ( ipconc >= 6 ) THEN + IF ( lzr > 0 ) an(ix,1,kz,lzr) = zrw(ix,kz,jy)*zscale + IF ( lzh > 0 ) an(ix,1,kz,lzh) = zhw(ix,kz,jy)*zscale + IF ( lzhl > 0 ) an(ix,1,kz,lzhl) = zhl(ix,kz,jy)*zscale + ENDIF + ENDDO + ENDDO + + DO kz = kts,kte + DO ix = its,ite IF ( present( tt ) ) THEN @@ -2458,6 +2637,26 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ELSE t0(ix,1,kz) = th(ix,kz,jy)*pii(ix,kz,jy) ! temperature (Kelvin) ENDIF + t00(ix,1,kz) = 380.0/p(ix,kz,jy) + t77(ix,1,kz) = pii(ix,kz,jy) + dbz2d(ix,1,kz) = 0.0 + vzf2d(ix,1,kz) = 0.0 + ENDDO + ENDDO + + DO ix = its,ite + RAINNCV(ix,jy) = 0.0 + IF ( present( GRPLNCV ) ) GRPLNCV(ix,jy) = 0.0 + IF ( present( HAILNCV ) ) HAILNCV(ix,jy) = 0.0 + IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = 0.0 + ENDDO + + DO loopcnt = 1,loopmax + + DO kz = kts,kte + DO ix = its,ite + + t1(ix,1,kz) = 0.0 t2(ix,1,kz) = 0.0 t3(ix,1,kz) = 0.0 @@ -2467,14 +2666,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw t7(ix,1,kz) = 0.0 t8(ix,1,kz) = 0.0 t9(ix,1,kz) = 0.0 - t00(ix,1,kz) = 380.0/p(ix,kz,jy) - t77(ix,1,kz) = pii(ix,kz,jy) - dbz2d(ix,1,kz) = 0.0 - vzf2d(ix,1,kz) = 0.0 - dn1(ix,1,kz) = dn(ix,kz,jy) pn(ix,1,kz) = p(ix,kz,jy) wn(ix,1,kz) = w(ix,kz,jy) +! calculate dn1 in case we are substepping: rho = con_eps*prsl/(con_rd*tgrs*(qv_mp+con_eps)) + dn1(ix,1,kz) = rdorv*pn(ix,1,kz)/(rd*t0(ix,1,kz)*(an(ix,1,kz,lv) + rdorv)) ! wmax = Max(wmax,wn(ix,1,kz)) dz2d(ix,1,kz) = dz(ix,kz,jy) dz2dinv(ix,1,kz) = 1./dz(ix,kz,jy) @@ -2544,19 +2740,19 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ELSEIF ( icenucopt == 4 ) THEN ! DeMott 2010 - IF ( t0(ix,jy,kz) < 268.16 .and. t0(ix,jy,kz) > 223.15 .and. ssival > 1.001 ) THEN ! + IF ( t0(ix,1,kz) < 268.16 .and. t0(ix,1,kz) > 223.15 .and. ssival > 1.001 ) THEN ! ! a = 0.0000594, b = 3.33, c = 0.0264, d = 0.0033, ! nint = a*(-Tc)**b * naer**(c*(-Tc) + d) ! nint has units of per (standard) liter, so mult by 1.e3 and scale by dn/rho00 ! naer needs units of cm**-3, so mult by 1.e-6 - ! dp1 = 1.e3*0.0000594*(273.16 - t0(ix,jy,kz))**3.33 * (1.e-6*cin*dn(ix,jy,kz))**(0.0264*(273.16 - t0(ix,jy,kz)) + 0.0033) - dp1 = 1.e3*dn(ix,jy,kz)/rho00*0.0000594*(273.16 - t0(ix,jy,kz))**3.33 * (1.e-6*naer)**(0.0264*(273.16 - t0(ix,jy,kz)) + 0.0033) - t7(ix,jy,kz) = Min(dp1, 1.0d30) + ! dp1 = 1.e3*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * (1.e-6*cin*dn(ix,1,kz))**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) + dp1 = 1.e3*dn1(ix,1,kz)/rho00*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * (1.e-6*naer)**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) + t7(ix,1,kz) = Min(dp1, 1.0d30) ELSE - t7(ix,jy,kz) = 0.0 + ! t7(ix,1,kz) = 0.0 ENDIF ENDIF ! icenucopt @@ -2583,25 +2779,29 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! transform from number mixing ratios to number conc. + IF ( loopcnt == 1 ) THEN DO il = lnb,na IF ( denscale(il) == 1 ) THEN DO kz = kts,kte DO ix = its,ite - an(ix,1,kz,il) = an(ix,1,kz,il)*dn(ix,kz,jy) + an(ix,1,kz,il) = an(ix,1,kz,il)*dn1(ix,1,kz) ! dn(ix,kz,jy) ENDDO ENDDO ENDIF ENDDO ! il + ENDIF + ! sedimentation xfall(:,:,:) = 0.0 - IF ( .true. ) THEN + +! IF ( .true. ) THEN ! #ifndef CM1 ! for real cases when hydrometeor mixing ratios have been initialized without concentrations - IF ( itimestep == 1 .and. ipconc > 0 ) THEN + IF ( itimestep == 1 .and. ipconc > 0 .and. loopcnt == 1 ) THEN call calcnfromq(nx,ny,nz,an,na,nor,nor,dn1) ENDIF ! IF ( itimestep == 3 .and. ipconc > 0 ) THEN @@ -2611,9 +2811,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( present(cu_used) .and. & ( present( qrcuten ) .or. present( qscuten ) .or. & - present( qicuten ) .or. present( qccuten ) ) ) THEN + present( qicuten ) .or. present( qccuten ) ) ) THEN !{ - IF ( cu_used == 1 ) THEN + IF ( cu_used == 1 ) THEN !{ DO kz = kts,kte DO ix = its,ite @@ -2627,10 +2827,22 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw call calcnfromcuten(nx,ny,nz,ancuten,an,na,nor,nor,dn1) + DO kz = kts,kte + DO ix = its,ite + + + IF ( ipconc >= 6 ) THEN +! IF ( lzr > 0 ) an(ix,1,kz,lzr) = an(ix,1,kz,lzr) + ancuten(ix,1,kz,lzr) + ENDIF + + ENDDO + ENDDO - ENDIF + ENDIF !} - ENDIF + ENDIF !} + + call sediment1d(dtp,nx,ny,nz,an,na,nor,nor,xfall,dn1,dz2d,dz2dinv, & @@ -2644,10 +2856,12 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw DO ix = its,ite IF ( lhl > 1 ) THEN - RAINNCV(ix,jy) = dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & + RAINNCV(ix,jy) = RAINNCV(ix,jy) + & + dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & & xfall(ix,1,lh)*1000./xdn0(lr) + xfall(ix,1,lhl)*1000./xdn0(lr) ) ELSE - RAINNCV(ix,jy) = dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & + RAINNCV(ix,jy) = RAINNCV(ix,jy) + & + dtp*dn1(ix,1,1)*(xfall(ix,1,lr) + xfall(ix,1,ls)*1000./xdn0(lr) + & & xfall(ix,1,lh)*1000./xdn0(lr) ) ENDIF IF ( present ( rainncw2 ) ) THEN ! rain only @@ -2662,17 +2876,19 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & xfall(ix,1,lh)*1000./xdn0(lr) ) ENDIF ENDIF - IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,ls)*1000./xdn0(lr) + IF ( present( SNOWNCV ) ) SNOWNCV(ix,jy) = SNOWNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,ls)*1000./xdn0(lr) IF ( present( GRPLNCV ) ) THEN IF ( lhl > 1 .and. .not. present( HAILNC) ) THEN ! if no separate hail accum, then add to graupel - GRPLNCV(ix,jy) = dtp*dn1(ix,1,1)*(xfall(ix,1,lh) + xfall(ix,1,lhl)) *1000./xdn0(lr) + GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*(xfall(ix,1,lh) + xfall(ix,1,lhl)) *1000./xdn0(lr) ELSE - GRPLNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,lh)*1000./xdn0(lr) + GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,lh)*1000./xdn0(lr) ENDIF ENDIF - RAINNC(ix,jy) = RAINNC(ix,jy) + RAINNCV(ix,jy) + IF ( loopcnt == loopmax ) RAINNC(ix,jy) = RAINNC(ix,jy) + RAINNCV(ix,jy) - IF ( present (SNOWNC) .and. present (SNOWNCV) ) SNOWNC(ix,jy) = SNOWNC(ix,jy) + SNOWNCV(ix,jy) + IF ( present (SNOWNC) .and. present (SNOWNCV) .and. loopcnt == loopmax ) THEN + SNOWNC(ix,jy) = SNOWNC(ix,jy) + SNOWNCV(ix,jy) + ENDIF IF ( lhl > 1 ) THEN !#ifdef CM1 ! IF ( .true. ) THEN @@ -2680,13 +2896,15 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( present( HAILNC ) ) THEN !#endif HAILNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,lhl)*1000./xdn0(lr) - HAILNC(ix,jy) = HAILNC(ix,jy) + HAILNCV(ix,jy) + IF ( loopcnt == loopmax ) HAILNC(ix,jy) = HAILNC(ix,jy) + HAILNCV(ix,jy) ! ELSEIF ( present( GRPLNCV ) ) THEN ! if no separate hail accum, then add to graupel ! GRPLNCV(ix,jy) = GRPLNCV(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,lhl)*1000./xdn0(lr) ENDIF ENDIF - IF ( present( GRPLNCV ) ) GRPLNC(ix,jy) = GRPLNC(ix,jy) + GRPLNCV(ix,jy) - IF ( present( SR ) .and. present (SNOWNCV) .and. present(GRPLNCV) ) THEN + IF ( present( GRPLNCV ) .and. loopcnt == loopmax ) THEN + GRPLNC(ix,jy) = GRPLNC(ix,jy) + GRPLNCV(ix,jy) + ENDIF + IF ( present( SR ) .and. present (SNOWNCV) .and. present(GRPLNCV) .and. loopcnt == loopmax ) THEN IF ( present( HAILNC ) ) THEN SR(ix,jy) = (SNOWNCV(ix,jy)+HAILNCV(ix,jy)+GRPLNCV(ix,jy))/(RAINNCV(ix,jy)+1.e-12) ELSE @@ -2695,7 +2913,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDDO - ENDIF ! .false. +! ENDIF ! .false. IF ( isedonly /= 1 ) THEN ! call nssl_2mom_gs: main gather-scatter routine to calculate microphysics @@ -2726,6 +2944,13 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw +! recalculate dn1 after temperature changes: rho = con_eps*prsl/(con_rd*tgrs*(qv_mp+con_eps)) + DO kz = kts,kte + DO ix = its,ite + dn1(ix,1,kz) = rdorv*pn(ix,1,kz)/(rd*t0(ix,1,kz)*(an(ix,1,kz,lv) + rdorv)) + ENDDO + ENDDO + ENDIF ! isedonly /= 1 @@ -2741,11 +2966,21 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & ,axtra2d, makediag & & ,ssat,t00,t77,flag_qndrop) +! recalculate dn1 after temperature changes + DO kz = kts,kte + DO ix = its,ite + dn1(ix,1,kz) = rdorv*pn(ix,1,kz)/(rd*t0(ix,1,kz)*(an(ix,1,kz,lv) + rdorv)) + ENDDO + ENDDO + ENDIF + + ENDDO ! loopcnt=1,loopmax + IF ( present( pcc2 ) .and. makediag ) THEN DO kz = kts,kte DO ix = its,ite @@ -2759,7 +2994,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! compute diagnostic S-band reflectivity if needed - IF ( present( dbz ) .and. makediag ) THEN + IF ( present( dbz ) .and. makediag .and. lastlooptmp ) THEN ! calc dbz IF ( .true. ) THEN @@ -2797,7 +3032,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! Following Greg Thompson, calculation for effective radii. Used by RRTMG LW/SW schemes if enabled in module_physics_init.F IF ( present( has_reqc ).and. present( has_reqi ) .and. present( has_reqs ) .and. & - present( re_cloud ).and. present( re_ice ) .and. present( re_snow ) ) THEN + present( re_cloud ).and. present( re_ice ) .and. present( re_snow ) .and. & + lastlooptmp) THEN IF ( has_reqc.ne.0 .or. has_reqi.ne.0 .or. has_reqs.ne.0) THEN DO kz = kts,kte DO ix = its,ite @@ -2821,10 +3057,10 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw DO kz = kts,kte DO ix = its,ite re_cloud(ix,kz,jy) = MAX(2.51E-6, MIN(t1(ix,1,kz), 50.E-6)) - re_ice(ix,kz,jy) = MAX(10.01E-6, MIN(t2(ix,1,kz), 200.E-6)) + re_ice(ix,kz,jy) = MAX(10.01E-6, MIN(t2(ix,1,kz), 125.E-6)) re_snow(ix,kz,jy) = MAX(25.E-6, MIN(t3(ix,1,kz), 999.E-6)) ! check for case where snow needs to be treated as cloud ice (for rrtmg radiation) - IF ( .not. present(qi) ) re_ice(ix,kz,jy) = MAX(10.E-6, MIN(t3(ix,1,kz), 200.E-6)) + IF ( .not. present(qi) ) re_ice(ix,kz,jy) = MAX(10.E-6, MIN(t3(ix,1,kz), 125.E-6)) ENDDO ENDDO @@ -2849,7 +3085,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( denscale(il) == 1 ) THEN DO kz = kts,kte DO ix = its,ite - an(ix,1,kz,il) = an(ix,1,kz,il)/dn(ix,kz,jy) + an(ix,1,kz,il) = an(ix,1,kz,il)/dn1(ix,1,kz) ! dn(ix,kz,jy) ENDDO ENDDO ENDIF @@ -2896,6 +3132,21 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDIF + IF ( lccnuf > 0 .and. flag_cnuf ) THEN + IF ( i_uf_or_ccn > 0 ) THEN ! UF are ccn and lccnuf is zero, so put cnuf into lccnuf to do decay + an(ix,1,kz,lccnuf) = Max(0.0, cnuf(ix,kz,jy) ) + ENDIF + IF ( decayufccn ) THEN + IF ( an(ix,1,kz,lccnuf) > ufbackground ) THEN + an(ix,1,kz,lccnuf) = an(ix,1,kz,lccnuf) - (an(ix,1,kz,lccnuf) - & + ufbackground)*(1.0 - exp(-dtp/ufccntimeconst)) + ENDIF + ENDIF + cnuf(ix,kz,jy) = an(ix,1,kz,lccnuf) + ENDIF + + + IF ( ipconc >= 5 ) THEN ccw(ix,kz,jy) = an(ix,1,kz,lnc) @@ -2906,6 +3157,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lhl > 1 ) chl(ix,kz,jy) = an(ix,1,kz,lnhl) ENDIF + IF ( ipconc >= 6 ) THEN + IF ( lzr > 0 ) zrw(ix,kz,jy) = an(ix,1,kz,lzr) *zscaleinv + IF ( lzh > 0 ) zhw(ix,kz,jy) = an(ix,1,kz,lzh) *zscaleinv + IF ( lzhl > 0 ) zhl(ix,kz,jy) = an(ix,1,kz,lzhl)*zscaleinv + ENDIF @@ -2914,6 +3170,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw #if ( WRF_CHEM == 1 ) IF ( has_wetscav ) THEN + IF ( loopmax > 1 ) THEN + ! wrferror not supported + ENDIF IF ( PRESENT( rainprod ) ) rainprod(ix,kz,jy) = rainprod2d(ix,kz) IF ( PRESENT( evapprod ) ) evapprod(ix,kz,jy) = evapprod2d(ix,kz) ENDIF @@ -2923,6 +3182,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDDO ! jy + + @@ -3217,7 +3478,7 @@ END FUNCTION GAML02 ! ********************************************************** !>\ingroup mod_nsslmp !! Function calculates fraction of drops larger than 300 microns ( imurain == 3 ) - real FUNCTION GAML02d300(x) + real FUNCTION GAML02d300(x) implicit none integer ig, i, ii, n, np real x @@ -3825,7 +4086,8 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & IF ( il >= lr .and. ( infall .eq. 3 .or. infall .eq. 4 ) .and. ln(il) > 0 ) THEN - IF ( (il .eq. lr .and. irfall .eq. infall .and. lzr < 1) .or. (il .ge. lh .and. lz(il) .lt. 1 ) ) THEN + IF ( (il .eq. lr .and. irfall .eq. infall .and. lzr < 1) .or. & + (il .ge. lh .and. lz(il) .lt. 1 ) .or. (il == ls .and. isfall == infall ) ) THEN call calczgr1d(nx,ny,nz,nor,na,an,ixe,kze, & & z,db1,jgs,ipconc, dnu(il), il, ln(il), qxmin(il), xvmn(il), xvmx(il), lvol(il), xdn0(il), ix ) ENDIF @@ -3850,6 +4112,14 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDIF ENDIF +! reflectivity + + IF ( ipconc .ge. 6 ) THEN + IF ( lz(il) .gt. 1 ) THEN + call fallout1d(nx,ny,nz,nor,na,dtptmp,dtfrac,jgs,xvt(1,1,3,il), & + & an,db1,lz(il),0,xfall,dtz1,ix) + ENDIF + ENDIF if (ndebug .gt. 0 ) write(0,*) 'dbg = 3d' @@ -3863,9 +4133,11 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! to put a lower bound on number conc. ! - IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( il .eq. lh .or. il .eq. lhl .or. & + IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( (il == ls .and. isfall .eq. infall ) & + & .or. il .eq. lh .or. il .eq. lhl .or. il == lf .or. & & ( il .eq. lr .and. irfall .eq. infall) ) ) THEN + ! set up for method I+II DO kz = kzb,kze ! DO ix = ixb,ixe tmpn2(ix,jy,kz) = z(ix,kz,il) @@ -3878,7 +4150,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDDO ELSE - + ! set up for method II only DO kz = kzb,kze ! DO ix = ixb,ixe tmpn(ix,jy,kz) = an(ix,jy,kz,ln(il)) @@ -3907,7 +4179,8 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & xfall0(:,jgs) = 0.0 IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. & - & ( il .ge. lh .or. (il .eq. lr .and. irfall .eq. infall) ) ) THEN + & ( il .ge. lh .or. (il .eq. lr .and. irfall .eq. infall) & + .or. (il .eq. ls .and. isfall .eq. infall) ) ) THEN call fallout1d(nx,ny,nz,nor,1,dtptmp,dtfrac,jgs,xvt(1,1,3,il), & & tmpn2,db1,1,0,xfall0,dtz1,ix) call fallout1d(nx,ny,nz,nor,1,dtptmp,dtfrac,jgs,xvt(1,1,1,il), & @@ -3918,12 +4191,12 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDIF IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( (il .eq. lr .and. irfall .eq. infall) & - & .or. il .ge. lh ) ) THEN + & .or. il .ge. lh .or. (il == ls .and. isfall .eq. infall ) ) ) THEN ! "Method I" - dbz correction call calcnfromz1d(nx,ny,nz,nor,na,an,tmpn2,ixe,kze, & & z,db1,jgs,ipconc, dnu(il), il, ln(il), qxmin(il), xvmn(il), xvmx(il),tmpn, & - & lvol(il), rho_qh, infall, ix) + & lvol(il), xdn0(il), infall, ix) ELSEIF ( infall .eq. 5 .and. il .ge. lh .or. ( il == lr .and. irfall == 5 ) ) THEN @@ -3934,7 +4207,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! ENDDO ENDDO - ELSEIF ( .not. (il .eq. lr .and. irfall .eq. 0) ) THEN + ELSEIF ( .not. (il .eq. lr .and. irfall .eq. 0) .and. .not. (il .eq. ls .and. isfall .eq. 0) ) THEN ! "Method II" M-wgt N-fallout correction DO kz = kzb,kze @@ -4120,13 +4393,14 @@ subroutine calczgr1d(nx,ny,nz,nor,na,a,ixe,kze, & integer ix,jy,kz - real vr,qr,nrx,rd,xv,g1,zx,chw,xdn + real vr,qr,nrx,rd,xv,g1,zx,chw,xdn,ynu jy = jgs ix = ixcol - IF ( l .eq. lh .or. l .eq. lhl .or. ( l .eq. lr .and. imurain == 1 ) ) THEN + IF ( l .eq. lh .or. l .eq. lhl .or. ( l .eq. lr .and. imurain == 1 ) & + .or. ( l .eq. ls .and. imusnow == 1 ) ) THEN DO kz = 1,kze @@ -4176,16 +4450,19 @@ subroutine calczgr1d(nx,ny,nz,nor,na,a,ixe,kze, & ENDDO - ELSEIF ( l .eq. lr .and. imurain == 3) THEN + ELSEIF ( (l == ls .and. imusnow == 3) .or. ( l .eq. lr .and. imurain == 3 ) ) THEN - xdn = 1000. + xdn = rho_qx ! 1000. + IF ( l == ls ) ynu = snu + IF ( l == lr ) ynu = rnu DO kz = 1,kze + IF ( a(ix,jy,kz,l) .gt. qmin .and. a(ix,jy,kz,ln) .gt. 1.e-15 ) THEN vr = db(ix,kz)*a(ix,jy,kz,l)/(xdn*a(ix,jy,kz,ln)) -! z(ix,kz,l) = 3.6e18*(rnu+2.0)*a(ix,jy,kz,ln)*vr**2/(rnu+1.0) - z(ix,kz,l) = 3.6*(rnu+2.0)*a(ix,jy,kz,ln)*vr**2/(rnu+1.0) +! z(ix,kz,l) = 3.6e18*(ynu+2.0)*a(ix,jy,kz,ln)*vr**2/(ynu+1.0) + z(ix,kz,l) = 3.6*(ynu+2.0)*a(ix,jy,kz,ln)*vr**2/(ynu+1.0) ! qr = a(ix,jy,kz,lr) ! nrx = a(ix,jy,kz,lnr) @@ -4590,6 +4867,9 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & an(ix,jy,kz,lnr) = nrx ! *dninv ! convert to number mixing ratio + IF ( lzr > 1 ) THEN ! set reflectivity moment + an(ix,jy,kz,lzr) = 36.*g1r*dn(ix,kz)**2*q**2/(pi**2*xdnr**2*nrx) ! *dninv + ENDIF ELSEIF ( an(ix,jy,kz,lr) <= qxmin(lr) .or. & ( an(ix,jy,kz,lnr) <= cxmin .and. an(ix,jy,kz,lr) <= qxmin_init(lr)) ) THEN an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lr) @@ -4651,6 +4931,9 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & an(ix,jy,kz,lvh) = 0.0 ENDIF + IF ( lzh > 1 ) THEN ! set reflectivity moment + an(ix,jy,kz,lzh) = 36.*g1h*dn(ix,kz)**2*q**2/(pi**2*xdnh**2*nrx) ! *dninv + ENDIF ELSEIF ( an(ix,jy,kz,lh) <= qxmin(lh) .or. & ( an(ix,jy,kz,lnh) <= cxmin .and. an(ix,jy,kz,lh) <= qxmin_init(lh)) ) THEN @@ -4680,6 +4963,9 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & an(ix,jy,kz,lnhl) = nrx ! *dninv ! convert to number mixing ratio + IF ( lzhl > 1 ) THEN ! set reflectivity moment + an(ix,jy,kz,lzhl) = 36.*g1hl*dn(ix,kz)**2*q**2/(pi**2*xdnhl**2*nrx) ! *dninv + ENDIF ELSEIF ( an(ix,jy,kz,lhl) <= qxmin(lhl) .or. & ( an(ix,jy,kz,lnhl) <= cxmin .and. an(ix,jy,kz,lhl) <= qxmin_init(lhl)) ) THEN @@ -4859,6 +5145,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) anold(ix,jy,kz,lnr) = anold(ix,jy,kz,lnr) + an(ix,jy,kz,lr)/xmass ENDIF + IF ( lzr > 1 ) THEN ! set reflectivity moment + an(ix,jy,kz,lzr) = 36.*g1r*dn(ix,kz)**2*q**2/(pi**2*xdnr**2*nrx) ! *dninv + ENDIF ENDIF ENDIF @@ -4909,6 +5198,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) ! ! an(ix,jy,kz,lnh) = nrx ! *dninv ! convert to number mixing ratio ! +! IF ( lzh > 1 ) THEN ! set reflectivity moment +! an(ix,jy,kz,lzh) = 36.*g1h*dn(ix,kz)**2*q**2/(pi**2*xdnh**2*nrx) ! *dninv +! ENDIF ! ENDIF ! ENDIF ! @@ -4932,6 +5224,9 @@ subroutine calcnfromcuten(nx,ny,nz,an,anold,na,nor,norz,dn) ! ! an(ix,jy,kz,lnhl) = nrx ! *dninv ! convert to number mixing ratio ! +! IF ( lzhl > 1 ) THEN ! set reflectivity moment +! an(ix,jy,kz,lzhl) = 36.*g1hl*dn(ix,kz)**2*q**2/(pi**2*xdnhl**2*nrx) ! *dninv +! ENDIF ! ENDIF ! ENDIF @@ -6490,6 +6785,9 @@ SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & ELSEIF ( icdxhl .eq. 6 ) THEN ! Milbrandt and Morrison (2013) aax = axx(mgs,lhl) bbx = bxx(mgs,lhl) + ELSEIF ( icdxhl <= 0 ) THEN ! + aax = ax(lhl) + bbx = bx(lhl) ENDIF ENDIF ! } @@ -6798,7 +7096,11 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & real vtmax real xvbarmax - + + real, parameter :: c1r=19.0, c2r=0.6, c3r=1.8, c4r=17.0 ! rain + real, parameter :: c1h=5.5, c2h=0.7, c3h=4.5, c4h=8.5 ! Graupel + real, parameter :: c1hl=3.7, c2hl=0.3, c3hl=9.0, c4hl=6.5, c5hl=1.0, c6hl=6.5 ! Hail + integer l1, l2 double precision :: dpt1, dpt2 @@ -7074,83 +7376,564 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & ELSEIF ( imurain == 3 ) THEN alpha(:,lr) = xnu(lr) ENDIF - - - + IF ( ipconc == 5 .and. imydiagalpha > 0 ) THEN + DO mgs = 1,ngscnt + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > cxmin ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) ! + xdia(mgs,lr,3) = (xv(mgs,lr)*6.0*cwc1)**(1./3.) + alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) + ENDIF + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) > cxmin ) THEN + xv(mgs,lh) = rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ! + xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.) ! mwfac*xdia(mgs,lh,1) ! (xv(mgs,lh)*cwc0*6.0)**(1./3.) + alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) + ENDIF +! alpha(:,lr) = 0. ! 10. +! alpha(:,lh) = 0. ! 10. + IF ( lhl > 0 ) THEN + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) > cxmin ) THEN + xv(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/(xdn(mgs,lhl)*cx(mgs,lhl)) ! + xdia(mgs,lhl,3) = (xv(mgs,lhl)*6.*piinv)**(1./3.) + IF ( xdia(mgs,lhl,3) < 0.008 ) THEN + alpha(mgs,lhl) = Min(alphamax, c1hl*tanh(c2hl*(xdia(mgs,lhl,3)*1000. - c3hl)) + c4hl) + ELSE + alpha(mgs,lhl) = Min(alphamax, c5hl*xdia(mgs,lhl,3)*1000. + c6hl) + ENDIF + ENDIF + ENDIF + ENDDO + ENDIF ! -! Set density -! - if (ndebugzf .gt. 0 ) write(0,*) 'ZIEGFALL: call setvtz' +! Set 6th moments ! + IF ( ipconc .ge. 6 .or. lzr > 1) THEN - call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & - & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, & - & ipconc,ndebugzf,ngs,nz,kgs,fadvisc, & - & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, & - & itype1,itype2,temcg,infdo,alpha,ildo,axx,bxx) -! & itype1,itype2,temcg,infdo,alpha,ildo,axh,bxh,axhl,bxhl) - - - -! -! put fall speeds into the x-z arrays -! - DO il = l1,l2 - do mgs = 1,ngscnt - - vtmax = 150.0 - - - IF ( vtxbar(mgs,il,2) .gt. vtxbar(mgs,il,1) .or. & - & ( vtxbar(mgs,il,1) .gt. vtxbar(mgs,il,3) .and. vtxbar(mgs,il,3) > 0.0) ) THEN - - - - vtxbar(mgs,il,1) = Max( vtxbar(mgs,il,1), vtxbar(mgs,il,2) ) - vtxbar(mgs,il,3) = Max( vtxbar(mgs,il,3), vtxbar(mgs,il,1) ) + zx(:,:) = 0.0 + +! DO il = lr,lhab + DO il = l1,l2 + + IF ( lz(il) .ge. 1 ) THEN + + DO mgs = 1,ngscnt + zx(mgs,il) = Max(an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0) + ENDDO - ENDIF - - - IF ( vtxbar(mgs,il,1) .gt. vtmax .or. vtxbar(mgs,il,2) .gt. vtmax .or. & - & vtxbar(mgs,il,3) .gt. vtmax ) THEN - - vtxbar(mgs,il,1) = Min(vtmax,vtxbar(mgs,il,1) ) - vtxbar(mgs,il,2) = Min(vtmax,vtxbar(mgs,il,2) ) - vtxbar(mgs,il,3) = Min(vtmax,vtxbar(mgs,il,3) ) -! call commasmpi_abort() - ENDIF + ENDIF + + ENDDO + + ENDIF + - xvt(kgs(mgs),igs(mgs),1,il) = vtxbar(mgs,il,1) - xvt(kgs(mgs),igs(mgs),2,il) = vtxbar(mgs,il,2) - IF ( infdo .ge. 2 ) THEN - xvt(kgs(mgs),igs(mgs),3,il) = vtxbar(mgs,il,3) - ELSE - xvt(kgs(mgs),igs(mgs),3,il) = 0.0 - ENDIF -! xvt(kgs(mgs),igs(mgs),2,il) = xvt(kgs(mgs),igs(mgs),1,il) + +! Find shape parameter rain - enddo - ENDDO + IF ( lz(lr) > 1 .and. (ildo == 0 .or. ildo == lr ) .and. imurain == 3 ) THEN ! { RAIN SHAPE PARAM + il = lr + DO mgs = 1,ngscnt + + IF ( iresetmoments == 1 .or. iresetmoments == il ) THEN +! IF ( .false. .and. zx(mgs,lr) <= zxmin ) THEN + IF ( zx(mgs,lr) <= zxmin ) THEN + qx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) +! ELSEIF ( zx(mgs,lr) <= 0.0 .and. cx(mgs,lr) > 0.0 .and. qx(mgs,il) .gt. qxmin(il)) THEN +! write(91,*) 'ZF: overdepletion of Zr: z,c,q = ',zx(mgs,il),cx(mgs,il),qx(mgs,il) + ELSEIF ( cx(mgs,lr) <= cxmin ) THEN + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF + + + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN - if (ndebugzf .gt. 0 ) write(0,*) 'ZIEGFALL: COPIED FALL SPEEDS' + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! tmp = cx(mgs,lr) +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) +! IF ( tmp < cx(mgs,il) ) THEN ! breakup +! g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) +!! zx(mgs,lr) = zx(mgs,lr) + g1*(rho0(mgs)/(1000.))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) +!! an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) +! ENDIF + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + +! xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*Max(1.0e-9,cx(mgs,lr))) +! vr = xv(mgs,lr) + +! z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! write(91,*) 'alpha = ',alpha(mgs,il) + IF ( qx(mgs,il) < 1.e-8 ) THEN + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + ELSE +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*Max(1.0e-9,cx(mgs,lr))) + vr = xv(mgs,lr) +! z = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN +! alpha(mgs,lr) = 3. + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 +! IF ( 100.*Abs(alp - alpha(mgs,lr))/Abs(alpha(mgs,lr)) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. +! write(0,*) 'i,alp = ',i,alp + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO +! write(0,*) 'kz, alp, alpha(kz) = ',kz,alp,alpha(mgs,lr),qr*1000,z*1.e18,vr,nrx + + +! check for artificial breakup (rain larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) ) THEN + tmp = cx(mgs,il) + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + + +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + ENDIF + ENDIF - 9998 continue +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! +! IF ( alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax ) THEN + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN - if (ndebugzf .gt. 0 ) write(0,*) 'ZIEGFALL: DONE WITH LOOP' + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN - if ( kz .gt. nz-1 ) then - go to 1200 + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + + ENDIF + ENDIF + + ENDIF + ENDIF + + ELSE + + zx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ENDIF + + ENDDO + ENDIF ! } + + + IF ( ipconc .ge. 6 ) THEN + +! Find shape parameters for graupel,hail + + DO il = lr,lhab + + IF ( lz(il) .gt. 1 .and. (ildo == 0 .or. ildo == il ) .and. ( .not. ( il == lr .and. imurain == 3 )) ) THEN + + DO mgs = 1,ngscnt + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN +!! write(91,*) 'cx=0; qx,zx = ',1000.*qx(mgs,il),1.e18*zx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN +! tmp = cx(mgs,il) + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) +! IF ( tmp < cx(mgs,il) ) THEN ! breakup +! g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) +! zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) +! an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) +! +! ENDIF + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? +! write(91,*) 'ziegfall: something screwy with moments: il = ',il +! write(91,*) 'q,n,z = ', 1.e3*qx(mgs,il),cx(mgs,il),zx(mgs,il) +! write(91,*) 'alpha = ',alpha(mgs,il) + + IF ( qx(mgs,il) < 1.e-8 ) THEN + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + ELSE +! write(0,*) 'alpha = ',alpha(mgs,il) + ! set values according to dBZ of -10 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) .and. cx(mgs,il) .gt. 0.0 ) THEN + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN + +! rd = z*(pi/6.*1000.)**2*chw/(0.224*(dn(igs(mgs),jy,kgs(mgs))*qr)**2) + rd = z*(pi/6.*xdn(mgs,il))**2*chw/((dn(igs(mgs),jy,kgs(mgs))*qr)**2) + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 +! write(0,*) 'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + +! check for artificial breakup (graupel/hail larger than allowed max size) + + IF ( imaxdiaopt == 1 ) THEN + xvbarmax = xvmx(il) + ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter + xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSEIF ( imaxdiaopt == 3 ) THEN ! test against mass-weighted diameter + xvbarmax = xvmx(il) /((4. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ENDIF + + IF ( xv(mgs,il) .gt. xvbarmax ) THEN + tmp = cx(mgs,il) + xv(mgs,il) = Min( xvbarmax, Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rd = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + IF ( (rescale_low_alpha .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alpha .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) ) THEN + +!! z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*( 0.224*qr)*qr/chw + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + ENDIF + ELSE + ENDIF + ENDIF + ENDDO ! mgs + + ENDIF ! lz(il) .gt. 1 + + ENDDO ! il + +! CALL cld_cpu('Z-MOMENT-ZFAll') + + ENDIF + + IF ( lzhl > 1 ) THEN + IF ( lhl .gt. 1 ) THEN + + ENDIF + ENDIF + + + +! +! Set density +! + if (ndebugzf .gt. 0 ) write(0,*) 'ZIEGFALL: call setvtz' +! + + call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & + & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, & + & ipconc,ndebugzf,ngs,nz,kgs,fadvisc, & + & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, & + & itype1,itype2,temcg,infdo,alpha,ildo,axx,bxx) +! & itype1,itype2,temcg,infdo,alpha,ildo,axh,bxh,axhl,bxhl) + + + +! +! put fall speeds into the x-z arrays +! + DO il = l1,l2 + do mgs = 1,ngscnt + + vtmax = 150.0 + + + IF ( vtxbar(mgs,il,2) .gt. vtxbar(mgs,il,1) .or. & + & ( vtxbar(mgs,il,1) .gt. vtxbar(mgs,il,3) .and. vtxbar(mgs,il,3) > 0.0) ) THEN + + +! IF ( qx(mgs,il) > 1.e-4 .and. & +! & .not. ( il == lr .and. 1.e3*xdia(mgs,il,3) > 5.0 ) ) THEN +! write(0,*) 'infdo,mgs = ',infdo,lzr,mgs +! write(0,*) 'Moment problem with vtxbar for il at i,j,k = ',il,igs(mgs),jy,kgs(mgs) +! write(0,*) 'nx,ny,nz,ng = ',nx,ny,nz,nor +! write(0,*) 'cwmasn,cwmasx = ',cwmasn,cwmasx +! write(0,*) 'vt1,2,3 = ',vtxbar(mgs,il,1),vtxbar(mgs,il,2),vtxbar(mgs,il,3) +! write(0,*) 'q,n,d = ', 1.e3*qx(mgs,il),cx(mgs,il),1.e3*xdia(mgs,il,3) +! IF ( il .ge. lr .and. lz(il) > 1 ) write(0,*) 'z = ', zx(mgs,il) +! IF ( il .ge. lg .or. il == lr ) THEN +! write(0,*) 'alpha = ',alpha(mgs,il) +! ENDIF +! ENDIF + + vtxbar(mgs,il,1) = Max( vtxbar(mgs,il,1), vtxbar(mgs,il,2) ) + vtxbar(mgs,il,3) = Max( vtxbar(mgs,il,3), vtxbar(mgs,il,1) ) + + ENDIF + + + IF ( vtxbar(mgs,il,1) .gt. vtmax .or. vtxbar(mgs,il,2) .gt. vtmax .or. & + & vtxbar(mgs,il,3) .gt. vtmax ) THEN + +! IF ( ndebugzf >= 0 .and. 1.e3*qx(mgs,il) > 0.1 ) THEN +! write(0,*) 'infdo = ',infdo +! write(0,*) 'Problem with vtxbar for il at i,j,k = ',il,igs(mgs),jy,kgs(mgs) +! write(0,*) 'nx,ny,nz,ng = ',nx,ny,nz,nor +! write(0,*) 'cwmasn,cwmasx = ',cwmasn,cwmasx +! write(0,*) 'vt1,2,3 = ',vtxbar(mgs,il,1),vtxbar(mgs,il,2),vtxbar(mgs,il,3) +! write(0,*) 'q,n,d = ', 1.e3*qx(mgs,il),cx(mgs,il),1.e3*xdia(mgs,il,3) +! IF ( il .ge. lr .and. lz(il) > 1 ) write(0,*) 'z = ', zx(mgs,il) +! IF ( il .ge. lg ) THEN +! write(0,*) 'alpha = ',alpha(mgs,il) +! ENDIF +! ENDIF + vtxbar(mgs,il,1) = Min(vtmax,vtxbar(mgs,il,1) ) + vtxbar(mgs,il,2) = Min(vtmax,vtxbar(mgs,il,2) ) + vtxbar(mgs,il,3) = Min(vtmax,vtxbar(mgs,il,3) ) + +! call commasmpi_abort() + ENDIF + + + xvt(kgs(mgs),igs(mgs),1,il) = vtxbar(mgs,il,1) + xvt(kgs(mgs),igs(mgs),2,il) = vtxbar(mgs,il,2) + IF ( infdo .ge. 2 ) THEN + xvt(kgs(mgs),igs(mgs),3,il) = vtxbar(mgs,il,3) + ELSE + xvt(kgs(mgs),igs(mgs),3,il) = 0.0 + ENDIF + +! xvt(kgs(mgs),igs(mgs),2,il) = xvt(kgs(mgs),igs(mgs),1,il) + + enddo + ENDDO + + + if (ndebugzf .gt. 0 ) write(0,*) 'ZIEGFALL: COPIED FALL SPEEDS' + + + + 9998 continue + + if (ndebugzf .gt. 0 ) write(0,*) 'ZIEGFALL: DONE WITH LOOP' + + if ( kz .gt. nz-1 ) then + go to 1200 else nzmpb = kz end if @@ -7630,6 +8413,8 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( ipconc .le. 2 ) THEN gtmp(ix,kz) = dadr*an(ix,jy,kz,lr)**(0.25) dtmp(ix,kz) = zrc*gtmp(ix,kz)**7 + ELSEIF ( lzr .gt. 1 ) THEN + dtmp(ix,kz) = 1e18*an(ix,jy,kz,lzr) ELSEIF ( an(ix,jy,kz,lnr) .gt. 1.e-3 ) THEN IF ( imurain == 3 ) THEN vr = db(ix,jy,kz)*an(ix,jy,kz,lr)/(1000.*an(ix,jy,kz,lnr)) @@ -7822,7 +8607,7 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ELSE ! new form using a mass relationship m = p d^2 (instead of d^3 -- Cox 1988 QJRMS) so that density depends on size ! p = 0.106214 for m = p v^(2/3) - dnsnow = 0.346159*sqrt(an(ix,jy,kz,lns)/(an(ix,jy,kz,ls)*db(ix,jy,kz)) ) + dnsnow = 0.0346159*sqrt(an(ix,jy,kz,lns)/(an(ix,jy,kz,ls)*db(ix,jy,kz)) ) IF ( .true. .or. dnsnow < 900. ) THEN gtmp(ix,kz) = 1.e18*323.3226* 0.106214**2*(ksq*an(ix,jy,kz,ls) + & & (1.-ksq)*qxw)*an(ix,jy,kz,ls)*db(ix,jy,kz)**2*gsnow73/ & @@ -7898,6 +8683,10 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( izieg .ge. 1 .and. ipconc .ge. 5 ) THEN ltest = .false. + IF ( lzh > 1 ) THEN + IF ( an(ix,jy,kz,lzh) > 0.0 .and. an(ix,jy,kz,lh) > qhmin .and. & + an(ix,jy,kz,lnh) >= cxmin ) ltest = .true. + ENDIF IF ( ltest .or. (an(ix,jy,kz,lh) .ge. qhmin .and. an(ix,jy,kz,lnh) .ge. cxmin )) THEN @@ -7943,6 +8732,9 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ENDIF IF ( lzh .gt. 1 ) THEN + x = (0.224*qh + 0.776*qxw)/an(ix,jy,kz,lh) ! weighted average of dielectric const + dtmph = 1.e18*x*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + dtmp(ix,kz) = dtmp(ix,kz) + dtmph ELSE g1 = (6.0 + alphah)*(5.0 + alphah)*(4.0 + alphah)/((3.0 + alphah)*(2.0 + alphah)*(1.0 + alphah)) ! zx = g1*(db(ix,jy,kz)*an(ix,jy,kz,lh))**2/chw @@ -8015,6 +8807,10 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & IF ( ipconc .ge. 5 ) THEN ltest = .false. + IF ( lzhl > 1 ) THEN + IF ( an(ix,jy,kz,lzhl) > 0.0 .and. an(ix,jy,kz,lhl) > qhlmin .and. & + an(ix,jy,kz,lnhl) > 0.0 ) ltest = .true. + ENDIF IF ( ltest .or. ( an(ix,jy,kz,lhl) .ge. qhlmin .and. an(ix,jy,kz,lnhl) .gt. 0.) ) THEN !{ chl = an(ix,jy,kz,lnhl) @@ -8038,6 +8834,9 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ENDIF IF ( lzhl .gt. 1 ) THEN !{ + x = (0.224*an(ix,jy,kz,lhl) + 0.776*qxw)/an(ix,jy,kz,lhl) ! weighted average of dielectric const + dtmphl = 1.e18*x*an(ix,jy,kz,lzhl)*(hldn/rwdn)**2 + dtmp(ix,kz) = dtmp(ix,kz) + dtmphl ELSE !} g1 = (6.0 + alphahl)*(5.0 + alphahl)*(4.0 + alphahl)/((3.0 + alphahl)*(2.0 + alphahl)*(1.0 + alphahl)) @@ -8118,8 +8917,7 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & ! write(0,*) 'Hail,snow c: ',an(ix,jy,kz,lnh),an(ix,jy,kz,lns) ! write(0,*) 'dtmps,dtmph = ',dtmps,dtmph ! ENDIF - - IF ( ndebug>1 .and. .not. dtmp(ix,kz) .lt. 1.e30 .or. dbz(ix,jy,kz) > 190.0 ) THEN + IF ( .not. dtmp(ix,kz) .lt. 1.e30 .or. dbz(ix,jy,kz) > 190.0 ) THEN ! IF ( ix == 31 .and. kz == 20 .and. jy == 23 ) THEN ! write(0,*) 'my_rank = ',my_rank write(0,*) 'ix,jy,kz = ',ix,jy,kz @@ -8190,6 +8988,8 @@ END subroutine radardd02 ! ##################################################################### ! ! Subroutine for explicit cloud condensation and droplet nucleation +! +! 11/30/2022: Fixed droplet evaporation heating term for CM1 eqtset=2 (was only doing eqtset=1) ! SUBROUTINE NUCOND & & (nx,ny,nz,na,jyslab & @@ -8543,6 +9343,7 @@ SUBROUTINE NUCOND & qx(:,:) = 0.0 cx(:,:) = 0.0 + zx(:,:) = 0.0 xv(:,:) = 0.0 xmas(:,:) = 0.0 @@ -8602,6 +9403,7 @@ SUBROUTINE NUCOND & ELSE ! equation set 2 in cm1 tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh) IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl) + IF ( lf > 1 ) tmp = tmp + qx(mgs,lf) cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & +cpigb*(tmp) cpm = cp+cpv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & @@ -8716,6 +9518,237 @@ SUBROUTINE NUCOND & ventrxn(:) = ventrn +! Find shape parameter rain + + IF ( lzr > 1 .and. rcond == 2 ) THEN ! { RAIN SHAPE PARAM + DO mgs = 1,ngscnt + zx(mgs,lr) = Max(an(igs(mgs),jy,kgs(mgs),lzr), 0.0) + ENDDO + +! CALL cld_cpu('Z-MOMENT-1r2') + il = lr + DO mgs = 1,ngscnt + + IF ( zx(mgs,il) <= 0.0 ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( cx(mgs,il) <= 0.0 ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN + xv(mgs,lr) = xvmx(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + + ENDIF +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(chw*1000.*1000) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(chw*1000.*1000) + + ENDIF + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z1*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( imurain == 1 ) THEN + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z1 = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(z1*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + + ENDIF + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + vr = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) +! z1 = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z1 = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z1*(pi/6.*1000.)**2/xv + + +! determine shape parameter alpha by iteration + IF ( z1 .gt. 0.0 ) THEN + + IF ( imurain == 3 ) THEN + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z1*pi**2) - 1. +! write(0,*) 'kz, alp, alpha(kz) = ',kz,alp,alpha(kz),rd,z1,xv + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z1*pi**2) - 1. +! write(0,*) 'i,alp = ',i,alp + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + ELSE ! imurain == 1 + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + + rd1 = z1*(pi/6.*xdn(mgs,il))**2*nrx/(rho0(mgs)*qr)**2 + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd1) - 1.0 + + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rd1) - 1.0 + + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF +! ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + IF ( imurain == 3 ) THEN + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + + z1 = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z1 + ENDIF + ENDIF + + ELSEIF ( imurain == 1 ) THEN + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( (rescale_low_alpha .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*rho0(mgs)**2*(qr)*qr/zx(mgs,lr)*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alpha .and. alp <= alphamin ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + z1 = g1*rho0(mgs)**2*(qr)*qr/nrx + z2 = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z2 + an(igs(mgs),jy,kgs(mgs),lz(il)) = z2 + ENDIF + ENDIF ! imurain + + ENDIF ! z > 0 + + tmp = alpha(mgs,lr) + 4./3. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma(alpha(mgs,lr) + 1.) + ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) + + IF ( imurain == 3 .and. izwisventr == 2 ) THEN + + tmp = alpha(mgs,lr) + 1.5 + br/6. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 1.5 + br/6.)/Gamma(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/(y*(alpha(mgs,lr) + 1.)**((1.+br)/6. + 1./3.)) + + ELSEIF ( imurain == 1 .and. iferwisventr == 2 ) THEN + + tmp = alpha(mgs,lr) + 2.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma(alpha(mgs,lr) + 1.5 + br/6.)/Gamma(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/y + + + ENDIF + + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r2') + ENDIF ! } + ! write(0,*) 'NUCOND: Set ssf variables, ssmxinit =',ssmxinit ssmx = 0.0 @@ -8868,9 +9901,9 @@ SUBROUTINE NUCOND & QEVAP= Min( qx(mgs,lc), R1*(qss(mgs)-qvap(mgs)) ) - IF ( qx(mgs,lc) .LT. QEVAP ) THEN ! GO TO 63 + IF ( qx(mgs,lc) <= QEVAP ) THEN ! GO TO 63 qwvp(mgs) = qwvp(mgs) + qx(mgs,lc) - thetap(mgs) = thetap(mgs) - felv(mgs)*qx(mgs,lc)/(cp*pi0(mgs)) + thetap(mgs) = thetap(mgs) - felvcp(mgs)*qx(mgs,lc)/(pi0(mgs)) IF ( io_flag .and. nxtra > 1 ) THEN axtra(igs(mgs),jy,kgs(mgs),1) = -qx(mgs,lc)/dtp ENDIF @@ -8878,13 +9911,13 @@ SUBROUTINE NUCOND & IF ( restoreccn ) THEN IF ( irenuc <= 2 ) THEN IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) ELSE - ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ENDIF ENDIF IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - cx(mgs,lc) + ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) ENDIF ENDIF cx(mgs,lc) = 0. @@ -8898,13 +9931,13 @@ SUBROUTINE NUCOND & ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) ! ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) ELSE - ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ENDIF ENDIF IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - cx(mgs,lc) + ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) ENDIF ENDIF cx(mgs,lc) = 0. @@ -8915,18 +9948,18 @@ SUBROUTINE NUCOND & ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + tmp ) ) ! ccnc(mgs) = ccnc(mgs) + tmp IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + tmp ) ) + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*tmp ) ) ELSE - ccnc(mgs) = ccnc(mgs) + tmp + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*tmp ENDIF ENDIF IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - tmp + ccna(mgs) = ccna(mgs) - restoreccnfrac*tmp ENDIF ENDIF cx(mgs,lc) = cx(mgs,lc) - tmp ENDIF - thetap(mgs) = thetap(mgs) - felv(mgs)*QEVAP/(CP*pi0(mgs)) + thetap(mgs) = thetap(mgs) - felvcp(mgs)*QEVAP/(pi0(mgs)) IF ( io_flag .and. nxtra > 1 ) THEN axtra(igs(mgs),jy,kgs(mgs),1) = -QEVAP/dtp ENDIF @@ -9208,6 +10241,19 @@ SUBROUTINE NUCOND & !! & dx*dy*dz3d(igs(mgs),jy,kgs(mgs)) + IF ( lzr > 1 .and. rcond == 2 .and. qx(mgs,lr) .gt. qxmin(lr) & + & .and. cx(mgs,lr) .gt. 1.e-9 ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) + IF ( imurain == 3 ) THEN + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + ELSE + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + + ENDIF + zx(mgs,lr) = zx(mgs,lr) + g1*(rho0(mgs)/(xdn(mgs,lr)))**2*( 2.*( tmp ) * dqr ) + ENDIF + theta(mgs) = thetap(mgs) + theta0(mgs) temg(mgs) = theta(mgs)*f1 ltemq = (temg(mgs)-163.15)/fqsat+1.5 @@ -9468,15 +10514,143 @@ SUBROUTINE NUCOND & ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) - ELSEIF ( irenuc == 5 ) THEN !} { - - ! modification of Phillips Donner Garner 2007 + ELSEIF ( irenuc == 3 ) THEN !} { + ! Phillips Donner Garner 2007 ! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) -! CN(mgs) = Min( 0.91*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 - CN(mgs) = Min( cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp ) +! CN(mgs) = cwccn*Min(ssf(mgs),ssfcut)**cck - - IF ( ccna(mgs) >= cnuc(mgs) ) THEN ! apply limit after all "base" CCN have been depleted +! Need to calculate new ssf since condensation has happened: + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + + c1= pqs(mgs)*tabqvs(ltemq) + + ssf(mgs) = 0.0 + IF ( c1 > 0. ) THEN + ssf(mgs) = 100.*(qx(mgs,lv)/c1 - 1.0) ! from "new" values + ENDIF + CN(mgs) = cnuc(mgs)*Min(1.0, (ssf(mgs))**cck ) ! + + CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation + CN(mgs) = Min(cn(mgs), ccnc(mgs)) + cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + + ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. + ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air + ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + ELSEIF ( irenuc == 4 ) THEN !} { + ! modification of Phillips Donner Garner 2007 +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) +! CN(mgs) = CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp +! cn(mgs) = Min( cn(mgs), cnuc(mgs) ) +! Need to calculate new ssf since condensation has happened: + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + + c1= pqs(mgs)*tabqvs(ltemq) + IF ( c1 > 0. ) THEN + ssf(mgs) = Max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) ) ! from "new" values + ELSE + ssf(mgs) = 0.0 + ENDIF + CN(mgs) = cnuc(mgs)*Min(ssf2kmax, ssf(mgs)**cck) ! this allows cn(mgs) > cnuc(mgs) + + CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation +! CN(mgs) = Min(cn(mgs), ccnc(mgs)) + cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + IF ( cn(mgs) > 0.0 ) THEN + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + dcrit = 2.0*2.5e-7 + + dcloud = 1000.*dcrit**3*Pi/6.*cn(mgs) + qx(mgs,lc) = qx(mgs,lc) + DCLOUD + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) + qwvp(mgs) = qwvp(mgs) - DCLOUD + ENDIF + ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. + ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air +! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + + + + ELSEIF ( irenuc == 6 ) THEN !} { + + ! simple Twomey scheme but limit activation to try to do most activation near cloud base, but keep some CCN available for renuclation +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) + cn(mgs) = 0.0 +! IF ( ccna(mgs) < 0.7*cnuc(mgs) .and. ccnc(mgs) > 0.69*cnuc(mgs) - ccna(mgs)) THEN ! here, assume we are near cloud base and use Twomey formulation + IF ( ccna(mgs) < 0.7*cnuc(mgs) ) THEN ! here, assume we are near cloud base and use Twomey formulation + CN(mgs) = Min( 0.9*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 +! IF ( cn(mgs) + ccna(mgs) > 0.71*cnuc ) THEN + ! prevent this branch from activating more than 70% of CCN + CN(mgs) = Min( CN(mgs), Max(0.0, (0.7*cnuc(mgs) - ccna(mgs) )) ) +! CN(mgs) = Min( CN(mgs), Max(0.0, 0.71*ccnc(mgs) - ccna(mgs) ) ) + + ELSE + ! if a large fraction of CCN have been activated, then assume we are in the cloud interior and use local SSw as in Phillips et al. 2007. + + temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) +! t0(ix,jy,kz) = temp1 + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + +! c1 = t00(igs(mgs),jy,kgs(mgs))*tabqvs(ltemq) + c1= pqs(mgs)*tabqvs(ltemq) + IF ( c1 > 0. ) THEN + ssf(mgs) = Max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) ) ! from "new" values + ELSE + ssf(mgs) = 0.0 + ENDIF + +! CN(mgs) = cnuc(mgs)*Min(0.99, Min(ssf(mgs),ssfcut)**cck ) ! + CN(mgs) = cnuc(mgs)*Min(2.0, Max(0.0,ssf(mgs))**cck ) ! +! CN(mgs) = cnuc(mgs)*Min(ssf(mgs),ssfcut)**cck ! + + + CN(mgs) = Min(0.01*cnuc(mgs), Max( 0.0, CN(mgs) - ccna(mgs) ) ) ! this was from +! cn(mgs) = 0.0 + ENDIF +! ccne = ccnefac*1.e6*(1.e-6*Abs(cwccn))**(2./(2.+cck)) +!!! CN(mgs) = Max( 0.0, CN(mgs) - ccna(mgs) ) ! this was from + ! Philips, Donner et al. 2007, but results in too much limitation of + ! nucleation +! CN(mgs) = Min(cn(mgs), ccnc(mgs)) +! cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + + IF ( cn(mgs) > 0.0 ) THEN + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) + + ! create some small droplets at minimum size (CP 2000), although it adds very little liquid + + dcrit = 2.0*2.5e-7 + + dcloud = 1000.*dcrit**3*Pi/6.*cn(mgs) + qx(mgs,lc) = qx(mgs,lc) + DCLOUD + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) + qwvp(mgs) = qwvp(mgs) - DCLOUD + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + ENDIF + ELSEIF ( irenuc == 5 ) THEN !} { + + ! modification of Phillips Donner Garner 2007 +! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) +! CN(mgs) = Min( 0.91*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 + CN(mgs) = Min( cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp ) + + + IF ( ccna(mgs) >= cnuc(mgs) ) THEN ! apply limit after all "base" CCN have been depleted temp1 = (theta0(mgs)+thetap(mgs))*pk(mgs) ! t77(ix,jy,kz) ltemq = Int( (temp1-163.15)/fqsat+1.5 ) ltemq = Min( nqsat, Max(1,ltemq) ) @@ -9573,7 +10747,7 @@ SUBROUTINE NUCOND & ! write(0,*) 'k,cn = ',kgs(mgs),cn(mgs),ssf(mgs) ! write(0,*) 'ccn-ccna = ',cnuc(mgs) - ccna(mgs),ccnc(mgs) - ccna(mgs) ! IF ( ccncuf(mgs) > 0.0 .and. cn(mgs) < 1.e-3 .and. ssmax(mgs) > 1.0 ) THEN - IF ( ccncuf(mgs) > 0.0 .and. ssf(mgs) > ssmxuf .and. ssmax(mgs) > ssmxuf ) THEN + IF ( ccncuf(mgs) > 0.0 .and. ssf(mgs) > ssmxuf .and. ( ssmax(mgs) > ssmxuf .or. lss < 1 ) ) THEN CNuf(mgs) = Min( ccncuf(mgs), CCNE0*ccncuf(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 ! IF ( cnuf(mgs) >= 0.0 ) write(0,*) 'cnuf, k = ',cnuf(mgs),ccncuf(mgs),kgs(mgs) ENDIF @@ -9853,6 +11027,10 @@ SUBROUTINE NUCOND & ! qx(mgs,lr) = an(igs(mgs),jy,kgs(mgs),lr) end if + IF ( lzr > 1 .and. rcond == 2 ) THEN + an(igs(mgs),jy,kgs(mgs),lzr) = zx(mgs,lr) + & + & min( an(igs(mgs),jy,kgs(mgs),lzr), 0.0 ) + ENDIF IF ( ipconc .ge. 2 ) THEN @@ -9938,6 +11116,42 @@ SUBROUTINE NUCOND & IF ( lhl .gt. 1 ) THEN + IF ( lzhl .gt. 1 ) THEN + + an(ix,jy,kz,lzhl) = Max(0.0, an(ix,jy,kz,lzhl) ) + + IF ( an(ix,jy,kz,lhl) .ge. frac*qxmin(lhl) .and. rescale_low_alpha ) THEN ! check 6th moment + + IF ( an(ix,jy,kz,lnhl) .gt. 0.0 ) THEN + + IF ( lvhl .gt. 1 ) THEN + IF ( an(ix,jy,kz,lvhl) .gt. 0.0 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl) + ELSE + hwdn = xdn0(lhl) + ENDIF + hwdn = Max( xdnmn(lhl), hwdn ) + ELSE + hwdn = xdn0(lhl) + ENDIF + + chw = an(ix,jy,kz,lnhl) + g1 = (6.0+alphamin)*(5.0+alphamin)*(4.0+alphamin)/ & + & ((3.0+alphamin)*(2.0+alphamin)*(1.0+alphamin)) + z1 = g1*dn(ix,jy,kz)**2*( an(ix,jy,kz,lhl) )*an(ix,jy,kz,lhl)/chw + z1 = z1*(6./(pi*hwdn))**2 + ELSE + z1 = 0.0 + ENDIF + + an(ix,jy,kz,lzhl) = Min( z1, an(ix,jy,kz,lzhl) ) + + IF ( an(ix,jy,kz,lnhl) .lt. 1.e-5 ) THEN +! an(ix,jy,kz,lzhl) = 0.9*an(ix,jy,kz,lzhl) + ENDIF + ENDIF + + ENDIF !lzhl if ( an(ix,jy,kz,lhl) .lt. frac*qxmin(lhl) .or. zerocx(lhl) ) then @@ -10038,6 +11252,42 @@ SUBROUTINE NUCOND & + IF ( lzh .gt. 1 ) THEN + + an(ix,jy,kz,lzh) = Max(0.0, an(ix,jy,kz,lzh) ) + + IF ( .false. .and. an(ix,jy,kz,lh) .ge. frac*qxmin(lh) .and. rescale_low_alpha ) THEN + + IF ( an(ix,jy,kz,lnh) .gt. 0.0 ) THEN + + IF ( lvh .gt. 1 ) THEN + IF ( an(ix,jy,kz,lvh) .gt. 0.0 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh) + ELSE + hwdn = xdn0(lh) + ENDIF + hwdn = Max( xdnmn(lh), hwdn ) + ELSE + hwdn = xdn0(lh) + ENDIF + + chw = an(ix,jy,kz,lnh) + g1 = (6.0+alphamin)*(5.0+alphamin)*(4.0+alphamin)/ & + & ((3.0+alphamin)*(2.0+alphamin)*(1.0+alphamin)) + z1 = g1*dn(ix,jy,kz)**2*( an(ix,jy,kz,lh) )*an(ix,jy,kz,lh)/chw + z1 = z1*(6./(pi*hwdn))**2 + ELSE + z1 = 0.0 + ENDIF + + an(ix,jy,kz,lzh) = Min( z1, an(ix,jy,kz,lzh) ) + + IF ( an(ix,jy,kz,lnh) .lt. 1.e-5 ) THEN +! an(ix,jy,kz,lzh) = 0.9*an(ix,jy,kz,lzh) + ENDIF + ENDIF + + ENDIF if ( an(ix,jy,kz,lh) .lt. frac*qxmin(lh) .or. zerocx(lh) ) then @@ -10198,6 +11448,9 @@ SUBROUTINE NUCOND & end if + IF ( lzr > 1 ) THEN + an(ix,jy,kz,lzr) = Max(0.0, an(ix,jy,kz,lzr) ) + ENDIF if ( an(ix,jy,kz,lr) .lt. frac*qxmin(lr) .or. zerocx(lr) & & ) then @@ -10208,6 +11461,10 @@ SUBROUTINE NUCOND & an(ix,jy,kz,lnr) = 0.0 ENDIF + IF ( lzr > 1 ) THEN + an(ix,jy,kz,lzr) = 0.0 + ENDIF + end if ! @@ -10265,12 +11522,14 @@ SUBROUTINE NUCOND & & an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) ENDIF an(ix,jy,kz,lnc) = 0.0 + IF ( lccn > 1 ) an(ix,jy,kz,lccn) = Max( 0.0, an(ix,jy,kz,lccn) ) IF ( lccna > 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value + IF ( restoreccn ) THEN tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) IF ( an(ix,jy,kz,lccna) > 1. .and. tmp < qxmin(li) ) an(ix,jy,kz,lccna) = an(ix,jy,kz,lccna)*Exp(-dtp/ccntimeconst) - + ENDIF ELSEIF ( lccn > 1 .and. restoreccn ) THEN ! in this case, we are treating the ccn field as ccna tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) @@ -10425,6 +11684,7 @@ subroutine nssl_2mom_gs & real rainprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz) real evapprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz) + logical lrescalelow(lc:lhab) real tkediss(-nor+1:nx+nor,-norz+ng1:nz+norz) real axtra(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz,nxtra) @@ -10633,7 +11893,8 @@ subroutine nssl_2mom_gs & real ex1, ft, rhoinv(ngs) double precision ec0(ngs) - real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,temp3 ! , sstdy, super + real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,temp3 ! , sstdy, super + real :: flim real dw,dwr double precision :: tmpz, tmpzmlt real ratio, delx, dely @@ -10714,7 +11975,7 @@ subroutine nssl_2mom_gs & real temgx(ngs),temcgx(ngs) real qvs(ngs),qis(ngs),qss(ngs),pqs(ngs) real elv(ngs),elf(ngs),els(ngs) - real tsqr(ngs),ssi(ngs),ssw(ngs) + real tsqr(ngs),ssi(ngs),ssw(ngs),ssi0(ngs) real qcwtmp(ngs),qtmp,qtot(ngs) real qcond(ngs) real ctmp, sctmp @@ -10729,6 +11990,7 @@ subroutine nssl_2mom_gs & parameter ( rwradmn = 50.e-6 ) real dh0 real dg0(ngs),df0(ngs) + real dhwet(ngs),dhlwet(ngs),dfwet(ngs) real clionpmx,clionnmx parameter (clionpmx=1.e9,clionnmx=1.e9) ! Takahashi 84 @@ -10736,7 +11998,7 @@ subroutine nssl_2mom_gs & ! other arrays real fwet1(ngs),fwet2(ngs) - real fmlt1(ngs),fmlt2(ngs) + real fmlt1(ngs),fmlt2(ngs),fmlt1e(ngs) real fvds(ngs),fvce(ngs),fiinit(ngs) real fvent(ngs),fraci(ngs),fracl(ngs) ! @@ -10760,6 +12022,7 @@ subroutine nssl_2mom_gs & ! real :: sfm1(ngs),sfm2(ngs) real :: gfm1(ngs),gfm2(ngs) + real :: ffm1(ngs),ffm2(ngs) real :: hfm1(ngs),hfm2(ngs) logical :: wetsfc(ngs),wetsfchl(ngs),wetsfcf(ngs) @@ -10800,6 +12063,10 @@ subroutine nssl_2mom_gs & real :: alpha(ngs,lc:lhab) real :: dab0lh(ngs,lc:lhab,lc:lhab) real :: dab1lh(ngs,lc:lhab,lc:lhab) + real :: zx(ngs,lr:lhab) + real :: zxmxd(ngs,lr:lhab) + real :: g1x(ngs,lr:lhab) + real :: qsimxdep(ngs) ! max sublimation of qi+qs+qis real :: qsimxsub(ngs) ! max depositionof qi+qs+qis @@ -10815,6 +12082,7 @@ subroutine nssl_2mom_gs & real ventrxn(ngs) real g1shr, alphashr real g1mlr, alphamlr + real g1smlr, alphasmlr real massfacshr, massfacmlr real :: qhgt8mm ! ice mass greater than 8mm @@ -10827,6 +12095,8 @@ subroutine nssl_2mom_gs & real, parameter :: srasheym = 0.1389 ! slope fraction from Rasmussen and Heymsfield ! real swvent(ngs),hwvent(ngs),rwvent(ngs),hlvent(ngs),hwventy(ngs),hlventy(ngs),rwventz(ngs) + real hxventtmp + real hlventinc(ngs),hwventinc(ngs) integer, parameter :: ndiam = 10 integer :: numdiam real hwvent0(ndiam+4),hlvent0 ! 0 to d1 @@ -10946,9 +12216,10 @@ subroutine nssl_2mom_gs & real qsacw(ngs) ! ,qwacs(ngs), real qhacw(ngs) ! qwach(ngs), - real :: qhlacw(ngs) ! + real :: qhlacw(ngs), qxacwtmp, qxacrtmp ! real vhacw(ngs), vsacw(ngs), vhlacw(ngs), vhlacr(ngs) + real qfcev(ngs) real qfmul1(ngs),cfmul1(ngs) ! real qsacws(ngs) @@ -10957,7 +12228,7 @@ subroutine nssl_2mom_gs & ! arrays for x-ac-r and r-ac-x; ! real qsacr(ngs),qracs(ngs) - real qhacr(ngs),qhacrmlr(ngs) ! ,qrach(ngs) + real qhacr(ngs),qhacrmlr(ngs),qhacwmlr(ngs) ! ,qrach(ngs) real vhacr(ngs), zhacr(ngs), zhacrf(ngs), zrach(ngs), zrachl(ngs) real qiacr(ngs),qraci(ngs) @@ -10965,7 +12236,7 @@ subroutine nssl_2mom_gs & real qracif(ngs),qiacrf(ngs),qiacrs(ngs),ciacrs(ngs) - real :: qhlacr(ngs),qhlacrmlr(ngs) + real :: qhlacr(ngs),qhlacrmlr(ngs), qhlacwmlr(ngs) real qsacrs(ngs) !,qracss(ngs) ! ! ice - ice interactions @@ -11011,7 +12282,7 @@ subroutine nssl_2mom_gs & real zfmlr(ngs), zfdsv(ngs), zfsbv(ngs), zhlcnf(ngs), zfshr(ngs), zfshrr(ngs) real zhmlrtmp,zhmlr0inf,zhlmlr0inf real zhmlrr(ngs),zhlmlrr(ngs),zhshrr(ngs),zhlshrr(ngs),zfmlrr(ngs) - real zsmlr(ngs), zsmlrr(ngs), zsshr(ngs) + real zsmlr(ngs), zsmlrr(ngs), zsshr(ngs), zsshrr(ngs) real zhcns(ngs), zhcni(ngs) real zhwdn(ngs), zfwdn(ngs) ! change in Z due to density changes real zhldn(ngs) ! change in Z due to density changes @@ -11052,9 +12323,10 @@ subroutine nssl_2mom_gs & ! real :: qhldpv(ngs), qhlsbv(ngs) ! qhlcnv(ngs),qhlevv(ngs), real :: qhlmlr(ngs), qhldsv(ngs), qhlmlrsave(ngs) - real :: qhlwet(ngs), qhldry(ngs), qhlshr(ngs) + real :: qhlwet(ngs), qhldry(ngs), qhlshr(ngs), qxwettmp ! real :: qrfz(ngs),qsfz(ngs),qhfz(ngs),qhlfz(ngs) + real :: qffz(ngs) ! real qhdpv(ngs),qhsbv(ngs) ! qhcnv(ngs),qhevv(ngs), real qhmlr(ngs),qhdsv(ngs),qhcev(ngs),qhcndv(ngs),qhevv(ngs) @@ -11064,6 +12336,7 @@ subroutine nssl_2mom_gs & real qhshh(ngs) !accreted water that remains on graupel real qhmlh(ngs) !melt water that remains on graupel real qhfzh(ngs) !water that freezes on mixed-phase graupel + real qffzf(ngs) !water that freezes on mixed-phase FD real qhlfzhl(ngs) !water that freezes on mixed-phase hail real qhmlrlg(ngs),qhlmlrlg(ngs) ! melting from the larger diameters @@ -11115,6 +12388,7 @@ subroutine nssl_2mom_gs & real qrshr(ngs) real fsw(ngs),fhw(ngs),fhlw(ngs),ffw(ngs) !liquid water fractions real fswmax(ngs),fhwmax(ngs),fhlwmax(ngs) !liquid water fractions + real ffwmax(ngs) real qhcnf(ngs) real :: qhlcnh(ngs) real qhcngh(ngs),qhcngm(ngs),qhcngl(ngs) @@ -11128,7 +12402,7 @@ subroutine nssl_2mom_gs & real ehxr(ngs),ehlr(ngs),egmr(ngs) real eri(ngs),esi(ngs),egli(ngs),eghi(ngs),efi(ngs),efis(ngs) real ehxi(ngs),ehli(ngs),egmi(ngs),ehi(ngs),ehis(ngs),ehlis(ngs) - real ers(ngs),ess(ngs),egls(ngs),eghs(ngs),efs(ngs),ehs(ngs) + real ers(ngs),ess(ngs),egls(ngs),eghs(ngs),efs(ngs),ehs(ngs),ehsfac(ngs) real ehscnv(ngs) real ehxs(ngs),ehls(ngs),egms(ngs),egmip(ngs) @@ -11187,12 +12461,13 @@ subroutine nssl_2mom_gs & real pqgli(ngs),pqghi(ngs),pqfwi(ngs) real pqgmi(ngs),pqhli(ngs) ! ,pqhxi(ngs) real pqiri(ngs),pqipi(ngs) ! pqwai(ngs), - real pqlwsi(ngs),pqlwhi(ngs),pqlwhli(ngs) + real pqlwsi(ngs),pqlwhi(ngs),pqlwhli(ngs),pqlwfi(ngs) real pqlwlghi(ngs),pqlwlghli(ngs) real pqlwlghd(ngs),pqlwlghld(ngs) + real pvhwi(ngs), pvhwd(ngs) real pvfwi(ngs), pvfwd(ngs) @@ -11204,7 +12479,7 @@ subroutine nssl_2mom_gs & real pqgld(ngs),pqghd(ngs),pqfwd(ngs) real pqgmd(ngs),pqhld(ngs) ! ,pqhxd(ngs) real pqird(ngs),pqipd(ngs) ! pqwad(ngs), - real pqlwsd(ngs),pqlwhd(ngs),pqlwhld(ngs) + real pqlwsd(ngs),pqlwhd(ngs),pqlwhld(ngs),pqlwfd(ngs) ! ! real pqxii(ngs,nhab),pqxid(ngs,nhab) ! @@ -11352,7 +12627,7 @@ subroutine nssl_2mom_gs & real frcrglgm, frcrglgh, frcrglfw, frcrglgl1 real frcgmrgl, frcgmrgm, frcgmrgh, frcgmrfw, frcgmrgm1 real frcrgmgl, frcrgmgm, frcrgmgh, frcrgmfw, frcrgmgm1 - real sum, qweps, gf2a, gf4a, dqldt, dqidt, dqdt + real total, qweps, gf2a, gf4a, dqldt, dqidt, dqdt real frcghrgl, frcghrgm, frcghrgh, frcghrfw, frcghrgh1, frcrghgl real frcrghgm, frcrghgh, frcrghfw, frcrghgh1 real a1,a2,a3,a4,a5,a6 @@ -11385,8 +12660,20 @@ subroutine nssl_2mom_gs & real :: term1,term2,term3,term4 real :: qaacw ! combined qsacw-qhacw for WSM6 variation + real, parameter :: c1r=19.0, c2r=0.6, c3r=1.8, c4r=17.0 ! rain + real, parameter :: c1h=5.5, c2h=0.7, c3h=4.5, c4h=8.5 ! Graupel + real, parameter :: c1hl=3.7, c2hl=0.3, c3hl=9.0, c4hl=6.5, c5hl=1.0, c6hl=6.5 ! Hail + +! inline functions for Newton method + real :: galpha, dgalpha + real :: a_in + logical, parameter :: newton = .false. + + galpha(a_in) = ((4. + a_in)*(5. + a_in)*(6. + a_in))/((1. + a_in)*(2. + a_in)*(3. + a_in)) + dgalpha(a_in) = (876. + 1260.*a_in + 621.*a_in**2 + 126.*a_in**3 + 9.*a_in**4)/ & + & (36. + 132.*a_in + 193.*a_in**2 + 144.*a_in**3 + 58.*a_in**4 + 12.*a_in**5 + a_in**6) ! ! #################################################################### ! @@ -11416,6 +12703,11 @@ subroutine nssl_2mom_gs & jstag = 0 kstag = 1 + lrescalelow(:) = rescale_low_alpha + lrescalelow(lr) = rescale_low_alphar .and. rescale_low_alpha + lrescalelow(lh) = rescale_low_alphah .and. rescale_low_alpha + IF ( lf > 1 ) lrescalelow(lf) = rescale_low_alphah .and. rescale_low_alpha + IF ( lhl > 1 ) lrescalelow(lhl) = rescale_low_alphahl .and. rescale_low_alpha ! @@ -11533,11 +12825,18 @@ subroutine nssl_2mom_gs & vmlt = Min(xvmx(lr), 0.523599*(dmlt)**3 ) vshd = Min(xvmx(lr), 0.523599*(dshd)**3 ) - snowmeltmass = pi/6.0 * 1000. * snowmeltdia**3 ! maximum rain particle mass from melting snow (if snowmeltdia > 0) + IF ( snowmeltdia > 0.0 ) THEN + snowmeltmass = pi/6.0 * 1000. * snowmeltdia**3 ! maximum rain particle mass from melting snow (if snowmeltdia > 0) + ENDIF tdtol = 1.0e-05 tfrcbw = tfr - cbw tfrcbi = tfr - cbi + + IF ( mixedphase ) THEN + ibinhmlr = 0 + ibinhlmlr = 0 + ENDIF ! ! ! #ifdef COMMAS @@ -11695,10 +12994,15 @@ subroutine nssl_2mom_gs & temg(1) = t0(ix,jy,kz) temcg(1) = temg(1) - tfr tqvcon = temg(1)-cbw - ltemq = (temg(1)-163.15)/fqsat+1.5 + ltemq = (temg(1)-163.15)/fqsat + 1.5 ltemq = Min( nqsat, Max(1,ltemq) ) qvs(1) = pqs(1)*tabqvs(ltemq) - qis(1) = pqs(1)*tabqis(ltemq) + IF ( iqis0 == 1 .or. temg(1) <= tfr+0.5 ) THEN + qis(1) = pqs(1)*tabqis(ltemq) + ELSE + ltemq = (tfr - 163.15)/fqsat + 1.5 + qis(1) = pqs(1)*tabqis(ltemq) + ENDIF qss(1) = qvs(1) @@ -11793,7 +13097,12 @@ subroutine nssl_2mom_gs & ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) qvs(mgs) = pqs(mgs)*tabqvs(ltemq) - qis(mgs) = pqs(mgs)*tabqis(ltemq) + IF ( iqis0 == 1 .or. temg(mgs) <= tfr+0.5 ) THEN + qis(mgs) = pqs(mgs)*tabqis(ltemq) + ELSE + ltemq = (tfr - 163.15)/fqsat + 1.5 + qis(mgs) = pqs(mgs)*tabqis(ltemq) + ENDIF qss(mgs) = qvs(mgs) ! es(mgs) = 6.1078e2*tabqvs(ltemq) ! eis(mgs) = 6.1078e2*tabqis(ltemq) @@ -11834,78 +13143,6 @@ subroutine nssl_2mom_gs & - scx(:,:) = 0.0 -! -! set shape parameters -! - IF ( imurain == 1 ) THEN - alpha(:,lr) = alphar - ELSEIF ( imurain == 3 ) THEN - alpha(:,lr) = xnu(lr) - ENDIF - - alpha(:,li) = xnu(li) - alpha(:,lc) = xnu(lc) - - IF ( imusnow == 1 ) THEN - alpha(:,ls) = alphas - ELSEIF ( imusnow == 3 ) THEN - alpha(:,ls) = xnu(ls) - ENDIF - - DO il = lr,lhab - do mgs = 1,ngscnt - IF ( il .ge. lg ) alpha(mgs,il) = dnu(il) - - - DO ic = lc,lhab - dab0lh(mgs,il,ic) = dab0(il,ic) ! dab0(ic,il) - dab1lh(mgs,il,ic) = dab1(il,ic) ! dab1(ic,il) - ENDDO - ENDDO - end do - - -! DO mgs = 1,ngscnt - DO il = lr,lhab - da0lx(:,il) = da0(il) - ENDDO - da0lh(:) = da0(lh) - da0lr(:) = da0(lr) - da1lr(:) = da1(lr) - da0lc(:) = da0(lc) - da1lc(:) = da1(lc) - - - IF ( lzh < 1 .or. lzhl < 1 ) THEN - rzxhlh(:) = rzhl/rz - ELSEIF ( lzh > 1 .and. lzhl > 1 ) THEN - rzxhlh(:) = 1. - ENDIF - IF ( lzr > 1 ) THEN - rzxh(:) = 1. - rzxhl(:) = 1. - ELSE - rzxh(:) = rz - rzxhl(:) = rzhl - ENDIF - - IF ( imurain == 1 .and. imusnow == 3 .and. lzr < 1 ) THEN - rzxs(:) = rzs - ELSEIF ( imurain == imusnow .or. lzr > 1 ) THEN - rzxs(:) = 1. - ENDIF - ! ENDDO - - IF ( lhl .gt. 1 ) THEN - DO mgs = 1,ngscnt - da0lhl(mgs) = da0(lhl) - ENDDO - ENDIF - - ventrx(:) = ventr - ventrxn(:) = ventrn - gf1palp(:) = gamma_sp(1.0 + alphar) ! ! set concentrations @@ -12076,17 +13313,136 @@ subroutine nssl_2mom_gs & ! -! set factors -! - do mgs = 1,ngscnt -! - ssi(mgs) = qx(mgs,lv)/qis(mgs) - ssw(mgs) = qx(mgs,lv)/qvs(mgs) +! 6th moments ! - tsqr(mgs) = temg(mgs)**2 -! - temgx(mgs) = min(temg(mgs),313.15) - temgx(mgs) = max(temgx(mgs),233.15) + + IF ( ipconc .ge. 6 ) THEN + zx(:,:) = 0.0 + DO il = lr,lhab + IF ( lz(il) .gt. 1 ) THEN + DO mgs = 1,ngscnt + zx(mgs,il) = Max( an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0 ) + ENDDO + ENDIF + ENDDO + + ENDIF + + IF ( ipconc .ge. 6 ) THEN + + IF ( lz(lr) .lt. 1 ) THEN + g1x(:,lr) = (6.0 + alphar)*(5.0 + alphar)*(4.0 + alphar)/ & + & ((3.0 + alphar)*(2.0 + alphar)*(1.0 + alphar)) + + + DO mgs = 1,ngscnt + IF ( cx(mgs,lr) .gt. 0.0 .and. qx(mgs,lr) .gt. qxmin(lr) ) THEN + + vr = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + IF ( lzr < 1 ) THEN + IF ( imurain == 3 ) THEN + zx(mgs,lr) = 3.6476*(rnu+2.0)*cx(mgs,lr)*vr**2/(rnu+1.0) + ELSE ! imurain == 1 + zx(mgs,lr) = 3.6476*g1x(mgs,lr)*cx(mgs,lr)*vr**2 + ENDIF + ENDIF + + ENDIF + ENDDO + ENDIF + + ENDIF + + + scx(:,:) = 0.0 +! +! set shape parameters +! + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set alpha' + IF ( imurain == 1 ) THEN + alpha(:,lr) = alphar + ELSEIF ( imurain == 3 ) THEN + alpha(:,lr) = xnu(lr) + ENDIF + + alpha(:,li) = xnu(li) + alpha(:,lc) = xnu(lc) + + IF ( imusnow == 1 ) THEN + alpha(:,ls) = alphas + ELSEIF ( imusnow == 3 ) THEN + alpha(:,ls) = xnu(ls) + ENDIF + + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set dab' + + DO il = lr,lhab + do mgs = 1,ngscnt + IF ( il .ge. lg ) alpha(mgs,il) = dnu(il) + + + DO ic = lc,lhab + dab0lh(mgs,il,ic) = dab0(il,ic) ! dab0(ic,il) + dab1lh(mgs,il,ic) = dab1(il,ic) ! dab1(ic,il) + ENDDO + end do + ENDDO + + +! DO mgs = 1,ngscnt + DO il = lr,lhab + da0lx(:,il) = da0(il) + ENDDO + da0lh(:) = da0(lh) + da0lr(:) = da0(lr) + da1lr(:) = da1(lr) + da0lc(:) = da0(lc) + da1lc(:) = da1(lc) + + if ( ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'ICEZVD_GS: dbg = set rz' + + IF ( lzh < 1 .or. lzhl < 1 ) THEN + rzxhlh(:) = rzhl/rz + ELSEIF ( lzh > 1 .and. lzhl > 1 ) THEN + rzxhlh(:) = 1. + ENDIF + IF ( lzr > 1 ) THEN + rzxh(:) = 1. + rzxhl(:) = 1. + ELSE + rzxh(:) = rz + rzxhl(:) = rzhl + ENDIF + + IF ( imurain == 1 .and. imusnow == 3 .and. lzr < 1 ) THEN + rzxs(:) = rzs + ELSEIF ( imurain == imusnow .or. lzr > 1 ) THEN + rzxs(:) = 1. + ENDIF + ! ENDDO + + IF ( lhl .gt. 1 ) THEN + DO mgs = 1,ngscnt + da0lhl(mgs) = da0(lhl) + ENDDO + ENDIF + + ventrx(:) = ventr + ventrxn(:) = ventrn + gf1palp(:) = gamma_sp(1.0 + alphar) + +! +! set factors +! + do mgs = 1,ngscnt +! + ssi(mgs) = qx(mgs,lv)/qis(mgs) + ssw(mgs) = qx(mgs,lv)/qvs(mgs) +! + tsqr(mgs) = temg(mgs)**2 +! + temgx(mgs) = min(temg(mgs),313.15) + temgx(mgs) = max(temgx(mgs),233.15) felv(mgs) = 2500837.367 * (273.15/temgx(mgs))**((0.167)+(3.67e-4)*temgx(mgs)) ! temcgx(mgs) = min(temg(mgs),273.15) @@ -12112,6 +13468,7 @@ subroutine nssl_2mom_gs & tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh) IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl) + IF ( lf > 1 ) tmp = tmp + qx(mgs,lf) cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & +cpigb*(tmp) @@ -12260,14 +13617,86 @@ subroutine nssl_2mom_gs & end do + IF ( ipconc == 5 .and. imydiagalpha > 1 ) THEN + + DO mgs = 1,ngscnt + !IF ( igs(mgs) == 19 ) write(0,*) 'k,qr,qh,cr,ch = ',kgs(mgs),qx(mgs,lr),cx(mgs,lr),qx(mgs,lh),cx(mgs,lh) + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > cxmin ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) ! + xdia(mgs,lr,3) = (xv(mgs,lr)*6.0*cwc1)**(1./3.) + alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) + ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alpr,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lr),xdia(mgs,lr,3)*1000. + ENDIF + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) > cxmin ) THEN + xv(mgs,lh) = rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ! + xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.) ! mwfac*xdia(mgs,lh,1) ! (xv(mgs,lh)*cwc0*6.0)**(1./3.) + alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) + + ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alph,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lh),xdia(mgs,lh,3)*1000. + il = lh + DO ic = lc,lh-1 ! lhab + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + ENDDO + ENDIF +! alpha(:,lr) = 0. ! 10. +! alpha(:,lh) = 0. ! 10. + IF ( lhl > 0 ) THEN + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) > cxmin ) THEN + xv(mgs,lhl) = rho0(mgs)*qx(mgs,lhl)/(xdn(mgs,lhl)*cx(mgs,lhl)) ! + xdia(mgs,lhl,3) = (xv(mgs,lhl)*6.*piinv)**(1./3.) + IF ( xdia(mgs,lhl,3) < 0.008 ) THEN + alpha(mgs,lhl) = Min(alphamax, c1hl*tanh(c2hl*(xdia(mgs,lhl,3)*1000. - c3hl)) + c4hl) + ELSE + alpha(mgs,lhl) = Min(alphamax, c5hl*xdia(mgs,lhl,3)*1000. + c6hl) + ENDIF + + il = lhl + DO ic = lc,lh-1 ! lhab + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + ENDDO + + ENDIF + ENDIF + + + + ENDDO + ENDIF + IF ( imurain == 3 ) THEN IF ( lzr > 1 ) THEN alphashr = 0.0 alphamlr = -2.0/3.0 + alphasmlr = -2.0/3.0 ELSE alphashr = xnu(lr) alphamlr = xnu(lr) + alphasmlr = xnu(lr) ENDIF ! massfacshr = ( (2. + 3.*(1. +alphashr) )/( 3.*(1. + alphashr) ) )**(1./3.) ! this is the diameter factor ! massfacmlr = ( (2. + 3.*(1. +alphamlr) )/( 3.*(1. + alphamlr) ) )**(1./3.) @@ -12277,9 +13706,11 @@ subroutine nssl_2mom_gs & IF ( lzr > 1 ) THEN alphashr = 4.0 alphamlr = 4.0 + alphasmlr = alphasmlr0 ELSE alphashr = alphar alphamlr = alphar + alphasmlr = alphar ENDIF ! massfacshr = (3.0 + alphashr)*((3.+alphashr)*(2.+alphashr)*(1. + alphashr) )**(-1./3.) ! this is the diameter factor ! massfacmlr = (3.0 + alphamlr)*((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) )**(-1./3.) @@ -12287,110 +13718,819 @@ subroutine nssl_2mom_gs & massfacmlr = (3.0 + alphamlr)**3/((3.+alphamlr)*(2.+alphamlr)*(1. + alphamlr) ) ENDIF +! Find shape parameter rain -! -! set some values for ice nucleation -! - do mgs = 1,ngscnt - kp1 = Min(nz, kgs(mgs)+1 ) -! wvel(mgs) = (0.5)*(w(igs(mgs),jgs,kp1) & -! & +w(igs(mgs),jgs,kgs(mgs))) + g1shr = 1.0 + g1mlr = 1.0 + g1smlr = 1.0 + +! CALL cld_cpu('Z-MOMENT-1') + + ! set base g1x in case rain is not 3-moment + IF ( ipconc >= 6 .and. imurain == 3 ) THEN + il = lr + DO mgs = 1,ngscnt +! g1x(mgs,il) = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + g1x(mgs,il) = (alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)) + ENDDO + ENDIF + IF (lzr > 1 ) THEN + IF ( imurain == 3 ) THEN + g1shr = (alphashr+2.0)/((alphashr+1.0)) + g1mlr = (alphamlr+2.0)/((alphamlr+1.0)) + g1smlr = (alphasmlr+2.0)/((alphasmlr+1.0)) + ELSEIF ( imurain == 1 ) THEN +! g1shr = 36.*(6.0 + alphashr)*(5.0 + alphashr)*(4.0 + alphashr)/ & +! & (pi**2*(3.0 + alphashr)*(2.0 + alphashr)*(1.0 + alphashr)) + g1shr = (6.0 + alphashr)*(5.0 + alphashr)*(4.0 + alphashr)/ & + & ((3.0 + alphashr)*(2.0 + alphashr)*(1.0 + alphashr)) +! g1mlr = 36.*(6.0 + alphamlr)*(5.0 + alphamlr)*(4.0 + alphamlr)/ & +! & (pi**2*(3.0 + alphamlr)*(2.0 + alphamlr)*(1.0 + alphamlr)) + g1mlr = (6.0 + alphamlr)*(5.0 + alphamlr)*(4.0 + alphamlr)/ & + & ((3.0 + alphamlr)*(2.0 + alphamlr)*(1.0 + alphamlr)) + g1smlr = (6.0 + alphasmlr)*(5.0 + alphasmlr)*(4.0 + alphasmlr)/ & + & ((3.0 + alphasmlr)*(2.0 + alphasmlr)*(1.0 + alphasmlr)) + ENDIF + ENDIF + + IF ( lzr > 1 .and. imurain == 3 ) THEN ! { RAIN SHAPE PARAM - wvelkm1(mgs) = (0.5)*(w(igs(mgs),jgs,kgs(mgs)) & - & +w(igs(mgs),jgs,kgsm(mgs))) - cninm(mgs) = t7(igs(mgs),jgs,kgsm(mgs)) - cnina(mgs) = t7(igs(mgs),jgs,kgs(mgs)) - cninp(mgs) = t7(igs(mgs),jgs,kgsp(mgs)) - end do + +! CALL cld_cpu('Z-MOMENT-1r') + il = lr + DO mgs = 1,ngscnt + -! -! Set a couple of cloud variables... -! + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! .or. qx(mgs,il) <= qxmin(il) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 THEN +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 THEN + + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF -! SUBROUTINE setvt(ngscnt,qx,qxmin,cx,rho0,rhovt,xdia,cno, -! : xmas,xdn,xvmn,xvmx,xv,cdx, -! : ipconc,ndebug) -! SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno, & -! & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx, & -! & ipconc1,ndebug1,ngs,nz,kgs,cwnccn,fadvisc, & -! & cwmasn,cwmasx,cwradn,cnina,cimna,cimxa, & -! & itype1a,itype2a,temcg,infdo,alpha) + IF ( .false. .and. zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN - infdo = 0 - IF ( rimdenvwgt > 0 ) infdo = 1 + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF - call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & - & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, & - & ipconc,ndebug,ngs,nz,kgs,fadvisc, & - & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, & - & itype1,itype2,temcg,infdo,alpha,0,axx,bxx) ! ,cdh,cdhl) -! & itype1,itype2,temcg,infdo,alpha,0,axh,bxh,axhl,bxhl) ! ,cdh,cdhl) + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + vr = xv(mgs,lr) +! z = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN +! alpha(mgs,lr) = 3. + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. +! print*,'kz, alp, alpha(kz) = ',kz,alp,alpha(kz),rd,z,xv + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO +! check for artificial breakup (rain larger than allowed max size) + IF ( (xv(mgs,il) .gt. xvmx(il) .or. (ioldlimiter >= 2 .and. xv(mgs,il) .gt. xvmx(il)/8.) )) THEN + tmp = cx(mgs,il) + IF ( ioldlimiter >= 2 ) THEN ! MY-style active breakup + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE ! simple cutoff + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + !xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + !cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) - IF ( lwsm6 .and. ipconc == 0 ) THEN - tmp = Max(qxmin(lh), qxmin(ls)) - DO mgs = 1,ngscnt - sum = qx(mgs,lh) + qx(mgs,ls) - IF ( sum > tmp ) THEN - vt2ave(mgs) = (qx(mgs,lh)*vtxbar(mgs,lh,1) + qx(mgs,ls)*vtxbar(mgs,ls,1))/sum - ELSE - vt2ave(mgs) = 0.0 - ENDIF - ENDDO - ENDIF + IF ( tmp < cx(mgs,il) ) THEN ! breakup + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) -! -! Set number concentrations (need xdia from setvt) -! - if ( ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: Set concentration' - IF ( ipconc .lt. 1 ) THEN - cina(1:ngscnt) = cx(1:ngscnt,li) - ENDIF - if ( ipconc .lt. 5 ) then - do mgs = 1,ngscnt + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) - IF ( ipconc .lt. 3 ) THEN -! cx(mgs,lr) = 0.0 - if ( qx(mgs,lr) .gt. qxmin(lh) ) then -! cx(mgs,lr) = cno(lr)*xdia(mgs,lr,1) -! xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) - end if - ENDIF +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO - IF ( ipconc .lt. 4 ) THEN -! tmp = cx(mgs,ls) -! cx(mgs,ls) = 0.0 - if ( qx(mgs,ls) .gt. qxmin(ls) ) then -! cx(mgs,ls) = cno(ls)*xdia(mgs,ls,1) -! xv(mgs,ls) = rho0(mgs)*qx(mgs,ls)/(xdn(mgs,ls)*cx(mgs,ls)) - end if - ENDIF ! ( ipconc .lt. 4 ) + + ENDIF + ENDIF - IF ( ipconc .lt. 5 ) THEN +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + + ! set g1x to use as G factor later. If alpha is in the range ( rnumin < alpha < rnumax ), then + ! this will be the same as computing G from alpha. If alpha = rnumax, however, it probably means that + ! the moments are not matched correctly, so we compute G from the moments instead so that the dZ/dt rates + ! stay consistent with dN/dt and dq/dt. + IF ( alp >= rnumax - 0.01 ) THEN +! g1x(mgs,il) = 6**2*zx(mgs,il)/(cx(mgs,il)*(pi*xv(mgs,lr))**2) +! g1x(mgs,il) = xdn(mgs,il)*zx(mgs,il)*cx(mgs,il)/((rho0(mgs)*qx(mgs,lr))**2) + g1x(mgs,il) = (pi*xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((6.*rho0(mgs)*qx(mgs,il))**2) + ELSE + g1x(mgs,il) = g1 + ENDIF + + tmp = alpha(mgs,lr) + 4./3. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + gf1palp(mgs) = y -! cx(mgs,lh) = 0.0 - if ( qx(mgs,lh) .gt. qxmin(lh) ) then -! cx(mgs,lh) = cno(lh)*xdia(mgs,lh,1) -! xv(mgs,lh) = Max(xvmn(lh), rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ) -! xdia(mgs,lh,3) = (xv(mgs,lh)*6./pi)**(1./3.) - end if +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma_sp(alpha(mgs,lr) + 1.) + ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) - ENDIF ! ( ipconc .lt. 5 ) + IF ( imurain == 3 .and. izwisventr == 2 ) THEN - end do - end if - - IF ( ipconc .ge. 2 ) THEN - DO mgs = 1,ngscnt - - rb(mgs) = 0.5*xdia(mgs,lc,1)*(1./(1.+alpha(mgs,lc)))**(1./6.) - xl2p(mgs) = Max(0.0d0, 2.7e-2*xdn(mgs,lc)*cx(mgs,lc)*xv(mgs,lc)* & - & ((0.5e20*rb(mgs)**3*xdia(mgs,lc,1))-0.4) ) + tmp = alpha(mgs,lr) + 1.5 + br/6. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) + ventrxn(mgs) = x/(y*(alpha(mgs,lr) + 1.)**((1.+br)/6. + 1./3.)) + +! This whole section is imurain == 3, so this branch never runs +! ELSEIF ( imurain == 1 .and. iferwisventr == 2 ) THEN +! +! tmp = alpha(mgs,lr) + 2.5 + br/2. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +!! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) +! ventrxn(mgs) = x/y + + + ENDIF + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r') + ENDIF ! } + + +! Find shape parameters for graupel and hail + IF ( ipconc .ge. 6 ) THEN + + DO il = lr,lhab + + ! set base values of g1x + IF ( (.not. ( il == lr .and. imurain == 3 )) .and. ( il == lr .or. il == lh .or. il == lhl .or. il == lf ) ) THEN + DO mgs = 1,ngscnt + g1x(mgs,il) = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + ENDDO + ENDIF + + IF ( lz(il) .gt. 1 .and. ( .not. ( il == lr .and. imurain == 3 )) ) THEN + + DO mgs = 1,ngscnt + + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! .or. qx(mgs,il) <= qxmin(il) ) THEN + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + zx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + ENDIF + + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > cxmin ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + g1 = (6.0 + alphamax)*(5.0 + alphamax)*(4.0 + alphamax)/ & + & ((3.0 + alphamax)*(2.0 + alphamax)*(1.0 + alphamax)) + zx(mgs,il) = Max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSE + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN + +! rdi = z*(pi/6.*1000.)**2*chw/((rho0(mgs)*qr)**2) + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'kz, alp, alpha(mgs,il) = ',kz,alp,alpha(mgs,il),rdi,z,xv + alp = Max( alphamin, Min( alphamax, alp ) ) + + IF ( newton ) THEN + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = alp + ( galpha(alp) - rdi )/dgalpha(alp) + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + ELSE + DO i = 1,10 +! IF ( 100.*Abs(alp - alpha(mgs,il))/(Abs(alpha(mgs,il))+1.e-5) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + ENDIF + + +! check for artificial breakup (graupel/hail larger than allowed max size) + IF ( imaxdiaopt == 1 ) THEN + xvbarmax = xvmx(il) + ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter + xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSEIF ( imaxdiaopt == 3 ) THEN ! test against mass-weighted diameter + xvbarmax = xvmx(il) /((4. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) + ELSE + xvbarmax = xvmx(il) + ENDIF + + IF ( xv(mgs,il) .gt. xvbarmax .or. (il == lr .and. ioldlimiter >= 2 .and. xv(mgs,il) .gt. xvmx(il)/8.)) THEN + tmp = cx(mgs,il) + IF( ioldlimiter >= 2 .and. il == lr) THEN ! MY-style drop limiter for rain + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE + xv(mgs,il) = Min( xvbarmax, Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + IF ( tmp < cx(mgs,il) ) THEN ! artificial breakup has happened, so need to adjust reflectivity and find new shape parameter + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( ( lrescalelow(il) .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN + + + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( lrescalelow(il) .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) .and. & + .not. ( il == lr .and. .not. rescale_low_alphar ) ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + wtest = .false. + IF ( irescalerainopt == 0 ) THEN + wtest = .false. + ELSEIF ( irescalerainopt == 1 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) + ELSEIF ( irescalerainopt == 2 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ELSEIF ( irescalerainopt == 3 ) THEN + wtest = temcg(mgs) > rescale_tempthresh .and. qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ENDIF + + IF ( il == lr .and. ( wtest ) ) THEN +! IF ( temcg(mgs) > 0.0 .and. il == lr .and. qx(mgs,lc) > qxmin(lc) ) THEN + ! certain situations where rain number is adjusted instead of Z. Helps avoid rain being 'zapped' by autoconverted + ! drops (i.e., favor preserving Z when alpha tries to go negative) + chw = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 ! g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1 + cx(mgs,il) = chw + an(igs(mgs),jy,kgs(mgs),ln(il)) = chw + ELSE + + ! Usual resetting of reflectivity moment to force consisntency between Q, N, Z, and alpha when alpha = alphamin + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + ENDIF + ENDIF + + + ! set g1x to use as G factor later. If alpha is in the range ( rnumin < alpha < rnumax ), then + ! this will be the same as computing G from alpha. If alpha = rnumax, however, it probably means that + ! the moments are not matched correctly, so we compute G from the moments instead so that the dZ/dt rates + ! stay consistent with dN/dt and dq/dt. +! g1x(mgs,il) = zx(mgs,il)*chw*(pi*xdn(mgs,il))**2/(6.*qr*dn(igs(mgs),jy,kgs(mgs)))**2 +! g1x(mgs,il) = g1 ! zx(mgs,il)*cx(mgs,il)/(qr)**2 + IF ( alp >= alphamax - 0.5 ) THEN +! g1x(mgs,il) = 6**2*zx(mgs,il)/(cx(mgs,il)*(pi*xv(mgs,lr))**2) +! g1x(mgs,il) = (xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((rho0(mgs)*qx(mgs,il))**2) + g1x(mgs,il) = (pi*xdn(mgs,il))**2*zx(mgs,il)*cx(mgs,il)/((6.*rho0(mgs)*qx(mgs,il))**2) + ELSE + g1x(mgs,il) = g1 + ENDIF + + ENDIF + +! IF ( ny .eq. 2 ) THEN +! IF ( qr .gt. 1.e-3 ) THEN +! write(0,*) 'alphah at nstep,i,k = ',dtp*(nstep-1),igs(mgs),kgs(mgs),alpha(mgs,il),qr*1000. +! ENDIF +! ENDIF + + + ENDIF ! .true. + + IF ( il == lr ) THEN + +! tmp = alpha(mgs,lr) + 4./3. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +! tmp = alpha(mgs,lr) + 1. +! i = Int(dgami*(tmp)) +! del = tmp - dgam*i +! y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami +! +!! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 4./3.)/(alpha(mgs,lr) + 1.)**(1./3.)/Gamma_sp(alpha(mgs,lr) + 1.) +! ventrx(mgs) = x/(y*(alpha(mgs,lr) + 1.)**(1./3.)) + + + tmp = alpha(mgs,lr) + 1. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + gf1palp(mgs) = y + + IF ( iferwisventr == 2 ) THEN + tmp = alpha(mgs,lr) + 2.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) + + ventrxn(mgs) = x/y + + ENDIF + + ENDIF ! il==lr + + + ELSE ! below mass threshold +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) +! z1 = g1*rho0(mgs)**2*(qr)*qr/chw +! z = 1.e18*z1*(6./(pi*1000.))**2 +! z = z1*(6./(pi*1000.))**2 +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF ! ( qx(mgs,il) .gt. qxmin(il) ) + + + +! ENDIF + ENDDO ! mgs + +! CALL cld_cpu('Z-DELABK') + +! IF ( il == lr ) THEN +! xnutmp = (alpha(mgs,il) - 2.)/3. +! da0lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) +! ENDIF + + IF ( .not. ( il == lr .and. imurain == 3 ) ) THEN +! CALL cld_cpu('Z-DELABK') + DO mgs = 1,ngscnt + IF ( qx(mgs,il) > qxmin(il) ) THEN + xnutmp = (alpha(mgs,il) - 2.)/3. + +! IF ( .true. ) THEN + DO ic = lc,lh-1 ! lhab + IF ( il .ne. ic .and. qx(mgs,ic) .gt. qxmin(ic)) THEN + xnuc = xnu(ic) + IF ( ic == lc .and. idiagnosecnu > 0 ) xnuc = alpha(mgs,lc) ! alpha for droplets is actually nu + IF ( il /= lr .and. ic == lr .and. lzr > 1 ) THEN + IF ( imurain == 3 ) THEN + xnuc = alpha(mgs,lr) ! alpha is nu already + ELSE + xnuc = ( alpha(mgs,lr) - 2. )/3. ! convert alpha to nu + ENDIF + ENDIF + ! delabk(ba,bb,nua,nub,mua,mub,k), where a (il) is collector and b (ic) is collected + IF ( .false. ) THEN + dab0lh(mgs,ic,il) = delabk(bb(ic), bb(il), xnuc, xnutmp, xmu(ic), xmu(il), 0) !dab0(il,ic) + dab1lh(mgs,ic,il) = delabk(bb(ic), bb(il), xnuc, xnutmp, xmu(ic), xmu(il), 1) !dab1(il,ic) + dab0lh(mgs,il,ic) = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 0) !dab0(il,ic) + dab1lh(mgs,il,ic) = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 1) !dab1(il,ic) + ELSE ! use lookup table -- not interpolating yet because table resolution of 0.05 is good enough + i = Nint( alpha(mgs,il)*dqiacralphainv ) + IF ( ic == lc .or. ic == li .or. ic == ls .or. (ic == lr .and. imurain == 3) ) THEN + alp = (3.*alpha(mgs,ic) + 2.) + j = Nint( (3.*alpha(mgs,ic) + 2.)*dqiacralphainv ) + ELSE ! IF ( ic == lr .and. imurain == 1 ) ! rain + alp = alpha(mgs,ic) + j = Nint( alpha(mgs,ic)*dqiacralphainv ) + ENDIF + + dab0lh(mgs,ic,il) = dab0lu(j,i,ic,il) + dab1lh(mgs,ic,il) = dab1lu(j,i,ic,il) + dab0lh(mgs,il,ic) = dab0lu(i,j,il,ic) + dab1lh(mgs,il,ic) = dab1lu(i,j,il,ic) + +! tmp1 = dab0lu(j,i,ic,il) +! tmp2 = dab1lu(j,i,ic,il) +! tmp3 = dab0lu(i,j,il,ic) +! tmp4 = dab1lu(i,j,il,ic) +! tmp5 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(ic), xmu(il), 0) !dab0(il,ic) +! tmp6 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(ic), xmu(il), 1) !dab1(il,ic) +! tmp5 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 0) !dab0(il,ic) +! tmp6 = delabk(bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic), 1) !dab1(il,ic) + + IF ( .false. .and. ny <= 2 ) THEN + write(0,*) + write(0,*) 'bb: ', bb(il), bb(ic), xnutmp, xnuc, xmu(il), xmu(ic) + write(0,*) 'il,ic = ',il,ic,alpha(mgs,il),i,xnuc,alp,j + write(0,*) 'dab0lh,tmp1 = ',dab0lh(mgs,ic,il),tmp1 + write(0,*) 'dab1lh,tmp2 = ',dab1lh(mgs,ic,il),tmp2 + write(0,*) 'dab0lh,tmp3 = ',dab0lh(mgs,il,ic),tmp3,tmp5 + write(0,*) 'dab1lh,tmp4 = ',dab1lh(mgs,il,ic),tmp4,tmp6 + + ENDIF + + ENDIF + + ENDIF + ENDDO + +! ENDIF + + da0lx(mgs,il) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( il .eq. lh ) THEN + da0lh(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( lzr > 1 ) THEN + rzxh(mgs) = 1. + ELSE + rzxh(mgs) = ((4. + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr))) + ENDIF + + IF ( lzhl < 1 ) THEN + rzxhlh(mgs) = rzxhl(mgs)/(((4. + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr)))) + ENDIF + ELSEIF ( il .eq. lhl ) THEN + da0lhl(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + IF ( lzr > 1 ) THEN + rzxhl(mgs) = 1. + ELSE + rzxhl(mgs) = ((4.0 + alpha(mgs,il))*(5. + alpha(mgs,il))*(6. + alpha(mgs,il))*(1. + xnu(lr)))/ & + & ((1. + alpha(mgs,il))*(2. + alpha(mgs,il))*(3. + alpha(mgs,il))*(2. + xnu(lr))) + ENDIF + ELSEIF ( il == lr ) THEN + xnutmp = (alpha(mgs,il) - 2.)/3. + da0lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 0) + da1lr(mgs) = delbk(bb(il), xnutmp, xmu(il), 1) + ENDIF + + ENDIF ! ( qx(mgs,il) > qxmin(il) ) + ENDDO ! mgs +! CALL cld_cpu('Z-DELABK') + ENDIF ! il /= lr + +! CALL cld_cpu('Z-DELABK') + + ENDIF ! lz(il) .gt. 1 + + ENDDO ! il + + ENDIF ! ipconc .ge. 6 + +! CALL cld_cpu('Z-MOMENT-1') + +! +! set some values for ice nucleation +! + do mgs = 1,ngscnt + kp1 = Min(nz, kgs(mgs)+1 ) +! wvel(mgs) = (0.5)*(w(igs(mgs),jgs,kp1) & +! & +w(igs(mgs),jgs,kgs(mgs))) + + + wvelkm1(mgs) = (0.5)*(w(igs(mgs),jgs,kgs(mgs)) & + & +w(igs(mgs),jgs,kgsm(mgs))) + cninm(mgs) = t7(igs(mgs),jgs,kgsm(mgs)) + cnina(mgs) = t7(igs(mgs),jgs,kgs(mgs)) + cninp(mgs) = t7(igs(mgs),jgs,kgsp(mgs)) + end do + +! +! Set a couple of cloud variables... +! + +! SUBROUTINE setvt(ngscnt,qx,qxmin,cx,rho0,rhovt,xdia,cno, +! : xmas,xdn,xvmn,xvmx,xv,cdx, +! : ipconc,ndebug) +! SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno, & +! & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx, & +! & ipconc1,ndebug1,ngs,nz,kgs,cwnccn,fadvisc, & +! & cwmasn,cwmasx,cwradn,cnina,cimna,cimxa, & +! & itype1a,itype2a,temcg,infdo,alpha) + + + infdo = 1 + IF ( rimdenvwgt > 0 ) infdo = 1 + + call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & + & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, & + & ipconc,ndebug,ngs,nz,kgs,fadvisc, & + & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, & + & itype1,itype2,temcg,infdo,alpha,0,axx,bxx) ! ,cdh,cdhl) +! & itype1,itype2,temcg,infdo,alpha,0,axh,bxh,axhl,bxhl) ! ,cdh,cdhl) + + + IF ( lwsm6 .and. ipconc == 0 ) THEN + tmp = Max(qxmin(lh), qxmin(ls)) + DO mgs = 1,ngscnt + total = qx(mgs,lh) + qx(mgs,ls) + IF ( total > tmp ) THEN + vt2ave(mgs) = (qx(mgs,lh)*vtxbar(mgs,lh,1) + qx(mgs,ls)*vtxbar(mgs,ls,1))/total + ELSE + vt2ave(mgs) = 0.0 + ENDIF + ENDDO + ENDIF + + +! +! Set number concentrations (need xdia from setvt) +! + if ( ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: Set concentration' + IF ( ipconc .lt. 1 ) THEN + cina(1:ngscnt) = cx(1:ngscnt,li) + ENDIF + if ( ipconc .lt. 5 ) then + do mgs = 1,ngscnt + + + IF ( ipconc .lt. 3 ) THEN +! cx(mgs,lr) = 0.0 + if ( qx(mgs,lr) .gt. qxmin(lh) ) then +! cx(mgs,lr) = cno(lr)*xdia(mgs,lr,1) +! xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) + end if + ENDIF + + IF ( ipconc .lt. 4 ) THEN +! tmp = cx(mgs,ls) +! cx(mgs,ls) = 0.0 + if ( qx(mgs,ls) .gt. qxmin(ls) ) then +! cx(mgs,ls) = cno(ls)*xdia(mgs,ls,1) +! xv(mgs,ls) = rho0(mgs)*qx(mgs,ls)/(xdn(mgs,ls)*cx(mgs,ls)) + end if + ENDIF ! ( ipconc .lt. 4 ) + + IF ( ipconc .lt. 5 ) THEN + + +! cx(mgs,lh) = 0.0 + if ( qx(mgs,lh) .gt. qxmin(lh) ) then +! cx(mgs,lh) = cno(lh)*xdia(mgs,lh,1) +! xv(mgs,lh) = Max(xvmn(lh), rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ) +! xdia(mgs,lh,3) = (xv(mgs,lh)*6./pi)**(1./3.) + end if + + ENDIF ! ( ipconc .lt. 5 ) + + end do + end if + + IF ( ipconc .ge. 2 ) THEN + DO mgs = 1,ngscnt + + rb(mgs) = 0.5*xdia(mgs,lc,1)*(1./(1.+alpha(mgs,lc)))**(1./6.) + xl2p(mgs) = Max(0.0d0, 2.7e-2*xdn(mgs,lc)*cx(mgs,lc)*xv(mgs,lc)* & + & ((0.5e20*rb(mgs)**3*xdia(mgs,lc,1))-0.4) ) IF ( rb(mgs) .gt. 3.51e-6 ) THEN ! rh(mgs) = Max( 0.5d0*xdia(mgs,lc,1), 6.3d-4/(1.d6*(rb(mgs) - 3.5d-6)) ) rh(mgs) = Max( 41.d-6, 6.3d-4/(1.d6*(rb(mgs) - 3.5d-6)) ) @@ -12480,6 +14620,17 @@ subroutine nssl_2mom_gs & + IF ( ipconc >= 6 ) THEN + frac = 0.4d0 + zxmxd(:,:) = 0.0 + DO il = lr,lhab + IF ( lz(il) > 0 .or. ( il == lr ) ) THEN + DO mgs = 1,ngscnt + zxmxd(mgs,il) = frac*zx(mgs,il)*dtpinv + ENDDO + ENDIF + ENDDO + ENDIF @@ -12517,10 +14668,10 @@ subroutine nssl_2mom_gs & vshdgs(mgs,il) = vshd ! base value - IF ( qx(mgs,il) > qxmin(il) ) THEN + IF ( qx(mgs,il) > qxmin(il) .and. ivshdgs > 0 ) THEN ! tmpdiam is weighted diameter of d^(shedalp-1), so for shedalp=3, this is the area-weighted diameter or maximum mass diameter. - tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1)*( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 + tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1) ! *( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 IF ( tmpdiam > sheddiam0 ) THEN vshdgs(mgs,il) = 0.523599*(1.5e-3)**3/massfacshr ! 1.5mm drops from very large ice @@ -12577,6 +14728,7 @@ subroutine nssl_2mom_gs & ers(mgs) = 0.0 ess(mgs) = 0.0 ehs(mgs) = 0.0 ! used as sticking efficiency, so collection efficiency is ehs*ehsclsn + ehsfac(mgs) = 1.0 ! factor based on ice saturation ehls(mgs) = 0.0 ! used as sticking efficiency, so collection efficiency is ehls*ehlsclsn ehscnv(mgs) = 0.0 ! ehxs(mgs) = 0.0 @@ -12678,7 +14830,7 @@ subroutine nssl_2mom_gs & if ( qx(mgs,li).gt.qxmin(li) .and. qx(mgs,lc).gt.qxmin(lc) ) then - if (xdia(mgs,lc,1).gt.15.0e-06 .and. xdia(mgs,li,1).gt.30.0e-06) then + if (xdia(mgs,lc,1).gt.ewi_dcmin .and. xdia(mgs,li,1).gt.ewi_dimin) then ! erm 5/10/2007 test following change: ! if (xdia(mgs,lc,1).gt.12.0e-06 .and. xdia(mgs,li,1).gt.50.0e-06) then eiw(mgs) = 0.5 @@ -12802,7 +14954,7 @@ subroutine nssl_2mom_gs & ELSE fac = Abs(ess0) - IF ( .true. .and. ess0 < 0.0 ) THEN + IF ( iessopt == 2 ) THEN ! experimental code ! IF ( wvel(mgs) > 2.0 .or. wvel(mgs) < -0.5 .or. ssi(mgs) < 1.0 ) THEN IF ( wvel(mgs) > 2.0 ) THEN ! assume convective cell or downdraft @@ -12810,9 +14962,25 @@ subroutine nssl_2mom_gs & ELSEIF ( wvel(mgs) > 1.0 ) THEN ! transition to stratiform range of values fac = Max(0.0, 2.0 - wvel(mgs))*fac ENDIF + ELSEIF ( iessopt == 3 ) THEN ! factor based on ice supersat + IF ( ssi(mgs) <= 1.0 ) THEN + fac = 0.0 + ehsfac(mgs) = 0.0 + ELSEIF ( ssi(mgs) <= 1.02 ) THEN + fac = fac*(ssi(mgs) - 1.0)/0.02 + ehsfac(mgs) = (ssi(mgs) - 1.0)/0.02 + ENDIF + ELSEIF ( iessopt == 4 ) THEN ! factor based on ice supersat + IF ( ssi(mgs) <= 1.0 ) THEN + fac = 0.1 + ehsfac(mgs) = 0.1 + ELSEIF ( ssi(mgs) <= 1.005 ) THEN + fac = Max(0.1, fac*(ssi(mgs) - 1.0)/0.005) + ehsfac(mgs) = Max(0.1, (ssi(mgs) - 1.0)/0.005) + ENDIF ENDIF - IF ( temcg(mgs) > esstem1 .and. temcg(mgs) < esstem2 ) THEN ! only nonzero for T > -25 + IF ( temcg(mgs) > esstem1 .and. temcg(mgs) < esstem2 ) THEN ! only nonzero for T > esstem1 ess(mgs) = fac*Exp(ess1*(esstem2) )*(temcg(mgs) - esstem1)/(esstem2 - esstem1) ! linear ramp up from zero at esstem1 to value at esstem2 ELSEIF ( temcg(mgs) >= esstem2 ) THEN ess(mgs) = fac*Exp(ess1*Min( temcg(mgs), 0.0 ) ) @@ -12923,7 +15091,11 @@ subroutine nssl_2mom_gs & ELSE ehscnv(mgs) = exp(0.09*min(temcg(mgs),0.0)) ENDIF - if ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) > qxmin(lc) ) then + + IF ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) >= qxmin(lc) ) THEN +! ehsclsn(mgs) = ehs_collsn +! ehs(mgs) = ehscnv(mgs)*ehsfac(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) +! ELSEIF ( qx(mgs,lh).gt.qxmin(lh) .and. qx(mgs,lc) >= qxmin(lc) ) then ehsclsn(mgs) = ehs_collsn IF ( xdia(mgs,ls,3) < 40.e-6 ) THEN ehsclsn(mgs) = 0.0 @@ -12933,10 +15105,9 @@ subroutine nssl_2mom_gs & ehsclsn(mgs) = ehs_collsn ENDIF ! ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0., xdn(mgs,lh) - xdnmn(lh)*1.2)/xdnmn(lh) ) ! shut off qhacs as graupel goes to lowest density - ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density + ehs(mgs) = ehscnv(mgs)*Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density; limits scavenging of snow in bright band ! ehs(mgs) = ehscnv(mgs) ! *Min(1.0, Max(0.0,xdn(mgs,lh) - 300.)/300. ) ! shut off qhacs as graupel goes to low density ehs(mgs) = Min(ehs(mgs),ehsmax) - IF ( qx(mgs,lc) < qxmin(lc) ) ehs(mgs) = 0.0 end if ENDIF ! @@ -12944,7 +15115,7 @@ subroutine nssl_2mom_gs & ehiclsn(mgs) = ehi_collsn ehi(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0)) ehi(mgs) = Min( ehimax, Max( ehi(mgs), ehimin ) ) - if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehi(mgs) = 0.0 +! if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehi(mgs) = 0.0 end if IF ( lis > 1 ) THEN @@ -12952,7 +15123,7 @@ subroutine nssl_2mom_gs & ehisclsn(mgs) = ehi_collsn ehis(mgs)=eii0*exp(eii1*min(temcg(mgs),0.0)) ehis(mgs) = Min( ehimax, Max( ehis(mgs), ehimin ) ) - if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehis(mgs) = 0.0 +! if ( temg(mgs) .gt. 273.15 .or. ( qx(mgs,lc) < qxmin(lc)) ) ehis(mgs) = 0.0 end if ENDIF @@ -13089,6 +15260,7 @@ subroutine nssl_2mom_gs & end do + ! ! ! @@ -13207,6 +15379,7 @@ subroutine nssl_2mom_gs & ENDIF end do ! + IF ( ipconc < 3 ) THEN do mgs = 1,ngscnt qracs(mgs) = 0.0 IF ( ers(mgs) .gt. 0.0 .and. ipconc < 3 ) THEN @@ -13225,6 +15398,7 @@ subroutine nssl_2mom_gs & & , qsmxd(mgs)) ENDIF end do + ENDIF ! ! @@ -13371,6 +15545,7 @@ subroutine nssl_2mom_gs & ! do mgs = 1,ngscnt qhacw(mgs) = 0.0 + qhacwmlr(mgs) = 0.0 rarx(mgs,lh) = 0.0 vhacw(mgs) = 0.0 vhsoak(mgs) = 0.0 @@ -13437,6 +15612,11 @@ subroutine nssl_2mom_gs & ENDIF + qhacwmlr(mgs) = qhacw(mgs) + IF ( temg(mgs) > tfr .and. iqhacwshr == 0 ) THEN + qhacw(mgs) = 0.0 + ENDIF + IF ( lvol(lh) .gt. 1 .or. lhl .gt. 1 ) THEN ! calculate rime density for graupel volume and/or for graupel conversion to hail IF ( temg(mgs) .lt. 273.15) THEN @@ -13466,14 +15646,18 @@ subroutine nssl_2mom_gs & rimdn(mgs,lh) = 1000.*(0.051 + 0.114*tmp - 0.0055*tmp**2) - ELSEIF ( irimdenopt == 3 ) THEN ! Macklin + ELSEIF ( irimdenopt == 3 .or. irimdenopt == 4) THEN ! Macklin (3) or Saunders and Hosseini 2001 tmp = (-((0.5)*(1.e+06)*xdia(mgs,lc,1)) & & *( (1.0-rimdenvwgt)*vtxbar(mgs,lh,1) + rimdenvwgt*vtxbar(mgs,lh,2) ) & & /(temg(mgs)-273.15)) ! tmp = Min( 5.5/0.6, Max( 0.3/0.6, tmp ) ) - rimdn(mgs,lh) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + IF ( irimdenopt == 3 ) THEN + rimdn(mgs,lh) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + ELSEIF ( irimdenopt == 4 ) THEN ! Saunders and Hosseini + rimdn(mgs,lh) = Min(917., Max( 10., 900.0*(1.0 - 0.905**tmp ) ) ) + ENDIF ENDIF ELSE @@ -13687,6 +15871,7 @@ subroutine nssl_2mom_gs & do mgs = 1,ngscnt qhlacw(mgs) = 0.0 + qhlacwmlr(mgs) = 0.0 vhlacw(mgs) = 0.0 vhlsoak(mgs) = 0.0 IF ( lhl > 1 .and. .true.) THEN @@ -13715,10 +15900,15 @@ subroutine nssl_2mom_gs & qhlacw(mgs) = Min( qhlacw(mgs), 0.5*qx(mgs,lc)*dtpinv ) + qhlacwmlr(mgs) = qhlacw(mgs) + IF ( temg(mgs) > tfr .and. iqhlacwshr == 0 ) THEN + qhlacw(mgs) = 0.0 + ENDIF + IF ( lvol(lhl) .gt. 1 ) THEN IF ( temg(mgs) .lt. 273.15) THEN - IF ( irimdenopt == 1 ) THEN ! Rasmussen and Heymsfeld (1985) + IF ( irimdenopt == 1 ) THEN ! Heymsfeld and Pflaum (1985) rimdn(mgs,lhl) = rimc1*(-((0.5)*(1.e+06)*xdia(mgs,lc,1)) & & *((0.60)*( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) )) & & /(temg(mgs)-273.15))**(rimc2) @@ -13732,13 +15922,17 @@ subroutine nssl_2mom_gs & rimdn(mgs,lhl) = 1000.*(0.051 + 0.114*tmp - 0.005*tmp**2) - ELSEIF ( irimdenopt == 3 ) THEN ! Macklin + ELSEIF ( irimdenopt == 3 .or. irimdenopt == 4) THEN ! Macklin (3) or Saunders and Hosseini 2001 tmp = -0.5*(1.e+06)*xdia(mgs,lc,1) & & *( (1.0-rimdenvwgt)*vtxbar(mgs,lhl,1) + rimdenvwgt*vtxbar(mgs,lhl,2) ) & & /(temg(mgs)-273.15) ! tmp = Min( 5.5/0.6, Max( 0.3/0.6, tmp ) ) - rimdn(mgs,lhl) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + IF ( irimdenopt == 3 ) THEN + rimdn(mgs,lhl) = Min(900., Max( 170., 110.*tmp**0.76 ) ) + ELSEIF ( irimdenopt == 4 ) THEN ! Saunders and Hosseini + rimdn(mgs,lhl) = Min(917., Max( 10., 900.0*(1.0 - 0.905**tmp ) ) ) + ENDIF ENDIF ELSE @@ -14053,7 +16247,7 @@ subroutine nssl_2mom_gs & frach = 0.5 *(1. + Tanh(0.2e12 *( xvfrz - 1.15*xvbiggsnow))) qiacrs(mgs) = (1.-frach)*qiacr(mgs) - ciacrs(mgs) = (1.-frach)*ciacr(mgs) ! *rzxh(mgs) + ciacrs(mgs) = (1.-frach)*ciacrf(mgs) ! *rzxh(mgs) ENDIF ENDIF @@ -14083,7 +16277,7 @@ subroutine nssl_2mom_gs & tmp = xv(mgs,ls)/(xvmx(ls)*Max(1.,100./Min(100.,xdn(mgs,ls)))) ! fraction of max snow mass IF ( tmp .lt. essfrac1 ) THEN ec0(mgs) = 1.0 - ELSEIF ( tmp .gt. essfrac2 ) THEN + ELSEIF ( tmp .ge. essfrac2 ) THEN ec0(mgs) = 0.0 ELSE ec0(mgs) = (essfrac2 - tmp)/(essfrac2 - essfrac1) @@ -14160,7 +16354,21 @@ subroutine nssl_2mom_gs & ec0(mgs) = 2.e9 IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN rwrad = 0.5*xdia(mgs,lr,3) - IF ( xdia(mgs,lr,3) .gt. 2.0e-3 .or. icracr <= 0 ) THEN + + + ! check median volume diameter + IF ( icracrthresh > 1 ) THEN + IF ( imurain == 1 ) THEN + tmp = (3.67+alpha(mgs,lr))*xdia(mgs,lr,1) ! median volume diameter; units of mm (Ulbrich 1983, JCAM) + ELSE ! imurain == 3, + tmp = (1.678+alpha(mgs,lr))**(1./3.)*xdia(mgs,lr,1) ! units of mm (using method of Ulbrich 1983. See ventillation_stuff.nb) + ENDIF + ELSE + tmp = xdia(mgs,lr,3) - 0.1e-3 + ENDIF + +! IF ( xdia(mgs,lr,3) .gt. 2.0e-3 .or. icracr <= 0 ) THEN + IF ( tmp .gt. 1.9e-3 .or. icracr <= 0 ) THEN ec0(mgs) = 0.0 cracr(mgs) = 0.0 ELSE @@ -14242,6 +16450,7 @@ subroutine nssl_2mom_gs & ! if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22kk' chaci(:) = 0.0 + chaci0(:) = 0.0 if ( ipconc .ge. 1 .or. ipelec .ge. 1 ) then do mgs = 1,ngscnt IF ( ehi(mgs) .gt. 0.0 .or. ( ehiclsn(mgs) > 0.0 .and. ipelec > 0 )) THEN @@ -14292,6 +16501,7 @@ subroutine nssl_2mom_gs & ! if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22nn' chacs(:) = 0.0 + chacs0(:) = 0.0 if ( ipconc .ge. 1 .or. ipelec .ge. 1 ) then do mgs = 1,ngscnt IF ( ehs(mgs) .gt. 0 ) THEN @@ -14534,6 +16744,45 @@ subroutine nssl_2mom_gs & IF ( crcnw(mgs) < 1.e-30 ) qrcnw(mgs) = 0.0 + IF ( lzr > 1 .and. qrcnw(mgs) > 0.0 ) THEN +! vr = rho0(mgs)*qrcnw(mgs)/(1000.*crcnw(mgs)) +! zrcnw(mgs) = 36.*(xnu(lr)+2.0)*crcnw(mgs)*vr**2/((xnu(lr)+1.0)*pi**2) + ! DTD: If rain exists at a grid point already either use the alpha-preserving Z-rate eqn. (dmrauto == 1) + ! or a mass-weighted average of the alpha-preserving Z-rate eqn. and the init. rate eqn. (dmrauto == 2) + ! or the original initiation rate equation (dmrauto == 0). Not sure if this is the correct way to go but seems to work ok. + IF (qx(mgs,lr) .gt. qxmin(lr) .and. ( dmrauto == 1 .or. dmrauto ==2 ) ) THEN + tmp3 = qx(mgs,lr)/cx(mgs,lr) + tmp4 = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*tmp3 * qrcnw(mgs) - tmp3**2 * crcnw(mgs) ) + if (imurain == 3) then + vr = rho0(mgs)*qrcnw(mgs)/(1000.) + tmp3 = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + else + tmp3 = galpharaut*(6.*rho0(mgs)*qrcnw(mgs)/(pi*xdn0(lr)))**2/crcnw(mgs) + endif + IF ( dmrauto == 1 ) THEN ! Preserve alpha + zrcnw(mgs) = tmp4 + ELSEIF ( dmrauto == 2 ) THEN ! Mass-weighted average + zrcnw(mgs) = (tmp3*qrcnw(mgs)+tmp4*qx(mgs,lr))/(qrcnw(mgs)+qx(mgs,lr)) + ENDIF + else ! original formulation + IF ( imurain == 3 ) THEN + vr = rho0(mgs)*qrcnw(mgs)/(1000.) ! crcnw(mgs) not divided here but is in next line, cancels one factor in the numerator + zrcnw(mgs) = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + ELSE ! rain in gamma of diameter + IF ( dmropt <= 1 .or. dmropt >= 4 .or. ( qx(mgs,lr) < qxmin(lr) .and. cx(mgs,lr) < cxmin ) ) THEN + zrcnw(mgs) = galpharaut*(6.*rho0(mgs)*qrcnw(mgs)/(pi*xdn0(lr)))**2/crcnw(mgs) + ELSE + tmp3 = qx(mgs,lr)/cx(mgs,lr) + zrcnw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*tmp3 * qrcnw(mgs) - tmp3**2 * crcnw(mgs) ) + ENDIF +! vr = rho0(mgs)*qrcnw(mgs)/(1000.) ! crcnw(mgs) not divided here but is in next line, cancels one factor in the numerator +! zrcnw(mgs) = 36.*(xnu(lc)+2.0)*vr**2/(crcnw(mgs)*(xnu(lc)+1.0)*pi**2) + ENDIF + endif +! z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + ENDIF ! IF ( crcnw(mgs) .gt. cautn(mgs) .and. crcnw(mgs) .gt. 1.0 ) ! : THEN ! write(0,*) 'crcnw,cautn ',crcnw(mgs)/cautn(mgs), @@ -14744,6 +16993,15 @@ subroutine nssl_2mom_gs & ELSE !{ + IF ( lzr > 1 ) THEN + ! interpolate along x, i.e., ratio; + tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) + tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1)) + + ! interpolate along alpha; + + zrfrz(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv + ENDIF IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < 2.*xvmn(lr) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN ! IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < xvbiggsnow .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN @@ -14753,6 +17011,10 @@ subroutine nssl_2mom_gs & crfrzs(mgs) = crfrz(mgs) qrfrzs(mgs) = qrfrz(mgs) + IF ( lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + zrfrzf(mgs) = 0. + ENDIF ELSEIF ( dbigg < Max( biggsnowdiam, Max(dfrz,dhmn)) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN ! { convert some to snow or ice crystals ! temporarily store qrfrz and crfrz in snow terms and caclulate new crfrzf, qrfrzf, and zrfrzf. Leave crfrz etc. alone! @@ -14764,6 +17026,10 @@ subroutine nssl_2mom_gs & crfrzf(mgs) = 0.0 qrfrzf(mgs) = 0.0 + IF ( lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + zrfrzf(mgs) = 0. + ENDIF ELSE !{ ! recalculate using dhmn for ratio @@ -14803,10 +17069,23 @@ subroutine nssl_2mom_gs & crfrzs(mgs) = crfrzs(mgs) - crfrzf(mgs) qrfrzs(mgs) = qrfrzs(mgs) - qrfrzf(mgs) + IF ( lzr > 1 ) THEN + zrfrzs(mgs) = zrfrz(mgs) + ! interpolate along x, i.e., ratio; + tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) + tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1)) + + ! interpolate along alpha; + + zrfrzf(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv + zrfrzs(mgs) = zrfrzs(mgs) - zrfrzf(mgs) + zrfrzf(mgs) = (1000./900.)**2*zrfrzf(mgs) + ENDIF ENDIF ! } ELSE crfrzs(mgs) = 0.0 qrfrzs(mgs) = 0.0 + zrfrzs(mgs) = 0.0 ENDIF ! } ENDIF !} @@ -14819,6 +17098,10 @@ subroutine nssl_2mom_gs & crfrz(mgs) = fac*crfrz(mgs) crfrzs(mgs) = fac*crfrzs(mgs) crfrzf(mgs) = fac*crfrzf(mgs) + IF ( lzr > 1 ) THEN + zrfrz(mgs) = fac*zrfrz(mgs) + zrfrzf(mgs) = fac*zrfrzf(mgs) + ENDIF ENDIF ENDIF !} @@ -15364,7 +17647,15 @@ subroutine nssl_2mom_gs & x = 1. + alpha(mgs,lr) IF ( lzr > 1 ) THEN ! 3 moment -! + tmp = 1. + alpr ! alpha(mgs,lr) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 2.5 + alpha(mgs,lr) + 0.5*bx(lr) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = (gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami)/g1palp ! ratio of gamma functions ELSE y = ventrxn(mgs) ENDIF @@ -15381,6 +17672,12 @@ subroutine nssl_2mom_gs & & Sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2) +! rwventz(mgs) = & +! & 0.78*x + & +! & 0.308*fvent(mgs)*y* & +! & Sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2) + + ELSEIF ( iferwisventr == 2 ) THEN ! Following Wisner et al. (1972) but using gamma of volume. Note that Ferrier rain fall speed does not integrate with gamma of volume, so using Vr = ar*d^br @@ -15392,6 +17689,22 @@ subroutine nssl_2mom_gs & & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) ) + alpr = Min(alpharmax,alpha(mgs,lr) ) + + tmp = alpr + 5.5 + br/2. + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + +! rwventz(mgs) = & +! & 0.78*(4. + alpha(mgs,lr))*(3. + alpha(mgs,lr))*(2. + alpha(mgs,lr))*(1. + alpha(mgs,lr)) + & + rwventz(mgs) = & + & 0.78*(4. + alpr)*(3. + alpr)*(2. + alpr)*(1. + alpr) + & + & 0.308*fvent(mgs)* & + & Sqrt(ax(lr)*rhovt(mgs))*(y/gf1palp(mgs))*(xdia(mgs,lr,1)**((1.0+br)/2.0)) + + + ENDIF ! iferwisventr @@ -15554,6 +17867,8 @@ subroutine nssl_2mom_gs & & -ftka(mgs)*temcg(mgs)/rho0(mgs) ) & & / (felf(mgs)) fmlt2(mgs) = -fcw(mgs)*temcg(mgs)/felf(mgs) + fmlt1e(mgs) = (2.0*pi)* & + & ( felv(mgs)*fwvdf(mgs)*(qss0(mgs)-qx(mgs,lv)) ) / (felf(mgs)) end do ! ! Vapor Deposition constants @@ -15581,6 +17896,7 @@ subroutine nssl_2mom_gs & qhlmlrlg(:) = 0.0 ENDIF qhfzh(:) = 0.0 + qffzf(:) = 0.0 qhlfzhl(:) = 0.0 qhfzhlg(:) = 0.0 qhlfzhllg(:) = 0.0 @@ -15591,6 +17907,7 @@ subroutine nssl_2mom_gs & zsmlr(:) = 0.0 zhmlr(:) = 0.0 zhmlrr(:) = 0.0 + zsmlrr(:) = 0.0 zhshr(:) = 0.0 zhlmlr(:) = 0.0 zhlshr(:) = 0.0 @@ -15642,7 +17959,7 @@ subroutine nssl_2mom_gs & qhmlr(mgs) = & & meltfac*min( & & fmlt1(mgs)*cx(mgs,lh)*hwvent(mgs)*xdia(mgs,lh,1) & - & + fmlt2(mgs)*(qhacrmlr(mgs)+qhacw(mgs)) & + & + fmlt2(mgs)*(qhacrmlr(mgs)+qhacwmlr(mgs)) & & , 0.0 ) ELSEIF ( ibinhmlr == 1 ) THEN ! use incomplete gamma functions to approximate the bin results @@ -15674,13 +17991,13 @@ subroutine nssl_2mom_gs & qhlmlr(mgs) = & & meltfac*min( & & fmlt1(mgs)*cx(mgs,lhl)*hlvent(mgs)*xdia(mgs,lhl,1) & - & + fmlt2(mgs)*(qhlacrmlr(mgs)+qhlacw(mgs)) & + & + fmlt2(mgs)*(qhlacrmlr(mgs)+qhlacwmlr(mgs)) & & , 0.0 ) ELSEIF ( ibinhlmlr == 1 ) THEN ! use incomplete gamma functions to approximate the bin results -! #ifdef Z3MOM -! #if (defined Z3MOM) && defined( COMMAS ) || defined( COMMASTMP ) +! #ifdef 1 +! #if (defined 1) && defined( COMMAS ) || defined( COMMASTMP ) ELSEIF ( ibinhlmlr == -1 ) THEN ! OLD VERSION use incomplete gamma functions to approximate the bin results @@ -15711,7 +18028,7 @@ subroutine nssl_2mom_gs & chmlr(mgs) = max( chmlr(mgs), Min( -chmxd(mgs), -0.95*cx(mgs,lh)*dtpinv ) ) ENDIF ! qhmlr(mgs) = max( max( qhmlr(mgs), -qhmxd(mgs) ) , -0.5*qx(mgs,lh)*dtpinv ) !limits to 1/2 qh or max depletion - qhmlh(mgs) = 0. + qhmlh(mgs) = 0. ! not used ! Rasmussen and Heymsfield say melt water remains on graupel up to 9 mm before shedding @@ -15789,7 +18106,26 @@ subroutine nssl_2mom_gs & + IF ( lzr .gt. 1 .and. qx(mgs,ls) > qxmin(ls) ) THEN + tmp = qx(mgs,ls)/cx(mgs,ls) +! alp = Max( -0.8, alpha(mgs,lh) ) + alp = xnu(ls) + g1 = 36.*(alp+2.0)/((alp+1.0)*pi**2) + + zsmlr(mgs) = g1*(rho0(mgs)/(xdn(mgs,ls)))**2*( tmp * qsmlr(mgs) ) +! zhmlr(mgs) = (xdn0(lr)/(xdn(mgs,lh)))**2*( zx(mgs,lh) * qhmlr(mgs) ) + + ENDIF + IF ( chmlr(mgs) < 0.0 .and. (ibinhmlr < 1 .or. lzh < 1) ) THEN ! { already done if ibinhmlr > 0 + IF ( lzr .gt. 1 .and. lzh < 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN ! Only compute if rain is 3-moment but graupel is not, otherwise is computed later + tmp = qx(mgs,lh)/cx(mgs,lh) + alp = alpha(mgs,lh) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + zhmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlr(mgs) ) + + ENDIF IF ( ibinhmlr == 0 .or. lzh < 1 ) THEN IF ( ihmlt .eq. 1 ) THEN @@ -15895,6 +18231,17 @@ subroutine nssl_2mom_gs & ENDIF !} + IF ( lzhl .gt. 1 .and. ibinhlmlr <= 0 ) THEN + IF ( cx(mgs,lhl) > 0.0 ) THEN + + tmp = qx(mgs,lhl)/cx(mgs,lhl) + alp = alpha(mgs,lhl) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + zhlmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( tmp * qhlmlr(mgs) ) + ENDIF + ENDIF ENDIF ! } ENDIF ! }.not. mixedphase @@ -15932,6 +18279,7 @@ subroutine nssl_2mom_gs & ENDDO ! ! + qhdsv(:) = 0.0 qhldsv(:) = 0.0 do mgs = 1,ngscnt @@ -15941,6 +18289,7 @@ subroutine nssl_2mom_gs & & fvds(mgs)*cx(mgs,li)*civent(mgs)*cicap(mgs)*depfac qsdsv(mgs) = & & fvds(mgs)*cx(mgs,ls)*swvent(mgs)*swcap(mgs)*depfac + ! IF ( ny .eq. 2 .and. igs(mgs) .eq. 302 .and. temg(mgs) .le. tfrh+10 .and. qx(mgs,lv) .gt. qis(mgs) ! : .and. qx(mgs,li) .gt. qxmin(li) ) THEN ! write(0,*) 'qidsv = ',nstep,kgs(mgs),qidsv(mgs),temg(mgs)-tfrh,100.*(qx(mgs,lv)/qis(mgs) - 1.),1.e6*xdia(mgs,li,1), @@ -16177,20 +18526,41 @@ subroutine nssl_2mom_gs & ! end of qlimit + qhcev(:) = 0.0 + chcev(:) = 0.0 + qhlcev(:) = 0.0 + chlcev(:) = 0.0 + qfcev(:) = 0.0 + do mgs = 1,ngscnt qisbv(mgs) = 0.0 qssbv(mgs) = 0.0 qidpv(mgs) = 0.0 qsdpv(mgs) = 0.0 + qhsbv(mgs) = 0.0 + qscev(mgs) = 0.0 + cscev(mgs) = 0.0 IF ( icond .eq. 1 .or. temg(mgs) .le. tfrh & - & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) ) THEN + & .or. (qx(mgs,lr) .le. qxmin(lr) .and. qx(mgs,lc) .le. qxmin(lc)) ) THEN ! last condition (qr qxmin(lhl) ) THEN + IF ( temg(mgs) < tfr .or. .not. qhlmlr(mgs) < 0.0 ) THEN qhlsbv(mgs) = max( min(qhldsv(mgs), 0.0), -qxmxd(mgs,lhl) ) qhldpv(mgs) = Max(qhldsv(mgs), 0.0) + ENDIF + IF ( qhlmlr(mgs) < 0.0 .and. .not. mixedphase ) THEN + ! Liquid is forming, so find the evaporation that was subtracted from melting (if it is not condensing) + qhlcev(mgs) = evapfac* & + & 2.0*pi*(qx(mgs,lv)-qss0(mgs))*cx(mgs,lhl)*xdia(mgs,lhl,1)*hlvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) + + qhlcev(mgs) = max(qhlcev(mgs), -qhlmxd(mgs)) + + ENDIF + ENDIF ENDIF temp1 = qidpv(mgs) + qsdpv(mgs) + qhdpv(mgs) + qhldpv(mgs) @@ -16345,6 +18742,10 @@ subroutine nssl_2mom_gs & end if end do + + + + ! ! ! compute dry growth rate of snow, graupel, and hail @@ -16382,19 +18783,27 @@ subroutine nssl_2mom_gs & ! IF ( dnu(lh) .ne. 0. ) THEN ! qhwet(mgs) = qhdry(mgs) ! ELSE + IF ( incwet == 0 ) THEN qhwet(mgs) = & & ( xdia(mgs,lh,1)*hwvent(mgs)*cx(mgs,lh)*fwet1(mgs) & & + fwet2(mgs)*(qhaci(mgs) + qhacs(mgs)) ) qhwet(mgs) = max( 0.0, qhwet(mgs)) + ELSE + ENDIF + ! ENDIF qhlwet(mgs) = 0.0 IF ( lhl .gt. 1 ) THEN - qhlwet(mgs) = & - & ( xdia(mgs,lhl,1)*hlvent(mgs)*cx(mgs,lhl)*fwet1(mgs) & - & + fwet2(mgs)*(qhlaci(mgs) + qhlacs(mgs)) ) - qhlwet(mgs) = max( 0.0, qhlwet(mgs)) + IF ( incwet == 0 ) THEN + qhlwet(mgs) = & + & ( xdia(mgs,lhl,1)*hlvent(mgs)*cx(mgs,lhl)*fwet1(mgs) & + & + fwet2(mgs)*(qhlaci(mgs) + qhlacs(mgs)) ) + qhlwet(mgs) = max( 0.0, qhlwet(mgs)) + + ELSE + ENDIF ! incwet ENDIF ELSE @@ -16407,6 +18816,7 @@ subroutine nssl_2mom_gs & ! qhlwet(mgs) = qhldry(mgs) end do + ! ! shedding rate ! @@ -16466,7 +18876,7 @@ subroutine nssl_2mom_gs & qhshr(mgs) = -qhdry(mgs) qhlshr(mgs) = -qhldry(mgs) ELSE ! new and correct - + ! note that the qxacr terms should be zero here, so shedding at T > 0 is all from the droplets qsshr(mgs) = - qsacr(mgs) - qsacw(mgs) ! -qsdry(mgs) qhlshr(mgs) = - qhlacw(mgs) - qhlacr(mgs) ! -qhldry(mgs) qhshr(mgs) = - qhacw(mgs) - qhacr(mgs) ! -qhdry(mgs) @@ -16802,7 +19212,94 @@ subroutine nssl_2mom_gs & ltest = xdia(mgs,lh,1)*(4. + alpha(mgs,lh)) > Abs( hlcnhdia ) ! test on mass-weighted diameter ENDIF - dg0(mgs) = -1. + IF ( iusedw == 0 .and. ihlcnh == 1 ) THEN + dg0(mgs) = -1. + ELSE + IF (((qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 & + .and. temg(mgs) .gt. dwtempmin ) .or. ( wetgrowth(mgs) .and. qx(mgs,lh) > hlcnhqmin ) ) THEN + dw = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*ehw(mgs)*qx(mgs,lc) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) + dwr = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & + 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) + d = dwr + IF ( dwr < 0.2 .and. dwr > 0.0 ) THEN + fventh = sqrtrhovt*(fpndl(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) + fventm = sqrtrhovt*(fschm(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) + sqrtrhovt = Sqrt( rhovt(mgs) ) + ltemq = (tfr-163.15)/fqsat+1.5 + qvs0 = pqs(mgs)*tabqvs(ltemq) + denomdp = felf(mgs) + fcw(mgs)*temcg(mgs) + denominvdp = 1.d0/(felf(mgs) + fcw(mgs)*temcg(mgs)) + +! write(91,*) 'dw,dwr,temcg = ',100.*dw,100.*dwr,temcg(mgs) + h1 = ( -ftka(mgs)*temcg(mgs) - felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qx(mgs,lv) - qvs0) ) + h2 = ehi(mgs)*qx(mgs,li)*rho0(mgs)*fci(mgs)*temcg(mgs) + h3 = Max(dwehwmin, ehw(mgs))*qx(mgs,lc) + h4 = ehr(mgs)* qx(mgs,lr) + ! iterate to find minimum diameter for wet growth. Start with value of dwr + DO n = 1,10 + dold = d + vth = axx(mgs,lh)*d**bxx(mgs,lh) + x2 = fventh*sqrtrhovt*Sqrt(d*vth) + IF ( x2 > 1.4 ) THEN + ah = 0.78 + 0.308*x2 ! heat ventillation + ELSE + ah = 1.0 + 0.108*x2**2 ! mass ventillation (Beard and Pruppacher 1971, eq. 9) + ENDIF + + IF ( .false. ) THEN ! this option includes 'am' separate from ah, which makes only small differences. Otherwise equivalent to second option + x1 = fventm*sqrtrhovt*Sqrt(d*vth) + IF ( x1 > 1.4 ) THEN + am = 0.78 + 0.308*x1 ! mass ventillation (Beard and Pruppacher 1971, eq. 8) + ELSE + am = 1.0 + 0.108*x1**2 ! mass ventillation (Beard and Pruppacher 1971, eq. 9) + ENDIF + + d = 8.*denominvdp*( am*felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qvs0 - qx(mgs,lv)) - ah*ftka(mgs)*temcg(mgs) )/ & + (dtp* ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & + Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs) + & + Max(0.001,vth - vtxbar(mgs,li,1))*h2*denominvdp)) + + ELSE + + d = 8.*ah*h1*dtpinv/ & + ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & + Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs)*denomdp + & + Max(0.001,vth - vtxbar(mgs,li,1))*h2) + ENDIF +! write(0,*) 'iter,d,dwr = ',n,d,dwr +! write(91,*) 'parts = ',( -ah*ftka*temcg - ah*felv*fwvdf*dn(i,j,k)*(qvamb - qvs0) ),( Max(0.001,vth - 0.01*vwmw)*ehw* qcmks*dn(i,j,k)/denominv + Max(0.001,vth - 0.01*vimw)*ehi*qimks*dn(i,j,k)*fci*temcg) +!! write(91,*) 'partsr = ',( -ah*ftka*temcg - ah*felv*fwvdf*dn(i,j,k)*(qvamb - qvs0) ),( ( Max(0.001,vth - 0.01*vwmw)*ehw* qcmks + Max(0.001,vth - 0.01*vrmw)*ehr* qrmks) *dn(i,j,k)/denominv + & +!! Max(0.001,vth - 0.01*vimw)*ehi*qimks*dn(i,j,k)*fci*temcg) +! write(91,*) 'parts2 = ',vth + + IF ( Abs(dold - d)/dold < 0.05 .or. ( n > 3 .and. d > dg0thresh ) ) EXIT + + ENDDO + ENDIF + + dg0(mgs) = Max( d, dwmin ) +! IF ( .false. .and. ny == 2 .and. dwr < 0.5 .and. dwr > 0. ) THEN +! write(0,*) 'i,k,dg0 = ',igs(mgs), kgs(mgs), dg0(mgs) +! write(0,*) 'h1,h2,h3,h4 = ',h1,h2,h3,h4 +! write(0,*) 'dw,dwr = ',dw,dwr +! write(0,*) 'wetgrowth = ',wetgrowth(mgs) +! write(0,*) 'temc,Dh, Dhl = ',temcg(mgs),xdia(mgs,lh,3),xdia(mgs,lhl,3) +! ENDIF + ELSE + dg0(mgs) = dg0thresh + 0.0001 + ENDIF + + IF ( ihlcnh == 3 .and. (qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin & + .and. temg(mgs) .le. tfr-2.0 ) THEN + ! set a secondary condition on to capture large graupel that is riming but not in wet growth + dg0(mgs) = Min( dg0(mgs), dg0thresh - 0.0001 ) + ENDIF + + ENDIF +! write(0,*) 'notwet growth graupel,hail,Dw,Dwr = ',wetgrowth(mgs) , wetgrowthhl(mgs), dh0 ,tmp,tmp1 +! write(0,*) 'temc,Dh, Dhl = ',temcg(mgs),xdia(mgs,lh,3),xdia(mgs,lhl,3) +! write(0,*) 'qc,qi = ', qx(mgs,lc) , qx(mgs,li) + wtest = (dg0(mgs) > 0.0 .and. dg0(mgs) < dg0thresh ) @@ -16874,12 +19371,142 @@ subroutine nssl_2mom_gs & ELSEIF ( ihlcnh == 3 ) THEN !{ + IF ( wtest .and. & + ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > hlcnhqmin ) ) THEN + ! convert number, mass, and reflectivity for d > dw + IF ( ipconc == 5 ) THEN + ! dg0(mgs) = Min( dg0(mgs), hldia1 ) + !dg0(mgs) = hldia1 + ENDIF + + ratio = Min( maxratiolu, dg0(mgs)/xdia(mgs,lh,1) ) + + + ! mass + tmp2 = gaminterp(ratio,alpha(mgs,lh),4,1) + IF ( ipconc == 5 ) THEN + ! tmp2 = Min( 0.25, tmp2 ) + ENDIF + qxd1 = qx(mgs,lh)*(tmp2) + qhlcnh(mgs) = dtpinv*qxd1 + flim = 1.0 +! tmp3 = Min( dtp*(qfacw(mgs) + qfacr(mgs) ), qxmxd(mgs,lf) ) + tmp3 = qxmxd(mgs,lh) + IF (qxd1 > tmp3 ) THEN + flim = tmp3/(qxd1) + qhlcnh(mgs) = flim*qhlcnh(mgs) + ENDIF + + + + IF ( ( qxd1 > qxmin(lhl) .and. ipconc > 5 ) .or. ( qxd1 > 10.*qxmin(lhl) .and. ipconc == 5) ) THEN + + ! number + tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + IF ( ipconc == 5 ) THEN + ! tmp = Min( 0.2, tmp ) + ENDIF + cxd1 = flim*cx(mgs,lh)*( tmp) + chlcnh(mgs) = dtpinv*cxd1 + chlcnhhl(mgs) = chlcnh(mgs) + + IF ( qx(mgs,lhl) > qxmin(lhl) .and. dmhlopt > 0 ) THEN + dh0 = rho0(mgs)*qhlcnh(mgs)/chlcnhhl(mgs) + IF ( dh0 < xmas(mgs,lhl) ) THEN + ! dh0 = ( qxd1*dh0 + qx(mgs,lhl)*xmas(mgs,lhl))/( qxd1 + qx(mgs,lhl)) ! weighted average + dh0 = (( qxd1*dh0**(1./3.) + qx(mgs,lhl)*xmas(mgs,lhl)**(1./3.))/( qxd1 + qx(mgs,lhl)))**3 ! weighted average + chlcnhhl(mgs) = Min( chlcnhhl(mgs), rho0(mgs)*qhlcnh(mgs)/dh0 ) + ELSE +! dh0 = Max( dh0, xmas(mgs,lhl) ) ! when enough hail is established, do not dilute the size + ENDIF + ENDIF + + + ! reflectivity + IF ( lzh > 1 .and. lzhl > 1 ) THEN + tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) + zxd1 = flim*zx(mgs,lh)*(tmp3) + zhlcnh(mgs) = dtpinv*zxd1 + ELSE + zxd1 = 0 + ENDIF + + ELSE + qhlcnh(mgs) = 0.0 + ENDIF + +! IF ( cxd1 < 0.0 .or. qxd1 < 0.0 ) THEN +! write(0,*) 'cxd1,qxd1 = ',cxd1,qxd1 +! write(0,*) 'dw,temcg = ',dw,temcg(mgs),ratio +! ENDIF + +! write(0,*) 'dw,temcg = ',dw,temcg(mgs),ratio +! write(0,*) 'qhlcnh,qh = ',qhlcnh(mgs),qx(mgs,lh),qxd1 +! write(0,*) 'chlcnh,ch = ',chlcnh(mgs),cx(mgs,lh),cxd1 +! write(0,*) 'zhlcnh,zh = ',zhlcnh(mgs),zx(mgs,lh),zxd1 +! write(0,*) 'tmp1,2,3 = ',tmp,tmp2,tmp3 + + vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh) + vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/Max(xdnmn(lhl), xdn(mgs,lh)) + + ENDIF + + ENDIF !} ENDDO ELSEIF ( ihlcnh == 2 ) THEN ! 10-ice type conversion +! +! Staka and Mansell (2005) type conversion +! +! hldia1 is set in micro_module and namelist +! IF ( .true. ) THEN + + ! convert number, mass, and reflectivity for d > hldia1, + ! regardless of wet growth status, but as long as riming > 0 + DO mgs = 1,ngscnt + IF ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > qxmin(lh) ) THEN + ratio = Min( maxratiolu, hldia1/xdia(mgs,lh,1) ) + + ! number + tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + cxd1 = cx(mgs,lh)*( tmp) + chlcnh(mgs) = dtpinv*cxd1 + chlcnhhl(mgs) = chlcnh(mgs) + + ! mass + tmp2 = gaminterp(ratio,alpha(mgs,lh),4,1) + qxd1 = qx(mgs,lh)*(tmp2) + qhlcnh(mgs) = dtpinv*qxd1 + + ! reflectivity + IF ( lzh > 1 .and. lzhl > 1 ) THEN + tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) + zxd1 = zx(mgs,lh)*(tmp3) + zhlcnh(mgs) = dtpinv*zxd1 + ELSE + zxd1 = 0 + ENDIF +! IF ( cxd1 < 0.0 .or. qxd1 < 0.0 ) THEN +! write(0,*) 'cxd1,qxd1 = ',cxd1,qxd1 +! write(0,*) 'dw,temcg = ',dw,temcg(mgs),ratio +! ENDIF + +! write(0,*) 'dw,temcg = ',dw,temcg(mgs),ratio +! write(0,*) 'qhlcnh,qh = ',qhlcnh(mgs),qx(mgs,lh),qxd1 +! write(0,*) 'chlcnh,ch = ',chlcnh(mgs),cx(mgs,lh),cxd1 +! write(0,*) 'zhlcnh,zh = ',zhlcnh(mgs),zx(mgs,lh),zxd1 +! write(0,*) 'tmp1,2,3 = ',tmp,tmp2,tmp3 + + vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh) + vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/Max(xdnmn(lhl), xdn(mgs,lh)) + + ENDIF + + ENDDO +! ENDIF ELSEIF ( ihlcnh == 0 ) THEN do mgs = 1,ngscnt @@ -17115,6 +19742,10 @@ subroutine nssl_2mom_gs & ciacrf(mgs) = qrzfac(mgs)*ciacrf(mgs) ciacrs(mgs) = qrzfac(mgs)*ciacrs(mgs) +! IF ( lzh .gt. 1 ) THEN +! zrfrzf(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.)) * & +! ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) +! ENDIF vrfrzf(mgs) = qrzfac(mgs)*vrfrzf(mgs) viacrf(mgs) = qrzfac(mgs)*viacrf(mgs) @@ -17154,7 +19785,13 @@ subroutine nssl_2mom_gs & IF ( qrcev(mgs) .lt. 0. .and. lnr > 1 ) THEN ! qrcev(mgs) = -qrmxd(mgs) ! crcev(mgs) = (rho0(mgs)/(xmas(mgs,lr)+1.e-20))*qrcev(mgs) - crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs) + IF ( icrcev == 1 ) THEN + crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs) + ELSEIF ( icrcev == 2 ) THEN + crcev(mgs) = (cx(mgs,lr)/(qx(mgs,lr)))*qrcev(mgs)*vtxbar(mgs,lr,2)/vtxbar(mgs,lr,1) + ELSE + crcev(mgs) = 0.0 + ENDIF ELSE crcev(mgs) = 0.0 ENDIF @@ -17166,12 +19803,6 @@ subroutine nssl_2mom_gs & ! ! evaporation/condensation of wet graupel and snow ! - qscev(:) = 0.0 - cscev(:) = 0.0 - qhcev(:) = 0.0 - chcev(:) = 0.0 - qhlcev(:) = 0.0 - chlcev(:) = 0.0 IF ( lhwlg > 1 ) THEN qhcevlg(:) = 0.0 chcevlg(:) = 0.0 @@ -17181,6 +19812,7 @@ subroutine nssl_2mom_gs & chlcevlg(:) = 0.0 ENDIF + ! ! ! @@ -18140,6 +20772,7 @@ subroutine nssl_2mom_gs & pqwvi(mgs) = & & -Min(0.0, qrcev(mgs)) & & -Min(0.0, qhcev(mgs)) & + & -Min(0.0, qfcev(mgs)) & & -Min(0.0, qhlcev(mgs)) & & -Min(0.0, qscev(mgs)) & ! > +il5(mgs)*(-qhsbv(mgs) - qhlsbv(mgs) ) & @@ -18150,6 +20783,7 @@ subroutine nssl_2mom_gs & pqwvd(mgs) = & & -Max(0.0, qrcev(mgs)) & & -Max(0.0, qhcev(mgs)) & + & -Max(0.0, qfcev(mgs)) & & -Max(0.0, qhlcev(mgs)) & & -Max(0.0, qscev(mgs)) & & +il5(mgs)*(-qiint(mgs) & @@ -18366,7 +21000,8 @@ subroutine nssl_2mom_gs & qrcev(mgs) = frac*qrcev(mgs) qhlacr(mgs) = frac*qhlacr(mgs) vhlacr(mgs) = frac*vhlacr(mgs) -! qhcev(mgs) = frac*qhcev(mgs) + qhcev(mgs) = frac*qhcev(mgs) + qhlcev(mgs) = frac*qhlcev(mgs) IF ( warmonly < 0.5 ) THEN @@ -18412,6 +21047,8 @@ subroutine nssl_2mom_gs & ! STOP ENDIF + + end do IF ( warmonly < 0.5 ) THEN @@ -18440,7 +21077,7 @@ subroutine nssl_2mom_gs & & -qhcns(mgs) & & +(1-il5(mgs))*qsmlr(mgs) + qsshr(mgs) & !null at this point when wet snow included ! > +il5(mgs)*(qssbv(mgs)) & - & + (qssbv(mgs)) & + & + qssbv(mgs) & & + Min(0.0, qscev(mgs)) & & -qsmul(mgs) @@ -18534,74 +21171,656 @@ subroutine nssl_2mom_gs & ENDIF - end do - - ENDIF ! lhl + end do + + ENDIF ! lhl + + ELSEIF ( warmonly < 0.8 ) THEN +! +! Graupel +! + do mgs = 1,ngscnt + pqhwi(mgs) = & + & +il5(mgs)*ifrzg*(qrfrzf(mgs) ) & + & +il5(mgs)*(qhdpv(mgs)) & + & +qhacr(mgs)+qhacw(mgs) + pqhwd(mgs) = & + & qhshr(mgs) & !null at this point when wet graupel included + & - qhlcnh(mgs) & + & - qhmul1(mgs) & + & - qsplinter(mgs) - qsplinter2(mgs) & + & +(1-il5(mgs))*qhmlr(mgs) !null at this point when wet graupel included + end do + +! +! Hail +! + IF ( lhl .gt. 1 ) THEN + + do mgs = 1,ngscnt + pqhli(mgs) = & + & +il5(mgs)*(qhldpv(mgs) ) & ! + (1.0-ifrzg)*(qiacrf(mgs)+qrfrzf(mgs) + qracif(mgs))) & + & +il5(mgs)*(1.0-ifrzg)*(qrfrzf(mgs) ) & + & +qhlacr(mgs)+qhlacw(mgs) & +! & +qhlacs(mgs)+qhlaci(mgs) & + & + qhlcnh(mgs) + pqhld(mgs) = & + & qhlshr(mgs) & + & +(1-il5(mgs))*qhlmlr(mgs) & +! > +il5(mgs)*qhlsbv(mgs) & + & + qhlsbv(mgs) & + & -qhlmul1(mgs) - qhcnhl(mgs) + + end do + + ENDIF ! lhl + + ENDIF ! warmonly + +! +! Liquid water on snow and graupel +! + + vhmlr(:) = 0.0 + vhlmlr(:) = 0.0 + vhfzh(:) = 0.0 + vhlfzhl(:) = 0.0 + + IF ( mixedphase ) THEN + ELSE ! set arrays for non-mixedphase graupel + +! vhshdr(:) = 0.0 + vhmlr(:) = qhmlr(:) ! not actually volume, but treated as q in rate equation +! vhsoak(:) = 0.0 + +! vhlshdr(:) = 0.0 + vhlmlr(:) = qhlmlr(:) ! not actually volume, but treated as q in rate equation +! vhlmlr(:) = rho0(:)*qhlmlr(:)/xdn(:,lhl) +! vhlsoak(:) = 0.0 + + ENDIF ! mixedphase + + + +! +! Graupel reflectivity +! + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'graupel reflectivity' + + do mgs = 1,ngscnt + +! zhmlr(mgs) = 0.0 +! zhshr(mgs) = 0.0 +! zhmlrr(mgs) = 0.0 +! zhshrr(mgs) = 0.0 + zhdsv(mgs) = 0.0 +! IF ( lf < 1 ) THEN + IF ( ffrzh > 0.0 ) THEN + ziacr(mgs) = 0.0 + ziacrf(mgs) = 0.0 + ENDIF +! ENDIF + zhcns(mgs) = 0.0 + zhcni(mgs) = 0.0 + zhacs(mgs) = 0.0 + zhaci(mgs) = 0.0 + + ENDDO + + IF ( lzh .gt. 1 ) THEN ! + do mgs = 1,ngscnt + + + IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) .gt. 0.0 ) THEN + tmp = qx(mgs,lh)/cx(mgs,lh) + alp = Max( alphamin, alpha(mgs,lh) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) +! g1r = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + + zhaci(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhaci(mgs) ) + zhacs(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhacs(mgs) ) + + IF ( .not. mixedphase .and. ibinhmlr < 1 ) THEN + zhmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlr(mgs) ) + ENDIF + + zhshr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) + +! IF ( lzr > 0 .and. qhshr(mgs) /= 0.0 .and. chshrr(mgs) /= 0.0 .and. ibinhmlr < 1 ) THEN + IF ( lzr > 0 .and. qhshr(mgs) /= 0.0 .and. chshrr(mgs) /= 0.0 ) THEN +! IF ( temg(mgs) > tfr + 2.0 ) THEN +! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshrr(mgs) ) +! IF ( zhshrr(mgs) > 0. ) THEN +! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) +! ENDIF +! z1 = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? +! zhshrr(mgs) = Max( z1, zhshrr(mgs)) +! ELSE +! zhshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + + + IF ( temg(mgs) >= tfr ) THEN + ! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshrr(mgs) ) + ! IF ( zhshrr(mgs) > 0.0 ) THEN + ! zhshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ) + ! ENDIF + IF ( (shedalp + alpha(mgs,lh))*xdia(mgs,lh,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + ELSE + z1 = g1shr*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? + ENDIF + zhshrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) ! should this be g1shr? +! zhshrr(mgs) = Max( z1, zhshrr(mgs)) + ELSE + zhshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhshr(mgs)**2/ chshrr(mgs) ) + ENDIF + + zhshrr(mgs) = Min( 0.0, zhshrr(mgs) ) + ENDIF + + IF ( zhshr(mgs) > 0.0 ) THEN + write(0,*) 'Problem with zhshr! zhshr,qhshr,chshr = ',zhshr(mgs),qhshr(mgs),chshr(mgs) + write(0,*) 'g1,tmp, qx,cx,zx = ',g1,tmp,qx(mgs,lh),cx(mgs,lh),zx(mgs,lh) + write(0,*) ( 2.*tmp * qhshr(mgs) - tmp**2 * chshr(mgs) ), 2.*tmp * qhshr(mgs), - tmp**2 * chshr(mgs) + write(0,*) 'temcg = ',temcg(mgs),'chshr recalc = ',(cx(mgs,lh)/(qx(mgs,lh)+1.e-20))*qhshr(mgs) + + STOP + ENDIF + + +! zhshr(mgs) = (xdn0(lr)/(xdn(mgs,lh)))**2*( zx(mgs,lh) * qhshr(mgs) ) + + qtmp = qhdpv(mgs) + qhcev(mgs) + ctmp = chdpv(mgs) + chcev(mgs) + + zhdsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + alp = Max( alphahacx, alpha(mgs,lh) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .true. ) THEN ! { + IF ( qhacr(mgs) .gt. 0.0 ) THEN +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) + +! g1r = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) + zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) +! zhacrf(mgs) = g1*zhacr + + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*qhacr(mgs))**2)/(cx(mgs,lh)) + + IF ( z > zx(mgs,lh) ) THEN +! zhacr(mgs) = (z - zx(mgs,lh))*dtpinv + ELSE +! zhacr(mgs) = 0.0 + ENDIF + ENDIF + +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) ) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + +! alp = Max( 1.0, alpha(mgs,lh)+1. ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/ +! : ((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( qhacw(mgs) .gt. 0.0 ) THEN +! zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*(qhacw(mgs)-qhmul1(mgs)))**2)/(cx(mgs,lh)) + IF ( z > zx(mgs,lh) ) THEN +! zhacw(mgs) = (z - zx(mgs,lh))*dtpinv + ENDIF + ENDIF + + ELSE ! } { ! this is not used because of the 'true' above + + IF ( qhacw(mgs) .gt. 0.0 .or. qhacr(mgs) .gt. 0.0 ) THEN + z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*(qhacr(mgs) + qhacw(mgs)-qhmul1(mgs)))**2)/(cx(mgs,lh)) +! zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) + IF ( z > zx(mgs,lh) ) THEN + zhacw(mgs) = (z - zx(mgs,lh))*dtpinv + ENDIF + ENDIF + + ENDIF ! } + + IF ( qhlcnh(mgs) .gt. 0.0 .and. ihlcnh < 2 ) THEN + zhlcnh(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qhlcnh(mgs) - tmp**2 * chlcnh(mgs) ) + ENDIF + ENDIF +! qsplinter(mgs) + IF ( ffrzh*qiacrf(mgs) .gt. 0.0 .and. cx(mgs,lr) .gt. 0.0 .and. qx(mgs,lr) .gt. qxmin(lr) ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) +! alp = 3.0 +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( imurain == 3 ) THEN + ! note that 3.6476 = (6/pi)**2 + ziacr(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.))* & + & ( 2.*tmp * qiacrf(mgs) - tmp**2 * ciacrf(mgs) ) + ELSE ! imurain == 1 + ziacr(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2)* & + & ( 2.*tmp * qiacrf(mgs) - tmp**2 * ciacrf(mgs) ) + ENDIF + ziacr(mgs) = Min( ziacr(mgs), zxmxd(mgs,lr) ) +! ziacrf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * ziacr(mgs) + ziacrf(mgs) = (xdn(mgs,lr)/xdnmx(lh))**2 * ziacr(mgs) +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * (qiacrf(mgs) - qsplinter(mgs)) - tmp**2 * ciacrf(mgs) ) +! ziacrf(mgs) = Min( ziacrf(mgs), z ) + ENDIF + + + + IF ( ffrzh*qrfrzf(mgs) .gt. 0.0 .and. cx(mgs,lr) .gt. 0.0 ) THEN + tmp = qx(mgs,lr)/cx(mgs,lr) +! alp = 3.0 +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + IF ( imurain == 3 ) THEN + zrfrz(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,lr)+2.)/(xdn0(lr)**2*(alpha(mgs,lr)+1.)) * & + & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) + zrfrzf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * zrfrz(mgs) + ELSEIF ( imurain == 1 .and. ibiggopt /= 2 ) THEN +! zrfrz(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2) * & +! & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrz(mgs) ) + zrfrz(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(xdn0(lr)**2) * & + & ( 2.*tmp * qrfrz(mgs) - tmp**2 * crfrz(mgs) ) + zrfrzf(mgs) = 3.6476*rho0(mgs)**2*g1x(mgs,lr)/(rhofrz**2) * & + & ( 2.*tmp * qrfrzf(mgs) - tmp**2 * crfrzf(mgs) ) + ENDIF + zrfrz(mgs) = Min( zrfrz(mgs), Max(0.4,qrfrz(mgs)/qx(mgs,lr))*zx(mgs,lr)*dtpinv ) +! zrfrzf(mgs) = (xdn(mgs,lr)/xdn(mgs,lh))**2 * zrfrz(mgs) +! zrfrzf(mgs) = (xdn(mgs,lr)/xdnmx(lh))**2 * zrfrz(mgs) +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * (qrfrzf(mgs)-qsplinter2(mgs)) - tmp**2 * crfrzf(mgs) ) +! zrfrzf(mgs) = Min( zrfrzf(mgs), z ) + ! change this to be alpha=0? + ENDIF + + IF ( lhl > 1 .and. qhcnhl(mgs) .gt. 0.0 ) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) + zhcnhl(mgs) = g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qhcnhl(mgs) - tmp**2 * chcnhl(mgs) ) + + ENDIF + + IF ( qhcns(mgs) > 0.0 .and. chcns(mgs) > 0.0 .and. cx(mgs,ls) > cxmin .and. vhcns(mgs) > 0 ) THEN + tmp = qx(mgs,ls)/cx(mgs,ls) + r = rho0(mgs)*qhcns(mgs)/vhcns(mgs) ! density of new graupel particles + IF ( imusnow == 3 ) THEN + zhcns(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,ls)+2.)/(r**2*(alpha(mgs,ls)+1.)) * & + & ( 2.*tmp * qhcns(mgs) - tmp**2 * chcns(mgs) ) + ELSE + write(0,*) 'Value of imusnow not valid. Must be 3 (fix me for =1). imusnow = ',imusnow + STOP + ENDIF + ENDIF + + IF ( qhcni(mgs) > 0.0 .and. chcni(mgs) > 0.0 .and. cx(mgs,li) > cxmin .and. vhcni(mgs) > 0 ) THEN + tmp = qx(mgs,li)/cx(mgs,li) + r = rho0(mgs)*qhcni(mgs)/vhcni(mgs) ! density of new graupel particles + zhcni(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,li)+2.)/(r**2*(alpha(mgs,li)+1.)) * & + & ( 2.*tmp * qhcni(mgs) - tmp**2 * chcni(mgs) ) + ENDIF + + + pzhwi(mgs) = & + & +ifrzg*ffrzh*(zrfrzf(mgs) & + & +il5(mgs)*ifiacrg*(ziacrf(mgs) ) ) & +! : + zhcnsh(mgs) + zhcnih(mgs) & + & + zhacw(mgs) & + & + zhacr(mgs) & + & + zhcnhl(mgs) & + & + zhacs(mgs) & + & + zhaci(mgs) & + & + f2h*zhcni(mgs) + f2h*zhcns(mgs) & + & + Max( 0.0, zhdsv(mgs) ) + + pzhwd(mgs) = 0.0 & + & + (1-il5(mgs))*zhmlr(mgs) & + & + zhshr(mgs) & +! > + il5(mgs)*chsbv(mgs) & + & + Min( 0.0, zhdsv(mgs) ) & + & - il5(mgs)*zhlcnh(mgs) + + + IF ( igs(mgs) == 44 .and. kgs(mgs) == 23 .or. dtp*( pqhwi(mgs) + pqhwd(mgs) ) > qxmin(lh) ) THEN +! write(0,*) 'i,k,time = ',igs(mgs),kgs(mgs),time_real +! write(0,*) 'pzhwi,d = ',pzhwi(mgs),pzhwd(mgs),dtp*( pzhwi(mgs) + pzhwd(mgs) ),zx(mgs,lh) +! write(0,*) 'pqhwi,d = ',pqhwi(mgs),pqhwd(mgs),dtp*( pqhwi(mgs) + pqhwd(mgs) ),qx(mgs,lh) +! write(0,*) 'pchwi,d = ',pchwi(mgs),pchwd(mgs),dtp*( pchwi(mgs) + pchwd(mgs) ),cx(mgs,lh) + ENDIF + + +! IF ( zhcnhl(mgs) < 0.0 ) THEN +! write(0,*) 'Problem with zhcnhl! zhcnhl,qhcnhl,chcnhl = ',zhcnhl(mgs),qhcnhl(mgs),chcnhl(mgs) +! write(0,*) 'g1,tmp = ',g1x(mgs,lhl),tmp +! write(0,*) ( 2.*( tmp ) * qhcnhl(mgs) - tmp**2 * chcnhl(mgs) ) +! +!! STOP +! ENDIF + end do + + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'end graupel reflectivity' + + ENDIF + +! +! Hail reflectivity +! + + do mgs = 1,ngscnt + + zhldsv(mgs) = 0.0 + zhlacr(mgs) = 0.0 + zhlacw(mgs) = 0.0 + + ENDDO + + IF ( lzhl .gt. 1 .or. ( lzr > 1 .and. lnhl > 1 ) ) THEN ! also run for 2-moment hail for 3-moment rain sources + + if (ndebug .gt. 0 .and. my_rank>=0 ) write(0,*) my_rank, 'hail reflectivity' + + do mgs = 1,ngscnt + + IF ( qx(mgs,lhl) .gt. qxmin(lhl) .and. cx(mgs,lhl) .gt. 0.0 ) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) + alp = Max( alphamin, alpha(mgs,lhl) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .not. mixedphase .and. qhlmlr(mgs) /= 0.0 .and. chlmlr(mgs) /= 0.0 .and. ibinhlmlr < 1 ) THEN + zhlmlr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlmlr(mgs) - tmp**2 * chlmlr(mgs) ) + ENDIF + + zhlshr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ) + IF ( lzr > 1 .and. qhlshr(mgs) /= 0.0 .and. chlshrr(mgs) /= 0.0 ) THEN + IF ( temg(mgs) >= tfr ) THEN + ! zhlshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshrr(mgs) ) + ! IF ( zhlshrr(mgs) > 0.0 ) THEN + ! zhlshrr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn0(lr)))**2*( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ) + ! ENDIF + IF ( (shedalp + alpha(mgs,lhl))*xdia(mgs,lhl,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) + ELSE + z1 = g1shr*(6.0*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) ! should this be g1shr? + ENDIF + zhlshrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) ! should this be g1shr? +! zhlshrr(mgs) = Max( z1, zhlshrr(mgs)) + ELSE + zhlshrr(mgs) = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlshr(mgs)**2/ chlshrr(mgs) ) + ENDIF + + zhlshrr(mgs) = Min( 0.0, zhlshrr(mgs) ) + ENDIF + + IF ( zhlshr(mgs) > 0.0 ) THEN + write(0,*) 'Problem with zhlshr! zhlshr,qhlshr,chlshr = ',zhlshr(mgs),qhlshr(mgs),chlshr(mgs) + write(0,*) 'g1,tmp, qx,cx,zx = ',g1,tmp,qx(mgs,lhl),cx(mgs,lhl),zx(mgs,lhl) + write(0,*) ( 2.*tmp * qhlshr(mgs) - tmp**2 * chlshr(mgs) ), 2.*tmp * qhlshr(mgs), - tmp**2 * chlshr(mgs) + write(0,*) 'temcg = ',temcg(mgs),'chlshr recalc = ',(cx(mgs,lhl)/(qx(mgs,lhl)+1.e-20))*qhlshr(mgs) + + STOP + ENDIF +! zhlshr(mgs) = Min( 0.0, zhlshr(mgs) ) + +! zhlshr(mgs) = (xdn0(lr)/(xdn(mgs,lhl)))**2*( zx(mgs,lhl) * qhlshr(mgs) ) + + qtmp = qhldpv(mgs) + qhlcev(mgs) + ctmp = chldpv(mgs) + chlcev(mgs) + + zhldsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + alp = Max( alphahacx, alpha(mgs,lhl) ) +! g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + + IF ( .true. ) THEN ! { + IF ( qhlacr(mgs) .gt. 0.0 ) THEN +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*qhlacr(mgs))**2)/(cx(mgs,lhl)) + zhlacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*( tmp ) * qhlacr(mgs) ) +! zhlacr(mgs) = Min( zxmxd(mgs,lr), zhlacr(mgs) ) + +! IF ( z > zx(mgs,lhl) ) THEN +! zhlacr(mgs) = (z - zx(mgs,lhl))*dtpinv +! ELSE +! zhlacr(mgs) = 0.0 +! ENDIF + ENDIF + +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) ) +! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + + IF ( qhlacw(mgs) .gt. 0.0 ) THEN + alp = Max( 3.0, alpha(mgs,lhl)+1. ) + g1 = (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + +! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*(qhlacw(mgs)-qhlmul1(mgs)))**2)/(cx(mgs,lhl)) +! zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lhl)/cx(mgs,lhl)) * qhlacw(mgs) ) + zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlacw(mgs) ) + +! IF ( z > zx(mgs,lhl) ) THEN +! zhlacw(mgs) = (z - zx(mgs,lhl))*dtpinv +! ENDIF + g1 = g1x(mgs,lhl) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) + ENDIF + + ELSE ! } .false. { + + IF ( qhlacw(mgs) .gt. 0.0 .or. qhlacr(mgs) .gt. 0.0 ) THEN + z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lhl)+dtp*(qhlacr(mgs) + qhlacw(mgs)-qhlmul1(mgs)))**2)/(cx(mgs,lhl)) +! zhlacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lhl)/cx(mgs,lhl)) * qhlacw(mgs) ) + IF ( z > zx(mgs,lhl) ) THEN + zhlacw(mgs) = (z - zx(mgs,lhl))*dtpinv + ENDIF + ENDIF + + ENDIF ! } + + ENDIF +! qsplinter(mgs) + + IF ( lzhl > 1 ) THEN + pzhli(mgs) = ffrzh*(((1.0-ifrzg)*zrfrzf(mgs) & + & +il5(mgs)*(1.0-ifiacrg)*ziacrf(mgs) )) & + & + il5(mgs)*zhlcnh(mgs) & + & + zhlacw(mgs) & + & + zhlacr(mgs) & +! : + zhlacs(mgs) & + & + Max( 0.0, zhldsv(mgs) ) + + pzhld(mgs) = 0.0 & + & + (1-il5(mgs))*zhlmlr(mgs) & + & + zhlshr(mgs) & + & - zhcnhl(mgs) & + & + Min( 0.0, zhldsv(mgs) ) + + + IF ( .not. ( -1.0 < pzhli(mgs) .and. pzhli(mgs) < 1.e20 ) ) THEN + write(iunit,*) 'Problem with pzhli!' + write(iunit,*) 'zhlcnh,zhlacw,zhlacr,zhldsv = ',zhlcnh(mgs),zhlacw(mgs),zhlacr(mgs),zhldsv(mgs) + ENDIF + + IF ( .not. ( -1.0e20 < pzhld(mgs) .and. pzhld(mgs) < 1. ) ) THEN + write(iunit,*) 'Problem with pzhld!' + write(iunit,*) 'zhlmlr,zhlshr,zhldsv = ',zhlmlr(mgs),zhlshr(mgs),zhldsv(mgs) + ENDIF + + ENDIF ! lzhl > 1 + + end do + + ENDIF + +! +! rain reflectivity +! + if (ndebug .gt. 0 ) write(0,*) 'WARMZIEG: dbg = 11' + + IF ( lzr .gt. 1 ) THEN ! + + DO mgs = 1,ngscnt + + zracw(mgs) = 0.0 + zracr(mgs) = 0.0 + zrcev(mgs) = 0.0 + zrach(mgs) = 0.0 + zrachl(mgs) = 0.0 + zsshr(mgs) = 0.0 + zsshrr(mgs) = 0.0 + zsmlr(mgs) = 0.0 + zsmlrr(mgs) = 0.0 + + IF ( qx(mgs,ls) .gt. qxmin(ls) .and. ( csmlr(mgs) /= 0.0 .or. csshr(mgs) /= 0.0 .or. & + csmlrr(mgs) /= 0.0 .or. csshrr(mgs) /= 0.0) ) THEN !{ + tmp = qx(mgs,ls)/cx(mgs,ls) + g1 = 36.*(xnu(ls)+2.0)/((xnu(ls)+1.0)*pi**2) + IF ( .not. mixedphase ) THEN + zsmlr(mgs) = (xdn(mgs,ls)/xdn(mgs,lr))**2*g1*(rho0(mgs)/(xdn(mgs,ls)))**2* & + & ( 2.*tmp * qsmlr(mgs) - tmp**2 * csmlr(mgs) ) + + IF ( csmlrr(mgs) /= 0.0 ) THEN + z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsmlr(mgs)**2/ csmlrr(mgs) ) + zsmlrr(mgs) = z1 + ENDIF + ENDIF + +! zsshr(mgs) = (xdn(mgs,ls)/xdn(mgs,lr))**2*g1*(rho0(mgs)/(xdn(mgs,ls)))**2* & +! & ( 2.*tmp * qsshr(mgs) - tmp**2 * csshr(mgs) ) + + IF ( csshrr(mgs) /= 0.0 ) THEN + z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsshr(mgs)**2/ csshrr(mgs) ) + zsshrr(mgs) = z1 + ENDIF + + ENDIF !} + + IF ( .not. mixedphase ) THEN !{ + IF ( zhmlr(mgs) < 0.0 .and. chmlrr(mgs) /= 0.0 .and. ibinhmlr == 0 ) THEN !{ + tmp = qx(mgs,lh)/cx(mgs,lh) +! zhmlrr(mgs) = Min(0.0, (xdn(mgs,lh)/xdn(mgs,lr))**2 * & +! & g1x(mgs,lh)*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*tmp * qhmlr(mgs) - tmp**2 * chmlrr(mgs) ) ) + +! IF ( zhmlrr(mgs) >= 0. ) THEN +! zhmlrr(mgs) = (xdn(mgs,lh)/xdn(mgs,lr))**2 * zhmlr(mgs) +! ENDIF + IF ( (shedalp + alpha(mgs,lh))*xdia(mgs,lh,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of graupel + z1 = g1x(mgs,lh)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) + ELSE ! assume drops are shed off, so use either alpha for shedding or graupel alpha, whichever gives the lower g-factor (i.e., larger alpha) + z1 = Min(g1x(mgs,lh),g1shr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) + ENDIF + zhmlrr(mgs) = z1 +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhmlr(mgs)**2/ chmlrr(mgs) ) +! zhmlrr(mgs) = Max( z1, zhmlrr(mgs)) + ENDIF !} + + +! zhshrr(mgs) = (xdn(mgs,lh)/xdn(mgs,lr))**2 * zhshr(mgs) + + IF ( lhl > 1 .and. qhlmlr(mgs) /= 0 .and. ibinhlmlr == 0) THEN + tmp = qx(mgs,lhl)/cx(mgs,lhl) +! zhlmlrr(mgs) = Min(0.0, (xdn(mgs,lhl)/xdn(mgs,lr))**2 * & +! & g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lhl)))**2*( 2.*tmp * qhlmlr(mgs) - tmp**2 * chlmlrr(mgs) ) ) + +! IF ( zhlmlrr(mgs) >= 0. ) THEN ! should be negative, if not, then use alternate calculation +! zhlmlrr(mgs) = (xdn(mgs,lhl)/xdn(mgs,lr))**2 * zhlmlr(mgs) +! ENDIF + + IF ( (shedalp + alpha(mgs,lhl))*xdia(mgs,lhl,1) < sheddiam ) THEN ! if not shedding small drops, then use alpha of hail + z1 = g1x(mgs,lhl)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) + ELSE ! assume drops are shed off, so use either alpha for shedding or graupel alpha, whichever gives the lower g-factor (i.e., larger alpha) + z1 = Min(g1x(mgs,lhl),g1shr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) +! z1 = g1shr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) + ENDIF + zhlmlrr(mgs) = z1 + +! z1 = g1mlr*(rho0(mgs)/(xdn(mgs,lr)))**2*( qhlmlr(mgs)**2/ chlmlrr(mgs) ) +! zhlmlrr(mgs) = Max( z1, zhlmlrr(mgs)) +! zhlmlr(mgs) = +! zhlshrr(mgs) = (xdn(mgs,lhl)/xdn(mgs,lr))**2 * zhlshr(mgs) + ENDIF + + ENDIF ! } + + IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) .gt. 0.0 ) THEN + + tmp = qx(mgs,lr)/cx(mgs,lr) + g1 = g1x(mgs,lr) ! 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + + + IF ( qracw(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 ) THEN + zracw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * qracw(mgs) ) + ENDIF + + IF ( cracr(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 ) THEN + zracr(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( tmp**2 * cracr(mgs) ) + ENDIF + + qtmp = qrcev(mgs) + ctmp = crcev(mgs) + +! IF ( .false. .or. iferwisventr == 2 ) THEN +! zrcev(mgs) = Min(0.0, (12./(pii*xdn(mgs,lr)))*xdia(mgs,lr,1)**3*fvce(mgs)*rwcap(mgs)*rwventz(mgs) ) +! ELSE + zrcev(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) + + + IF ( iferwisventr == 2 ) THEN + vent1 = Min(0.0, (12./(pii*xdn(mgs,lr)))*xdia(mgs,lr,1)**3*fvce(mgs)*rwcap(mgs)*rwventz(mgs)) + zrcev(mgs) = Max( zrcev(mgs), vent1 ) + ENDIF +! IF ( ny == 2 .and. igs(mgs) == 20 ) THEN +! write(0,*) 'k,zrcevold,new,maxdep : ',kgs(mgs),zrcev(mgs),vent1,-zxmxd(mgs,lr),alpha(mgs,lr),cx(mgs,lr) +! ENDIF + + +! ENDIF + zrcev(mgs) = Max( zrcev(mgs), -zxmxd(mgs,lr) ) - ELSEIF ( warmonly < 0.8 ) THEN -! -! Graupel -! - do mgs = 1,ngscnt - pqhwi(mgs) = & - & +il5(mgs)*ifrzg*(qrfrzf(mgs) ) & - & +il5(mgs)*(qhdpv(mgs)) & - & +qhacr(mgs)+qhacw(mgs) - pqhwd(mgs) = & - & qhshr(mgs) & !null at this point when wet graupel included - & - qhlcnh(mgs) & - & - qhmul1(mgs) & - & - qsplinter(mgs) - qsplinter2(mgs) & - & +(1-il5(mgs))*qhmlr(mgs) !null at this point when wet graupel included - end do + IF ( qhacr(mgs) > 0.0 ) THEN + zrach(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*( qx(mgs,lr)/cx(mgs,lr)) * qhacr(mgs) - tmp**2 * chacr(mgs) ) + zrach(mgs) = Min( zrach(mgs), zxmxd(mgs,lr) ) + + ENDIF -! -! Hail -! - IF ( lhl .gt. 1 ) THEN + IF ( lhl > 1 .and. qhlacr(mgs) > 0.0 ) THEN + zrachl(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2* & + & ( 2.*( qx(mgs,lr)/cx(mgs,lr)) * qhlacr(mgs) - tmp**2 * chlacr(mgs) ) + zrachl(mgs) = Min( zrachl(mgs), zxmxd(mgs,lr) ) + ENDIF - do mgs = 1,ngscnt - pqhli(mgs) = & - & +il5(mgs)*(qhldpv(mgs) ) & ! + (1.0-ifrzg)*(qiacrf(mgs)+qrfrzf(mgs) + qracif(mgs))) & - & +il5(mgs)*(1.0-ifrzg)*(qrfrzf(mgs) ) & - & +qhlacr(mgs)+qhlacw(mgs) & -! & +qhlacs(mgs)+qhlaci(mgs) & - & + qhlcnh(mgs) - pqhld(mgs) = & - & qhlshr(mgs) & - & +(1-il5(mgs))*qhlmlr(mgs) & -! > +il5(mgs)*qhlsbv(mgs) & - & + qhlsbv(mgs) & - & -qhlmul1(mgs) - qhcnhl(mgs) - end do + + ENDIF - ENDIF ! lhl + pzrwi(mgs) = zrcnw(mgs) + zracw(mgs) + zracr(mgs) & + & + Max( 0.,zrcev(mgs) ) & + & - (1-il5(mgs))*zsmlrr(mgs) & + & - zsshrr(mgs) & + & - (1-il5(mgs))*zhmlrr(mgs) & + & - zhshrr(mgs) & + & - (1-il5(mgs))*zhlmlrr(mgs) & + & - zhlshrr(mgs) - ENDIF ! warmonly -! -! Liquid water on snow and graupel -! + pzrwd(mgs) = 0.0 & + & + Min(0.,zrcev(mgs) ) & + & - zrach(mgs) & + & - zrachl(mgs) & + & - zrfrz(mgs) & + & - il5(mgs)*(ziacr(mgs) ) - vhmlr(:) = 0.0 - vhlmlr(:) = 0.0 - vhfzh(:) = 0.0 - vhlfzhl(:) = 0.0 - IF ( mixedphase ) THEN - ELSE ! set arrays for non-mixedphase graupel - -! vhshdr(:) = 0.0 - vhmlr(:) = qhmlr(:) ! not actually volume, but treated as q in rate equation -! vhsoak(:) = 0.0 + IF ( zx(mgs,lr) + dtp*(pzrwi(mgs)+pzrwd(mgs)) <= 0.0 & + .and. qx(mgs,lr) > qxmin(lr) ) THEN + pzrwd(mgs) = -zx(mgs,lr)*dtpinv - pzrwi(mgs) + ENDIF -! vhlshdr(:) = 0.0 - vhlmlr(:) = qhlmlr(:) ! not actually volume, but treated as q in rate equation -! vhlmlr(:) = rho0(:)*qhlmlr(:)/xdn(:,lhl) -! vhlsoak(:) = 0.0 + ENDDO - ENDIF ! mixedphase + ENDIF @@ -18678,6 +21897,33 @@ subroutine nssl_2mom_gs & ! > + rho0(mgs)*qhshr(mgs)/xdn(mgs,lh) !xdn(mgs,lr) ! ENDIF + IF ( lzh > 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN +! Calculate change in reflectivity due to density changes + + xdn_new = rho0(mgs)*(qx(mgs,lh) + dtp*(pqhwi(mgs) + pqhwd(mgs) ))/ & + & (vx(mgs,lh) + dtp*(pvhwi(mgs) + pvhwd(mgs)) ) + + IF ( mixedphase ) THEN + IF ( qxw(mgs,lh) .gt. 0.0 ) THEN + dnmx = xdnmx(lr) + ELSE + dnmx = xdnmx(lh) + ENDIF + ELSE + dnmx = xdnmx(lh) + ENDIF + + xdn_new = Max( Min( xdn_new, dnmx ), xdnmn(lh) ) + + drhodt = (xdn_new - xdn(mgs,lh))*dtpinv + + zhwdn(mgs) = -2.*g1x(mgs,lh)*(rho0(mgs)*qx(mgs,lh)*6.*pii )**2/(cx(mgs,lh)*xdn(mgs,lh)**3)*drhodt + + pzhwi(mgs) = pzhwi(mgs) + Max(0.0, zhwdn(mgs)) + pzhwd(mgs) = pzhwd(mgs) + Min(0.0, zhwdn(mgs)) + + + ENDIF IF ( .false. .and. ny .eq. 2 .and. kgs(mgs) .eq. 9 .and. igs(mgs) .eq. 19 ) THEN write(iunit,*) @@ -18760,6 +22006,32 @@ subroutine nssl_2mom_gs & & + rho0(mgs)*(1-il5(mgs))*vhlmlr(mgs)/xdn(mgs,lhl) & & + vhlshdr(mgs) - vhlsoak(mgs) + IF ( lzhl > 1 .and. qx(mgs,lhl) > qxmin(lhl) ) THEN +! Calculate change in reflectivity due to density changes + + xdn_new = rho0(mgs)*(qx(mgs,lhl) + dtp*(pqhli(mgs) + pqhld(mgs) ))/ & + & (vx(mgs,lhl) + dtp*(pvhli(mgs) + pvhld(mgs)) ) + + IF ( mixedphase ) THEN + IF ( qxw(mgs,lhl) .gt. 0.0 ) THEN + dnmx = xdnmx(lr) + ELSE + dnmx = xdnmx(lhl) + ENDIF + ELSE + dnmx = xdnmx(lhl) + ENDIF + xdn_new = Max( Min( xdn_new, dnmx ), xdnmn(lhl) ) + + drhodt = (xdn_new - xdn(mgs,lhl))*dtpinv + + zhldn(mgs) = -2.*g1x(mgs,lhl)*(rho0(mgs)*qx(mgs,lhl)*6.*pii )**2/(cx(mgs,lhl)*xdn(mgs,lhl)**3)*drhodt + + pzhli(mgs) = pzhli(mgs) + Max(0.0, zhldn(mgs)) + pzhld(mgs) = pzhld(mgs) + Min(0.0, zhldn(mgs)) + + + ENDIF ENDDO @@ -18989,7 +22261,7 @@ subroutine nssl_2mom_gs & write(iunit,*) -qracs(mgs)*(1-il2(mgs)) , qhacs(mgs) , qhlacs(mgs) write(iunit,*) -qhcns(mgs) write(iunit,*) +(1-il5(mgs))*qsmlr(mgs) , qsshr(mgs) - write(iunit,*) (qssbv(mgs)) + write(iunit,*) qssbv(mgs) write(iunit,*) Min(0.0, qscev(mgs)) write(iunit,*) -qsmul(mgs) ! @@ -19061,33 +22333,37 @@ subroutine nssl_2mom_gs & IF ( warmonly < 0.5 ) THEN pfrz(mgs) = & & (1-il5(mgs))* & - & (qhmlr(mgs)+qsmlr(mgs)+qhlmlr(mgs)) & !+qhmlh(mgs)) & - & +il5(mgs)*(qhfzh(mgs)+qsfzs(mgs)+qhlfzhl(mgs)) & + & (qhmlr(mgs)+ & + & qsmlr(mgs)+qhlmlr(mgs)) & !+qhmlh(mgs)) & & +il5(mgs)*(1-imixedphase)*( & & qsacw(mgs)+qhacw(mgs) + qhlacw(mgs) & & +qsacr(mgs)+qhacr(mgs) + qhlacr(mgs) & & +qsshr(mgs) & & +qhshr(mgs) & - & +qhlshr(mgs) +qrfrz(mgs)+qiacr(mgs) & + & +qhlshr(mgs) & + & +qrfrz(mgs)+qiacr(mgs) & & ) & & +il5(mgs)*(qwfrz(mgs) & & +qwctfz(mgs)+qiihr(mgs) & & +qiacw(mgs)) pmlt(mgs) = & & (1-il5(mgs))* & - & (qhmlr(mgs)+qsmlr(mgs)+qhlmlr(mgs)) !+qhmlh(mgs)) + & (qhmlr(mgs)+qsmlr(mgs)+ & + & qhlmlr(mgs)) !+qhmlh(mgs)) ! NOTE: psub is sum of sublimation and deposition psub(mgs) = & & il5(mgs)*( & & + qsdpv(mgs) + qhdpv(mgs) & & + qhldpv(mgs) & & + qidpv(mgs) + qisbv(mgs) ) & - & + qssbv(mgs) + qhsbv(mgs) + qhlsbv(mgs) & + & + qssbv(mgs) + qhsbv(mgs) & + & + qhlsbv(mgs) & & +il5(mgs)*(qiint(mgs)) pvap(mgs) = & - & qrcev(mgs) + qhcev(mgs) + qscev(mgs) + qhlcev(mgs) + & qrcev(mgs) + qhcev(mgs) + qscev(mgs) + qhlcev(mgs) + qfcev(mgs) pevap(mgs) = & - & Min(0.0,qrcev(mgs)) + Min(0.0,qhcev(mgs)) + Min(0.0,qscev(mgs)) + Min(0.0,qhlcev(mgs)) + & Min(0.0,qrcev(mgs)) + Min(0.0,qhcev(mgs)) + Min(0.0,qscev(mgs)) + Min(0.0,qhlcev(mgs)) & + + Min(0.0,qfcev(mgs)) ! NOTE: pdep is the deposition part only pdep(mgs) = & & il5(mgs)*( & @@ -19115,7 +22391,7 @@ subroutine nssl_2mom_gs & & + qidpv(mgs) + qisbv(mgs) ) & & +il5(mgs)*(qiint(mgs)) pvap(mgs) = & - & qrcev(mgs) + qhcev(mgs) + qhlcev(mgs) ! + qscev(mgs) + & qrcev(mgs) + qhcev(mgs) + qhlcev(mgs) + qfcev(mgs) ELSE pfrz(mgs) = 0.0 psub(mgs) = 0.0 @@ -19143,6 +22419,8 @@ subroutine nssl_2mom_gs & ! ! do mgs = 1,ngscnt + + qwvp(mgs) = qwvp(mgs) + & & dtp*(pqwvi(mgs)+pqwvd(mgs)) qx(mgs,lc) = qx(mgs,lc) + & @@ -19155,6 +22433,7 @@ subroutine nssl_2mom_gs & & dtp*(pqswi(mgs)+pqswd(mgs)) qx(mgs,lh) = qx(mgs,lh) + & & dtp*(pqhwi(mgs)+pqhwd(mgs)) + IF ( lhl .gt. 1 ) THEN qx(mgs,lhl) = qx(mgs,lhl) + & & dtp*(pqhli(mgs)+pqhld(mgs)) @@ -19224,6 +22503,27 @@ subroutine nssl_2mom_gs & + ENDIF + ENDIF + IF ( ipconc .ge. 6 ) THEN + IF ( lzr .gt. 1 ) THEN + zx(mgs,lr) = zx(mgs,lr) + & + & dtp*(pzrwi(mgs)+pzrwd(mgs)) + ENDIF + IF ( lzs .gt. 1 ) THEN + zx(mgs,ls) = zx(mgs,ls) + & + & dtp*(pzswi(mgs)+pzswd(mgs)) + ENDIF + IF ( lzh .gt. 1 ) THEN + zx(mgs,lh) = zx(mgs,lh) + & + & dtp*(pzhwi(mgs)+pzhwd(mgs)) + ENDIF + IF ( lzhl .gt. 1 ) THEN + zx(mgs,lhl) = zx(mgs,lhl) + & + & dtp*(pzhli(mgs)+pzhld(mgs)) +! IF ( pchli(mgs) .ne. 0. .or. pchld(mgs) .ne. 0 ) THEN +! write(0,*) 'dr: cx,pchli,pchld = ', cx(mgs,lhl),pchli(mgs),pchld(mgs), igs(mgs),kgs(mgs) +! ENDIF ENDIF ENDIF end do @@ -19775,6 +23075,29 @@ subroutine nssl_2mom_gs & ENDIF + + + +! +! 6th moments +! + + IF ( ipconc .ge. 6 ) THEN + DO il = lr,lhab + IF ( lz(il) .gt. 1 ) THEN + IF ( lf > 1 .and. il == lf ) THEN + lfsave(mgs,3) = an(igs(mgs),jy,kgs(mgs),lz(il)) + lfsave(mgs,4) = zx(mgs,il) + ENDIF + + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + & + & min( an(igs(mgs),jy,kgs(mgs),lz(il)), 0.0 ) + zx(mgs,il) = an(igs(mgs),jy,kgs(mgs),lz(il)) + + ENDIF + ENDDO + + ENDIF ! end do ! @@ -19839,6 +23162,447 @@ subroutine nssl_2mom_gs & ENDIF !} ENDDO ! mgs + ELSE ! } { is three-moment, so have to adjust Z if size is too large + IF ( il == lr .and. imurain == 3 ) THEN ! { { RAIN + +! rdmx = +! rdmn = + + DO mgs = 1,ngscnt + + + IF ( iresetmoments == 1 .or. iresetmoments == il ) THEN + IF ( zx(mgs,lr) <= zxmin ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + qx(mgs,lr) = 0.0 + cx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),ln(lr)) = cx(mgs,lr) + ELSEIF ( cx(mgs,lr) <= cxmin ) THEN + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,lr) = 0.0 + qx(mgs,lr) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),lr) + an(igs(mgs),jgs,kgs(mgs),lr) = qx(mgs,lr) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + ENDIF + ENDIF + + IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN + + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*Max(1.0e-11,cx(mgs,lr))) + IF ( xv(mgs,lr) .gt. xvmx(lr) ) THEN +! xv(mgs,lr) = xvmx(lr) +! cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmx(lr)*xdn(mgs,lr)) + ELSEIF ( xv(mgs,lr) .lt. xvmn(lr) ) THEN + xv(mgs,lr) = xvmn(lr) + cx(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xvmn(lr)*xdn(mgs,lr)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2) +! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + chw = cx(mgs,il) + qr = qx(mgs,il) + zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) + an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + z = zx(mgs,il) + qr = qx(mgs,il) + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + + IF ( zx(mgs,lr) > 0.0 ) THEN + xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) + vr = xv(mgs,lr) +! z = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + +! xv = (db(1,kz)*a(1,1,kz,lr))**2/(a(1,1,kz,lnr)) +! rd = z*(pi/6.*1000.)**2/xv + +! determine shape parameter alpha by iteration + IF ( z .gt. 0.0 ) THEN +! alpha(mgs,lr) = 3. + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. +! write(0,*) 'kz, alp, alpha(kz) = ',kz,alp,alpha(kz),rd,z,xv + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + +! check for artificial breakup (rain larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) .or. (ioldlimiter == 2 .and. xv(mgs,il) .gt. xvmx(il)/8.) ) THEN + tmp = cx(mgs,il) +! write(0,*) 'MY limiter: xv: ',xv(mgs,il), xv(mgs,il)/(xvmx(il)/8.) +! STOP + IF ( ioldlimiter == 2 ) THEN ! MY-style active breakup + x = (6.*rho0(mgs)*qx(mgs,il)/(pi*xdn(mgs,il)*cx(mgs,il)))**(1./3.) + x1 = Max(0.0e-3, x - 3.0e-3) + x2 = Max(0.5, x/6.0e-3) + x3 = x2**3 + cx(mgs,il) = cx(mgs,il)*Max((1.+2.222e3*x1**2), x3) + xv(mgs,il) = xv(mgs,il)/Max((1.+2.222e3*x1**2), x3) + ELSE ! simple cutoff + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + !xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + !cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + + + IF ( tmp < cx(mgs,il) ) THEN ! breakup + + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + vr = xv(mgs,lr) + qr = qx(mgs,lr) + nrx = cx(mgs,lr) + z = zx(mgs,lr) + + +! determine shape parameter alpha by iteration + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + DO i = 1,20 + IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT + alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) + alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. + alp = Max( rnumin, Min( rnumax, alp ) ) + ENDDO + + + ENDIF + ENDIF + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) + IF ( .true. .and. (alpha(mgs,il) <= rnumin .or. alp == rnumin .or. alp == rnumax) ) THEN + + IF ( rescale_high_alpha .and. alp >= rnumax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(1./(xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( rescale_low_alphar .and. alp <= rnumin ) THEN + z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ENDIF + + + + ENDIF + ENDIF + + ENDIF + + ENDDO +! CALL cld_cpu('Z-MOMENT-1r') + + + ELSEIF ( il == lh .or. il == lhl .or. il == lf .or. (il == lr .and. imurain == 1 )) THEN ! } { Rain, GRAUPEL OR HAIL + + + + DO mgs = 1,ngscnt + + IF ( lf > 1 .and. il == lf ) THEN + lfsave(mgs,5) = an(igs(mgs),jy,kgs(mgs),ln(il)) + lfsave(mgs,6) = cx(mgs,il) + ENDIF + + IF ( il == lhl .and. lnhlf > 1 ) THEN + IF ( cx(mgs,lhl) > cxmin ) THEN + frac = chxf(mgs,lhl)/cx(mgs,lhl) + ELSE + frac = 0.0 + ENDIF + ENDIF + + IF ( il == lh .and. lnhf > 1 ) THEN + IF ( cx(mgs,lh) > cxmin ) THEN + frach = chxf(mgs,lh)/cx(mgs,lh) + ELSE + frach = 0.0 + ENDIF + ENDIF + + + + IF ( iresetmoments == 1 .or. iresetmoments == il .or. iresetmoments == -1 ) THEN ! { .or. qx(mgs,il) <= qxmin(il) + IF ( zx(mgs,il) <= zxmin ) THEN ! .and. qx(mgs,il) > 0.05e-3 +!! write(91,*) 'zx=0; qx,cx = ',1000.*qx(mgs,il),cx(mgs,il) + qx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ELSEIF ( iresetmoments == -1 .and. qx(mgs,il) < qxmin(il) ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( cx(mgs,il) <= cxmin .and. iresetmoments /= -1 ) THEN ! .and. qx(mgs,il) > 0.05e-3 + qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) + zx(mgs,il) = 0.0 + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + ELSE + IF ( zx(mgs,il) < 0.0 ) THEN ! .and. qx(mgs,il) > 0.05e-3 + zx(mgs,il) = 0.0 + ENDIF + ENDIF !} + + + IF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= cxmin ) THEN + zx(mgs,il) = 0.0 + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + ENDIF + + IF ( qx(mgs,il) .gt. qxmin(il) ) THEN !{ + + xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + + IF ( xv(mgs,il) .lt. xvmn(il) ) THEN + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + ENDIF + + IF ( zx(mgs,il) > 0.0 .and. cx(mgs,il) <= 0.0 ) THEN !{ +! have mass and reflectivity but no concentration, so set concentration, using default alpha + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN +! have mass and concentration but no reflectivity, so set reflectivity, using default alpha +! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & +! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + chw = cx(mgs,il) + qr = qx(mgs,il) +! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + g1 = (6.0 + alphamax)*(5.0 + alphamax)*(4.0 + alphamax)/ & + & ((3.0 + alphamax)*(2.0 + alphamax)*(1.0 + alphamax)) + zx(mgs,il) = Max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN +! How did this happen? + ! set values according to dBZ of -10, or Z = 0.1 +! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 + +! write(0,*) 'GS: moment problem! il,c,z,q = ',il,cx(mgs,il),zx(mgs,il),qx(mgs,il) + + zx(mgs,il) = 1.e-19/0.224*(xdn0(lr)/xdn0(il))**2 + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + z = zx(mgs,il) + qr = qx(mgs,il) +! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + +! write(0,*) 'GS: moment problem! reset il,c,z,q = ',il,cx(mgs,il),zx(mgs,il),qx(mgs,il) + + ELSE + ! have all valid moments, so find shape parameter + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + IF ( zx(mgs,il) .gt. 0. ) THEN !{ + +! rdi = z*(pi/6.*1000.)**2*chw/((rho0(mgs)*qr)**2) + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'kz, alp, alpha(mgs,il) = ',kz,alp,alpha(mgs,il),rdi,z,xv + DO i = 1,10 +! IF ( 100.*Abs(alp - alpha(mgs,il))/(Abs(alpha(mgs,il))+1.e-5) .lt. 1. ) EXIT + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) +! alp = 1.e18*(6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ +! : ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 +! print*,'i,alp = ',i,alp + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + +! check for artificial breakup (graupel/hail larger than allowed max size) + IF ( xv(mgs,il) .gt. xvmx(il) ) THEN !{ + tmp = cx(mgs,il) + + + xv(mgs,il) = Min( xvmx(il), Max( xvmn(il),xv(mgs,il) ) ) + xmas(mgs,il) = xv(mgs,il)*xdn(mgs,il) + cx(mgs,il) = rho0(mgs)*qx(mgs,il)/(xmas(mgs,il)) + IF ( tmp < cx(mgs,il) ) THEN ! breakup + g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) + zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) + + chw = cx(mgs,il) + qr = qx(mgs,il) + z = zx(mgs,il) + + rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) + alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + DO i = 1,10 + IF ( Abs(alp - alpha(mgs,il)) .lt. 0.01 ) EXIT + alpha(mgs,il) = Max( alphamin, Min( alphamax, alp ) ) + alp = (6.+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & + & ((3.0+alpha(mgs,il))*(2.0+alpha(mgs,il))*rdi) - 1.0 + alp = Max( alphamin, Min( alphamax, alp ) ) + ENDDO + + + ENDIF + ENDIF !} + +! +! Check whether the shape parameter is at or less than the minimum, and if it is, reset the +! concentration or reflectivity to match (prevents reflectivity from being out of balance with Q and N) +! + g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & + & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) + + IF ( ( lrescalelow(il) .or. rescale_high_alpha ) .and. & + & ( alpha(mgs,il) <= alphamin .or. alp == alphamin .or. alp == alphamax ) ) THEN !{ + + IF ( rescale_high_alpha .and. alp >= alphamax - 0.01 ) THEN ! reset c at high alpha to prevent growth in Z + cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 + an(igs(mgs),jy,kgs(mgs),ln(il)) = cx(mgs,il) + + ELSEIF ( lrescalelow(il) .and. alp <= alphamin .and. .not. (il == lh .and. icvhl2h > 0 ) .and. & + .not. ( il == lr .and. .not. rescale_low_alphar ) ) THEN ! alpha = alphamin, so reset Z to prevent growth in C + + wtest = .false. + IF ( irescalerainopt == 0 ) THEN + wtest = .false. + ELSEIF ( irescalerainopt == 1 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) + ELSEIF ( irescalerainopt == 2 ) THEN + wtest = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ELSEIF ( irescalerainopt == 3 ) THEN + wtest = temcg(mgs) > rescale_tempthresh .and. qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < rescale_wthresh + ENDIF + + IF ( il == lr .and. ( wtest .or. .not. rescale_low_alphar ) ) THEN + ! certain situations where rain number is adjusted instead of Z. Helps avoid rain being 'zapped' by autoconverted + ! drops (i.e., favor preserving Z when alpha tries to go negative) + chw = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z*(6./(pi*xdn(mgs,il)))**2 ! g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z1 + cx(mgs,il) = chw + an(igs(mgs),jy,kgs(mgs),ln(il)) = chw + ELSE + ! Usual resetting of reflectivity moment to force consisntency between Q, N, Z, and alpha when alpha = alphamin + z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw + z = z1*(6./(pi*xdn(mgs,il)))**2 + zx(mgs,il) = z + an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + +! z1 = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw +! z = z1*(6./(pi*xdn(mgs,il)))**2 +! zx(mgs,il) = z +! an(igs(mgs),jy,kgs(mgs),lz(il)) = z + ENDIF + + ENDIF !} + + + ENDIF !} + + + ENDIF ! !} + + + + ENDIF !} + + IF ( il == lhl .and. lnhlf > 1 ) THEN + ! update chxf in case cx has changed + chxf(mgs,lhl) = frac*cx(mgs,lhl) + ENDIF + IF ( il == lh .and. lnhf > 1 ) THEN + ! update chxf in case cx has changed + chxf(mgs,lh) = frach*cx(mgs,lh) + ENDIF + + +! IF ( lf > 0 .and. il == lf .and. kgs(mgs) <= 20 .and. ( cx(mgs,lf) + dtp*( pcfwi(mgs) + pcfwd(mgs) ) > 200. .or. cx(mgs,lf) > 400. )) THEN +! write(0,*) 'ix,jy, kz, cf = ',igs(mgs)+ixbeg,jy+jybeg,kgs(mgs), an(igs(mgs),jy,kgs(mgs),ln(lf)),lfsave(mgs,5),lfsave(mgs,6) +! write(0,*) 'qold,qxold,zold,zxold = ',lfsave(mgs,1),lfsave(mgs,2),lfsave(mgs,3),lfsave(mgs,4) +! write(0,*) 'cf_new,pcfwi,pcfwd = ',cx(mgs,lf),cx(mgs,lf) + dtp*( pcfwi(mgs) + pcfwd(mgs) ),pcfwi(mgs) + pcfwd(mgs) +! +! ENDIF + + ENDDO ! mgs + +! CALL cld_cpu('Z-DELABK') + + +! CALL cld_cpu('Z-DELABK') + + + + + ENDIF ! } } ENDIF ! }} ENDIF ! } diff --git a/physics/mp_nssl.F90 b/physics/mp_nssl.F90 index 4e0e323ce..9c7951542 100644 --- a/physics/mp_nssl.F90 +++ b/physics/mp_nssl.F90 @@ -32,7 +32,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & imp_physics, imp_physics_nssl, & nssl_cccn, nssl_alphah, nssl_alphahl, & nssl_alphar, nssl_ehw0_in, nssl_ehlw0_in, & - nssl_ccn_on, nssl_hail_on, nssl_invertccn ) + nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment ) use module_mp_nssl_2mom, only: nssl_2mom_init, nssl_2mom_init_const @@ -54,12 +54,12 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer, intent(in) :: imp_physics_nssl real(kind_phys), intent(in) :: nssl_cccn, nssl_alphah, nssl_alphahl real(kind_phys), intent(in) :: nssl_alphar, nssl_ehw0_in, nssl_ehlw0_in - logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn + logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment ! Local variables: dimensions used in nssl_init integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k real :: nssl_params(20) - integer :: ihailv + integer :: ihailv,ipc ! Initialize the CCPP error handling variables @@ -104,9 +104,9 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & nssl_params(:) = 0.0 - nssl_params(1) = nssl_cccn - nssl_params(2) = nssl_alphah - nssl_params(3) = nssl_alphahl + ! nssl_params(1) = nssl_cccn ! use direct interface instead + ! nssl_params(2) = nssl_alphah ! use direct interface instead + ! nssl_params(3) = nssl_alphahl ! use direct interface instead nssl_params(4) = 4.e5 ! nssl_cnoh -- not used for 2-moment nssl_params(5) = 4.e4 ! nssl_cnohl-- not used for 2-moment nssl_params(6) = 4.e5 ! nssl_cnor-- not used for 2-moment @@ -114,10 +114,6 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & nssl_params(8) = 500. ! nssl_rho_qh nssl_params(9) = 800. ! nssl_rho_qhl nssl_params(10) = 100. ! nssl_rho_qs - nssl_params(11) = 0 ! nssl_ipelec_tmp - nssl_params(12) = 11 ! nssl_isaund - nssl_params(13) = 0 ! 1= turn on cccna; 0 = turn off - nssl_params(14) = nssl_alphar nssl_qccn = nssl_cccn/1.225 ! if (mpirank==mpiroot) then @@ -129,10 +125,21 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ELSE ihailv = -1 ENDIF + + IF ( nssl_3moment ) THEN + ipc = 8 + ELSE + ipc = 5 + ENDIF ! write(0,*) 'call nssl_2mom_init' - CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=5,mixphase=0, & - ihvol=ihailv,nssl_ehw0=nssl_ehw0_in,nssl_ehlw0=nssl_ehlw0_in,errmsg=errmsg,errflg=errflg,myrank=mpirank,mpiroot=mpiroot) + CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=ipc,mixphase=0, & + ihvol=ihailv,nssl_ehw0=nssl_ehw0_in,nssl_ehlw0=nssl_ehlw0_in,errmsg=errmsg, & + nssl_alphar=nssl_alphar, & + nssl_alphah=nssl_alphah, & + nssl_alphahl=nssl_alphahl, & + nssl_cccn=nssl_cccn, & + errflg=errflg,myrank=mpirank,mpiroot=mpiroot) ! For restart runs, the init is done here if (restart) then @@ -161,6 +168,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ! spechum, cccn, qc, qr, qi, qs, qh, qhl, & spechum, cccn, cccna, qc, qr, qi, qs, qh, qhl, & ccw, crw, cci, csw, chw, chl, vh, vhl, & + zrw, zhw, zhl, & tgrs, prslk, prsl, phii, omega, dtp, & prcp, rain, graupel, ice, snow, sr, & refl_10cm, do_radar_ref, first_time_step, restart, & @@ -168,7 +176,8 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & nleffr, nieffr, nseffr, nreffr, & imp_physics, convert_dry_rho, & imp_physics_nssl, nssl_ccn_on, & - nssl_hail_on, nssl_invertccn, ntccn, ntccna, & + nssl_hail_on, nssl_invertccn, nssl_3moment, & + ntccn, ntccna, & errflg, errmsg) use module_mp_nssl_2mom, only: calcnfromq, na @@ -197,6 +206,9 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & real(kind_phys), intent(inout) :: chl(:,:) !(1:ncol,1:nlev) hail number real(kind_phys), intent(inout) :: vh (:,:) !(1:ncol,1:nlev) graupel volume real(kind_phys), intent(inout) :: vhl(:,:) !(1:ncol,1:nlev) hail volume + real(kind_phys), intent(inout) :: zrw(:,:) !(1:ncol,1:nlev) rain reflectivity + real(kind_phys), intent(inout) :: zhw(:,:) !(1:ncol,1:nlev) graupel reflectivity + real(kind_phys), intent(inout) :: zhl(:,:) !(1:ncol,1:nlev) hail reflectivity ! State variables and timestep information real(kind_phys), intent(inout) :: tgrs (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(in ) :: prsl (:,:) !(1:ncol,1:nlev) @@ -223,7 +235,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & integer, intent(in) :: nleffr, nieffr, nseffr, nreffr integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl - logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn + logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment integer, intent(in) :: ntccn, ntccna integer, intent(out) :: errflg @@ -256,6 +268,9 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ! create temporaries for hail in case it does not exist !real(kind_phys) :: chl_mp(1:ncol,1:nlev) !< kg-1 (number mixing ratio) real(kind_phys) :: vhl_mp(1:ncol,1:nlev) !< m3 kg-1 (volume mixing ratio) + real(kind_phys) :: zrw_mp(1:ncol,1:nlev) !< m6 kg-1 (reflectivity) + real(kind_phys) :: zhw_mp(1:ncol,1:nlev) !< m6 kg-1 (reflectivity) + real(kind_phys) :: zhl_mp(1:ncol,1:nlev) !< m6 kg-1 (reflectivity) ! Vertical velocity and level width real(kind_phys) :: w(1:ncol,1:nlev) !< m s-1 real(kind_phys) :: dz(1:ncol,1:nlev) !< m @@ -342,10 +357,17 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ns_mp = csw/(1.0_kind_phys-spechum) nh_mp = chw/(1.0_kind_phys-spechum) vh_mp = vh/(1.0_kind_phys-spechum) + IF ( nssl_3moment ) THEN + zrw_mp = zrw/(1.0_kind_phys-spechum) + zhw_mp = zhw/(1.0_kind_phys-spechum) + ENDIF IF ( nssl_hail_on ) THEN qhl_mp = qhl/(1.0_kind_phys-spechum) nhl_mp = chl/(1.0_kind_phys-spechum) vhl_mp = vhl/(1.0_kind_phys-spechum) + IF ( nssl_3moment ) THEN + zhl_mp = zhl/(1.0_kind_phys-spechum) + ENDIF ENDIF ELSE ! qv_mp = spechum ! /(1.0_kind_phys-spechum) @@ -361,10 +383,18 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ni_mp = cci ns_mp = csw nh_mp = chw + vh_mp = vh + IF ( nssl_3moment ) THEN + zrw_mp = zrw + zhw_mp = zhw + ENDIF IF ( nssl_hail_on ) THEN qhl_mp = qhl ! /(1.0_kind_phys-spechum) nhl_mp = chl vhl_mp = vhl + IF ( nssl_3moment ) THEN + zhl_mp = zhl + ENDIF ENDIF ENDIF @@ -593,6 +623,9 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & VHW=vh_mp, & VHL=vhl_mp, & cn=cn_mp, & + ZRW=zrw_mp, & + ZHW=zhw_mp, & + ZHL=zhl_mp, & ! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use cna=cna_mp, f_cna=.false. , & PII=prslk, & @@ -645,6 +678,9 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & CHL=nhl_mp, & VHW=vh_mp, & VHL=vhl_mp, & + ZRW=zrw_mp, & + ZHW=zhw_mp, & + ZHL=zhl_mp, & ! cn=cccn, & PII=prslk, & P=prsl, & @@ -750,10 +786,17 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & csw = ns_mp/(1.0_kind_phys+qv_mp) chw = nh_mp/(1.0_kind_phys+qv_mp) vh = vh_mp/(1.0_kind_phys+qv_mp) + IF ( nssl_3moment ) THEN + zrw = zrw_mp/(1.0_kind_phys+qv_mp) + zhw = zhw_mp/(1.0_kind_phys+qv_mp) + ENDIF IF ( nssl_hail_on ) THEN qhl = qhl_mp/(1.0_kind_phys+qv_mp) chl = nhl_mp/(1.0_kind_phys+qv_mp) vhl = vhl_mp/(1.0_kind_phys+qv_mp) + IF ( nssl_3moment ) THEN + zhl = zhl_mp/(1.0_kind_phys+qv_mp) + ENDIF ENDIF ELSE ! spechum = qv_mp ! /(1.0_kind_phys+qv_mp) @@ -770,10 +813,17 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & csw = ns_mp chw = nh_mp vh = vh_mp + IF ( nssl_3moment ) THEN + zrw = zrw_mp + zhw = zhw_mp + ENDIF IF ( nssl_hail_on ) THEN qhl = qhl_mp ! /(1.0_kind_phys+qv_mp) chl = nhl_mp vhl = vhl_mp + IF ( nssl_3moment ) THEN + zhl = zhl_mp + ENDIF ENDIF ENDIF diff --git a/physics/mp_nssl.meta b/physics/mp_nssl.meta index c7e398f0a..e628b0ff0 100644 --- a/physics/mp_nssl.meta +++ b/physics/mp_nssl.meta @@ -210,6 +210,13 @@ dimensions = () type = logical intent = in +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical + intent = in ######################################################################## [ccpp-arg-table] name = mp_nssl_run @@ -387,6 +394,30 @@ type = real kind = kind_phys intent = inout +[zrw] + standard_name = reflectivity_of_rain_of_new_state + long_name = rain reflectivity + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[zhw] + standard_name = reflectivity_of_graupel_of_new_state + long_name = graupel reflectivity + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[zhl] + standard_name = reflectivity_of_hail_of_new_state + long_name = hail reflectivity + units = m6 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [tgrs] standard_name = air_temperature_of_new_state long_name = model layer mean temperature @@ -614,6 +645,13 @@ dimensions = () type = logical intent = in +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical + intent = in [ntccn] standard_name = index_of_cloud_condensation_nuclei_number_concentration_in_tracer_concentration_array long_name = tracer index for cloud condensation nuclei number concentration From 4e7ca4ebfd25441c67f8fe4c36c26ee76ffa6b09 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Sat, 15 Apr 2023 19:47:21 -0500 Subject: [PATCH 008/132] Added NSSL 3-moment variables to pre/post tracer arrays --- physics/GFS_DCNV_generic_post.F90 | 8 +++-- physics/GFS_DCNV_generic_post.meta | 21 +++++++++++++ physics/GFS_DCNV_generic_pre.F90 | 7 +++-- physics/GFS_DCNV_generic_pre.meta | 21 +++++++++++++ physics/GFS_PBL_generic_post.F90 | 29 +++++++++++++----- physics/GFS_PBL_generic_post.meta | 28 +++++++++++++++++ physics/GFS_PBL_generic_pre.F90 | 49 +++++++++++++++++++----------- physics/GFS_PBL_generic_pre.meta | 28 +++++++++++++++++ 8 files changed, 162 insertions(+), 29 deletions(-) diff --git a/physics/GFS_DCNV_generic_post.F90 b/physics/GFS_DCNV_generic_post.F90 index 51a228122..3b69849a7 100644 --- a/physics/GFS_DCNV_generic_post.F90 +++ b/physics/GFS_DCNV_generic_post.F90 @@ -15,7 +15,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gq0, save_q, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv, ntsigma, ntrac,clw, & + ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, ntsigma, ntrac,clw, & satmedmf, trans_trac, errmsg, errflg) @@ -44,8 +44,9 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_temperature, & index_of_x_wind, index_of_y_wind, ntqv - integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv, ntsigma, ntrac + integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & + ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, & + ntsigma, ntrac real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -112,6 +113,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc .and. & n /= nthl .and. n /= nthnc .and. n /= nthv .and. & + n /= ntrz .and. n /= ntgz .and. n /= nthz .and. & n /= ntgv .and. n /= ntsigma) then tracers = tracers + 1 idtend = dtidx(100+n,index_of_process_dcnv) diff --git a/physics/GFS_DCNV_generic_post.meta b/physics/GFS_DCNV_generic_post.meta index 8428752ce..191e83a3a 100644 --- a/physics/GFS_DCNV_generic_post.meta +++ b/physics/GFS_DCNV_generic_post.meta @@ -454,6 +454,27 @@ dimensions = () type = integer intent = in +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer + intent = in +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer + intent = in +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer + intent = in [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers diff --git a/physics/GFS_DCNV_generic_pre.F90 b/physics/GFS_DCNV_generic_pre.F90 index b31daf5d6..1dd3aafc7 100644 --- a/physics/GFS_DCNV_generic_pre.F90 +++ b/physics/GFS_DCNV_generic_pre.F90 @@ -13,7 +13,8 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc gu0, gv0, gt0, gq0, nsamftrac, ntqv, & save_u, save_v, save_t, save_q, clw, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv,ntsigma, & + ntgnc, nthl, nthnc, nthv, ntgv, & + ntrz, ntgz, nthz, ntsigma, & cscnv, satmedmf, trans_trac, ras, ntrac, & dtidx, index_of_process_dcnv, errmsg, errflg) @@ -22,7 +23,8 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc implicit none integer, intent(in) :: im, levs, nsamftrac, ntqv, index_of_process_dcnv, dtidx(:,:), & - ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc,nthl,nthnc,nthv,ntgv,ntsigma + ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc,nthl,nthnc,nthv,ntgv, & + ntrz, ntgz, nthz, ntsigma logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm real(kind=kind_phys), dimension(:,:), intent(in) :: gu0 real(kind=kind_phys), dimension(:,:), intent(in) :: gv0 @@ -68,6 +70,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc n /= ntrw .and. n /= ntsw .and. n /= ntrnc .and. & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc .and. & n /= nthl .and. n /= nthnc .and. n /= nthv .and. & + n /= ntrz .and. n /= ntgz .and. n /= nthz .and. & n /= ntgv .and. n/= ntsigma) then tracers = tracers + 1 if(dtidx(100+n,index_of_process_dcnv)>0) then diff --git a/physics/GFS_DCNV_generic_pre.meta b/physics/GFS_DCNV_generic_pre.meta index ee2050926..a9008436e 100644 --- a/physics/GFS_DCNV_generic_pre.meta +++ b/physics/GFS_DCNV_generic_pre.meta @@ -267,6 +267,27 @@ dimensions = () type = integer intent = in +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer + intent = in +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer + intent = in +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer + intent = in [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers diff --git a/physics/GFS_PBL_generic_post.F90 b/physics/GFS_PBL_generic_post.F90 index 0d13dc5d8..a4e5f172a 100644 --- a/physics/GFS_PBL_generic_post.F90 +++ b/physics/GFS_PBL_generic_post.F90 @@ -10,9 +10,9 @@ module GFS_PBL_generic_post !! subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev,nqrimef, & - trans_aero, ntchs, ntchm, ntccn, nthl, nthnc, ntgv, nthv, & + trans_aero, ntchs, ntchm, ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, imp_physics_mg, & - imp_physics_fer_hires, imp_physics_nssl, nssl_ccn_on, ltaerosol, mraerosol, nssl_hail_on, & + imp_physics_fer_hires, imp_physics_nssl, nssl_ccn_on, ltaerosol, mraerosol, nssl_hail_on, nssl_3moment, & cplflx, cplaqm, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf, & shinhong, do_ysu, dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & @@ -30,12 +30,12 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, parameter :: kp = kind_phys integer, intent(in) :: im, levs, nvdiff, ntrac, ntchs, ntchm, kdt integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef - integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv + integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz logical, intent(in) :: trans_aero integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires integer, intent(in) :: imp_physics_nssl - logical, intent(in) :: nssl_ccn_on, nssl_hail_on + logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_3moment logical, intent(in) :: ltaerosol, cplflx, cplaqm, cplchm, lssav, ldiag3d, lsidea, use_med_flux, mraerosol logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu @@ -270,8 +270,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntgv) = dvdftra(i,k,14) dqdt(i,k,nthv) = dvdftra(i,k,15) dqdt(i,k,ntoz) = dvdftra(i,k,16) + n = 16 IF ( nssl_ccn_on ) THEN - dqdt(i,k,ntccn) = dvdftra(i,k,17) + dqdt(i,k,ntccn) = dvdftra(i,k,n+1) + n = n+1 + ENDIF + IF ( nssl_3moment ) THEN + dqdt(i,k,ntrz) = dvdftra(i,k,n+1) + dqdt(i,k,ntgz) = dvdftra(i,k,n+2) + dqdt(i,k,nthz) = dvdftra(i,k,n+3) + n = n+3 ENDIF enddo enddo @@ -292,9 +300,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt(i,k,ntsnc) = dvdftra(i,k,10) dqdt(i,k,ntgnc) = dvdftra(i,k,11) dqdt(i,k,ntgv) = dvdftra(i,k,12) - dqdt(i,k,ntoz) = dvdftra(i,k,13) + dqdt(i,k,ntoz) = dvdftra(i,k,13) + n = 13 IF ( nssl_ccn_on ) THEN - dqdt(i,k,ntccn) = dvdftra(i,k,14) + dqdt(i,k,ntccn) = dvdftra(i,k,n+1) + n = n+1 + ENDIF + IF ( nssl_3moment ) THEN + dqdt(i,k,ntrz) = dvdftra(i,k,n+1) + dqdt(i,k,ntgz) = dvdftra(i,k,n+2) + n = n+2 ENDIF enddo enddo diff --git a/physics/GFS_PBL_generic_post.meta b/physics/GFS_PBL_generic_post.meta index b20142991..a53acbc64 100644 --- a/physics/GFS_PBL_generic_post.meta +++ b/physics/GFS_PBL_generic_post.meta @@ -211,6 +211,27 @@ dimensions = () type = integer intent = in +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer + intent = in +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer + intent = in +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer + intent = in [imp_physics] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme @@ -295,6 +316,13 @@ dimensions = () type = logical intent = in +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical + intent = in [cplflx] standard_name = flag_for_surface_flux_coupling long_name = flag controlling cplflx collection (default off) diff --git a/physics/GFS_PBL_generic_pre.F90 b/physics/GFS_PBL_generic_pre.F90 index b9f7bb880..d8ed0f8fc 100644 --- a/physics/GFS_PBL_generic_pre.F90 +++ b/physics/GFS_PBL_generic_pre.F90 @@ -12,10 +12,10 @@ module GFS_PBL_generic_pre subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, & ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & - ntccn, nthl, nthnc, ntgv, nthv, & + ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, imp_physics_nssl, & - ltaerosol, mraerosol, nssl_ccn_on, nssl_hail_on, & + ltaerosol, mraerosol, nssl_ccn_on, nssl_hail_on, nssl_3moment, & hybedmf, do_shoc, satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q, & flag_for_pbl_generic_tend, ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) @@ -29,13 +29,13 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, integer, intent(in) :: im, levs, nvdiff, ntrac integer, intent(in) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc integer, intent(in) :: ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef,ntchs, ntchm - integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv + integer, intent(in) :: ntccn, nthl, nthnc, ntgv, nthv, ntrz, ntgz, nthz logical, intent(in) :: trans_aero, ldiag3d, qdiag3d, lssav integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, hybedmf, do_shoc, satmedmf, flag_for_pbl_generic_tend, mraerosol integer, intent(in) :: imp_physics_nssl - logical, intent(in) :: nssl_hail_on, nssl_ccn_on + logical, intent(in) :: nssl_hail_on, nssl_ccn_on, nssl_3moment real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs @@ -215,15 +215,23 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, vdftra(i,k,7) = qgrs(i,k,nthl) vdftra(i,k,8) = qgrs(i,k,ntlnc) vdftra(i,k,9) = qgrs(i,k,ntinc) - vdftra(i,k,10) = qgrs(i,k,ntrnc) - vdftra(i,k,11) = qgrs(i,k,ntsnc) - vdftra(i,k,12) = qgrs(i,k,ntgnc) - vdftra(i,k,13) = qgrs(i,k,nthnc) - vdftra(i,k,14) = qgrs(i,k,ntgv) - vdftra(i,k,15) = qgrs(i,k,nthv) - vdftra(i,k,16) = qgrs(i,k,ntoz) + vdftra(i,k,10) = qgrs(i,k,ntrnc) + vdftra(i,k,11) = qgrs(i,k,ntsnc) + vdftra(i,k,12) = qgrs(i,k,ntgnc) + vdftra(i,k,13) = qgrs(i,k,nthnc) + vdftra(i,k,14) = qgrs(i,k,ntgv) + vdftra(i,k,15) = qgrs(i,k,nthv) + vdftra(i,k,16) = qgrs(i,k,ntoz) + n = 16 IF ( nssl_ccn_on ) THEN - vdftra(i,k,17) = qgrs(i,k,ntccn) + vdftra(i,k,n+1) = qgrs(i,k,ntccn) + n = n+1 + ENDIF + IF ( nssl_3moment ) THEN + vdftra(i,k,n+1) = qgrs(i,k,ntrz) + vdftra(i,k,n+2) = qgrs(i,k,ntgz) + vdftra(i,k,n+3) = qgrs(i,k,nthz) + n = n+3 ENDIF enddo enddo @@ -241,12 +249,19 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, vdftra(i,k,7) = qgrs(i,k,ntlnc) vdftra(i,k,8) = qgrs(i,k,ntinc) vdftra(i,k,9) = qgrs(i,k,ntrnc) - vdftra(i,k,10) = qgrs(i,k,ntsnc) - vdftra(i,k,11) = qgrs(i,k,ntgnc) - vdftra(i,k,12) = qgrs(i,k,ntgv) - vdftra(i,k,13) = qgrs(i,k,ntoz) + vdftra(i,k,10) = qgrs(i,k,ntsnc) + vdftra(i,k,11) = qgrs(i,k,ntgnc) + vdftra(i,k,12) = qgrs(i,k,ntgv) + vdftra(i,k,13) = qgrs(i,k,ntoz) + n = 13 IF ( nssl_ccn_on ) THEN - vdftra(i,k,14) = qgrs(i,k,ntccn) + vdftra(i,k,n+1) = qgrs(i,k,ntccn) + n = n+1 + ENDIF + IF ( nssl_3moment ) THEN + vdftra(i,k,n+1) = qgrs(i,k,ntrz) + vdftra(i,k,n+2) = qgrs(i,k,ntgz) + n = n+2 ENDIF enddo enddo diff --git a/physics/GFS_PBL_generic_pre.meta b/physics/GFS_PBL_generic_pre.meta index a09b34b48..995fac565 100644 --- a/physics/GFS_PBL_generic_pre.meta +++ b/physics/GFS_PBL_generic_pre.meta @@ -217,6 +217,27 @@ dimensions = () type = integer intent = in +[ntrz] + standard_name = index_of_reflectivity_of_rain_in_tracer_concentration_array + long_name = tracer index for rain reflectivity + units = index + dimensions = () + type = integer + intent = in +[ntgz] + standard_name = index_of_reflectivity_of_graupel_in_tracer_concentration_array + long_name = tracer index for graupel reflectivity + units = index + dimensions = () + type = integer + intent = in +[nthz] + standard_name = index_of_reflectivity_of_hail_in_tracer_concentration_array + long_name = tracer index for hail reflectivity + units = index + dimensions = () + type = integer + intent = in [imp_physics] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme @@ -301,6 +322,13 @@ dimensions = () type = logical intent = in +[nssl_3moment] + standard_name = nssl_3moment + long_name = 3-moment activation flag in NSSL microphysics scheme + units = flag + dimensions = () + type = logical + intent = in [hybedmf] standard_name = flag_for_hybrid_edmf_pbl_scheme long_name = flag for hybrid edmf pbl scheme (moninedmf) From 7956ada51d49617acc7f1e03c0381dfafbf2ba25 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Tue, 18 Apr 2023 16:48:30 -0500 Subject: [PATCH 009/132] Turn off unneeded print statement --- physics/module_mp_nssl_2mom.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/module_mp_nssl_2mom.F90 index f2f9707fb..cac1218a9 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/module_mp_nssl_2mom.F90 @@ -1326,7 +1326,7 @@ SUBROUTINE nssl_2mom_init( & - IF ( .false. ) THEN ! set to true to enable internal namelist read + IF ( .true. ) THEN ! set to true to enable internal namelist read open(15,file='input.nml',status='old',form='formatted',action='read') rewind(15) read(15,NML=nssl_mp_params,iostat=istat) @@ -1633,7 +1633,7 @@ SUBROUTINE nssl_2mom_init( & lccnuf = ltmp denscale(lccnuf) = 1 ENDIF - write(0,*) 'nsslwrf: lccnuf = ',lccnuf + lccn= ltmp+1 ! 9 lnc = ltmp+2 ! 10 lnr = ltmp+3 ! 11 From 4c60a2f50b163cb52495c3815a41ade7e536de39 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Tue, 23 May 2023 14:00:52 -0600 Subject: [PATCH 010/132] Reorganize NRL ozone physics scheme into CCPP phases. Make scheme (memory) stateless. --- physics/GFS_phys_time_vary.fv3.F90 | 80 ++----- physics/GFS_phys_time_vary.fv3.meta | 76 +----- physics/GFS_phys_time_vary.scm.F90 | 68 ++---- physics/GFS_phys_time_vary.scm.meta | 76 +----- physics/GFS_rrtmg_pre.F90 | 11 +- physics/GFS_rrtmg_pre.meta | 30 +++ physics/GFS_rrtmg_setup.F90 | 7 +- physics/GFS_rrtmg_setup.meta | 21 ++ physics/ozinterp.f90 | 212 ----------------- physics/ozne_def.f | 24 -- physics/ozne_def.meta | 29 --- physics/ozphys_2015.F90 | 343 ++++++++++++++++++++++++++++ physics/ozphys_2015.f | 190 --------------- physics/ozphys_2015.meta | 203 ++++++++++++++-- physics/radiation_gases.f | 13 +- 15 files changed, 635 insertions(+), 748 deletions(-) delete mode 100644 physics/ozinterp.f90 delete mode 100644 physics/ozne_def.f delete mode 100644 physics/ozne_def.meta create mode 100644 physics/ozphys_2015.F90 delete mode 100644 physics/ozphys_2015.f diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 42f2bbc15..334228afe 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -2,7 +2,7 @@ !! Contains code related to GFS physics suite setup (physics part of time_vary_step) !>\defgroup mod_GFS_phys_time_vary GFS Physics Time Update -!! This module contains GFS physics time vary subroutines including ozone, stratospheric water vapor, +!! This module contains GFS physics time vary subroutines including stratospheric water vapor, !! aerosol, IN&CCN and surface properties updates. module GFS_phys_time_vary @@ -14,9 +14,6 @@ module GFS_phys_time_vary use mersenne_twister, only: random_setseed, random_number - use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin - use ozinterp, only : read_o3data, setindxoz, ozinterpol - use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol @@ -66,9 +63,9 @@ module GFS_phys_time_vary !>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm !> @{ subroutine GFS_phys_time_vary_init ( & - me, master, ntoz, h2o_phys, iaerclm, iccn, iaermdl, iflip, im, levs, & + me, master, h2o_phys, iaerclm, iccn, iaermdl, iflip, im, levs, & nx, ny, idate, xlat_d, xlon_d, & - jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -85,15 +82,15 @@ subroutine GFS_phys_time_vary_init ( implicit none ! Interface variables - integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny, levs, iaermdl + integer, intent(in) :: me, master, iccn, iflip, im, nx, ny, levs, iaermdl logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) - integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) - real(kind_phys), intent(in) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(inout) :: jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout) :: ddy_h(:) + real(kind_phys), intent(in) :: h2opl(:,:,:) integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(out) :: aer_nm(:,:,:) @@ -196,13 +193,12 @@ subroutine GFS_phys_time_vary_init ( jamax=-999 !$OMP parallel num_threads(nthrds) default(none) & -!$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,levs,idate) & +!$OMP shared (me,master,h2o_phys,im,nx,ny,levs,idate) & !$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & -!$OMP shared (levozp,oz_coeff,oz_pres,ozpl) & !$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & !$OMP shared (iamin, iamax, jamin, jamax) & !$OMP shared (iaerclm,iaermdl,ntrcaer,aer_nm,iflip,iccn) & -!$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & +!$OMP shared (jindx1_h,jindx2_h,ddy_h) & !$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & !$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & !$OMP shared (do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau) & @@ -212,32 +208,12 @@ subroutine GFS_phys_time_vary_init ( !$OMP sections -!$OMP section -!> - Call read_o3data() to read ozone data - call read_o3data (ntoz, me, master) - - ! Consistency check that the hardcoded values for levozp and - ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data - ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(ozpl, dim=2).ne.levozp) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(ozpl, dim=2) - errflg = 1 - end if - if (size(ozpl, dim=3).ne.oz_coeff) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(ozpl, dim=3) - errflg = 1 - end if - !$OMP section !> - Call read_h2odata() to read stratospheric water vapor data call read_h2odata (h2o_phys, me, master) ! Consistency check that the hardcoded values for levh2o and - ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data + ! h2o_coeff in GFS_typedefs.F90 match what is set by read_h2odata ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) if (size(h2opl, dim=2).ne.levh2o) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & @@ -295,12 +271,6 @@ subroutine GFS_phys_time_vary_init ( !$OMP sections -!$OMP section -!> - Call setindxoz() to initialize ozone data - if (ntoz > 0) then - call setindxoz (im, xlat_d, jindx1_o3, jindx2_o3, ddy_o3) - endif - !$OMP section !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then @@ -708,8 +678,8 @@ end subroutine GFS_phys_time_vary_init !> @{ subroutine GFS_phys_time_vary_timestep_init ( & me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, nscyc, ntoz, h2o_phys, iaerclm, iccn, clstp, & - jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & + imfdeepcnv, cal_pre, random_clds, nscyc, h2o_phys, iaerclm, iccn, clstp, & + jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, fn_nml, & imap, jmap, prsl, seed0, rann, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, lsoil_lsm,& @@ -724,14 +694,14 @@ subroutine GFS_phys_time_vary_timestep_init ( ! Interface variables integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & - nsswr, imfdeepcnv, iccn, nscyc, ntoz, iflip + nsswr, imfdeepcnv, iccn, nscyc, iflip integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm real(kind_phys), intent(out) :: clstp - integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) - real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(in) :: jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in) :: ddy_h(:) + real(kind_phys), intent(inout) :: h2opl(:,:,:) integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) @@ -788,8 +758,8 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP parallel num_threads(nthrds) default(none) & !$OMP shared(kdt,nsswr,lsswr,clstp,imfdeepcnv,cal_pre,random_clds) & !$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval) & -!$OMP shared(rann,im,isc,jsc,imap,jmap,ntoz,me,idate,jindx1_o3,jindx2_o3) & -!$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & +!$OMP shared(rann,im,isc,jsc,imap,jmap,me,idate) & +!$OMP shared(h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & !$OMP shared(ddy_j2tau,tau_amf,iflip) & @@ -842,14 +812,6 @@ subroutine GFS_phys_time_vary_timestep_init ( endif ! imfdeepcnv, cal_re, random_clds -!$OMP section -!> - Call ozinterpol() to make ozone interpolation - if (ntoz > 0) then - call ozinterpol (me, im, idate, fhour, & - jindx1_o3, jindx2_o3, & - ozpl, ddy_o3) - endif - !$OMP section !> - Call h2ointerpol() to make stratospheric water vapor data interpolation if (h2o_phys) then @@ -944,12 +906,6 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (.not.is_initialized) return - ! Deallocate ozone arrays - if (allocated(oz_lat) ) deallocate(oz_lat) - if (allocated(oz_pres) ) deallocate(oz_pres) - if (allocated(oz_time) ) deallocate(oz_time) - if (allocated(ozplin) ) deallocate(ozplin) - ! Deallocate h2o arrays if (allocated(h2o_lat) ) deallocate(h2o_lat) if (allocated(h2o_pres)) deallocate(h2o_pres) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index ce8c6c54b..654b5afd8 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -2,7 +2,7 @@ name = GFS_phys_time_vary type = scheme dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90 + dependencies = namelist_soilveg.f,set_soilveg.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90 ######################################################################## [ccpp-arg-table] @@ -23,13 +23,6 @@ dimensions = () type = integer intent = in -[ntoz] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in [h2o_phys] standard_name = flag_for_stratospheric_water_vapor_physics long_name = flag for stratospheric water vapor physics @@ -116,36 +109,6 @@ type = real kind = kind_phys intent = in -[jindx1_o3] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout -[jindx2_o3] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout -[ddy_o3] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys - intent = in [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -1077,13 +1040,6 @@ dimensions = () type = integer intent = in -[ntoz] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in [h2o_phys] standard_name = flag_for_stratospheric_water_vapor_physics long_name = flag for stratospheric water vapor physics @@ -1113,36 +1069,6 @@ type = real kind = kind_phys intent = out -[jindx1_o3] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[jindx2_o3] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[ddy_o3] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys - intent = inout [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 74b34e974..97460ac98 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -2,7 +2,7 @@ !! Contains code related to GFS physics suite setup (physics part of time_vary_step) !>\defgroup mod_GFS_phys_time_vary GFS Physics Time Update -!! This module contains GFS physics time vary subroutines including ozone, stratospheric water vapor, +!! This module contains GFS physics time vary subroutines including, stratospheric water vapor, !! aerosol, IN&CCN and surface properties updates. !> @{ module GFS_phys_time_vary @@ -11,9 +11,6 @@ module GFS_phys_time_vary use mersenne_twister, only: random_setseed, random_number - use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin - use ozinterp, only : read_o3data, setindxoz, ozinterpol - use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol @@ -61,8 +58,8 @@ module GFS_phys_time_vary !>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm !! @{ subroutine GFS_phys_time_vary_init ( & - me, master, ntoz, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & - jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + me, master, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & + jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -79,15 +76,15 @@ subroutine GFS_phys_time_vary_init ( implicit none ! Interface variables - integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny + integer, intent(in) :: me, master, iccn, iflip, im, nx, ny logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) - integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) - real(kind_phys), intent(in) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(inout) :: jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout) :: ddy_h(:) + real(kind_phys), intent(in) :: h2opl(:,:,:) integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(in) :: aer_nm(:,:,:) @@ -189,30 +186,11 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!> - Call read_o3data() to read ozone data - call read_o3data (ntoz, me, master) - - ! Consistency check that the hardcoded values for levozp and - ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data - ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(ozpl, dim=2).ne.levozp) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(ozpl, dim=2) - errflg = 1 - end if - if (size(ozpl, dim=3).ne.oz_coeff) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(ozpl, dim=3) - errflg = 1 - end if - !> - Call read_h2odata() to read stratospheric water vapor data call read_h2odata (h2o_phys, me, master) ! Consistency check that the hardcoded values for levh2o and - ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data + ! h2o_coeff in GFS_typedefs.F90 match what is set by read_h2odata ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) if (size(h2opl, dim=2).ne.levh2o) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & @@ -266,11 +244,6 @@ subroutine GFS_phys_time_vary_init ( !> - Initialize soil vegetation (needed for sncovr calculation further down) call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) -!> - Call setindxoz() to initialize ozone data - if (ntoz > 0) then - call setindxoz (im, xlat_d, jindx1_o3, jindx2_o3, ddy_o3) - endif - !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) @@ -652,8 +625,8 @@ end subroutine GFS_phys_time_vary_init !! @{ subroutine GFS_phys_time_vary_timestep_init ( & me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, ntoz, h2o_phys, iaerclm, iccn, clstp, & - jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & + imfdeepcnv, cal_pre, random_clds, h2o_phys, iaerclm, iccn, clstp, & + jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & imap, jmap, prsl, seed0, rann, do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau,& @@ -663,14 +636,14 @@ subroutine GFS_phys_time_vary_timestep_init ( ! Interface variables integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & - nsswr, imfdeepcnv, iccn, ntoz, iflip + nsswr, imfdeepcnv, iccn, iflip integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm real(kind_phys), intent(out) :: clstp - integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) - real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(in) :: jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in) :: ddy_h(:) + real(kind_phys), intent(inout) :: h2opl(:,:,:) integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) @@ -748,13 +721,6 @@ subroutine GFS_phys_time_vary_timestep_init ( endif ! imfdeepcnv, cal_re, random_clds -!> - Call ozinterpol() to make ozone interpolation - if (ntoz > 0) then - call ozinterpol (me, im, idate, fhour, & - jindx1_o3, jindx2_o3, & - ozpl, ddy_o3) - endif - !> - Call h2ointerpol() to make stratospheric water vapor data interpolation if (h2o_phys) then call h2ointerpol (me, im, idate, fhour, & @@ -844,12 +810,6 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (.not.is_initialized) return - ! Deallocate ozone arrays - if (allocated(oz_lat) ) deallocate(oz_lat) - if (allocated(oz_pres) ) deallocate(oz_pres) - if (allocated(oz_time) ) deallocate(oz_time) - if (allocated(ozplin) ) deallocate(ozplin) - ! Deallocate h2o arrays if (allocated(h2o_lat) ) deallocate(h2o_lat) if (allocated(h2o_pres)) deallocate(h2o_pres) diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 8b59e4bed..21d1f2736 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -2,7 +2,7 @@ name = GFS_phys_time_vary type = scheme dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,cires_tauamf_data.F90,noahmp_tables.f90 + dependencies = namelist_soilveg.f,set_soilveg.f,cires_tauamf_data.F90,noahmp_tables.f90 ######################################################################## [ccpp-arg-table] @@ -23,13 +23,6 @@ dimensions = () type = integer intent = in -[ntoz] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in [h2o_phys] standard_name = flag_for_stratospheric_water_vapor_physics long_name = flag for stratospheric water vapor physics @@ -102,36 +95,6 @@ type = real kind = kind_phys intent = in -[jindx1_o3] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout -[jindx2_o3] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout -[ddy_o3] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys - intent = in [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -1056,13 +1019,6 @@ dimensions = () type = logical intent = in -[ntoz] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in [h2o_phys] standard_name = flag_for_stratospheric_water_vapor_physics long_name = flag for stratospheric water vapor physics @@ -1092,36 +1048,6 @@ type = real kind = kind_phys intent = out -[jindx1_o3] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[jindx2_o3] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[ddy_o3] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys - intent = inout [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index c45bec3e3..ae88ca0fc 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -45,7 +45,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& gasvmr_ccl4, gasvmr_cfc113, aerodp,ext550, clouds6, clouds7, clouds8, & clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, & faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, & - aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, errmsg, errflg) + aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, latsozp, levozp, & + blatc, dphiozc, errmsg, errflg) use machine, only: kind_phys @@ -101,7 +102,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& imp_physics_mg, imp_physics_wsm6, & imp_physics_nssl, & imp_physics_fer_hires, & - yearlen, icloud, iaermdl, iaerflg + yearlen, icloud, iaermdl, iaerflg, & + latsozp, levozp integer, intent(in) :: & iovr, & ! choice of cloud-overlap method @@ -132,7 +134,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& integer, intent(in) :: spp_rad real(kind_phys), intent(in) :: spp_wts_rad(:,:) - real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con + real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con, blatc, dphiozc real(kind=kind_phys), intent(in) :: con_eps, epsm1, fvirt, rog, rocp, con_rd, con_pi, con_g, con_ttp, con_thgni real(kind=kind_phys), dimension(:), intent(in) :: xlat_d, xlat, xlon, & @@ -429,8 +431,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& enddo enddo else ! climatological ozone - call getozn (prslk1, xlat, im, lmk, top_at_1, & ! --- inputs - olyr) ! --- outputs + call getozn (prslk1, xlat, im, lmk, top_at_1, latsozp, levozp, blatc, dphiozc, olyr) endif ! end_if_ntoz !> - Call coszmn(), to compute cosine of zenith angle (only when SW is called) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index d7feaeb3f..88363ef18 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -1496,6 +1496,36 @@ dimensions = () type = integer intent = in +[latsozp] + standard_name = number_of_latitudes_in_ozone_data + long_name = number of latitude in ozone data + units = count + dimensions = () + type = integer + intent = in +[levozp] + standard_name = number_of_levels_in_ozone_data + long_name = number of levels in ozone data + units = count + dimensions = () + type = integer + intent = in +[dphiozc] + standard_name = ozone_data_parameter_1 + long_name = ozone data parameter 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[blatc] + standard_name = ozone_data_parameter_2 + long_name = ozone data parameter 2 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 384d5252d..30917b961 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -44,7 +44,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & iaermdl, iaerflg, aeros_file, con_pi, con_t0c, con_c, con_boltz, & con_plnk, con_solr_2008, con_solr_2002, con_g, con_rd, co2usr_file, & co2cyc_file, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, isubclw,& - iswmode, ipsd0, ltp, lextop, errmsg, errflg) + iswmode, latsozp, levozp, timeozp, ipsd0, ltp, lextop, errmsg, errflg) ! ================= subprogram documentation block ================ ! ! ! ! subprogram: GFS_rrtmg_setup_init - a subprogram to initialize radiation ! @@ -155,7 +155,8 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & integer, intent(in) :: levr, ictm, isol, ico2, iaer, ntcw, num_p3d, & ltp, npdf3d, ntoz, iovr, iovr_rand, iovr_maxrand, iovr_max, & iovr_dcorr, iovr_exp, iovr_exprand, icliq_sw, imp_physics, & - iflip, me, rad_hr_units, icliq_lw, isubcsw, isubclw, iswmode + iflip, me, rad_hr_units, icliq_lw, isubcsw, isubclw, iswmode, & + latsozp, levozp, timeozp integer, intent(in) :: idate(:) logical, intent(in) :: lcrick, lcnorm, lnoprec, do_RRTMGP, lalw1bd, & inc_minor_gas, lextop @@ -219,7 +220,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, & con_pi, con_t0c, con_c, con_boltz, con_plnk, errflg, errmsg) call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, ntoz, & - con_pi, errflg, errmsg) + con_pi, latsozp, levozp, timeozp, errflg, errmsg) call cld_init ( si, levr, imp_physics, me, con_g, con_rd, errflg, errmsg) call rlwinit ( me, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index adf6d8750..42b999c82 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -173,6 +173,27 @@ dimensions = () type = integer intent = in +[levozp] + standard_name = number_of_levels_in_ozone_data + long_name = number of levels in ozone data + units = count + dimensions = () + type = integer + intent = in +[timeozp] + standard_name = number_of_times_in_ozone_data + long_name = number of times in ozone data + units = count + dimensions = () + type = integer + intent = in +[latsozp] + standard_name = number_of_latitudes_in_ozone_data + long_name = number of latitude in ozone data + units = count + dimensions = () + type = integer + intent = in [icliq_sw] standard_name = control_for_shortwave_radiation_liquid_clouds long_name = sw optical property for liquid clouds diff --git a/physics/ozinterp.f90 b/physics/ozinterp.f90 deleted file mode 100644 index 5b3149d61..000000000 --- a/physics/ozinterp.f90 +++ /dev/null @@ -1,212 +0,0 @@ -!>\file ozinterp.f90 -!! This file contains ozone climatology interpolation subroutines. - -!>\ingroup mod_GFS_phys_time_vary -!! This module contains subroutines of reading and interpolating ozone coefficients. -module ozinterp - - implicit none - - private - - public :: read_o3data, setindxoz, ozinterpol - -contains - - SUBROUTINE read_o3data (ntoz, me, master) - use machine, only: kind_phys - use ozne_def -!--- in/out - integer, intent(in) :: ntoz - integer, intent(in) :: me - integer, intent(in) :: master -!--- locals - integer :: i, n, k - real(kind=4), allocatable, dimension(:) :: oz_lat4, oz_pres4 - real(kind=4), allocatable, dimension(:) :: oz_time4, tempin - real(kind=4) :: blatc4 - - if (ntoz <= 0) then ! Diagnostic ozone - rewind (kozc) - read (kozc,end=101) latsozc, levozc, timeozc, blatc4 - 101 if (levozc < 10 .or. levozc > 100) then - rewind (kozc) - levozc = 17 - latsozc = 18 - blatc = -85.0 - else - blatc = blatc4 - endif - latsozp = 2 - levozp = 1 - timeoz = 1 - oz_coeff = 0 - dphiozc = -(blatc+blatc)/(latsozc-1) - return - endif - - open(unit=kozpl,file='global_o3prdlos.f77', form='unformatted', convert='big_endian') - -!--- read in indices -!--- - read (kozpl) oz_coeff, latsozp, levozp, timeoz - if (me == master) then - write(*,*) 'Reading in o3data from global_o3prdlos.f77 ' - write(*,*) ' oz_coeff = ', oz_coeff - write(*,*) ' latsozp = ', latsozp - write(*,*) ' levozp = ', levozp - write(*,*) ' timeoz = ', timeoz - endif - -!--- read in data -!--- oz_lat - latitude of data (-90 to 90) -!--- oz_pres - vertical pressure level (mb) -!--- oz_time - time coordinate (days) -!--- - allocate (oz_lat(latsozp), oz_pres(levozp),oz_time(timeoz+1)) - allocate (oz_lat4(latsozp), oz_pres4(levozp),oz_time4(timeoz+1)) - rewind (kozpl) - read (kozpl) oz_coeff, latsozp, levozp, timeoz, oz_lat4, oz_pres4, oz_time4 - oz_pres(:) = oz_pres4(:) -!--- convert pressure levels from mb to ln(Pa) - oz_pres(:) = log(100.0*oz_pres(:)) - oz_lat(:) = oz_lat4(:) - oz_time(:) = oz_time4(:) - deallocate (oz_lat4, oz_pres4, oz_time4) - -!--- read in ozplin which is in order of (lattitudes, ozone levels, coeff number, time) -!--- assume latitudes is on a uniform gaussian grid -!--- - allocate (tempin(latsozp)) - allocate (ozplin(latsozp,levozp,oz_coeff,timeoz)) - DO i=1,timeoz - DO n=1,oz_coeff - DO k=1,levozp - READ(kozpl) tempin - ozplin(:,k,n,i) = tempin(:) - ENDDO - ENDDO - ENDDO - deallocate (tempin) - - close(kozpl) - - END SUBROUTINE read_o3data -! -!********************************************************************** -! - SUBROUTINE setindxoz(npts,dlat,jindx1,jindx2,ddy) -! - USE MACHINE, ONLY: kind_phys - USE OZNE_DEF, ONLY: jo3 => latsozp, oz_lat -! - implicit none -! - integer npts, JINDX1(npts),JINDX2(npts) - real(kind=kind_phys) dlat(npts),DDY(npts) -! - integer i,j,lat -! - DO J=1,npts - jindx2(j) = jo3 + 1 - do i=1,jo3 - if (dlat(j) < oz_lat(i)) then - jindx2(j) = i - exit - endif - enddo - jindx1(j) = max(jindx2(j)-1,1) - jindx2(j) = min(jindx2(j),jo3) - if (jindx2(j) .ne. jindx1(j)) then - DDY(j) = (dlat(j) - oz_lat(jindx1(j))) & - / (oz_lat(jindx2(j)) - oz_lat(jindx1(j))) - else - ddy(j) = 1.0 - endif -! print *,' j=',j,' dlat=',dlat(j),' jindx12=',jindx1(j), & -! jjindx2(j),' oz_lat=',oz_lat(jindx1(j)), & -! oz_lat(jindx2(j)),' ddy=',ddy(j) - ENDDO - - RETURN - END SUBROUTINE setindxoz -! -!********************************************************************** -! - SUBROUTINE ozinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ozplout,ddy) -! - USE MACHINE, ONLY : kind_phys - USE OZNE_DEF - implicit none - integer iday,j,j1,j2,l,npts,nc,n1,n2 - real(kind=kind_phys) fhour,tem, tx1, tx2 -! - - integer JINDX1(npts), JINDX2(npts) - integer me, idate(4), IDAT(8),JDAT(8) -! - real(kind=kind_phys) DDY(npts) - real(kind=kind_phys) ozplout(npts,levozp,oz_coeff) - real(kind=kind_phys) rjday - integer jdow, jdoy, jday - real(8) rinc(5) - real(4) rinc4(5) - integer w3kindreal,w3kindint -! - IDAT=0 - IDAT(1)=IDATE(4) - IDAT(2)=IDATE(2) - IDAT(3)=IDATE(3) - IDAT(5)=IDATE(1) - RINC=0. - RINC(2)=FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif -! - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jdat,jdow,jdoy,jday) - rjday = jdoy + jdat(5) / 24. - IF (RJDAY < oz_time(1)) RJDAY = RJDAY + 365. -! - n2 = timeoz + 1 - do j=2,timeoz - if (rjday < oz_time(j)) then - n2 = j - exit - endif - enddo - n1 = n2 - 1 -! -! if (me == 0) print *,' n1=',n1,' n2=',n2,' rjday=',rjday -! &,'oz_time=',oz_time(n1),oz_time(n2) -! - - tx1 = (oz_time(n2) - rjday) / (oz_time(n2) - oz_time(n1)) - tx2 = 1.0 - tx1 - - if (n2 > timeoz) n2 = n2 - timeoz -! - do nc=1,oz_coeff - DO L=1,levozp - DO J=1,npts - J1 = JINDX1(J) - J2 = JINDX2(J) - TEM = 1.0 - DDY(J) - ozplout(j,L,nc) = & - tx1*(TEM*ozplin(J1,L,nc,n1)+DDY(J)*ozplin(J2,L,nc,n1)) & - + tx2*(TEM*ozplin(J1,L,nc,n2)+DDY(J)*ozplin(J2,L,nc,n2)) - ENDDO - ENDDO - enddo -! - RETURN - END SUBROUTINE ozinterpol - -end module ozinterp diff --git a/physics/ozne_def.f b/physics/ozne_def.f deleted file mode 100644 index 8f3af6240..000000000 --- a/physics/ozne_def.f +++ /dev/null @@ -1,24 +0,0 @@ -!>\file ozne_def.f -!! This file contains the ozone array definition used in ozone physics. - -!>\ingroup mod_GFS_phys_time_vary -!! This module defines arrays in Ozone scheme. - module ozne_def - -!> \section arg_table_ozne_def -!! \htmlinclude ozne_def.html -!! - - use machine , only : kind_phys - implicit none - - integer, parameter :: kozpl=28, kozc=48 - - integer latsozp, levozp, timeoz, latsozc, levozc, timeozc - &, oz_coeff - real (kind=kind_phys) blatc, dphiozc - real (kind=kind_phys), allocatable :: oz_lat(:), oz_pres(:) - &, oz_time(:) - real (kind=kind_phys), allocatable :: ozplin(:,:,:,:) - - end module ozne_def diff --git a/physics/ozne_def.meta b/physics/ozne_def.meta deleted file mode 100644 index 3cad9c14d..000000000 --- a/physics/ozne_def.meta +++ /dev/null @@ -1,29 +0,0 @@ -[ccpp-table-properties] - name = ozne_def - type = module - dependencies = machine.F - -[ccpp-arg-table] - name = ozne_def - type = module - -[levozp] - standard_name = vertical_dimension_of_ozone_forcing_data - long_name = number of vertical layers in ozone forcing data - units = count - dimensions = () - type = integer -[oz_coeff] - standard_name = number_of_coefficients_in_ozone_forcing_data - long_name = number of coefficients in ozone forcing data - units = index - dimensions = () - type = integer -[oz_pres] - standard_name = natural_log_of_ozone_forcing_data_pressure_levels - long_name = natural log of ozone forcing data pressure levels in Pa - units = 1 - dimensions = (vertical_dimension_of_ozone_forcing_data) - type = real - kind = kind_phys - active = (index_of_ozone_mixing_ratio_in_tracer_concentration_array>0) diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 new file mode 100644 index 000000000..17f2178a4 --- /dev/null +++ b/physics/ozphys_2015.F90 @@ -0,0 +1,343 @@ +! ########################################################################################### +!> \file ozphys_2015.F90 +!! +! ########################################################################################### +module ozphys_2015 + use machine , only : kind_phys + implicit none + public ozphys_2015_init, ozphys_2015_timestep_init, ozphys_2015_run +contains + +! ########################################################################################### +!>\defgroup GFS_ozphys_2015 GFS Ozone Photochemistry (2015) Module +!! This module contains the CCPP-compliant Ozone 2015 photochemistry scheme. +!> @{ +!> \section arg_table_ozphys_2015_init Argument Table +!! \htmlinclude ozphys_2015_init.html +!! +! ########################################################################################### + subroutine ozphys_2015_init(oz_phys_2015, nPts, latsozp, oz_lat, dlat, jindx1, jindx2, & + ddy, errmsg, errflg) + ! Inputs + logical, intent(in) :: & + oz_phys_2015 ! Control flag for NRL 2015 ozone physics scheme + integer, intent(in) :: & + nPts, & ! Horizontal dimension + latsozp ! Number of latitudes in ozone data + real(kind_phys), intent(in), dimension(:) :: & + oz_lat, & ! Latitudes of ozone data + dlat ! Latitudes of grid + ! Outputs + integer, intent(out), dimension(:) :: & + jindx1, & ! Interpolation index (low) for ozone data + jindx2 ! Interpolation index (high) for ozone data + real(kind_phys), intent(out), dimension(:) :: & + ddy ! Interpolation high index for ozone data + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Local + integer i,j + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Sanity check + if (.not.oz_phys_2015) then + write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' + errflg = 1 + return + endif + + ! Set indices + do j=1,nPts + jindx2(j) = latsozp + 1 + do i=1,latsozp + if (dlat(j) < oz_lat(i)) then + jindx2(j) = i + exit + endif + enddo + jindx1(j) = max(jindx2(j)-1,1) + jindx2(j) = min(jindx2(j),latsozp) + if (jindx2(j) .ne. jindx1(j)) then + ddy(j) = (dlat(j) - oz_lat(jindx1(j))) / (oz_lat(jindx2(j)) - oz_lat(jindx1(j))) + else + ddy(j) = 1.0 + endif + enddo + + end subroutine ozphys_2015_init + +! ########################################################################################### +!> \section arg_table_ozphys_2015_timestep_init Argument Table +!! \htmlinclude ozphys_2015_timestep_init.html +!! +! ########################################################################################### + subroutine ozphys_2015_timestep_init(nPts, idate, fhour, jindx1, jindx2, latsozp, levozp, & + oz_coeff, timeoz, ozplin, oz_time, oz_pres, oz_lat, ddy, ozplout, errmsg, errflg) + ! Inputs + integer, intent(in) :: & + nPts, & ! Horizontal dimension + latsozp, & ! Number of latitudes in ozone data + levozp, & ! Number of levels in ozone data + oz_coeff, & ! Number of coefficients in ozone data + timeoz ! Number of times in ozone data + integer, intent(in),dimension(:) :: & + idate, & ! Initial date with different size and ordering + jindx1, & ! Interpolation index (low) for ozone + jindx2 ! Interpolation index (high) for ozone + real(kind_phys), intent(in) :: & + fhour ! Forecast hour + real(kind_phys), intent(in), dimension(:) :: & + ddy, & ! Interpolation high index for ozone data + oz_lat, & ! Latitudes for ozone data + oz_pres, & ! Levels for ozone data + oz_time ! Time for ozone data + real(kind_phys), intent(in), dimension(:,:,:,:) :: & + ozplin ! Ozone data + + ! Outputs + real(kind_phys), intent(out), dimension(:,:,:) :: & + ozplout ! Ozone forcing data + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Local + integer :: idat(8),jdat(8),iday,j,j1,j2,l,nc,n1,n2,jdow,jdoy,& + jday,w3kindreal,w3kindint + real(kind_phys) :: tem, tx1, tx2, rjday + real(8) :: rinc(5) + real(4) :: rinc4(5) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! + idat=0 + idat(1)=idate(4) + idat(2)=idate(2) + idat(3)=idate(3) + idat(5)=idate(1) + rinc=0. + rinc(2)=fhour + call w3kind(w3kindreal,w3kindint) + if(w3kindreal==4) then + rinc4=rinc + CALL w3movdat(rinc4,idat,jdat) + else + CALL w3movdat(rinc,idat,jdat) + endif + ! + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + IF (RJDAY < oz_time(1)) RJDAY = RJDAY + 365. + ! + n2 = timeoz + 1 + do j=2,timeoz + if (rjday < oz_time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + + tx1 = (oz_time(n2) - rjday) / (oz_time(n2) - oz_time(n1)) + tx2 = 1.0 - tx1 + + if (n2 > timeoz) n2 = n2 - timeoz + ! + do nc=1,oz_coeff + do L=1,levozp + do J=1,npts + J1 = jindx1(J) + J2 = jindx2(J) + TEM = 1.0 - ddy(J) + ozplout(j,L,nc) = tx1*(TEM*ozplin(J1,L,nc,n1)+ddy(J)*ozplin(J2,L,nc,n1)) & + + tx2*(TEM*ozplin(J1,L,nc,n2)+ddy(J)*ozplin(J2,L,nc,n2)) + enddo + enddo + enddo + + ! + return + + end subroutine ozphys_2015_timestep_init + +! ########################################################################################### +!> The operational GFS currently parameterizes ozone production and +!! destruction based on monthly mean coefficients ( +!! \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by Naval +!! Research Laboratory through CHEM2D chemistry model +!! (McCormack et al. (2006) \cite mccormack_et_al_2006). +!! \section arg_table_ozphys_2015_run Argument Table +!! \htmlinclude ozphys_2015_run.html +!! +!> \section genal_ozphys_2015 GFS ozphys_2015_run General Algorithm +!> - This code assumes that both prsl and po3 are from bottom to top +!! as are all other variables. +!> - This code is specifically for NRL parameterization and +!! climatological T and O3 are in location 5 and 6 of prdout array +!!\author June 2015 - Shrinivas Moorthi +! ########################################################################################### + subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_coeff, & + delp, ldiag3d, dtend, dtidx, ntoz, index_of_process_prod_loss, & + index_of_process_ozmix, index_of_process_temp, index_of_process_overhead_ozone, & + con_g, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + ldiag3d + real(kind_phys),intent(in) :: & + con_g + integer, intent(in) :: & + im, & ! + levs, & ! + ko3, & ! + pl_coeff, & ! + ntoz, & ! + index_of_process_prod_loss, & ! + index_of_process_ozmix, & ! + index_of_process_temp, & + index_of_process_overhead_ozone + integer, intent(in), dimension(:,:) :: & + dtidx ! + real(kind_phys), intent(in) :: & + dt ! + real(kind_phys), intent(in), dimension(:) :: & + po3 ! + real(kind_phys), intent(in), dimension(:,:) :: & + prsl, & ! + tin, & ! + delp ! + real(kind_phys), intent(in), dimension(:,:,:) :: & + prdout ! + + ! In/Outs + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: & + dtend ! + + ! Outputs + real(kind=kind_phys), intent(inout), dimension(:,:) :: & + oz ! + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Locals + integer :: k, kmax, kmin, l, i, j + integer, dimension(4) :: idtend + logical, dimension(im) :: flg + real :: gravi + real(kind_phys) :: pmax, pmin, tem, temp + real(kind_phys), dimension(im) :: wk1, wk2, wk3, ozib + real(kind_phys), dimension(im,pl_coeff) :: prod + real(kind_phys), dimension(im,levs) :: ozi + real(kind_phys), dimension(im,levs+1) :: colo3, coloz + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Are UFS diagnostic tendencies requested? If so, set up bookeeping indices... + if(ldiag3d) then + idtend(1) = dtidx(100+ntoz,index_of_process_prod_loss) ! was ozp1 + idtend(2) = dtidx(100+ntoz,index_of_process_ozmix) ! was ozp2 + idtend(3) = dtidx(100+ntoz,index_of_process_temp) ! was ozp3 + idtend(4) = dtidx(100+ntoz,index_of_process_overhead_ozone) ! was ozp4 + else + idtend=0 + endif + + ! Temporaries + ozi = oz + gravi=1.0/con_g + + colo3(:,levs+1) = 0.0 + coloz(:,levs+1) = 0.0 + + do l=levs,1,-1 + pmin = 1.0e10 + pmax = -1.0e10 + + do i=1,im + wk1(i) = log(prsl(i,l)) + pmin = min(wk1(i), pmin) + pmax = max(wk1(i), pmax) + prod(i,:) = 0.0 + enddo + kmax = 1 + kmin = 1 + do k=1,ko3-1 + if (pmin < po3(k)) kmax = k + if (pmax < po3(k)) kmin = k + enddo + ! + do k=kmin,kmax + temp = 1.0 / (po3(k) - po3(k+1)) + do i=1,im + flg(i) = .false. + if (wk1(i) < po3(k) .and. wk1(i) >= po3(k+1)) then + flg(i) = .true. + wk2(i) = (wk1(i) - po3(k+1)) * temp + wk3(i) = 1.0 - wk2(i) + endif + enddo + do j=1,pl_coeff + do i=1,im + if (flg(i)) then + prod(i,j) = wk2(i) * prdout(i,k,j) + wk3(i) * prdout(i,k+1,j) + endif + enddo + enddo + enddo + + do j=1,pl_coeff + do i=1,im + if (wk1(i) < po3(ko3)) then + prod(i,j) = prdout(i,ko3,j) + endif + if (wk1(i) >= po3(1)) then + prod(i,j) = prdout(i,1,j) + endif + enddo + enddo + do i=1,im + colo3(i,l) = colo3(i,l+1) + ozi(i,l) * delp(i,l)*gravi + coloz(i,l) = coloz(i,l+1) + prod(i,6) * delp(i,l)*gravi + prod(i,2) = min(prod(i,2), 0.0) + enddo + do i=1,im + ozib(i) = ozi(i,l) ! no filling + tem = prod(i,1) - prod(i,2) * prod(i,6) + prod(i,3) * (tin(i,l) - prod(i,5)) & + + prod(i,4) * (colo3(i,l)-coloz(i,l)) + oz(i,l) = (ozib(i) + tem*dt) / (1.0 - prod(i,2)*dt) + enddo + if(idtend(1)>=1) then + dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + (prod(:,1)-prod(:,2)*prod(:,6))*dt + endif + if(idtend(2)>=1) then + dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + (oz(:,l) - ozib(:)) + endif + if(idtend(3)>=1) then + dtend(:,l,idtend(3)) = dtend(:,l,idtend(3)) + prod(:,3)*(tin(:,l)-prod(:,5))*dt + endif + if(idtend(4)>=1) then + dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + prod(:,4) * (colo3(:,l)-coloz(:,l))*dt + endif + enddo + + return + end subroutine ozphys_2015_run +!> @} +end module ozphys_2015 diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f deleted file mode 100644 index 85c79f733..000000000 --- a/physics/ozphys_2015.f +++ /dev/null @@ -1,190 +0,0 @@ -!> \file ozphys_2015.f -!! This file is ozone sources and sinks. - - - module ozphys_2015 - - contains - -!>\defgroup GFS_ozphys_2015 GFS Ozone Photochemistry (2015) Module -!! This module contains the CCPP-compliant Ozone 2015 photochemistry scheme. -!> @{ -!> \section arg_table_ozphys_2015_init Argument Table -!! \htmlinclude ozphys_2015_init.html -!! - subroutine ozphys_2015_init(oz_phys_2015, errmsg, errflg) - - implicit none - logical, intent(in) :: oz_phys_2015 - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not.oz_phys_2015) then - write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' - errflg = 1 - return - endif - - end subroutine ozphys_2015_init - -!> The operational GFS currently parameterizes ozone production and -!! destruction based on monthly mean coefficients ( -!! \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by Naval -!! Research Laboratory through CHEM2D chemistry model -!! (McCormack et al. (2006) \cite mccormack_et_al_2006). -!! \section arg_table_ozphys_2015_run Argument Table -!! \htmlinclude ozphys_2015_run.html -!! -!> \section genal_ozphys_2015 GFS ozphys_2015_run General Algorithm -!> - This code assumes that both prsl and po3 are from bottom to top -!! as are all other variables. -!> - This code is specifically for NRL parameterization and -!! climatological T and O3 are in location 5 and 6 of prdout array -!!\author June 2015 - Shrinivas Moorthi - subroutine ozphys_2015_run ( & - & im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_coeff, & - & delp, ldiag3d, dtend, dtidx, ntoz, index_of_process_prod_loss& - & , index_of_process_ozmix, index_of_process_temp, & - & index_of_process_overhead_ozone, con_g, me, errmsg, errflg) -! -! - use machine , only : kind_phys - implicit none -! - real(kind=kind_phys),intent(in) :: con_g - real :: gravi - integer, intent(in) :: im, levs, ko3, pl_coeff,me - real(kind=kind_phys), intent(in) :: po3(:), & - & prsl(:,:), tin(:,:), & - & delp(:,:), & - & prdout(:,:,:), dt - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), ntoz, & - & index_of_process_prod_loss, index_of_process_ozmix, & - & index_of_process_temp, index_of_process_overhead_ozone - real(kind=kind_phys), intent(inout) :: oz(im,levs) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer k,kmax,kmin,l,i,j, idtend(4) - logical ldiag3d, flg(im), qdiag3d - real(kind=kind_phys) pmax, pmin, tem, temp - real(kind=kind_phys) wk1(im), wk2(im), wk3(im),prod(im,pl_coeff), & - & ozib(im), colo3(im,levs+1), coloz(im,levs+1),& - & ozi(im,levs) -! - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if(ldiag3d) then - idtend(1) = dtidx(100+ntoz,index_of_process_prod_loss) ! was ozp1 - idtend(2) = dtidx(100+ntoz,index_of_process_ozmix) ! was ozp2 - idtend(3) = dtidx(100+ntoz,index_of_process_temp) ! was ozp3 - idtend(4) = dtidx(100+ntoz,index_of_process_overhead_ozone) ! was ozp4 - else - idtend=0 - endif - -!ccpp: save input oz in ozi - ozi = oz - gravi=1.0/con_g - - colo3(:,levs+1) = 0.0 - coloz(:,levs+1) = 0.0 -! - do l=levs,1,-1 - pmin = 1.0e10 - pmax = -1.0e10 -! - do i=1,im - wk1(i) = log(prsl(i,l)) - pmin = min(wk1(i), pmin) - pmax = max(wk1(i), pmax) - prod(i,:) = 0.0 - enddo - kmax = 1 - kmin = 1 - do k=1,ko3-1 - if (pmin < po3(k)) kmax = k - if (pmax < po3(k)) kmin = k - enddo -! - do k=kmin,kmax - temp = 1.0 / (po3(k) - po3(k+1)) - do i=1,im - flg(i) = .false. - if (wk1(i) < po3(k) .and. wk1(i) >= po3(k+1)) then - flg(i) = .true. - wk2(i) = (wk1(i) - po3(k+1)) * temp - wk3(i) = 1.0 - wk2(i) - endif - enddo - do j=1,pl_coeff - do i=1,im - if (flg(i)) then - prod(i,j) = wk2(i) * prdout(i,k,j) - & + wk3(i) * prdout(i,k+1,j) - endif - enddo - enddo - enddo -! - do j=1,pl_coeff - do i=1,im - if (wk1(i) < po3(ko3)) then - prod(i,j) = prdout(i,ko3,j) - endif - if (wk1(i) >= po3(1)) then - prod(i,j) = prdout(i,1,j) - endif - enddo - enddo - do i=1,im - colo3(i,l) = colo3(i,l+1) + ozi(i,l) * delp(i,l)*gravi - coloz(i,l) = coloz(i,l+1) + prod(i,6) * delp(i,l)*gravi - prod(i,2) = min(prod(i,2), 0.0) - enddo -! write(1000+me,*) ' colo3=',colo3(1,l),' coloz=',coloz(1,l) -! &,' l=',l - do i=1,im - ozib(i) = ozi(i,l) ! no filling - tem = prod(i,1) - prod(i,2) * prod(i,6) - & + prod(i,3) * (tin(i,l) - prod(i,5)) - & + prod(i,4) * (colo3(i,l)-coloz(i,l)) - -! if (me .eq. 0) print *,'ozphys_2015 tem=',tem,' prod=',prod(i,:) -! &,' ozib=',ozib(i),' l=',l,' tin=',tin(i,l),'colo3=',colo3(i,l+1) - -!ccpp ozo(i,l) = (ozib(i) + tem*dt) / (1.0 - prod(i,2)*dt) - oz(i,l) = (ozib(i) + tem*dt) / (1.0 - prod(i,2)*dt) - enddo - if(idtend(1)>=1) then - dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 - & (prod(:,1)-prod(:,2)*prod(:,6))*dt - endif - if(idtend(2)>=1) then - dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 - & (oz(:,l) - ozib(:)) - endif - if(idtend(3)>=1) then - dtend(:,l,idtend(3)) = dtend(:,l,idtend(3)) + ! was ozp3 - & prod(:,3)*(tin(:,l)-prod(:,5))*dt - endif - if(idtend(4)>=1) then - dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 - & prod(:,4) * (colo3(:,l)-coloz(:,l))*dt - endif - enddo ! vertical loop -! - return - end subroutine ozphys_2015_run - -!> @} - - end module ozphys_2015 diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 8bce7defe..59621b386 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -7,6 +7,20 @@ [ccpp-arg-table] name = ozphys_2015_init type = scheme +[nPts] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[latsozp] + standard_name = number_of_latitudes_in_ozone_data + long_name = number of latitude in ozone data + units = count + dimensions = () + type = integer + intent = in [oz_phys_2015] standard_name = flag_for_nrl_2015_ozone_scheme long_name = flag for new (2015) ozone physics @@ -14,6 +28,176 @@ dimensions = () type = logical intent = in +[oz_lat] + standard_name = ozone_data_latitude + long_name = ozone data latitude + units = deg + dimensions = (number_of_latitudes_in_ozone_data) + type = real + kind = kind_phys + intent = in +[dlat] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[jindx1] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out +[jindx2] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out +[ddy] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = ozphys_2015_timestep_init + type = scheme +[nPts] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[idate] + standard_name = date_and_time_at_model_initialization_in_united_states_order + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[jindx1] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[jindx2] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[latsozp] + standard_name = number_of_latitudes_in_ozone_data + long_name = number of latitude in ozone data + units = count + dimensions = () + type = integer + intent = in +[levozp] + standard_name = number_of_levels_in_ozone_data + long_name = number of levels in ozone data + units = count + dimensions = () + type = integer + intent = in +[oz_coeff] + standard_name = number_of_coefficients_in_ozone_data + long_name = number of coefficients in ozone data + units = count + dimensions = () + type = integer + intent = in +[timeoz] + standard_name = number_of_times_in_ozone_data + long_name = number of times in ozone data + units = count + dimensions = () + type = integer + intent = in +[ozplin] + standard_name = ozone_data + long_name = ozone data + units = 1 + dimensions = (number_of_latitudes_in_ozone_data,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data,number_of_times_in_ozone_data) + type = real + kind = kind_phys + intent = in +[oz_time] + standard_name = ozone_data_time + long_name = ozone data time + units = none + dimensions = (13) + type = real + kind = kind_phys + intent = in +[oz_pres] + standard_name = ozone_data_level_pressure + long_name = ozone data level pressure + units = Pa + dimensions = (number_of_levels_in_ozone_data) + type = real + kind = kind_phys + intent = in +[oz_lat] + standard_name = ozone_data_latitude + long_name = ozone data latitude + units = deg + dimensions = (number_of_latitudes_in_ozone_data) + type = real + kind = kind_phys + intent = in +[ddy] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[ozplout] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_dimension,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -49,7 +233,7 @@ type = integer intent = in [ko3] - standard_name = vertical_dimension_of_ozone_forcing_data + standard_name = number_of_levels_in_ozone_data long_name = number of vertical layers in ozone forcing data units = count dimensions = () @@ -80,10 +264,10 @@ kind = kind_phys intent = in [po3] - standard_name = natural_log_of_ozone_forcing_data_pressure_levels + standard_name = natural_log_of_ozone_data_pressure_levels long_name = natural log of ozone forcing data pressure levels units = 1 - dimensions = (vertical_dimension_of_ozone_forcing_data) + dimensions = (number_of_levels_in_ozone_data) type = real kind = kind_phys intent = in @@ -99,14 +283,14 @@ standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + dimensions = (horizontal_loop_extent,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) type = real kind = kind_phys intent = in [pl_coeff] - standard_name = number_of_coefficients_in_ozone_forcing_data + standard_name = number_of_coefficients_in_ozone_data long_name = number of coefficients in ozone forcing data - units = index + units = count dimensions = () type = integer intent = in @@ -183,13 +367,6 @@ type = real kind = kind_phys intent = in -[me] - standard_name = mpi_rank - long_name = rank of the current MPI task - units = index - dimensions = () - type = integer - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/radiation_gases.f b/physics/radiation_gases.f index ccc3b598a..5f017598f 100644 --- a/physics/radiation_gases.f +++ b/physics/radiation_gases.f @@ -142,9 +142,6 @@ module module_radiation_gases use machine, only : kind_phys, kind_io4 use funcphys, only : fpkapx - use ozne_def, only : JMR => latsozc, LOZ => levozc, & - & blte => blatc, dlte=> dphiozc, & - & timeozc => timeozc use module_iounitdef, only : NIO3CLM, NICO2CN ! implicit none @@ -233,7 +230,7 @@ module module_radiation_gases !>\section gas_init_gen gas_init General Algorithm !----------------------------------- subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & - & ictmflg, ioznflg, con_pi, errflg, errmsg) + & ictmflg, ioznflg, con_pi, JMR, LOZ, timeozc, errflg, errmsg) ! =================================================================== ! ! ! @@ -283,8 +280,10 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & ! --- inputs: integer, intent(in) :: me, ictmflg, ioznflg, ico2flg + integer, intent(in) :: JMR, LOZ, timeozc character(len=26),intent(in) :: co2usr_file,co2cyc_file real(kind=kind_phys), intent(in) :: con_pi + ! --- output: character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -1115,7 +1114,8 @@ end subroutine getgases !! ratio (g/g) !>\section getozn_gen getozn General Algorithm !----------------------------------- - subroutine getozn( prslk,xlat, IMAX, LM, top_at_1, o3mmr) + subroutine getozn( prslk,xlat, IMAX, LM, top_at_1, JMR, LOZ, blte,& + & dlte, o3mmr) ! =================================================================== ! ! ! @@ -1144,7 +1144,8 @@ subroutine getozn( prslk,xlat, IMAX, LM, top_at_1, o3mmr) implicit none ! --- inputs: - integer, intent(in) :: IMAX, LM + integer, intent(in) :: IMAX, LM, JMR, LOZ + real(kind=kind_phys), intent(in) :: blte, dlte logical, intent(in) :: top_at_1 real (kind=kind_phys), intent(in) :: prslk(:,:), xlat(:) From 70b9d7e5ddaf8a4308415ea601a1f8366f62e9d1 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 25 May 2023 10:27:12 -0600 Subject: [PATCH 011/132] RRTMGP changes for refactored NRL ozone physics. --- physics/GFS_rrtmgp_pre.F90 | 13 +++++++--- physics/GFS_rrtmgp_pre.meta | 30 ++++++++++++++++++++++ physics/GFS_rrtmgp_setup.F90 | 13 +++++----- physics/GFS_rrtmgp_setup.meta | 21 ++++++++++++++++ physics/ozphys_2015.F90 | 47 ++++++++++++++++++----------------- 5 files changed, 91 insertions(+), 33 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 009eb8c38..e9cbc3d23 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -117,7 +117,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl vmr_n2o, vmr_co2, tsfg, tsfa, qs_lay, q_lay, tv_lay, & relhum, deltaZ, deltaZc, deltaP, active_gases_array, & tsfc_radtime, coszen, coszdg, top_at_1, iSFC, iTOA, nDay, idxday, semis, & - sfc_emiss_byband, ico2, con_pi, errmsg, errflg) + sfc_emiss_byband, ico2, latsozp, levozp, blatc, dphiozc, con_pi, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -125,13 +125,17 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers ico2, & ! Flag for co2 radiation scheme - i_o3 ! Index into tracer array for ozone + i_o3, & ! Index into tracer array for ozone + latsozp, & ! + levozp logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad ! Call LW radiation real(kind_phys), intent(in) :: & fhswr, & ! Frequency of SW radiation call. - fhlwr ! Frequency of LW radiation call. + fhlwr, & ! Frequency of LW radiation call. + blatc, & ! + dphiozc real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravitational constant con_rd, & ! Physical constant: gas-constant for dry air @@ -350,7 +354,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl enddo ! OR Use climatological ozone data else - call getozn (prslk(1:NCOL,:), xlat, nCol, nLev, top_at_1, o3_lay) + call getozn (prslk(1:NCOL,:), xlat, nCol, nLev, top_at_1, latsozp, levozp, blatc, & + dphiozc, o3_lay) endif ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index abb07b825..47980b513 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -503,6 +503,36 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout +[latsozp] + standard_name = number_of_latitudes_in_ozone_data + long_name = number of latitude in ozone data + units = count + dimensions = () + type = integer + intent = in +[levozp] + standard_name = number_of_levels_in_ozone_data + long_name = number of levels in ozone data + units = count + dimensions = () + type = integer + intent = in +[dphiozc] + standard_name = ozone_data_parameter_1 + long_name = ozone data parameter 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[blatc] + standard_name = ozone_data_parameter_2 + long_name = ozone data parameter 2 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 76db14279..7b5479e60 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -37,9 +37,10 @@ module GFS_rrtmgp_setup subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & - ntcw, ntoz, iovr, isubc_sw, isubc_lw, lalw1bd, idate, me, aeros_file, & - iaermdl, iaerflg, con_pi, con_t0c, con_c, con_boltz, con_plnk, solar_file, & - con_solr_2008, con_solr_2002, co2usr_file, co2cyc_file, ipsd0, errmsg, errflg) + ntcw, ntoz, iovr, latsozp, levozp, timeozp, isubc_sw, isubc_lw, lalw1bd, idate, & + me, aeros_file, iaermdl, iaerflg, con_pi, con_t0c, con_c, con_boltz, con_plnk, & + solar_file, con_solr_2008, con_solr_2002, co2usr_file, co2cyc_file, ipsd0, & + errmsg, errflg) ! Inputs logical, intent(in) :: do_RRTMGP @@ -57,8 +58,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, real(kind_phys), dimension(:), intent(in) :: & si integer, intent(in) :: levr, ictm, isol, ico2, iaer, & - ntcw, ntoz, iovr, isubc_sw, isubc_lw, & - me + ntcw, ntoz, iovr, isubc_sw, isubc_lw, latsozp, levozp, timeozp, me logical, intent(in) :: & lalw1bd integer, intent(in), dimension(:) :: & @@ -129,7 +129,8 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, call sol_init ( me, isol, solar_file, con_solr_2008, con_solr_2002, con_pi ) call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, con_t0c, & con_c, con_boltz, con_plnk, errflg, errmsg) - call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, ntoz, con_pi, errflg, errmsg ) + call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, ntoz, con_pi, latsozp, & + levozp, timeozp, errflg, errmsg ) if ( me == 0 ) then print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index c4f7cfaa5..567294d4a 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -266,6 +266,27 @@ dimensions = () type = integer intent = inout +[levozp] + standard_name = number_of_levels_in_ozone_data + long_name = number of levels in ozone data + units = count + dimensions = () + type = integer + intent = in +[timeozp] + standard_name = number_of_times_in_ozone_data + long_name = number of times in ozone data + units = count + dimensions = () + type = integer + intent = in +[latsozp] + standard_name = number_of_latitudes_in_ozone_data + long_name = number of latitude in ozone data + units = count + dimensions = () + type = integer + intent = in [iaermdl] standard_name = control_for_aerosol_radiation_scheme long_name = control of aerosol scheme in radiation diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 index 17f2178a4..4e73a5262 100644 --- a/physics/ozphys_2015.F90 +++ b/physics/ozphys_2015.F90 @@ -83,7 +83,7 @@ subroutine ozphys_2015_timestep_init(nPts, idate, fhour, jindx1, jindx2, latsozp integer, intent(in) :: & nPts, & ! Horizontal dimension latsozp, & ! Number of latitudes in ozone data - levozp, & ! Number of levels in ozone data + levozp, & ! Number of vertical layers in ozone data oz_coeff, & ! Number of coefficients in ozone data timeoz ! Number of times in ozone data integer, intent(in),dimension(:) :: & @@ -188,6 +188,7 @@ end subroutine ozphys_2015_timestep_init !> - This code is specifically for NRL parameterization and !! climatological T and O3 are in location 5 and 6 of prdout array !!\author June 2015 - Shrinivas Moorthi +!!\author May 2023 - Dustin Swales ! ########################################################################################### subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_coeff, & delp, ldiag3d, dtend, dtidx, ntoz, index_of_process_prod_loss, & @@ -196,43 +197,43 @@ subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_c ! Inputs logical, intent(in) :: & - ldiag3d + ldiag3d ! Flag to output GFS diagnostic tendencies real(kind_phys),intent(in) :: & - con_g + con_g ! Physical constant: Gravitational acceleration (ms-2) integer, intent(in) :: & - im, & ! - levs, & ! - ko3, & ! - pl_coeff, & ! - ntoz, & ! - index_of_process_prod_loss, & ! - index_of_process_ozmix, & ! - index_of_process_temp, & - index_of_process_overhead_ozone + im, & ! Horizontal dimension + levs, & ! Number of vertical layers + ko3, & ! Number of vertical layers in ozone forcing data + pl_coeff, & ! Number of coefficients in ozone forcing data + ntoz, & ! Index for ozone mixing ratio + index_of_process_prod_loss, & ! Index for process in diagnostic tendency output + index_of_process_ozmix, & ! Index for process in diagnostic tendency output + index_of_process_temp, & ! Index for process in diagnostic tendency output + index_of_process_overhead_ozone ! Index for process in diagnostic tendency output integer, intent(in), dimension(:,:) :: & - dtidx ! + dtidx ! Bookkeeping indices for GFS diagnostic tendencies real(kind_phys), intent(in) :: & - dt ! + dt ! Physics timestep (seconds) real(kind_phys), intent(in), dimension(:) :: & - po3 ! + po3 ! Natural log of ozone forcing data pressure levels real(kind_phys), intent(in), dimension(:,:) :: & - prsl, & ! - tin, & ! - delp ! + prsl, & ! Air-pressure (Pa) + tin, & ! Temperature of new-state (K) + delp ! Difference between mid-layer pressures (Pa) real(kind_phys), intent(in), dimension(:,:,:) :: & - prdout ! + prdout ! Ozone forcing data ! In/Outs real(kind=kind_phys), intent(inout), dimension(:,:,:) :: & - dtend ! + dtend ! Diagnostic tendencies for state variables ! Outputs real(kind=kind_phys), intent(inout), dimension(:,:) :: & - oz ! + oz ! Ozone concentration updated by physics character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag + errflg ! CCPP error flag ! Locals integer :: k, kmax, kmin, l, i, j From 6ff8689d3e1ed9ccaec7c09db6d8b12f633e59c1 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 25 May 2023 11:34:29 -0600 Subject: [PATCH 012/132] Revert change to CI test from NCAR->UWM merge --- .github/workflows/ci_fv3_ccpp_prebuild.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci_fv3_ccpp_prebuild.yml b/.github/workflows/ci_fv3_ccpp_prebuild.yml index b23c9977e..a5c2f8092 100644 --- a/.github/workflows/ci_fv3_ccpp_prebuild.yml +++ b/.github/workflows/ci_fv3_ccpp_prebuild.yml @@ -24,7 +24,7 @@ jobs: run: echo "GIT_REMOTE_HASH=`git rev-parse HEAD`" >> $GITHUB_ENV - name: Checkout latest fv3atm - run: git clone https://github.com/NCAR/fv3atm.git + run: git clone https://github.com/NOAA-EMC/fv3atm.git - name: Initialize submodules run: | From 9859339985948e4d1fe2c721f7fab7830101dd72 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Thu, 15 Jun 2023 11:17:35 -0600 Subject: [PATCH 013/132] Some changes --- physics/GFS_rrtmg_pre.F90 | 6 +++--- physics/GFS_rrtmg_pre.meta | 12 ++++++------ physics/GFS_rrtmgp_pre.F90 | 8 ++++---- physics/GFS_rrtmgp_pre.meta | 12 ++++++------ physics/ozphys_2015.F90 | 7 ++++--- physics/ozphys_2015.meta | 8 -------- 6 files changed, 23 insertions(+), 30 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index ae88ca0fc..cf9bbb6aa 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -45,7 +45,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& gasvmr_ccl4, gasvmr_cfc113, aerodp,ext550, clouds6, clouds7, clouds8, & clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, & faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, & - aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, latsozp, levozp, & + aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, latsozc, levozc, & blatc, dphiozc, errmsg, errflg) use machine, only: kind_phys @@ -103,7 +103,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& imp_physics_nssl, & imp_physics_fer_hires, & yearlen, icloud, iaermdl, iaerflg, & - latsozp, levozp + latsozc, levozc integer, intent(in) :: & iovr, & ! choice of cloud-overlap method @@ -431,7 +431,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& enddo enddo else ! climatological ozone - call getozn (prslk1, xlat, im, lmk, top_at_1, latsozp, levozp, blatc, dphiozc, olyr) + call getozn (prslk1, xlat, im, lmk, top_at_1, latsozc, levozc, blatc, dphiozc, olyr) endif ! end_if_ntoz !> - Call coszmn(), to compute cosine of zenith angle (only when SW is called) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 88363ef18..3b4d35c6d 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -1496,16 +1496,16 @@ dimensions = () type = integer intent = in -[latsozp] - standard_name = number_of_latitudes_in_ozone_data - long_name = number of latitude in ozone data +[latsozc] + standard_name = number_of_latitudes_in_ozone_climotology_data + long_name = number of latitude in ozone climotology data units = count dimensions = () type = integer intent = in -[levozp] - standard_name = number_of_levels_in_ozone_data - long_name = number of levels in ozone data +[levozc] + standard_name = number_of_levels_in_ozone_climotology_data + long_name = number of levels in ozone climotology data units = count dimensions = () type = integer diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index e9cbc3d23..dd72a6a1c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -117,7 +117,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl vmr_n2o, vmr_co2, tsfg, tsfa, qs_lay, q_lay, tv_lay, & relhum, deltaZ, deltaZc, deltaP, active_gases_array, & tsfc_radtime, coszen, coszdg, top_at_1, iSFC, iTOA, nDay, idxday, semis, & - sfc_emiss_byband, ico2, latsozp, levozp, blatc, dphiozc, con_pi, errmsg, errflg) + sfc_emiss_byband, ico2, latsozc, levozc, blatc, dphiozc, con_pi, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -126,8 +126,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl nLev, & ! Number of vertical layers ico2, & ! Flag for co2 radiation scheme i_o3, & ! Index into tracer array for ozone - latsozp, & ! - levozp + latsozc, & ! + levozc logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad ! Call LW radiation @@ -354,7 +354,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl enddo ! OR Use climatological ozone data else - call getozn (prslk(1:NCOL,:), xlat, nCol, nLev, top_at_1, latsozp, levozp, blatc, & + call getozn (prslk(1:NCOL,:), xlat, nCol, nLev, top_at_1, latsozc, levozc, blatc, & dphiozc, o3_lay) endif diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 47980b513..1a96eee1b 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -503,16 +503,16 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout -[latsozp] - standard_name = number_of_latitudes_in_ozone_data - long_name = number of latitude in ozone data +[latsozc] + standard_name = number_of_latitudes_in_ozone_climotology_data + long_name = number of latitude in ozone climotology data units = count dimensions = () type = integer intent = in -[levozp] - standard_name = number_of_levels_in_ozone_data - long_name = number of levels in ozone data +[levozc] + standard_name = number_of_levels_in_ozone_climotology_data + long_name = number of levels in ozone climotology data units = count dimensions = () type = integer diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 index 4e73a5262..fda87611c 100644 --- a/physics/ozphys_2015.F90 +++ b/physics/ozphys_2015.F90 @@ -3,7 +3,7 @@ !! ! ########################################################################################### module ozphys_2015 - use machine , only : kind_phys + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec implicit none public ozphys_2015_init, ozphys_2015_timestep_init, ozphys_2015_run contains @@ -78,7 +78,7 @@ end subroutine ozphys_2015_init !! ! ########################################################################################### subroutine ozphys_2015_timestep_init(nPts, idate, fhour, jindx1, jindx2, latsozp, levozp, & - oz_coeff, timeoz, ozplin, oz_time, oz_pres, oz_lat, ddy, ozplout, errmsg, errflg) + oz_coeff, timeoz, ozplin, oz_time, oz_lat, ddy, ozplout, errmsg, errflg) ! Inputs integer, intent(in) :: & nPts, & ! Horizontal dimension @@ -95,7 +95,6 @@ subroutine ozphys_2015_timestep_init(nPts, idate, fhour, jindx1, jindx2, latsozp real(kind_phys), intent(in), dimension(:) :: & ddy, & ! Interpolation high index for ozone data oz_lat, & ! Latitudes for ozone data - oz_pres, & ! Levels for ozone data oz_time ! Time for ozone data real(kind_phys), intent(in), dimension(:,:,:,:) :: & ozplin ! Ozone data @@ -114,6 +113,8 @@ subroutine ozphys_2015_timestep_init(nPts, idate, fhour, jindx1, jindx2, latsozp real(kind_phys) :: tem, tx1, tx2, rjday real(8) :: rinc(5) real(4) :: rinc4(5) + !real(kind_dbl_prec) :: rinc(5) + !real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 59621b386..eab24baf1 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -166,14 +166,6 @@ type = real kind = kind_phys intent = in -[oz_pres] - standard_name = ozone_data_level_pressure - long_name = ozone data level pressure - units = Pa - dimensions = (number_of_levels_in_ozone_data) - type = real - kind = kind_phys - intent = in [oz_lat] standard_name = ozone_data_latitude long_name = ozone data latitude From 9891fff7bd9eb8660a60ff203112298bf1349406 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 31 Jul 2023 10:50:36 -0600 Subject: [PATCH 014/132] switch from in to inout for output variables --- physics/sfc_land.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_land.f b/physics/sfc_land.f index aec47ff77..d4e88c25a 100644 --- a/physics/sfc_land.f +++ b/physics/sfc_land.f @@ -112,7 +112,7 @@ subroutine sfc_land_run & & cmm_lnd, chh_lnd, zvfun_lnd ! --- outputs: - real (kind=kind_phys), dimension(:), intent(out) :: & + real (kind=kind_phys), dimension(:), intent(inout) :: & & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & & runoff, drain, cmm, chh, zvfun ! From 70038f6f5f70572f09489732e3563f1d11066a1f Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 31 Jul 2023 11:50:02 -0600 Subject: [PATCH 015/132] update meta file for sfc_land too --- physics/sfc_land.meta | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/physics/sfc_land.meta b/physics/sfc_land.meta index 979cca377..493d2a70b 100644 --- a/physics/sfc_land.meta +++ b/physics/sfc_land.meta @@ -153,7 +153,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [qsurf] standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land @@ -161,7 +161,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [evap] standard_name = kinematic_surface_upward_latent_heat_flux_over_land long_name = kinematic surface upward latent heat flux over land @@ -169,7 +169,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [hflx] standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land @@ -177,7 +177,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [ep] standard_name = surface_upward_potential_latent_heat_flux_over_land long_name = surface upward potential latent heat flux over land @@ -185,7 +185,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [t2mmp] standard_name = temperature_at_2m_from_noahmp long_name = 2 meter temperature from noahmp @@ -193,7 +193,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [q2mp] standard_name = specific_humidity_at_2m_from_noahmp long_name = 2 meter specific humidity from noahmp @@ -201,7 +201,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [gflux] standard_name = upward_heat_flux_in_soil_over_land long_name = soil heat flux over land @@ -209,7 +209,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [runoff] standard_name = surface_runoff_flux long_name = surface runoff flux @@ -217,7 +217,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [drain] standard_name = subsurface_runoff_flux long_name = subsurface runoff flux @@ -225,7 +225,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [cmm] standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land long_name = momentum exchange coefficient over land @@ -233,7 +233,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [chh] standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land long_name = thermal exchange coefficient over land @@ -241,7 +241,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [zvfun] standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction long_name = function of surface roughness length and green vegetation fraction @@ -249,7 +249,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 6ec72e918d2f2d04f78a9afaf5b58968370a44a4 Mon Sep 17 00:00:00 2001 From: uturuncoglu Date: Mon, 31 Jul 2023 16:21:27 -0600 Subject: [PATCH 016/132] update sfc_land --- physics/sfc_land.F90 | 108 ++++++++++++++++++++++++++++++ physics/sfc_land.f | 154 ------------------------------------------- 2 files changed, 108 insertions(+), 154 deletions(-) create mode 100644 physics/sfc_land.F90 delete mode 100644 physics/sfc_land.f diff --git a/physics/sfc_land.F90 b/physics/sfc_land.F90 new file mode 100644 index 000000000..2b0696ed8 --- /dev/null +++ b/physics/sfc_land.F90 @@ -0,0 +1,108 @@ +!> \file sfc_land.F90 +!! This file contains the code for coupling to land component + +!> This module contains the CCPP-compliant GFS land post +!! interstitial codes, which returns updated surface +!! properties such as latent heat and sensible heat +!! provided by the component version of land model + +!> This module contains the CCPP-compliant GFS land scheme. + module sfc_land + + use machine, only : kind_phys + + contains + +!> \defgroup sfc_land for coupling to land +!! @{ +!! \section diagram Calling Hierarchy Diagram +!! \section intraphysics Intraphysics Communication +!! +!> \brief Brief description of the subroutine +!! +!! \section arg_table_sfc_land_run Arguments +!! \htmlinclude sfc_land_run.html +!! + +!! +!! \section general General Algorithm +!! \section detailed Detailed Algorithm +!! @{ + subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, & + sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & + ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & + runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & + sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & + gflux, runoff, drain, cmm, chh, zvfun, & + errmsg, errflg) + + implicit none + + ! Inputs + integer , intent(in) :: im + logical , intent(in) :: cpllnd + logical , intent(in) :: cpllnd2atm + logical , intent(in) :: flag_iter(:) + logical , intent(in) :: dry(:) + real(kind=kind_phys), intent(in) :: sncovr1_lnd(:) + real(kind=kind_phys), intent(in) :: qsurf_lnd(:) + real(kind=kind_phys), intent(in) :: evap_lnd(:) + real(kind=kind_phys), intent(in) :: hflx_lnd(:) + real(kind=kind_phys), intent(in) :: ep_lnd(:) + real(kind=kind_phys), intent(in) :: t2mmp_lnd(:) + real(kind=kind_phys), intent(in) :: q2mp_lnd(:) + real(kind=kind_phys), intent(in) :: gflux_lnd(:) + real(kind=kind_phys), intent(in) :: runoff_lnd(:) + real(kind=kind_phys), intent(in) :: drain_lnd(:) + real(kind=kind_phys), intent(in) :: cmm_lnd(:) + real(kind=kind_phys), intent(in) :: chh_lnd(:) + real(kind=kind_phys), intent(in) :: zvfun_lnd(:) + ! Inputs/Outputs + real(kind=kind_phys), intent(inout) :: sncovr1(:) + real(kind=kind_phys), intent(inout) :: qsurf(:) + real(kind=kind_phys), intent(inout) :: evap(:) + real(kind=kind_phys), intent(inout) :: hflx(:) + real(kind=kind_phys), intent(inout) :: ep(:) + real(kind=kind_phys), intent(inout) :: t2mmp(:) + real(kind=kind_phys), intent(inout) :: q2mp(:) + real(kind=kind_phys), intent(inout) :: gflux(:) + real(kind=kind_phys), intent(inout) :: runoff(:) + real(kind=kind_phys), intent(inout) :: drain(:) + real(kind=kind_phys), intent(inout) :: cmm(:) + real(kind=kind_phys), intent(inout) :: chh(:) + real(kind=kind_phys), intent(inout) :: zvfun(:) + ! Outputs + character(len=*) , intent(out) :: errmsg + integer , intent(out) :: errflg + + ! Locals + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check coupling from component land to atmosphere + if (.not. cpllnd2atm) return + + ! Fill variables + do i = 1, im + sncovr1(i) = sncovr1_lnd(i) + qsurf(i) = qsurf_lnd(i) + hflx(i) = hflx_lnd(i) + evap(i) = evap_lnd(i) + ep(i) = ep_lnd(i) + t2mmp(i) = t2mmp_lnd(i) + q2mp(i) = q2mp_lnd(i) + gflux(i) = gflux_lnd(i) + drain(i) = drain_lnd(i) + runoff(i) = runoff_lnd(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) + zvfun(i) = zvfun_lnd(i) + enddo + + end subroutine sfc_land_run + +!> @} + end module sfc_land diff --git a/physics/sfc_land.f b/physics/sfc_land.f deleted file mode 100644 index d4e88c25a..000000000 --- a/physics/sfc_land.f +++ /dev/null @@ -1,154 +0,0 @@ -!> \file sfc_land.f -!! This file contains the code for coupling to land component - -!> This module contains the CCPP-compliant GFS land post -!! interstitial codes, which returns updated surface -!! properties such as latent heat and sensible heat -!! provided by the component version of land model - -!> This module contains the CCPP-compliant GFS land scheme. - module sfc_land - - contains - -!> \defgroup sfc_land for coupling to land -!! @{ -!! \section diagram Calling Hierarchy Diagram -!! \section intraphysics Intraphysics Communication -!! -!> \brief Brief description of the subroutine -!! -!! \section arg_table_sfc_land_run Arguments -!! \htmlinclude sfc_land_run.html -!! - -!! -!! \section general General Algorithm -!! \section detailed Detailed Algorithm -!! @{ - -! -!----------------------------------- - subroutine sfc_land_run & -! --- inputs: - & ( im, cpllnd, cpllnd2atm, flag_iter, dry, & - & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & - & ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & - & runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & -! --- outputs: - & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & - & gflux, runoff, drain, cmm, chh, zvfun, & - & errmsg, errflg - & ) - -! ===================================================================== ! -! description: ! -! Dec 2022 -- Ufuk Turuncoglu created for coupling to land ! -! ! -! usage: ! -! ! -! call sfc_land ! -! inputs: ! -! ( im, cpllnd, cpllnd2atm, flag_iter, dry, ! -! sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ! -! ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, ! -! runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, ! -! zvfun_lnd, ! -! outputs: ! -! sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, ! -! gflux, runoff, drain, cmm, chh, zvfun, ! -! errmsg, errflg) ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: -! im - integer, horiz dimension -! cpllnd - logical, flag for land coupling -! cpllnd2atm - logical, flag for land coupling (lnd->atm) -! flag_iter - logical, flag for iteration -! dry - logical, eq T if a point with any land -! sncovr1_lnd - real , surface snow area fraction -! qsurf_lnd - real , specific humidity at sfc -! evap_lnd - real , evaporation from latent heat -! hflx_lnd - real , sensible heat -! ep_lnd - real , surface upward potential latent heat flux -! t2mmp_lnd - real , 2m temperature -! q2mp_lnd - real , 2m specific humidity -! gflux_lnd - real , soil heat flux over land -! runoff_lnd - real , surface runoff -! drain_lnd - real , subsurface runoff -! cmm_lnd - real , surface drag wind speed for momentum -! chh_lnd - real , surface drag mass flux for heat and moisture -! zvfun_lnd - real , function of surface roughness length and green vegetation fraction -! outputs: -! sncovr1 - real , snow cover over land -! qsurf - real , specific humidity at sfc -! evap - real , evaporation from latent heat -! hflx - real , sensible heat -! ep - real , potential evaporation -! t2mmp - real , temperature at 2m -! q2mp - real , specific humidity at 2m -! gflux - real , soil heat flux over land -! runoff - real , surface runoff -! drain - real , subsurface runoff -! cmm - real , surface drag wind speed for momentum -! chh - real , surface drag mass flux for heat and moisture -! zvfun - real , function of surface roughness length and green vegetation fraction -! ==================== end of description ===================== ! -! -! - use machine , only : kind_phys - implicit none - -! --- inputs: - integer, intent(in) :: im - logical, intent(in) :: cpllnd, cpllnd2atm - logical, dimension(:), intent(in) :: flag_iter - logical, dimension(:), intent(in) :: dry - - real (kind=kind_phys), dimension(:), intent(in) :: & - & sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, ep_lnd, & - & t2mmp_lnd, q2mp_lnd, gflux_lnd, runoff_lnd, drain_lnd, & - & cmm_lnd, chh_lnd, zvfun_lnd - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: & - & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, gflux, & - & runoff, drain, cmm, chh, zvfun -! - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals: - - integer :: i - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 -! - if (.not. cpllnd2atm) return -! - do i = 1, im - sncovr1(i) = sncovr1_lnd(i) - qsurf(i) = qsurf_lnd(i) - hflx(i) = hflx_lnd(i) - evap(i) = evap_lnd(i) - ep(i) = ep_lnd(i) - t2mmp(i) = t2mmp_lnd(i) - q2mp(i) = q2mp_lnd(i) - gflux(i) = gflux_lnd(i) - drain(i) = drain_lnd(i) - runoff(i) = runoff_lnd(i) - cmm(i) = cmm_lnd(i) - chh(i) = chh_lnd(i) - zvfun(i) = zvfun_lnd(i) - enddo - - return -!----------------------------------- - end subroutine sfc_land_run -!----------------------------------- - -!> @} - end module sfc_land From 8188e26897b91083b315a0c8f83e32f54209c96d Mon Sep 17 00:00:00 2001 From: dustinswales Date: Tue, 1 Aug 2023 16:01:38 -0600 Subject: [PATCH 017/132] Split ozone physics into time_vary and run components --- physics/GFS_rrtmg_setup.meta | 12 +- physics/GFS_rrtmgp_setup.meta | 12 +- physics/ozphys_2015.F90 | 181 ++--------------------------- physics/ozphys_2015.meta | 205 +-------------------------------- physics/ozphys_time_vary.F90 | 177 +++++++++++++++++++++++++++++ physics/ozphys_time_vary.meta | 207 ++++++++++++++++++++++++++++++++++ 6 files changed, 406 insertions(+), 388 deletions(-) create mode 100644 physics/ozphys_time_vary.F90 create mode 100644 physics/ozphys_time_vary.meta diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 42b999c82..f92d6f8db 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -174,22 +174,22 @@ type = integer intent = in [levozp] - standard_name = number_of_levels_in_ozone_data - long_name = number of levels in ozone data + standard_name = number_of_levels_in_ozone_climotology_data + long_name = number of levels in ozone climotology data units = count dimensions = () type = integer intent = in [timeozp] - standard_name = number_of_times_in_ozone_data - long_name = number of times in ozone data + standard_name = number_of_times_in_ozone_climotology_data + long_name = number of times in ozone climotology data units = count dimensions = () type = integer intent = in [latsozp] - standard_name = number_of_latitudes_in_ozone_data - long_name = number of latitude in ozone data + standard_name = number_of_latitudes_in_ozone_climotology_data + long_name = number of latitude in ozone climotology data units = count dimensions = () type = integer diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 567294d4a..c8ed60650 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -267,22 +267,22 @@ type = integer intent = inout [levozp] - standard_name = number_of_levels_in_ozone_data - long_name = number of levels in ozone data + standard_name = number_of_levels_in_ozone_climotology_data + long_name = number of levels in ozone climotology data units = count dimensions = () type = integer intent = in [timeozp] - standard_name = number_of_times_in_ozone_data - long_name = number of times in ozone data + standard_name = number_of_times_in_ozone_climotology_data + long_name = number of times in ozone climotology data units = count dimensions = () type = integer intent = in [latsozp] - standard_name = number_of_latitudes_in_ozone_data - long_name = number of latitude in ozone data + standard_name = number_of_latitudes_in_ozone_climotology_data + long_name = number of latitude in ozone climotology data units = count dimensions = () type = integer diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 index fda87611c..82ade0cbd 100644 --- a/physics/ozphys_2015.F90 +++ b/physics/ozphys_2015.F90 @@ -5,176 +5,13 @@ module ozphys_2015 use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec implicit none - public ozphys_2015_init, ozphys_2015_timestep_init, ozphys_2015_run + public ozphys_2015_run contains ! ########################################################################################### !>\defgroup GFS_ozphys_2015 GFS Ozone Photochemistry (2015) Module !! This module contains the CCPP-compliant Ozone 2015 photochemistry scheme. !> @{ -!> \section arg_table_ozphys_2015_init Argument Table -!! \htmlinclude ozphys_2015_init.html -!! -! ########################################################################################### - subroutine ozphys_2015_init(oz_phys_2015, nPts, latsozp, oz_lat, dlat, jindx1, jindx2, & - ddy, errmsg, errflg) - ! Inputs - logical, intent(in) :: & - oz_phys_2015 ! Control flag for NRL 2015 ozone physics scheme - integer, intent(in) :: & - nPts, & ! Horizontal dimension - latsozp ! Number of latitudes in ozone data - real(kind_phys), intent(in), dimension(:) :: & - oz_lat, & ! Latitudes of ozone data - dlat ! Latitudes of grid - ! Outputs - integer, intent(out), dimension(:) :: & - jindx1, & ! Interpolation index (low) for ozone data - jindx2 ! Interpolation index (high) for ozone data - real(kind_phys), intent(out), dimension(:) :: & - ddy ! Interpolation high index for ozone data - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - - ! Local - integer i,j - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Sanity check - if (.not.oz_phys_2015) then - write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' - errflg = 1 - return - endif - - ! Set indices - do j=1,nPts - jindx2(j) = latsozp + 1 - do i=1,latsozp - if (dlat(j) < oz_lat(i)) then - jindx2(j) = i - exit - endif - enddo - jindx1(j) = max(jindx2(j)-1,1) - jindx2(j) = min(jindx2(j),latsozp) - if (jindx2(j) .ne. jindx1(j)) then - ddy(j) = (dlat(j) - oz_lat(jindx1(j))) / (oz_lat(jindx2(j)) - oz_lat(jindx1(j))) - else - ddy(j) = 1.0 - endif - enddo - - end subroutine ozphys_2015_init - -! ########################################################################################### -!> \section arg_table_ozphys_2015_timestep_init Argument Table -!! \htmlinclude ozphys_2015_timestep_init.html -!! -! ########################################################################################### - subroutine ozphys_2015_timestep_init(nPts, idate, fhour, jindx1, jindx2, latsozp, levozp, & - oz_coeff, timeoz, ozplin, oz_time, oz_lat, ddy, ozplout, errmsg, errflg) - ! Inputs - integer, intent(in) :: & - nPts, & ! Horizontal dimension - latsozp, & ! Number of latitudes in ozone data - levozp, & ! Number of vertical layers in ozone data - oz_coeff, & ! Number of coefficients in ozone data - timeoz ! Number of times in ozone data - integer, intent(in),dimension(:) :: & - idate, & ! Initial date with different size and ordering - jindx1, & ! Interpolation index (low) for ozone - jindx2 ! Interpolation index (high) for ozone - real(kind_phys), intent(in) :: & - fhour ! Forecast hour - real(kind_phys), intent(in), dimension(:) :: & - ddy, & ! Interpolation high index for ozone data - oz_lat, & ! Latitudes for ozone data - oz_time ! Time for ozone data - real(kind_phys), intent(in), dimension(:,:,:,:) :: & - ozplin ! Ozone data - - ! Outputs - real(kind_phys), intent(out), dimension(:,:,:) :: & - ozplout ! Ozone forcing data - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - - ! Local - integer :: idat(8),jdat(8),iday,j,j1,j2,l,nc,n1,n2,jdow,jdoy,& - jday,w3kindreal,w3kindint - real(kind_phys) :: tem, tx1, tx2, rjday - real(8) :: rinc(5) - real(4) :: rinc4(5) - !real(kind_dbl_prec) :: rinc(5) - !real(kind_sngl_prec) :: rinc4(5) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! - idat=0 - idat(1)=idate(4) - idat(2)=idate(2) - idat(3)=idate(3) - idat(5)=idate(1) - rinc=0. - rinc(2)=fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL w3movdat(rinc4,idat,jdat) - else - CALL w3movdat(rinc,idat,jdat) - endif - ! - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jdat,jdow,jdoy,jday) - rjday = jdoy + jdat(5) / 24. - IF (RJDAY < oz_time(1)) RJDAY = RJDAY + 365. - ! - n2 = timeoz + 1 - do j=2,timeoz - if (rjday < oz_time(j)) then - n2 = j - exit - endif - enddo - n1 = n2 - 1 - - tx1 = (oz_time(n2) - rjday) / (oz_time(n2) - oz_time(n1)) - tx2 = 1.0 - tx1 - - if (n2 > timeoz) n2 = n2 - timeoz - ! - do nc=1,oz_coeff - do L=1,levozp - do J=1,npts - J1 = jindx1(J) - J2 = jindx2(J) - TEM = 1.0 - ddy(J) - ozplout(j,L,nc) = tx1*(TEM*ozplin(J1,L,nc,n1)+ddy(J)*ozplin(J2,L,nc,n1)) & - + tx2*(TEM*ozplin(J1,L,nc,n2)+ddy(J)*ozplin(J2,L,nc,n2)) - enddo - enddo - enddo - - ! - return - - end subroutine ozphys_2015_timestep_init - -! ########################################################################################### !> The operational GFS currently parameterizes ozone production and !! destruction based on monthly mean coefficients ( !! \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by Naval @@ -187,11 +24,11 @@ end subroutine ozphys_2015_timestep_init !> - This code assumes that both prsl and po3 are from bottom to top !! as are all other variables. !> - This code is specifically for NRL parameterization and -!! climatological T and O3 are in location 5 and 6 of prdout array -!!\author June 2015 - Shrinivas Moorthi -!!\author May 2023 - Dustin Swales +!! climatological T and O3 are in location 5 and 6 of oz_data array +!!\author June 2015 - Shrinivas Moorthi +!!\modified May 2023 - Dustin Swales ! ########################################################################################### - subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_coeff, & + subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, oz_data, pl_coeff, & delp, ldiag3d, dtend, dtidx, ntoz, index_of_process_prod_loss, & index_of_process_ozmix, index_of_process_temp, index_of_process_overhead_ozone, & con_g, errmsg, errflg) @@ -222,7 +59,7 @@ subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_c tin, & ! Temperature of new-state (K) delp ! Difference between mid-layer pressures (Pa) real(kind_phys), intent(in), dimension(:,:,:) :: & - prdout ! Ozone forcing data + oz_data ! Ozone forcing data ! In/Outs real(kind=kind_phys), intent(inout), dimension(:,:,:) :: & @@ -298,7 +135,7 @@ subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_c do j=1,pl_coeff do i=1,im if (flg(i)) then - prod(i,j) = wk2(i) * prdout(i,k,j) + wk3(i) * prdout(i,k+1,j) + prod(i,j) = wk2(i) * oz_data(i,k,j) + wk3(i) * oz_data(i,k+1,j) endif enddo enddo @@ -307,10 +144,10 @@ subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, prdout, pl_c do j=1,pl_coeff do i=1,im if (wk1(i) < po3(ko3)) then - prod(i,j) = prdout(i,ko3,j) + prod(i,j) = oz_data(i,ko3,j) endif if (wk1(i) >= po3(1)) then - prod(i,j) = prdout(i,1,j) + prod(i,j) = oz_data(i,1,j) endif enddo enddo diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index eab24baf1..ea82defaa 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -3,209 +3,6 @@ type = scheme dependencies = machine.F -######################################################################## -[ccpp-arg-table] - name = ozphys_2015_init - type = scheme -[nPts] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[latsozp] - standard_name = number_of_latitudes_in_ozone_data - long_name = number of latitude in ozone data - units = count - dimensions = () - type = integer - intent = in -[oz_phys_2015] - standard_name = flag_for_nrl_2015_ozone_scheme - long_name = flag for new (2015) ozone physics - units = flag - dimensions = () - type = logical - intent = in -[oz_lat] - standard_name = ozone_data_latitude - long_name = ozone data latitude - units = deg - dimensions = (number_of_latitudes_in_ozone_data) - type = real - kind = kind_phys - intent = in -[dlat] - standard_name = latitude_in_degree - long_name = latitude in degree north - units = degree_north - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[jindx1] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = out -[jindx2] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = out -[ddy] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = ozphys_2015_timestep_init - type = scheme -[nPts] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[idate] - standard_name = date_and_time_at_model_initialization_in_united_states_order - long_name = initial date with different size and ordering - units = none - dimensions = (4) - type = integer - intent = in -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in -[jindx1] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[jindx2] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[latsozp] - standard_name = number_of_latitudes_in_ozone_data - long_name = number of latitude in ozone data - units = count - dimensions = () - type = integer - intent = in -[levozp] - standard_name = number_of_levels_in_ozone_data - long_name = number of levels in ozone data - units = count - dimensions = () - type = integer - intent = in -[oz_coeff] - standard_name = number_of_coefficients_in_ozone_data - long_name = number of coefficients in ozone data - units = count - dimensions = () - type = integer - intent = in -[timeoz] - standard_name = number_of_times_in_ozone_data - long_name = number of times in ozone data - units = count - dimensions = () - type = integer - intent = in -[ozplin] - standard_name = ozone_data - long_name = ozone data - units = 1 - dimensions = (number_of_latitudes_in_ozone_data,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data,number_of_times_in_ozone_data) - type = real - kind = kind_phys - intent = in -[oz_time] - standard_name = ozone_data_time - long_name = ozone data time - units = none - dimensions = (13) - type = real - kind = kind_phys - intent = in -[oz_lat] - standard_name = ozone_data_latitude - long_name = ozone data latitude - units = deg - dimensions = (number_of_latitudes_in_ozone_data) - type = real - kind = kind_phys - intent = in -[ddy] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[ozplout] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_dimension,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) - type = real - kind = kind_phys - intent = out -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - ######################################################################## [ccpp-arg-table] name = ozphys_2015_run @@ -271,7 +68,7 @@ type = real kind = kind_phys intent = in -[prdout] +[oz_data] standard_name = ozone_forcing long_name = ozone forcing data units = mixed diff --git a/physics/ozphys_time_vary.F90 b/physics/ozphys_time_vary.F90 new file mode 100644 index 000000000..5b36f88b9 --- /dev/null +++ b/physics/ozphys_time_vary.F90 @@ -0,0 +1,177 @@ +! ########################################################################################### +!> \file ozphys_time_vary.F90 +!! +! ########################################################################################### +module ozphys_time_vary + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec + implicit none + public ozphys_time_vary_init, ozphys_time_vary_timestep_init +contains + +! ########################################################################################### +!>\defgroup GFS Ozone Photochemistry (2015) Module +!! This module contains the CCPP-compliant Ozone 2015 photochemistry scheme. +!> @{ +!> \section arg_table_ozphys_time_vary_init Argument Table +!! \htmlinclude ozphys_time_vary_init.html +!! +! ########################################################################################### + subroutine ozphys_time_vary_init(oz_phys, nPts, latsozp, oz_lat, dlat, jindx1, jindx2, & + ddy, errmsg, errflg) + ! Inputs + logical, intent(in) :: & + oz_phys ! Control flag for NRL ozone scheme + integer, intent(in) :: & + nPts, & ! Horizontal dimension + latsozp ! Number of latitudes in ozone data + real(kind_phys), intent(in), dimension(:) :: & + oz_lat, & ! Latitudes of ozone data + dlat ! Latitudes of grid + ! Outputs + integer, intent(inout), dimension(:) :: & + jindx1, & ! Interpolation index (low) for ozone data + jindx2 ! Interpolation index (high) for ozone data + real(kind_phys), intent(inout), dimension(:) :: & + ddy ! Interpolation high index for ozone data + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Local + integer i,j + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Sanity check + if (.not.oz_phys) then + write (errmsg,'(*(a))') 'Logic error: oz_phys == .false.' + errflg = 1 + return + endif + + ! Set indices + do j=1,nPts + jindx2(j) = latsozp + 1 + do i=1,latsozp + if (dlat(j) < oz_lat(i)) then + jindx2(j) = i + exit + endif + enddo + jindx1(j) = max(jindx2(j)-1,1) + jindx2(j) = min(jindx2(j),latsozp) + if (jindx2(j) .ne. jindx1(j)) then + ddy(j) = (dlat(j) - oz_lat(jindx1(j))) / (oz_lat(jindx2(j)) - oz_lat(jindx1(j))) + else + ddy(j) = 1.0 + endif + enddo + + end subroutine ozphys_time_vary_init + +! ########################################################################################### +!> \section arg_table_ozphys_time_vary_timestep_init Argument Table +!! \htmlinclude ozphys_time_vary_timestep_init.html +!! +! ########################################################################################### + subroutine ozphys_time_vary_timestep_init(nPts, idate, fhour, jindx1, jindx2, latsozp, & + levozp, oz_coeff, timeoz, ozplin, oz_time, oz_lat, ddy, oz_data, errmsg, errflg) + ! Inputs + integer, intent(in) :: & + nPts, & ! Horizontal dimension + latsozp, & ! Number of latitudes in ozone data + levozp, & ! Number of vertical layers in ozone data + oz_coeff, & ! Number of coefficients in ozone data + timeoz ! Number of times in ozone data + integer, intent(in),dimension(:) :: & + idate, & ! Initial date with different size and ordering + jindx1, & ! Interpolation index (low) for ozone + jindx2 ! Interpolation index (high) for ozone + real(kind_phys), intent(in) :: & + fhour ! Forecast hour + real(kind_phys), intent(in), dimension(:) :: & + ddy, & ! Interpolation high index for ozone data + oz_lat, & ! Latitudes for ozone data + oz_time ! Time for ozone data + real(kind_phys), intent(in), dimension(:,:,:,:) :: & + ozplin ! Ozone data + + ! Outputs + real(kind_phys), intent(inout), dimension(:,:,:) :: & + oz_data ! Ozone forcing data + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Local + integer :: idat(8),jdat(8),iday,j,j1,j2,l,nc,n1,n2,jdow,jdoy,& + jday,w3kindreal,w3kindint + real(kind_phys) :: tem, tx1, tx2, rjday + real(8) :: rinc(5) + real(4) :: rinc4(5) + !real(kind_dbl_prec) :: rinc(5) + !real(kind_sngl_prec) :: rinc4(5) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! + idat=0 + idat(1)=idate(4) + idat(2)=idate(2) + idat(3)=idate(3) + idat(5)=idate(1) + rinc=0. + rinc(2)=fhour + call w3kind(w3kindreal,w3kindint) + if(w3kindreal==4) then + rinc4=rinc + CALL w3movdat(rinc4,idat,jdat) + else + CALL w3movdat(rinc,idat,jdat) + endif + ! + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + IF (RJDAY < oz_time(1)) RJDAY = RJDAY + 365. + ! + n2 = timeoz + 1 + do j=2,timeoz + if (rjday < oz_time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + + tx1 = (oz_time(n2) - rjday) / (oz_time(n2) - oz_time(n1)) + tx2 = 1.0 - tx1 + + if (n2 > timeoz) n2 = n2 - timeoz + ! + do nc=1,oz_coeff + do L=1,levozp + do J=1,npts + J1 = jindx1(J) + J2 = jindx2(J) + TEM = 1.0 - ddy(J) + oz_data(j,L,nc) = tx1*(TEM*ozplin(J1,L,nc,n1)+ddy(J)*ozplin(J2,L,nc,n1)) & + + tx2*(TEM*ozplin(J1,L,nc,n2)+ddy(J)*ozplin(J2,L,nc,n2)) + enddo + enddo + enddo + + ! + return + + end subroutine ozphys_time_vary_timestep_init +!> @} +end module ozphys_time_vary diff --git a/physics/ozphys_time_vary.meta b/physics/ozphys_time_vary.meta new file mode 100644 index 000000000..93aa4a3b0 --- /dev/null +++ b/physics/ozphys_time_vary.meta @@ -0,0 +1,207 @@ +[ccpp-table-properties] + name = ozphys_time_vary + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = ozphys_time_vary_init + type = scheme +[nPts] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[latsozp] + standard_name = number_of_latitudes_in_ozone_data + long_name = number of latitude in ozone data + units = count + dimensions = () + type = integer + intent = in +[oz_phys] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[oz_lat] + standard_name = ozone_data_latitude + long_name = ozone data latitude + units = deg + dimensions = (number_of_latitudes_in_ozone_data) + type = real + kind = kind_phys + intent = in +[dlat] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[jindx1] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[jindx2] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[ddy] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = ozphys_time_vary_timestep_init + type = scheme +[nPts] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[idate] + standard_name = date_and_time_at_model_initialization_in_united_states_order + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[jindx1] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[jindx2] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[latsozp] + standard_name = number_of_latitudes_in_ozone_data + long_name = number of latitude in ozone data + units = count + dimensions = () + type = integer + intent = in +[levozp] + standard_name = number_of_levels_in_ozone_data + long_name = number of levels in ozone data + units = count + dimensions = () + type = integer + intent = in +[oz_coeff] + standard_name = number_of_coefficients_in_ozone_data + long_name = number of coefficients in ozone data + units = count + dimensions = () + type = integer + intent = in +[timeoz] + standard_name = number_of_times_in_ozone_data + long_name = number of times in ozone data + units = count + dimensions = () + type = integer + intent = in +[ozplin] + standard_name = ozone_data + long_name = ozone data + units = 1 + dimensions = (number_of_latitudes_in_ozone_data,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data,number_of_times_in_ozone_data) + type = real + kind = kind_phys + intent = in +[oz_time] + standard_name = ozone_data_time + long_name = ozone data time + units = none + dimensions = (13) + type = real + kind = kind_phys + intent = in +[oz_lat] + standard_name = ozone_data_latitude + long_name = ozone data latitude + units = deg + dimensions = (number_of_latitudes_in_ozone_data) + type = real + kind = kind_phys + intent = in +[ddy] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[oz_data] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_dimension,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out From 0bfac2ac51d8c460b84cc49fd5240407bcaea6ba Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 2 Aug 2023 17:03:36 +0000 Subject: [PATCH 018/132] Some cleanup. Now working --- physics/GFS_rrtmg_pre.F90 | 2 +- physics/ozphys_2015.F90 | 52 +++++++++++++++++++++++++++++++---- physics/ozphys_2015.meta | 34 +++++++++++++++++++++++ physics/ozphys_time_vary.F90 | 22 ++++----------- physics/ozphys_time_vary.meta | 7 ----- 5 files changed, 87 insertions(+), 30 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 4a2c3b290..f2183919f 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -44,7 +44,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& gasvmr_o2, gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, & gasvmr_ccl4, gasvmr_cfc113, aerodp,ext550, clouds6, clouds7, clouds8, & clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, & - faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, rrfs_sd & + faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, rrfs_sd, & aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, latsozc, levozc, & blatc, dphiozc, errmsg, errflg) diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 index 82ade0cbd..110ba02e2 100644 --- a/physics/ozphys_2015.F90 +++ b/physics/ozphys_2015.F90 @@ -5,7 +5,7 @@ module ozphys_2015 use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec implicit none - public ozphys_2015_run + public ozphys_2015_init, ozphys_2015_run contains ! ########################################################################################### @@ -17,8 +17,6 @@ module ozphys_2015 !! \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by Naval !! Research Laboratory through CHEM2D chemistry model !! (McCormack et al. (2006) \cite mccormack_et_al_2006). -!! \section arg_table_ozphys_2015_run Argument Table -!! \htmlinclude ozphys_2015_run.html !! !> \section genal_ozphys_2015 GFS ozphys_2015_run General Algorithm !> - This code assumes that both prsl and po3 are from bottom to top @@ -28,13 +26,50 @@ module ozphys_2015 !!\author June 2015 - Shrinivas Moorthi !!\modified May 2023 - Dustin Swales ! ########################################################################################### - subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, oz_data, pl_coeff, & - delp, ldiag3d, dtend, dtidx, ntoz, index_of_process_prod_loss, & + +! ########################################################################################### +! SUBROUTINE ozphys_2015_init +! ########################################################################################### +!! \section arg_table_ozphys_2015_init Argument Table +!! \htmlinclude ozphys_2015_init.html +!! + subroutine ozphys_2015_init(oz_phys, errmsg, errflg) + ! Inputs + logical, intent(in) :: & + oz_phys + ! Outputs + character(len=*), intent(out) :: & + errmsg + integer, intent(out) :: & + errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Sanity check + if (.not.oz_phys) then + write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' + errflg = 1 + return + endif + + end subroutine ozphys_2015_init + +! ########################################################################################### +! SUBROUTINE ozphys_2015_run +! ########################################################################################### +!! \section arg_table_ozphys_2015_run Argument Table +!! \htmlinclude ozphys_2015_run.html +!! + subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_data, & + pl_coeff, delp, ldiag3d, dtend, dtidx, ntoz, index_of_process_prod_loss, & index_of_process_ozmix, index_of_process_temp, index_of_process_overhead_ozone, & con_g, errmsg, errflg) ! Inputs logical, intent(in) :: & + oz_phys, & ! ldiag3d ! Flag to output GFS diagnostic tendencies real(kind_phys),intent(in) :: & con_g ! Physical constant: Gravitational acceleration (ms-2) @@ -88,6 +123,13 @@ subroutine ozphys_2015_run ( im, levs, ko3, dt, oz, tin, po3, prsl, oz_data, pl_ errmsg = '' errflg = 0 + ! Sanity checkt + if (.not.oz_phys) then + write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' + errflg = 1 + return + endif + ! Are UFS diagnostic tendencies requested? If so, set up bookeeping indices... if(ldiag3d) then idtend(1) = dtidx(100+ntoz,index_of_process_prod_loss) ! was ozp1 diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index ea82defaa..4b19f2c04 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -3,10 +3,44 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = ozphys_2015_init + type = scheme +[oz_phys] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + ######################################################################## [ccpp-arg-table] name = ozphys_2015_run type = scheme +[oz_phys] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent diff --git a/physics/ozphys_time_vary.F90 b/physics/ozphys_time_vary.F90 index 5b36f88b9..a0a778c36 100644 --- a/physics/ozphys_time_vary.F90 +++ b/physics/ozphys_time_vary.F90 @@ -9,18 +9,16 @@ module ozphys_time_vary contains ! ########################################################################################### -!>\defgroup GFS Ozone Photochemistry (2015) Module -!! This module contains the CCPP-compliant Ozone 2015 photochemistry scheme. +!>\defgroup GFS Ozone Data Module +!! This module updates the ozone data used by physics. !> @{ !> \section arg_table_ozphys_time_vary_init Argument Table !! \htmlinclude ozphys_time_vary_init.html !! ! ########################################################################################### - subroutine ozphys_time_vary_init(oz_phys, nPts, latsozp, oz_lat, dlat, jindx1, jindx2, & + subroutine ozphys_time_vary_init(nPts, latsozp, oz_lat, dlat, jindx1, jindx2, & ddy, errmsg, errflg) ! Inputs - logical, intent(in) :: & - oz_phys ! Control flag for NRL ozone scheme integer, intent(in) :: & nPts, & ! Horizontal dimension latsozp ! Number of latitudes in ozone data @@ -44,13 +42,6 @@ subroutine ozphys_time_vary_init(oz_phys, nPts, latsozp, oz_lat, dlat, jindx1, j ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - ! Sanity check - if (.not.oz_phys) then - write (errmsg,'(*(a))') 'Logic error: oz_phys == .false.' - errflg = 1 - return - endif ! Set indices do j=1,nPts @@ -111,10 +102,8 @@ subroutine ozphys_time_vary_timestep_init(nPts, idate, fhour, jindx1, jindx2, la integer :: idat(8),jdat(8),iday,j,j1,j2,l,nc,n1,n2,jdow,jdoy,& jday,w3kindreal,w3kindint real(kind_phys) :: tem, tx1, tx2, rjday - real(8) :: rinc(5) - real(4) :: rinc4(5) - !real(kind_dbl_prec) :: rinc(5) - !real(kind_sngl_prec) :: rinc4(5) + real(kind_dbl_prec) :: rinc(5) + real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' @@ -169,7 +158,6 @@ subroutine ozphys_time_vary_timestep_init(nPts, idate, fhour, jindx1, jindx2, la enddo enddo - ! return end subroutine ozphys_time_vary_timestep_init diff --git a/physics/ozphys_time_vary.meta b/physics/ozphys_time_vary.meta index 93aa4a3b0..75b8b8e4f 100644 --- a/physics/ozphys_time_vary.meta +++ b/physics/ozphys_time_vary.meta @@ -21,13 +21,6 @@ dimensions = () type = integer intent = in -[oz_phys] - standard_name = flag_for_nrl_2015_ozone_scheme - long_name = flag for new (2015) ozone physics - units = flag - dimensions = () - type = logical - intent = in [oz_lat] standard_name = ozone_data_latitude long_name = ozone data latitude From bea77c8dd21b60b8af7603e494aed45abcccec40 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 10 Aug 2023 17:32:59 +0000 Subject: [PATCH 019/132] More reorganization. --- physics/GFS_physics_diagnostics.F90 | 97 +++++++++++++++++++ physics/GFS_physics_diagnostics.meta | 140 +++++++++++++++++++++++++++ physics/ozphys_2015.F90 | 80 ++++++--------- physics/ozphys_2015.meta | 91 +++++++---------- physics/ozphys_time_vary.F90 | 4 +- physics/physcons.F90 | 1 + 6 files changed, 300 insertions(+), 113 deletions(-) create mode 100644 physics/GFS_physics_diagnostics.F90 create mode 100644 physics/GFS_physics_diagnostics.meta diff --git a/physics/GFS_physics_diagnostics.F90 b/physics/GFS_physics_diagnostics.F90 new file mode 100644 index 000000000..0c6197bc2 --- /dev/null +++ b/physics/GFS_physics_diagnostics.F90 @@ -0,0 +1,97 @@ +! ########################################################################################### +!> \file GFS_physics_diagnostics.F90 +!! +! ########################################################################################### +module GFS_physics_diagnostics + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec + implicit none + public GFS_physics_diagnostics_init, GFS_physics_diagnostics_run +contains + +! ########################################################################################### +! SUBROUTINE GFS_physics_diagnostics_init +! ########################################################################################### +!! \section arg_table_GFS_physics_diagnostics_init Argument Table +!! \htmlinclude GFS_physics_diagnostics_init.html +!! + subroutine GFS_physics_diagnostics_init(errmsg, errflg) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + end subroutine GFS_physics_diagnostics_init + +! ########################################################################################### +! SUBROUTINE GFS_physics_diagnostics_run +! ########################################################################################### +!! \section arg_table_GFS_physics_diagnostics_run Argument Table +!! \htmlinclude GFS_physics_diagnostics_run.html +!! + subroutine GFS_physics_diagnostics_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip_ozmix, & + ip_temp, ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, dtend,& + errmsg, errflg) + ! Inputs + integer, intent(in) :: & + nCol, & ! Horizontal dimension + nLev, & ! Number of vertical layers + ntoz, & ! Index for ozone mixing ratio + ip_prod_loss, & ! Index for process in diagnostic tendency output + ip_ozmix, & ! Index for process in diagnostic tendency output + ip_temp, & ! Index for process in diagnostic tendency output + ip_overhead_ozone ! Index for process in diagnostic tendency output + integer, intent(in), dimension(:,:) :: & + dtidx ! Bookkeeping indices for GFS diagnostic tendencies + + ! Inputs (optional) + real(kind=kind_phys), intent(in), dimension(:,:), pointer, optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect + + ! Outputs + real(kind=kind_phys), intent(inout), dimension(:,:,:) :: & + dtend ! Diagnostic tendencies for state variables + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Locals + integer :: idtend + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! ####################################################################################### + ! + ! Ozone physics diagnostics + ! + ! ####################################################################################### + idtend = dtidx(100+ntoz,ip_prod_loss) + if (idtend >= 1 .and. associated(do3_dt_prd)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_prd + endif + ! + idtend = dtidx(100+ntoz,ip_ozmix) + if (idtend >= 1 .and. associated(do3_dt_ozmx)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_ozmx + endif + ! + idtend = dtidx(100+ntoz,ip_temp) + if (idtend >= 1 .and. associated(do3_dt_temp)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_temp + endif + ! + idtend = dtidx(100+ntoz,ip_overhead_ozone) + if (idtend >= 1 .and. associated(do3_dt_ohoz)) then + dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_ohoz + endif + + end subroutine GFS_physics_diagnostics_run + +end module GFS_physics_diagnostics diff --git a/physics/GFS_physics_diagnostics.meta b/physics/GFS_physics_diagnostics.meta new file mode 100644 index 000000000..b6036b0c9 --- /dev/null +++ b/physics/GFS_physics_diagnostics.meta @@ -0,0 +1,140 @@ +[ccpp-table-properties] + name = GFS_physics_diagnostics + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = GFS_physics_diagnostics_init + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = GFS_physics_diagnostics_run + type = scheme +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[nLev] + standard_name = vertical_layer_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + type = real + kind = kind_phys + intent = inout +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in +[ip_prod_loss] + standard_name = index_of_production_and_loss_process_in_cumulative_change_index + long_name = index of production and loss effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ip_ozmix] + standard_name = index_of_ozone_mixing_ratio_process_in_cumulative_change_index + long_name = index of ozone mixing ratio effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ip_temp] + standard_name = index_of_temperature_process_in_cumulative_change_index + long_name = index of temperature effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ip_overhead_ozone] + standard_name = index_of_overhead_process_in_cumulative_change_index + long_name = index of overhead ozone effect in photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[do3_dt_prd] + standard_name = ozone_tendency_due_to_production_and_loss_rate + long_name = ozone tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[do3_dt_ozmx] + standard_name = ozone_tendency_due_to_ozone_mixing_ratio + long_name = ozone tendency due to ozone mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[do3_dt_temp] + standard_name = ozone_tendency_due_to_temperature + long_name = ozone tendency due to temperature + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[do3_dt_ohoz] + standard_name = ozone_tendency_due_to_overhead_ozone_column + long_name = ozone tendency due to overhead ozone column + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 index 110ba02e2..9898c71e4 100644 --- a/physics/ozphys_2015.F90 +++ b/physics/ozphys_2015.F90 @@ -63,42 +63,35 @@ end subroutine ozphys_2015_init !! \htmlinclude ozphys_2015_run.html !! subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_data, & - pl_coeff, delp, ldiag3d, dtend, dtidx, ntoz, index_of_process_prod_loss, & - index_of_process_ozmix, index_of_process_temp, index_of_process_overhead_ozone, & - con_g, errmsg, errflg) + pl_coeff, delp, con_1ovg, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) ! Inputs logical, intent(in) :: & - oz_phys, & ! - ldiag3d ! Flag to output GFS diagnostic tendencies + oz_phys ! Flag for ozone_physics_2015 scheme. real(kind_phys),intent(in) :: & - con_g ! Physical constant: Gravitational acceleration (ms-2) + con_1ovg ! Physical constant: One divided by gravitational acceleration (m-1 s2) integer, intent(in) :: & - im, & ! Horizontal dimension - levs, & ! Number of vertical layers - ko3, & ! Number of vertical layers in ozone forcing data - pl_coeff, & ! Number of coefficients in ozone forcing data - ntoz, & ! Index for ozone mixing ratio - index_of_process_prod_loss, & ! Index for process in diagnostic tendency output - index_of_process_ozmix, & ! Index for process in diagnostic tendency output - index_of_process_temp, & ! Index for process in diagnostic tendency output - index_of_process_overhead_ozone ! Index for process in diagnostic tendency output - integer, intent(in), dimension(:,:) :: & - dtidx ! Bookkeeping indices for GFS diagnostic tendencies + im, & ! Horizontal dimension + levs, & ! Number of vertical layers + ko3, & ! Number of vertical layers in ozone forcing data + pl_coeff ! Number of coefficients in ozone forcing data real(kind_phys), intent(in) :: & - dt ! Physics timestep (seconds) + dt ! Physics timestep (seconds) real(kind_phys), intent(in), dimension(:) :: & - po3 ! Natural log of ozone forcing data pressure levels + po3 ! Natural log of ozone forcing data pressure levels real(kind_phys), intent(in), dimension(:,:) :: & - prsl, & ! Air-pressure (Pa) - tin, & ! Temperature of new-state (K) - delp ! Difference between mid-layer pressures (Pa) + prsl, & ! Air-pressure (Pa) + tin, & ! Temperature of new-state (K) + delp ! Difference between mid-layer pressures (Pa) real(kind_phys), intent(in), dimension(:,:,:) :: & - oz_data ! Ozone forcing data + oz_data ! Ozone forcing data - ! In/Outs - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: & - dtend ! Diagnostic tendencies for state variables + ! Outputs (optional) + real(kind=kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect ! Outputs real(kind=kind_phys), intent(inout), dimension(:,:) :: & @@ -110,9 +103,7 @@ subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_d ! Locals integer :: k, kmax, kmin, l, i, j - integer, dimension(4) :: idtend logical, dimension(im) :: flg - real :: gravi real(kind_phys) :: pmax, pmin, tem, temp real(kind_phys), dimension(im) :: wk1, wk2, wk3, ozib real(kind_phys), dimension(im,pl_coeff) :: prod @@ -130,19 +121,8 @@ subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_d return endif - ! Are UFS diagnostic tendencies requested? If so, set up bookeeping indices... - if(ldiag3d) then - idtend(1) = dtidx(100+ntoz,index_of_process_prod_loss) ! was ozp1 - idtend(2) = dtidx(100+ntoz,index_of_process_ozmix) ! was ozp2 - idtend(3) = dtidx(100+ntoz,index_of_process_temp) ! was ozp3 - idtend(4) = dtidx(100+ntoz,index_of_process_overhead_ozone) ! was ozp4 - else - idtend=0 - endif - ! Temporaries ozi = oz - gravi=1.0/con_g colo3(:,levs+1) = 0.0 coloz(:,levs+1) = 0.0 @@ -194,8 +174,8 @@ subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_d enddo enddo do i=1,im - colo3(i,l) = colo3(i,l+1) + ozi(i,l) * delp(i,l)*gravi - coloz(i,l) = coloz(i,l+1) + prod(i,6) * delp(i,l)*gravi + colo3(i,l) = colo3(i,l+1) + ozi(i,l) * delp(i,l)*con_1ovg + coloz(i,l) = coloz(i,l+1) + prod(i,6) * delp(i,l)*con_1ovg prod(i,2) = min(prod(i,2), 0.0) enddo do i=1,im @@ -204,18 +184,12 @@ subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_d + prod(i,4) * (colo3(i,l)-coloz(i,l)) oz(i,l) = (ozib(i) + tem*dt) / (1.0 - prod(i,2)*dt) enddo - if(idtend(1)>=1) then - dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + (prod(:,1)-prod(:,2)*prod(:,6))*dt - endif - if(idtend(2)>=1) then - dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + (oz(:,l) - ozib(:)) - endif - if(idtend(3)>=1) then - dtend(:,l,idtend(3)) = dtend(:,l,idtend(3)) + prod(:,3)*(tin(:,l)-prod(:,5))*dt - endif - if(idtend(4)>=1) then - dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + prod(:,4) * (colo3(:,l)-coloz(:,l))*dt - endif + + ! Diagnostics (optional) + if (associated(do3_dt_prd)) do3_dt_prd(:,l) = (prod(:,1)-prod(:,2)*prod(:,6))*dt + if (associated(do3_dt_ozmx)) do3_dt_ozmx(:,l) = (oz(:,l) - ozib(:)) + if (associated(do3_dt_temp)) do3_dt_temp(:,l) = prod(:,3)*(tin(:,l)-prod(:,5))*dt + if (associated(do3_dt_ohoz)) do3_dt_ohoz(:,l) = prod(:,4) * (colo3(:,l)-coloz(:,l))*dt enddo return diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 4b19f2c04..1d8fba74e 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -125,71 +125,46 @@ type = real kind = kind_phys intent = in -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for calculating 3-D diagnostic fields - units = flag +[con_1ovg] + standard_name = one_divided_by_the_gravitational_acceleration + long_name = inverse of gravitational acceleration + units = s2 m-1 dimensions = () - type = logical + type = real + kind = kind_phys intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) +[do3_dt_prd] + standard_name = ozone_tendency_due_to_production_and_loss_rate + long_name = ozone tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = inout -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[ntoz] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in -[index_of_process_prod_loss] - standard_name = index_of_production_and_loss_process_in_cumulative_change_index - long_name = index of production and loss effect in photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_ozmix] - standard_name = index_of_ozone_mixing_ratio_process_in_cumulative_change_index - long_name = index of ozone mixing ratio effect in photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_temp] - standard_name = index_of_temperature_process_in_cumulative_change_index - long_name = index of temperature effect in photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_overhead_ozone] - standard_name = index_of_overhead_process_in_cumulative_change_index - long_name = index of overhead ozone effect in photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () +[do3_dt_ozmx] + standard_name = ozone_tendency_due_to_ozone_mixing_ratio + long_name = ozone tendency due to ozone mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout +[do3_dt_temp] + standard_name = ozone_tendency_due_to_temperature + long_name = ozone tendency due to temperature + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[do3_dt_ohoz] + standard_name = ozone_tendency_due_to_overhead_ozone_column + long_name = ozone tendency due to overhead ozone column + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/ozphys_time_vary.F90 b/physics/ozphys_time_vary.F90 index a0a778c36..ddac1dcd4 100644 --- a/physics/ozphys_time_vary.F90 +++ b/physics/ozphys_time_vary.F90 @@ -16,8 +16,8 @@ module ozphys_time_vary !! \htmlinclude ozphys_time_vary_init.html !! ! ########################################################################################### - subroutine ozphys_time_vary_init(nPts, latsozp, oz_lat, dlat, jindx1, jindx2, & - ddy, errmsg, errflg) + subroutine ozphys_time_vary_init(nPts, latsozp, oz_lat, dlat, jindx1, jindx2, ddy, & + errmsg, errflg) ! Inputs integer, intent(in) :: & nPts, & ! Horizontal dimension diff --git a/physics/physcons.F90 b/physics/physcons.F90 index e7ec8fb77..19a03ef20 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -97,6 +97,7 @@ module physcons real(kind=kind_phys),parameter:: con_dldt =con_cvap-con_cliq real(kind=kind_phys),parameter:: con_xpona =-con_dldt/con_rv real(kind=kind_phys),parameter:: con_xponb =-con_dldt/con_rv+con_hvap/(con_rv*con_ttp) + real(kind=kind_phys),parameter:: con_1ovg = 1._kind_phys/con_g !> \name Other Physics/Chemistry constants (source: 2002 CODATA) real(kind=kind_phys),parameter:: con_c =2.99792458e+8_kind_phys !< speed of light (\f$m/s\f$) From a03c68443ccc2d3debc0b23b23843dfd027d6d7b Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Thu, 24 Aug 2023 14:46:44 +0000 Subject: [PATCH 020/132] Change 1D GS arrays from fixed size to allocated --- physics/module_mp_nssl_2mom.F90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/module_mp_nssl_2mom.F90 index cac1218a9..20239833a 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/module_mp_nssl_2mom.F90 @@ -2326,7 +2326,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(its:ite, 1, na) :: xfall real, dimension(kts:kte, nproc) :: thproclocal integer, parameter :: nor = 0, ng = 0 - integer :: nx,ny,nz + integer :: nx,ny,nz,ngs integer ix,jy,kz,i,j,k,il,n integer :: infdo real :: ssival, ssifac, t8s, t9s, qvapor @@ -2915,6 +2915,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! ENDIF ! .false. + + ngs = 128 + IF ( isedonly /= 1 ) THEN ! call nssl_2mom_gs: main gather-scatter routine to calculate microphysics @@ -2939,7 +2942,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & timevtcalc,axtra2d, makediag & & ,has_wetscav, rainprod2d, evapprod2d & & ,errmsg,errflg & - & ,elec2,its,ids,ide,jds,jde & + & ,elec2,its,ids,ide,jds,jde,ngs & & ) @@ -2964,7 +2967,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & ,an,dn1,t77 & & ,pn,wn & & ,axtra2d, makediag & - & ,ssat,t00,t77,flag_qndrop) + & ,ssat,t00,t77,flag_qndrop,ngs) ! recalculate dn1 after temperature changes DO kz = kts,kte @@ -8999,7 +9002,7 @@ SUBROUTINE NUCOND & & ,an,dn,p2 & & ,pn,w & & ,axtra,io_flag & - & ,ssfilt,t00,t77,flag_qndrop & + & ,ssfilt,t00,t77,flag_qndrop,ngs & & ) @@ -9064,7 +9067,7 @@ SUBROUTINE NUCOND & real, parameter :: cwmas20 = 1000.*0.523599*(2.*20.e-6)**3 ! mass of 20-micron radius droplet, for sat. adj. integer nxmpb,nzmpb,nxz integer mgs,ngs,numgs,inumgs - parameter (ngs=500) +! parameter (ngs=1 ) integer ngscnt,igs(ngs),kgs(ngs) integer kgsp(ngs),kgsm(ngs) integer nsvcnt @@ -9095,7 +9098,7 @@ SUBROUTINE NUCOND & integer ifilt ! =1 to filter ssat, =0 to set ssfilt=ssat parameter ( ifilt = 0 ) real temp1,temp2 ! ,ssold - real :: ssmax(ngs) = 0.0 ! maximum SS experienced by a parcel + real :: ssmax(ngs) ! maximum SS experienced by a parcel real ssmx real dnnet,dqnet ! real cnu,rnu,snu,cinu @@ -11598,7 +11601,7 @@ subroutine nssl_2mom_gs & & ,timevtcalc,axtra,io_flag & & , has_wetscav,rainprod2d, evapprod2d & & ,errmsg,errflg & - & ,elec,its,ids,ide,jds,jde & + & ,elec,its,ids,ide,jds,jde,ngs & & ) @@ -11830,7 +11833,7 @@ subroutine nssl_2mom_gs & ! integer nxmpb,nzmpb,nxz integer jgs,mgs,ngs,numgs - parameter (ngs=500) !500) +! parameter (ngs=1 ) !500) integer, parameter :: ngsz = 500 integer ntt parameter (ntt=300) From c31f9207d1d75f4a42e32404ba7ecad264f90404 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 1 Sep 2023 17:50:08 +0000 Subject: [PATCH 021/132] Reorganization --- .gitmodules | 2 +- physics/{ => CONV/CCC}/cu_c3_deep.F90 | 0 physics/{ => CONV/CCC}/cu_c3_driver.F90 | 0 physics/{ => CONV/CCC}/cu_c3_driver.meta | 2 +- physics/{ => CONV/CCC}/cu_c3_driver_post.F90 | 0 physics/{ => CONV/CCC}/cu_c3_driver_post.meta | 2 +- physics/{ => CONV/CCC}/cu_c3_driver_pre.F90 | 0 physics/{ => CONV/CCC}/cu_c3_driver_pre.meta | 2 +- physics/{ => CONV/CCC}/cu_c3_sh.F90 | 0 physics/{ => CONV/Chikira_Sugiyama}/cs_conv.F90 | 0 physics/{ => CONV/Chikira_Sugiyama}/cs_conv.meta | 2 +- .../{ => CONV/Chikira_Sugiyama}/cs_conv_aw_adj.F90 | 0 .../{ => CONV/Chikira_Sugiyama}/cs_conv_aw_adj.meta | 2 +- physics/{ => CONV/Chikira_Sugiyama}/cs_conv_post.F90 | 0 physics/{ => CONV/Chikira_Sugiyama}/cs_conv_post.meta | 2 +- physics/{ => CONV/Chikira_Sugiyama}/cs_conv_pre.F90 | 0 physics/{ => CONV/Chikira_Sugiyama}/cs_conv_pre.meta | 2 +- physics/{ => CONV/Grell_Freitas}/cu_gf_deep.F90 | 0 physics/{ => CONV/Grell_Freitas}/cu_gf_driver.F90 | 0 physics/{ => CONV/Grell_Freitas}/cu_gf_driver.meta | 2 +- .../{ => CONV/Grell_Freitas}/cu_gf_driver_post.F90 | 0 .../{ => CONV/Grell_Freitas}/cu_gf_driver_post.meta | 2 +- physics/{ => CONV/Grell_Freitas}/cu_gf_driver_pre.F90 | 0 .../{ => CONV/Grell_Freitas}/cu_gf_driver_pre.meta | 2 +- physics/{ => CONV/Grell_Freitas}/cu_gf_sh.F90 | 0 physics/{ => CONV/RAS}/rascnv.F90 | 0 physics/{ => CONV/RAS}/rascnv.meta | 2 +- physics/{ => CONV/SAMF}/samfaerosols.F | 0 physics/{ => CONV/SAMF}/samfdeepcnv.f | 0 physics/{ => CONV/SAMF}/samfdeepcnv.meta | 2 +- physics/{ => CONV/SAMF}/samfshalcnv.f | 0 physics/{ => CONV/SAMF}/samfshalcnv.meta | 2 +- physics/{ => CONV/SAS}/sascnvn.F | 0 physics/{ => CONV/SAS}/sascnvn.meta | 2 +- physics/{ => CONV/SAS}/shalcnv.F | 0 physics/{ => CONV/SAS}/shalcnv.meta | 2 +- physics/{ => CONV/nTiedtke}/cu_ntiedtke.F90 | 0 physics/{ => CONV/nTiedtke}/cu_ntiedtke.meta | 2 +- physics/{ => CONV/nTiedtke}/cu_ntiedtke_post.F90 | 0 physics/{ => CONV/nTiedtke}/cu_ntiedtke_post.meta | 2 +- physics/{ => CONV/nTiedtke}/cu_ntiedtke_pre.F90 | 0 physics/{ => CONV/nTiedtke}/cu_ntiedtke_pre.meta | 2 +- physics/{ => CONV}/progsigma_calc.f90 | 0 physics/{ => GWD}/cires_orowam2017.f | 0 physics/{ => GWD}/cires_tauamf_data.F90 | 0 physics/{ => GWD}/cires_ugwp.F90 | 0 physics/{ => GWD}/cires_ugwp.meta | 2 +- physics/{ => GWD}/cires_ugwp_initialize.F90 | 0 physics/{ => GWD}/cires_ugwp_module.F90 | 0 physics/{ => GWD}/cires_ugwp_post.F90 | 0 physics/{ => GWD}/cires_ugwp_post.meta | 2 +- physics/{ => GWD}/cires_ugwp_triggers.F90 | 0 physics/{ => GWD}/cires_ugwpv1_initialize.F90 | 0 physics/{ => GWD}/cires_ugwpv1_module.F90 | 0 physics/{ => GWD}/cires_ugwpv1_oro.F90 | 0 physics/{ => GWD}/cires_ugwpv1_solv2.F90 | 0 physics/{ => GWD}/cires_ugwpv1_sporo.F90 | 0 physics/{ => GWD}/cires_ugwpv1_triggers.F90 | 0 physics/{ => GWD}/drag_suite.F90 | 0 physics/{ => GWD}/drag_suite.meta | 2 +- physics/{ => GWD}/gwdc.f | 0 physics/{ => GWD}/gwdc.meta | 2 +- physics/{ => GWD}/gwdc_post.f | 0 physics/{ => GWD}/gwdc_post.meta | 2 +- physics/{ => GWD}/gwdc_pre.f | 0 physics/{ => GWD}/gwdc_pre.meta | 2 +- physics/{ => GWD}/gwdps.f | 0 physics/{ => GWD}/gwdps.meta | 2 +- physics/{ => GWD}/rayleigh_damp.f | 0 physics/{ => GWD}/rayleigh_damp.meta | 2 +- physics/{ => GWD}/ugwp_driver_v0.F | 0 physics/{ => GWD}/ugwpv1_gsldrag.F90 | 0 physics/{ => GWD}/ugwpv1_gsldrag.meta | 2 +- physics/{ => GWD}/ugwpv1_gsldrag_post.F90 | 0 physics/{ => GWD}/ugwpv1_gsldrag_post.meta | 2 +- physics/{ => GWD}/unified_ugwp.F90 | 0 physics/{ => GWD}/unified_ugwp.meta | 8 ++++---- physics/{ => GWD}/unified_ugwp_post.F90 | 0 physics/{ => GWD}/unified_ugwp_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_DCNV_generic_post.F90 | 0 .../GFS}/GFS_DCNV_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_DCNV_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_DCNV_generic_pre.meta | 2 +- .../{ => Interstitials/GFS}/GFS_GWD_generic_post.F90 | 0 .../{ => Interstitials/GFS}/GFS_GWD_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_GWD_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_GWD_generic_pre.meta | 2 +- .../{ => Interstitials/GFS}/GFS_MP_generic_post.F90 | 0 .../{ => Interstitials/GFS}/GFS_MP_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_MP_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_MP_generic_pre.meta | 2 +- .../GFS}/GFS_PBL_generic_common.F90 | 0 .../{ => Interstitials/GFS}/GFS_PBL_generic_post.F90 | 0 .../{ => Interstitials/GFS}/GFS_PBL_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_PBL_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_PBL_generic_pre.meta | 2 +- .../{ => Interstitials/GFS}/GFS_SCNV_generic_post.F90 | 0 .../GFS}/GFS_SCNV_generic_post.meta | 2 +- .../{ => Interstitials/GFS}/GFS_SCNV_generic_pre.F90 | 0 .../{ => Interstitials/GFS}/GFS_SCNV_generic_pre.meta | 2 +- .../{ => Interstitials/GFS}/GFS_cloud_diagnostics.F90 | 0 .../GFS}/GFS_cloud_diagnostics.meta | 3 ++- physics/{ => Interstitials/GFS}/GFS_debug.F90 | 0 physics/{ => Interstitials/GFS}/GFS_debug.meta | 2 +- .../GFS}/GFS_phys_time_vary.fv3.F90 | 0 .../GFS}/GFS_phys_time_vary.fv3.meta | 11 +++++++++-- .../GFS}/GFS_phys_time_vary.scm.F90 | 0 .../GFS}/GFS_phys_time_vary.scm.meta | 11 +++++++++-- .../{ => Interstitials/GFS}/GFS_rad_time_vary.fv3.F90 | 0 .../GFS}/GFS_rad_time_vary.fv3.meta | 3 ++- .../{ => Interstitials/GFS}/GFS_rad_time_vary.scm.F90 | 0 .../GFS}/GFS_rad_time_vary.scm.meta | 3 ++- .../{ => Interstitials/GFS}/GFS_radiation_surface.F90 | 0 .../GFS}/GFS_radiation_surface.meta | 5 ++++- physics/{ => Interstitials/GFS}/GFS_rrtmg_post.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmg_post.meta | 4 +++- physics/{ => Interstitials/GFS}/GFS_rrtmg_pre.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmg_pre.meta | 10 +++++++--- physics/{ => Interstitials/GFS}/GFS_rrtmg_setup.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmg_setup.meta | 8 ++++++-- .../{ => Interstitials/GFS}/GFS_rrtmgp_cloud_mp.F90 | 0 .../{ => Interstitials/GFS}/GFS_rrtmgp_cloud_mp.meta | 5 ++++- .../GFS}/GFS_rrtmgp_cloud_overlap.F90 | 0 .../GFS}/GFS_rrtmgp_cloud_overlap.meta | 4 +++- physics/{ => Interstitials/GFS}/GFS_rrtmgp_post.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmgp_post.meta | 4 +++- physics/{ => Interstitials/GFS}/GFS_rrtmgp_pre.F90 | 1 - physics/{ => Interstitials/GFS}/GFS_rrtmgp_pre.meta | 5 +++-- physics/{ => Interstitials/GFS}/GFS_rrtmgp_setup.F90 | 0 physics/{ => Interstitials/GFS}/GFS_rrtmgp_setup.meta | 6 ++++-- physics/{ => Interstitials/GFS}/GFS_stochastics.F90 | 0 physics/{ => Interstitials/GFS}/GFS_stochastics.meta | 2 +- .../GFS}/GFS_suite_interstitial_1.F90 | 0 .../GFS}/GFS_suite_interstitial_1.meta | 2 +- .../GFS}/GFS_suite_interstitial_2.F90 | 0 .../GFS}/GFS_suite_interstitial_2.meta | 2 +- .../GFS}/GFS_suite_interstitial_3.F90 | 0 .../GFS}/GFS_suite_interstitial_3.meta | 2 +- .../GFS}/GFS_suite_interstitial_4.F90 | 0 .../GFS}/GFS_suite_interstitial_4.meta | 4 +++- .../GFS}/GFS_suite_interstitial_5.F90 | 0 .../GFS}/GFS_suite_interstitial_5.meta | 2 +- .../GFS}/GFS_suite_interstitial_phys_reset.F90 | 0 .../GFS}/GFS_suite_interstitial_phys_reset.meta | 2 +- .../GFS}/GFS_suite_interstitial_rad_reset.F90 | 0 .../GFS}/GFS_suite_interstitial_rad_reset.meta | 2 +- .../GFS}/GFS_suite_stateout_reset.F90 | 0 .../GFS}/GFS_suite_stateout_reset.meta | 2 +- .../GFS}/GFS_suite_stateout_update.F90 | 0 .../GFS}/GFS_suite_stateout_update.meta | 2 +- .../GFS}/GFS_surface_composites_inter.F90 | 0 .../GFS}/GFS_surface_composites_inter.meta | 2 +- .../GFS}/GFS_surface_composites_post.F90 | 0 .../GFS}/GFS_surface_composites_post.meta | 3 ++- .../GFS}/GFS_surface_composites_pre.F90 | 0 .../GFS}/GFS_surface_composites_pre.meta | 2 +- .../GFS}/GFS_surface_generic_post.F90 | 0 .../GFS}/GFS_surface_generic_post.meta | 2 +- .../GFS}/GFS_surface_generic_pre.F90 | 0 .../GFS}/GFS_surface_generic_pre.meta | 3 ++- .../GFS}/GFS_surface_loop_control_part1.F90 | 0 .../GFS}/GFS_surface_loop_control_part1.meta | 2 +- .../GFS}/GFS_surface_loop_control_part2.F90 | 0 .../GFS}/GFS_surface_loop_control_part2.meta | 2 +- .../{ => Interstitials/GFS}/GFS_time_vary_pre.fv3.F90 | 0 .../GFS}/GFS_time_vary_pre.fv3.meta | 3 ++- .../{ => Interstitials/GFS}/GFS_time_vary_pre.scm.F90 | 0 .../GFS}/GFS_time_vary_pre.scm.meta | 3 ++- physics/{ => Interstitials/GFS}/aerinterp.F90 | 0 physics/{ => Interstitials/GFS}/cnvc90.f | 0 physics/{ => Interstitials/GFS}/cnvc90.meta | 2 +- physics/{ => Interstitials/GFS}/dcyc2t3.f | 0 physics/{ => Interstitials/GFS}/dcyc2t3.meta | 2 +- physics/{ => Interstitials/GFS}/gcycle.F90 | 0 physics/{ => Interstitials/GFS}/iccn_def.F | 0 physics/{ => Interstitials/GFS}/iccninterp.F90 | 0 .../GFS}/maximum_hourly_diagnostics.F90 | 0 .../GFS}/maximum_hourly_diagnostics.meta | 2 +- physics/{ => Interstitials/GFS}/phys_tend.F90 | 0 physics/{ => Interstitials/GFS}/phys_tend.meta | 2 +- physics/{ => Interstitials/GFS}/scm_sfc_flux_spec.F90 | 0 .../{ => Interstitials/GFS}/scm_sfc_flux_spec.meta | 2 +- physics/{ => Interstitials/GFS}/sfcsub.F | 0 physics/{ => Interstitials/GFS}/sgscloud_radpost.F90 | 0 physics/{ => Interstitials/GFS}/sgscloud_radpost.meta | 2 +- physics/{ => Interstitials/GFS}/sgscloud_radpre.F90 | 0 physics/{ => Interstitials/GFS}/sgscloud_radpre.meta | 5 ++++- physics/{ => Land/CLM_lake}/clm_lake.f90 | 0 physics/{ => Land/CLM_lake}/clm_lake.meta | 2 +- physics/{ => Land/Flake}/flake.F90 | 0 physics/{ => Land/Flake}/flake_driver.F90 | 0 physics/{ => Land/Flake}/flake_driver.meta | 2 +- physics/{ => Land/Noah}/lsm_noah.f | 0 physics/{ => Land/Noah}/lsm_noah.meta | 3 ++- physics/{ => Land/Noah}/sflx.f | 0 physics/{ => Land/Noah}/surface_perturbation.F90 | 0 .../{ => Land/Noahmp}/module_sf_noahmp_glacier.F90 | 0 physics/{ => Land/Noahmp}/module_sf_noahmplsm.F90 | 0 physics/{ => Land/Noahmp}/noahmp_tables.f90 | 0 physics/{ => Land/Noahmp}/noahmpdrv.F90 | 0 physics/{ => Land/Noahmp}/noahmpdrv.meta | 2 +- physics/{ => Land/Noahmp}/noahmptable.tbl | 0 physics/{ => Land/RUC}/lsm_ruc.F90 | 0 physics/{ => Land/RUC}/lsm_ruc.meta | 2 +- physics/{ => Land/RUC}/module_sf_ruclsm.F90 | 0 physics/{ => Land/RUC}/module_soil_pre.F90 | 0 physics/{ => Land/RUC}/namelist_soilveg_ruc.F90 | 0 physics/{ => Land/RUC}/set_soilveg_ruc.F90 | 0 physics/{ => Land}/namelist_soilveg.f | 0 physics/{ => Land}/set_soilveg.f | 0 .../{ => MP/Ferrier_Aligo}/module_MP_FER_HIRES.F90 | 0 physics/{ => MP/Ferrier_Aligo}/mp_fer_hires.F90 | 0 physics/{ => MP/Ferrier_Aligo}/mp_fer_hires.meta | 2 +- physics/{ => MP/GFDL}/GFDL_parse_tracers.F90 | 0 physics/{ => MP/GFDL}/fv_sat_adj.F90 | 0 physics/{ => MP/GFDL}/fv_sat_adj.meta | 2 +- physics/{ => MP/GFDL}/gfdl_cloud_microphys.F90 | 0 physics/{ => MP/GFDL}/gfdl_cloud_microphys.meta | 2 +- physics/{ => MP/GFDL}/gfdl_sfc_layer.F90 | 0 physics/{ => MP/GFDL}/gfdl_sfc_layer.meta | 2 +- physics/{ => MP/GFDL}/module_gfdl_cloud_microphys.F90 | 0 physics/{ => MP/GFDL}/module_sf_exchcoef.f90 | 0 physics/{ => MP/GFDL}/multi_gases.F90 | 0 physics/{ => MP/Morrison_Gettelman}/aer_cloud.F | 0 physics/{ => MP/Morrison_Gettelman}/aerclm_def.F | 0 physics/{ => MP/Morrison_Gettelman}/cldmacro.F | 0 physics/{ => MP/Morrison_Gettelman}/cldwat2m_micro.F | 0 physics/{ => MP/Morrison_Gettelman}/m_micro.F90 | 0 physics/{ => MP/Morrison_Gettelman}/m_micro.meta | 2 +- physics/{ => MP/Morrison_Gettelman}/m_micro_post.F90 | 0 physics/{ => MP/Morrison_Gettelman}/m_micro_post.meta | 2 +- physics/{ => MP/Morrison_Gettelman}/m_micro_pre.F90 | 0 physics/{ => MP/Morrison_Gettelman}/m_micro_pre.meta | 2 +- physics/{ => MP/Morrison_Gettelman}/micro_mg2_0.F90 | 0 physics/{ => MP/Morrison_Gettelman}/micro_mg3_0.F90 | 0 .../{ => MP/Morrison_Gettelman}/micro_mg_utils.F90 | 0 physics/{ => MP/Morrison_Gettelman}/wv_saturation.F | 0 physics/{ => MP/NSSL}/module_mp_nssl_2mom.F90 | 0 physics/{ => MP/NSSL}/mp_nssl.F90 | 0 physics/{ => MP/NSSL}/mp_nssl.meta | 2 +- physics/{ => MP/Thompson}/module_mp_radar.F90 | 0 physics/{ => MP/Thompson}/module_mp_thompson.F90 | 0 .../module_mp_thompson_make_number_concentrations.F90 | 0 physics/{ => MP/Thompson}/mp_thompson.F90 | 0 physics/{ => MP/Thompson}/mp_thompson.meta | 2 +- physics/{ => MP/Thompson}/mp_thompson_post.F90 | 0 physics/{ => MP/Thompson}/mp_thompson_post.meta | 2 +- physics/{ => MP/Thompson}/mp_thompson_pre.F90 | 0 physics/{ => MP/Thompson}/mp_thompson_pre.meta | 2 +- physics/{ => MP/Zhao_Carr}/zhaocarr_gscond.f | 0 physics/{ => MP/Zhao_Carr}/zhaocarr_gscond.meta | 2 +- physics/{ => MP/Zhao_Carr}/zhaocarr_precpd.f | 0 physics/{ => MP/Zhao_Carr}/zhaocarr_precpd.meta | 2 +- physics/{ => MP}/calpreciptype.f90 | 0 physics/{ => NOTUSED}/gfs_phy_tracer_config.F | 0 physics/{ => NOTUSED}/gocart_tracer_config_stub.f | 0 physics/{ => NOTUSED}/rrtmg_lw_pre.F90 | 0 physics/{ => NOTUSED}/rrtmg_lw_pre.meta | 0 physics/{ => PBL/HEDMF}/hedmf.f | 0 physics/{ => PBL/HEDMF}/hedmf.meta | 2 +- physics/{ => PBL/MYJ}/module_BL_MYJPBL.F90 | 0 physics/{ => PBL/MYJ}/myjpbl_wrapper.F90 | 0 physics/{ => PBL/MYJ}/myjpbl_wrapper.meta | 2 +- physics/{ => PBL/MYNN_EDMF}/bl_mynn_common.f90 | 0 physics/{ => PBL/MYNN_EDMF}/module_bl_mynn.F90 | 0 physics/{ => PBL/MYNN_EDMF}/mynnedmf_wrapper.F90 | 0 physics/{ => PBL/MYNN_EDMF}/mynnedmf_wrapper.meta | 2 +- physics/{ => PBL/SATMEDMF}/mfscu.f | 0 physics/{ => PBL/SATMEDMF}/mfscuq.f | 0 physics/{ => PBL/SATMEDMF}/satmedmfvdif.F | 0 physics/{ => PBL/SATMEDMF}/satmedmfvdif.meta | 2 +- physics/{ => PBL/SATMEDMF}/satmedmfvdifq.F | 0 physics/{ => PBL/SATMEDMF}/satmedmfvdifq.meta | 2 +- physics/{ => PBL/SHOC}/moninshoc.f | 0 physics/{ => PBL/SHOC}/moninshoc.meta | 2 +- physics/{ => PBL/SHOC}/shoc.F90 | 0 physics/{ => PBL/SHOC}/shoc.meta | 2 +- physics/{ => PBL/YSU}/ysuvdif.F90 | 0 physics/{ => PBL/YSU}/ysuvdif.meta | 2 +- physics/{ => PBL}/mfpbl.f | 0 physics/{ => PBL}/mfpblt.f | 0 physics/{ => PBL}/mfpbltq.f | 0 physics/{ => PBL/saYSU}/shinhongvdif.F90 | 0 physics/{ => PBL/saYSU}/shinhongvdif.meta | 2 +- physics/{ => PBL}/tridi.f | 0 physics/{ => Radiation/RRTMG}/iounitdef.f | 0 physics/{ => Radiation/RRTMG}/module_bfmicrophysics.f | 0 physics/{ => Radiation/RRTMG}/rad_sw_pre.F90 | 0 physics/{ => Radiation/RRTMG}/rad_sw_pre.meta | 2 +- physics/{ => Radiation/RRTMG}/radcons.f90 | 0 physics/{ => Radiation/RRTMG}/radlw_datatb.f | 0 physics/{ => Radiation/RRTMG}/radlw_main.F90 | 0 physics/{ => Radiation/RRTMG}/radlw_main.meta | 2 +- physics/{ => Radiation/RRTMG}/radlw_param.f | 0 physics/{ => Radiation/RRTMG}/radlw_param.meta | 0 physics/{ => Radiation/RRTMG}/radsw_datatb.f | 0 physics/{ => Radiation/RRTMG}/radsw_main.F90 | 0 physics/{ => Radiation/RRTMG}/radsw_main.meta | 2 +- physics/{ => Radiation/RRTMG}/radsw_param.f | 0 physics/{ => Radiation/RRTMG}/radsw_param.meta | 0 .../{ => Radiation/RRTMG}/rrtmg_lw_cloud_optics.F90 | 0 physics/{ => Radiation/RRTMG}/rrtmg_lw_post.F90 | 0 physics/{ => Radiation/RRTMG}/rrtmg_lw_post.meta | 2 +- .../{ => Radiation/RRTMG}/rrtmg_sw_cloud_optics.F90 | 0 physics/{ => Radiation/RRTMG}/rrtmg_sw_post.F90 | 0 physics/{ => Radiation/RRTMG}/rrtmg_sw_post.meta | 2 +- .../{ => Radiation/RRTMGP}/rrtmgp_aerosol_optics.F90 | 0 .../{ => Radiation/RRTMGP}/rrtmgp_aerosol_optics.meta | 2 +- .../{ => Radiation/RRTMGP}/rrtmgp_lw_cloud_optics.F90 | 0 .../{ => Radiation/RRTMGP}/rrtmgp_lw_gas_optics.F90 | 0 physics/{ => Radiation/RRTMGP}/rrtmgp_lw_main.F90 | 0 physics/{ => Radiation/RRTMGP}/rrtmgp_lw_main.meta | 7 ++++--- physics/{ => Radiation/RRTMGP}/rrtmgp_sampling.F90 | 0 .../{ => Radiation/RRTMGP}/rrtmgp_sw_cloud_optics.F90 | 0 .../{ => Radiation/RRTMGP}/rrtmgp_sw_gas_optics.F90 | 0 physics/{ => Radiation/RRTMGP}/rrtmgp_sw_main.F90 | 0 physics/{ => Radiation/RRTMGP}/rrtmgp_sw_main.meta | 7 ++++--- physics/{ => Radiation}/mersenne_twister.f | 0 physics/{ => Radiation}/radiation_aerosols.f | 0 physics/{ => Radiation}/radiation_astronomy.f | 0 physics/{ => Radiation}/radiation_cloud_overlap.F90 | 0 physics/{ => Radiation}/radiation_clouds.f | 0 physics/{ => Radiation}/radiation_gases.f | 0 physics/{ => Radiation}/radiation_surface.f | 0 physics/{ => Radiation}/radiation_tools.F90 | 0 physics/{ => SFC_Layer/GFS_sfc}/date_def.f | 0 physics/{ => SFC_Layer/GFS_sfc}/module_nst_model.f90 | 0 .../{ => SFC_Layer/GFS_sfc}/module_nst_parameters.f90 | 0 .../{ => SFC_Layer/GFS_sfc}/module_nst_water_prop.f90 | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_cice.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_cice.meta | 3 ++- physics/{ => SFC_Layer/GFS_sfc}/sfc_diag.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_diag.meta | 3 ++- physics/{ => SFC_Layer/GFS_sfc}/sfc_diag_post.F90 | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_diag_post.meta | 3 ++- physics/{ => SFC_Layer/GFS_sfc}/sfc_diff.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_diff.meta | 3 ++- physics/{ => SFC_Layer/GFS_sfc}/sfc_nst.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_nst.meta | 2 +- physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_post.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_post.meta | 2 +- physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_pre.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_pre.meta | 2 +- physics/{ => SFC_Layer/GFS_sfc}/sfc_ocean.F | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_ocean.meta | 2 +- physics/{ => SFC_Layer/GFS_sfc}/sfc_sice.f | 0 physics/{ => SFC_Layer/GFS_sfc}/sfc_sice.meta | 3 ++- physics/{ => SFC_Layer/MYJ}/module_SF_JSFC.F90 | 0 physics/{ => SFC_Layer/MYJ}/myjsfc_wrapper.F90 | 0 physics/{ => SFC_Layer/MYJ}/myjsfc_wrapper.meta | 2 +- physics/{ => SFC_Layer/MYNN}/module_sf_mynn.F90 | 0 physics/{ => SFC_Layer/MYNN}/mynnsfc_wrapper.F90 | 0 physics/{ => SFC_Layer/MYNN}/mynnsfc_wrapper.meta | 2 +- physics/{ => h2o_photo}/h2o_def.f | 0 physics/{ => h2o_photo}/h2o_def.meta | 2 +- physics/{ => h2o_photo}/h2ointerp.f90 | 0 physics/{ => h2o_photo}/h2ophys.f | 0 physics/{ => h2o_photo}/h2ophys.meta | 2 +- physics/{ => hooks}/machine.F | 0 physics/{ => hooks}/machine.meta | 0 physics/{ => hooks}/physcons.F90 | 0 physics/{ => o3_photo}/ozinterp.f90 | 0 physics/{ => o3_photo}/ozne_def.f | 0 physics/{ => o3_photo}/ozne_def.meta | 2 +- physics/{ => o3_photo}/ozphys.f | 0 physics/{ => o3_photo}/ozphys.meta | 2 +- physics/{ => o3_photo}/ozphys_2015.f | 0 physics/{ => o3_photo}/ozphys_2015.meta | 2 +- physics/rte-rrtmgp | 1 - physics/smoke_dust/rrfs_smoke_postpbl.meta | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.meta | 2 +- physics/{ => tools}/funcphys.f90 | 0 physics/{ => tools}/get_phi_fv3.F90 | 0 physics/{ => tools}/get_phi_fv3.meta | 2 +- physics/{ => tools}/get_prs_fv3.F90 | 0 physics/{ => tools}/get_prs_fv3.meta | 2 +- 376 files changed, 208 insertions(+), 153 deletions(-) rename physics/{ => CONV/CCC}/cu_c3_deep.F90 (100%) rename physics/{ => CONV/CCC}/cu_c3_driver.F90 (100%) rename physics/{ => CONV/CCC}/cu_c3_driver.meta (99%) rename physics/{ => CONV/CCC}/cu_c3_driver_post.F90 (100%) rename physics/{ => CONV/CCC}/cu_c3_driver_post.meta (98%) rename physics/{ => CONV/CCC}/cu_c3_driver_pre.F90 (100%) rename physics/{ => CONV/CCC}/cu_c3_driver_pre.meta (98%) rename physics/{ => CONV/CCC}/cu_c3_sh.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv.meta (99%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_aw_adj.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_aw_adj.meta (99%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_post.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_post.meta (97%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_pre.F90 (100%) rename physics/{ => CONV/Chikira_Sugiyama}/cs_conv_pre.meta (99%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_deep.F90 (100%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver.F90 (100%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver.meta (99%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver_post.F90 (100%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver_post.meta (98%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver_pre.F90 (100%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_driver_pre.meta (98%) rename physics/{ => CONV/Grell_Freitas}/cu_gf_sh.F90 (100%) rename physics/{ => CONV/RAS}/rascnv.F90 (100%) rename physics/{ => CONV/RAS}/rascnv.meta (99%) rename physics/{ => CONV/SAMF}/samfaerosols.F (100%) rename physics/{ => CONV/SAMF}/samfdeepcnv.f (100%) rename physics/{ => CONV/SAMF}/samfdeepcnv.meta (99%) rename physics/{ => CONV/SAMF}/samfshalcnv.f (100%) rename physics/{ => CONV/SAMF}/samfshalcnv.meta (99%) rename physics/{ => CONV/SAS}/sascnvn.F (100%) rename physics/{ => CONV/SAS}/sascnvn.meta (99%) rename physics/{ => CONV/SAS}/shalcnv.F (100%) rename physics/{ => CONV/SAS}/shalcnv.meta (99%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke.F90 (100%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke.meta (99%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke_post.F90 (100%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke_post.meta (97%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke_pre.F90 (100%) rename physics/{ => CONV/nTiedtke}/cu_ntiedtke_pre.meta (98%) rename physics/{ => CONV}/progsigma_calc.f90 (100%) rename physics/{ => GWD}/cires_orowam2017.f (100%) rename physics/{ => GWD}/cires_tauamf_data.F90 (100%) rename physics/{ => GWD}/cires_ugwp.F90 (100%) rename physics/{ => GWD}/cires_ugwp.meta (99%) rename physics/{ => GWD}/cires_ugwp_initialize.F90 (100%) rename physics/{ => GWD}/cires_ugwp_module.F90 (100%) rename physics/{ => GWD}/cires_ugwp_post.F90 (100%) rename physics/{ => GWD}/cires_ugwp_post.meta (99%) rename physics/{ => GWD}/cires_ugwp_triggers.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_initialize.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_module.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_oro.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_solv2.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_sporo.F90 (100%) rename physics/{ => GWD}/cires_ugwpv1_triggers.F90 (100%) rename physics/{ => GWD}/drag_suite.F90 (100%) rename physics/{ => GWD}/drag_suite.meta (99%) rename physics/{ => GWD}/gwdc.f (100%) rename physics/{ => GWD}/gwdc.meta (99%) rename physics/{ => GWD}/gwdc_post.f (100%) rename physics/{ => GWD}/gwdc_post.meta (99%) rename physics/{ => GWD}/gwdc_pre.f (100%) rename physics/{ => GWD}/gwdc_pre.meta (99%) rename physics/{ => GWD}/gwdps.f (100%) rename physics/{ => GWD}/gwdps.meta (99%) rename physics/{ => GWD}/rayleigh_damp.f (100%) rename physics/{ => GWD}/rayleigh_damp.meta (99%) rename physics/{ => GWD}/ugwp_driver_v0.F (100%) rename physics/{ => GWD}/ugwpv1_gsldrag.F90 (100%) rename physics/{ => GWD}/ugwpv1_gsldrag.meta (99%) rename physics/{ => GWD}/ugwpv1_gsldrag_post.F90 (100%) rename physics/{ => GWD}/ugwpv1_gsldrag_post.meta (99%) rename physics/{ => GWD}/unified_ugwp.F90 (100%) rename physics/{ => GWD}/unified_ugwp.meta (99%) rename physics/{ => GWD}/unified_ugwp_post.F90 (100%) rename physics/{ => GWD}/unified_ugwp_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_DCNV_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_DCNV_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_DCNV_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_DCNV_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_GWD_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_GWD_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_GWD_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_GWD_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_MP_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_MP_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_MP_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_MP_generic_pre.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_common.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_PBL_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_SCNV_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_SCNV_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_SCNV_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_SCNV_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_cloud_diagnostics.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_cloud_diagnostics.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_debug.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_debug.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_phys_time_vary.fv3.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_phys_time_vary.fv3.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_phys_time_vary.scm.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_phys_time_vary.scm.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rad_time_vary.fv3.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rad_time_vary.fv3.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rad_time_vary.scm.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rad_time_vary.scm.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_radiation_surface.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_radiation_surface.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_post.meta (97%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_pre.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_setup.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmg_setup.meta (97%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_cloud_mp.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_cloud_mp.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_cloud_overlap.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_cloud_overlap.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_post.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_pre.F90 (99%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_pre.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_setup.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_rrtmgp_setup.meta (97%) rename physics/{ => Interstitials/GFS}/GFS_stochastics.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_stochastics.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_1.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_1.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_2.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_2.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_3.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_3.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_4.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_4.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_5.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_5.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_phys_reset.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_phys_reset.meta (96%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_rad_reset.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_interstitial_rad_reset.meta (96%) rename physics/{ => Interstitials/GFS}/GFS_suite_stateout_reset.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_stateout_reset.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_suite_stateout_update.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_suite_stateout_update.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_inter.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_inter.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_composites_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_generic_post.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_generic_post.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_generic_pre.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_generic_pre.meta (99%) rename physics/{ => Interstitials/GFS}/GFS_surface_loop_control_part1.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_loop_control_part1.meta (97%) rename physics/{ => Interstitials/GFS}/GFS_surface_loop_control_part2.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_surface_loop_control_part2.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_time_vary_pre.fv3.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_time_vary_pre.fv3.meta (98%) rename physics/{ => Interstitials/GFS}/GFS_time_vary_pre.scm.F90 (100%) rename physics/{ => Interstitials/GFS}/GFS_time_vary_pre.scm.meta (98%) rename physics/{ => Interstitials/GFS}/aerinterp.F90 (100%) rename physics/{ => Interstitials/GFS}/cnvc90.f (100%) rename physics/{ => Interstitials/GFS}/cnvc90.meta (98%) rename physics/{ => Interstitials/GFS}/dcyc2t3.f (100%) rename physics/{ => Interstitials/GFS}/dcyc2t3.meta (99%) rename physics/{ => Interstitials/GFS}/gcycle.F90 (100%) rename physics/{ => Interstitials/GFS}/iccn_def.F (100%) rename physics/{ => Interstitials/GFS}/iccninterp.F90 (100%) rename physics/{ => Interstitials/GFS}/maximum_hourly_diagnostics.F90 (100%) rename physics/{ => Interstitials/GFS}/maximum_hourly_diagnostics.meta (99%) rename physics/{ => Interstitials/GFS}/phys_tend.F90 (100%) rename physics/{ => Interstitials/GFS}/phys_tend.meta (98%) rename physics/{ => Interstitials/GFS}/scm_sfc_flux_spec.F90 (100%) rename physics/{ => Interstitials/GFS}/scm_sfc_flux_spec.meta (99%) rename physics/{ => Interstitials/GFS}/sfcsub.F (100%) rename physics/{ => Interstitials/GFS}/sgscloud_radpost.F90 (100%) rename physics/{ => Interstitials/GFS}/sgscloud_radpost.meta (98%) rename physics/{ => Interstitials/GFS}/sgscloud_radpre.F90 (100%) rename physics/{ => Interstitials/GFS}/sgscloud_radpre.meta (98%) rename physics/{ => Land/CLM_lake}/clm_lake.f90 (100%) rename physics/{ => Land/CLM_lake}/clm_lake.meta (99%) rename physics/{ => Land/Flake}/flake.F90 (100%) rename physics/{ => Land/Flake}/flake_driver.F90 (100%) rename physics/{ => Land/Flake}/flake_driver.meta (99%) rename physics/{ => Land/Noah}/lsm_noah.f (100%) rename physics/{ => Land/Noah}/lsm_noah.meta (99%) rename physics/{ => Land/Noah}/sflx.f (100%) rename physics/{ => Land/Noah}/surface_perturbation.F90 (100%) rename physics/{ => Land/Noahmp}/module_sf_noahmp_glacier.F90 (100%) rename physics/{ => Land/Noahmp}/module_sf_noahmplsm.F90 (100%) rename physics/{ => Land/Noahmp}/noahmp_tables.f90 (100%) rename physics/{ => Land/Noahmp}/noahmpdrv.F90 (100%) rename physics/{ => Land/Noahmp}/noahmpdrv.meta (99%) rename physics/{ => Land/Noahmp}/noahmptable.tbl (100%) rename physics/{ => Land/RUC}/lsm_ruc.F90 (100%) rename physics/{ => Land/RUC}/lsm_ruc.meta (99%) rename physics/{ => Land/RUC}/module_sf_ruclsm.F90 (100%) rename physics/{ => Land/RUC}/module_soil_pre.F90 (100%) rename physics/{ => Land/RUC}/namelist_soilveg_ruc.F90 (100%) rename physics/{ => Land/RUC}/set_soilveg_ruc.F90 (100%) rename physics/{ => Land}/namelist_soilveg.f (100%) rename physics/{ => Land}/set_soilveg.f (100%) rename physics/{ => MP/Ferrier_Aligo}/module_MP_FER_HIRES.F90 (100%) rename physics/{ => MP/Ferrier_Aligo}/mp_fer_hires.F90 (100%) rename physics/{ => MP/Ferrier_Aligo}/mp_fer_hires.meta (99%) rename physics/{ => MP/GFDL}/GFDL_parse_tracers.F90 (100%) rename physics/{ => MP/GFDL}/fv_sat_adj.F90 (100%) rename physics/{ => MP/GFDL}/fv_sat_adj.meta (99%) rename physics/{ => MP/GFDL}/gfdl_cloud_microphys.F90 (100%) rename physics/{ => MP/GFDL}/gfdl_cloud_microphys.meta (99%) rename physics/{ => MP/GFDL}/gfdl_sfc_layer.F90 (100%) rename physics/{ => MP/GFDL}/gfdl_sfc_layer.meta (99%) rename physics/{ => MP/GFDL}/module_gfdl_cloud_microphys.F90 (100%) rename physics/{ => MP/GFDL}/module_sf_exchcoef.f90 (100%) rename physics/{ => MP/GFDL}/multi_gases.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/aer_cloud.F (100%) rename physics/{ => MP/Morrison_Gettelman}/aerclm_def.F (100%) rename physics/{ => MP/Morrison_Gettelman}/cldmacro.F (100%) rename physics/{ => MP/Morrison_Gettelman}/cldwat2m_micro.F (100%) rename physics/{ => MP/Morrison_Gettelman}/m_micro.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/m_micro.meta (99%) rename physics/{ => MP/Morrison_Gettelman}/m_micro_post.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/m_micro_post.meta (99%) rename physics/{ => MP/Morrison_Gettelman}/m_micro_pre.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/m_micro_pre.meta (99%) rename physics/{ => MP/Morrison_Gettelman}/micro_mg2_0.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/micro_mg3_0.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/micro_mg_utils.F90 (100%) rename physics/{ => MP/Morrison_Gettelman}/wv_saturation.F (100%) rename physics/{ => MP/NSSL}/module_mp_nssl_2mom.F90 (100%) rename physics/{ => MP/NSSL}/mp_nssl.F90 (100%) rename physics/{ => MP/NSSL}/mp_nssl.meta (99%) rename physics/{ => MP/Thompson}/module_mp_radar.F90 (100%) rename physics/{ => MP/Thompson}/module_mp_thompson.F90 (100%) rename physics/{ => MP/Thompson}/module_mp_thompson_make_number_concentrations.F90 (100%) rename physics/{ => MP/Thompson}/mp_thompson.F90 (100%) rename physics/{ => MP/Thompson}/mp_thompson.meta (99%) rename physics/{ => MP/Thompson}/mp_thompson_post.F90 (100%) rename physics/{ => MP/Thompson}/mp_thompson_post.meta (98%) rename physics/{ => MP/Thompson}/mp_thompson_pre.F90 (100%) rename physics/{ => MP/Thompson}/mp_thompson_pre.meta (97%) rename physics/{ => MP/Zhao_Carr}/zhaocarr_gscond.f (100%) rename physics/{ => MP/Zhao_Carr}/zhaocarr_gscond.meta (98%) rename physics/{ => MP/Zhao_Carr}/zhaocarr_precpd.f (100%) rename physics/{ => MP/Zhao_Carr}/zhaocarr_precpd.meta (98%) rename physics/{ => MP}/calpreciptype.f90 (100%) rename physics/{ => NOTUSED}/gfs_phy_tracer_config.F (100%) rename physics/{ => NOTUSED}/gocart_tracer_config_stub.f (100%) rename physics/{ => NOTUSED}/rrtmg_lw_pre.F90 (100%) rename physics/{ => NOTUSED}/rrtmg_lw_pre.meta (100%) rename physics/{ => PBL/HEDMF}/hedmf.f (100%) rename physics/{ => PBL/HEDMF}/hedmf.meta (99%) rename physics/{ => PBL/MYJ}/module_BL_MYJPBL.F90 (100%) rename physics/{ => PBL/MYJ}/myjpbl_wrapper.F90 (100%) rename physics/{ => PBL/MYJ}/myjpbl_wrapper.meta (99%) rename physics/{ => PBL/MYNN_EDMF}/bl_mynn_common.f90 (100%) rename physics/{ => PBL/MYNN_EDMF}/module_bl_mynn.F90 (100%) rename physics/{ => PBL/MYNN_EDMF}/mynnedmf_wrapper.F90 (100%) rename physics/{ => PBL/MYNN_EDMF}/mynnedmf_wrapper.meta (99%) rename physics/{ => PBL/SATMEDMF}/mfscu.f (100%) rename physics/{ => PBL/SATMEDMF}/mfscuq.f (100%) rename physics/{ => PBL/SATMEDMF}/satmedmfvdif.F (100%) rename physics/{ => PBL/SATMEDMF}/satmedmfvdif.meta (99%) rename physics/{ => PBL/SATMEDMF}/satmedmfvdifq.F (100%) rename physics/{ => PBL/SATMEDMF}/satmedmfvdifq.meta (99%) rename physics/{ => PBL/SHOC}/moninshoc.f (100%) rename physics/{ => PBL/SHOC}/moninshoc.meta (99%) rename physics/{ => PBL/SHOC}/shoc.F90 (100%) rename physics/{ => PBL/SHOC}/shoc.meta (99%) rename physics/{ => PBL/YSU}/ysuvdif.F90 (100%) rename physics/{ => PBL/YSU}/ysuvdif.meta (99%) rename physics/{ => PBL}/mfpbl.f (100%) rename physics/{ => PBL}/mfpblt.f (100%) rename physics/{ => PBL}/mfpbltq.f (100%) rename physics/{ => PBL/saYSU}/shinhongvdif.F90 (100%) rename physics/{ => PBL/saYSU}/shinhongvdif.meta (99%) rename physics/{ => PBL}/tridi.f (100%) rename physics/{ => Radiation/RRTMG}/iounitdef.f (100%) rename physics/{ => Radiation/RRTMG}/module_bfmicrophysics.f (100%) rename physics/{ => Radiation/RRTMG}/rad_sw_pre.F90 (100%) rename physics/{ => Radiation/RRTMG}/rad_sw_pre.meta (96%) rename physics/{ => Radiation/RRTMG}/radcons.f90 (100%) rename physics/{ => Radiation/RRTMG}/radlw_datatb.f (100%) rename physics/{ => Radiation/RRTMG}/radlw_main.F90 (100%) rename physics/{ => Radiation/RRTMG}/radlw_main.meta (99%) rename physics/{ => Radiation/RRTMG}/radlw_param.f (100%) rename physics/{ => Radiation/RRTMG}/radlw_param.meta (100%) rename physics/{ => Radiation/RRTMG}/radsw_datatb.f (100%) rename physics/{ => Radiation/RRTMG}/radsw_main.F90 (100%) rename physics/{ => Radiation/RRTMG}/radsw_main.meta (99%) rename physics/{ => Radiation/RRTMG}/radsw_param.f (100%) rename physics/{ => Radiation/RRTMG}/radsw_param.meta (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_lw_cloud_optics.F90 (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_lw_post.F90 (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_lw_post.meta (99%) rename physics/{ => Radiation/RRTMG}/rrtmg_sw_cloud_optics.F90 (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_sw_post.F90 (100%) rename physics/{ => Radiation/RRTMG}/rrtmg_sw_post.meta (99%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_aerosol_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_aerosol_optics.meta (98%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_lw_cloud_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_lw_gas_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_lw_main.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_lw_main.meta (98%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sampling.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sw_cloud_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sw_gas_optics.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sw_main.F90 (100%) rename physics/{ => Radiation/RRTMGP}/rrtmgp_sw_main.meta (98%) rename physics/{ => Radiation}/mersenne_twister.f (100%) rename physics/{ => Radiation}/radiation_aerosols.f (100%) rename physics/{ => Radiation}/radiation_astronomy.f (100%) rename physics/{ => Radiation}/radiation_cloud_overlap.F90 (100%) rename physics/{ => Radiation}/radiation_clouds.f (100%) rename physics/{ => Radiation}/radiation_gases.f (100%) rename physics/{ => Radiation}/radiation_surface.f (100%) rename physics/{ => Radiation}/radiation_tools.F90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/date_def.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/module_nst_model.f90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/module_nst_parameters.f90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/module_nst_water_prop.f90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_cice.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_cice.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diag.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diag.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diag_post.F90 (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diag_post.meta (98%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diff.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_diff.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_post.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_post.meta (98%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_pre.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_nst_pre.meta (97%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_ocean.F (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_ocean.meta (99%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_sice.f (100%) rename physics/{ => SFC_Layer/GFS_sfc}/sfc_sice.meta (99%) rename physics/{ => SFC_Layer/MYJ}/module_SF_JSFC.F90 (100%) rename physics/{ => SFC_Layer/MYJ}/myjsfc_wrapper.F90 (100%) rename physics/{ => SFC_Layer/MYJ}/myjsfc_wrapper.meta (99%) rename physics/{ => SFC_Layer/MYNN}/module_sf_mynn.F90 (100%) rename physics/{ => SFC_Layer/MYNN}/mynnsfc_wrapper.F90 (100%) rename physics/{ => SFC_Layer/MYNN}/mynnsfc_wrapper.meta (99%) rename physics/{ => h2o_photo}/h2o_def.f (100%) rename physics/{ => h2o_photo}/h2o_def.meta (94%) rename physics/{ => h2o_photo}/h2ointerp.f90 (100%) rename physics/{ => h2o_photo}/h2ophys.f (100%) rename physics/{ => h2o_photo}/h2ophys.meta (98%) rename physics/{ => hooks}/machine.F (100%) rename physics/{ => hooks}/machine.meta (100%) rename physics/{ => hooks}/physcons.F90 (100%) rename physics/{ => o3_photo}/ozinterp.f90 (100%) rename physics/{ => o3_photo}/ozne_def.f (100%) rename physics/{ => o3_photo}/ozne_def.meta (95%) rename physics/{ => o3_photo}/ozphys.f (100%) rename physics/{ => o3_photo}/ozphys.meta (99%) rename physics/{ => o3_photo}/ozphys_2015.f (100%) rename physics/{ => o3_photo}/ozphys_2015.meta (99%) delete mode 160000 physics/rte-rrtmgp rename physics/{ => tools}/funcphys.f90 (100%) rename physics/{ => tools}/get_phi_fv3.F90 (100%) rename physics/{ => tools}/get_phi_fv3.meta (97%) rename physics/{ => tools}/get_prs_fv3.F90 (100%) rename physics/{ => tools}/get_prs_fv3.meta (98%) diff --git a/.gitmodules b/.gitmodules index 8758980ec..c82541c5b 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ [submodule "physics/rte-rrtmgp"] - path = physics/rte-rrtmgp + path = physics/Radiation/RRTMGP/rte-rrtmgp url = https://github.com/earth-system-radiation/rte-rrtmgp branch = main diff --git a/physics/cu_c3_deep.F90 b/physics/CONV/CCC/cu_c3_deep.F90 similarity index 100% rename from physics/cu_c3_deep.F90 rename to physics/CONV/CCC/cu_c3_deep.F90 diff --git a/physics/cu_c3_driver.F90 b/physics/CONV/CCC/cu_c3_driver.F90 similarity index 100% rename from physics/cu_c3_driver.F90 rename to physics/CONV/CCC/cu_c3_driver.F90 diff --git a/physics/cu_c3_driver.meta b/physics/CONV/CCC/cu_c3_driver.meta similarity index 99% rename from physics/cu_c3_driver.meta rename to physics/CONV/CCC/cu_c3_driver.meta index 999b5c2bc..bb2784642 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/CONV/CCC/cu_c3_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_c3_driver type = scheme - dependencies = cu_c3_deep.F90,cu_c3_sh.F90,machine.F,physcons.F90,progsigma_calc.f90 + dependencies = cu_c3_deep.F90,cu_c3_sh.F90,../../hooks/machine.F,../../hooks/physcons.F90,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_c3_driver_post.F90 b/physics/CONV/CCC/cu_c3_driver_post.F90 similarity index 100% rename from physics/cu_c3_driver_post.F90 rename to physics/CONV/CCC/cu_c3_driver_post.F90 diff --git a/physics/cu_c3_driver_post.meta b/physics/CONV/CCC/cu_c3_driver_post.meta similarity index 98% rename from physics/cu_c3_driver_post.meta rename to physics/CONV/CCC/cu_c3_driver_post.meta index c53972f09..78dca2ed4 100644 --- a/physics/cu_c3_driver_post.meta +++ b/physics/CONV/CCC/cu_c3_driver_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_c3_driver_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_c3_driver_pre.F90 b/physics/CONV/CCC/cu_c3_driver_pre.F90 similarity index 100% rename from physics/cu_c3_driver_pre.F90 rename to physics/CONV/CCC/cu_c3_driver_pre.F90 diff --git a/physics/cu_c3_driver_pre.meta b/physics/CONV/CCC/cu_c3_driver_pre.meta similarity index 98% rename from physics/cu_c3_driver_pre.meta rename to physics/CONV/CCC/cu_c3_driver_pre.meta index c018bee9f..a022cf743 100644 --- a/physics/cu_c3_driver_pre.meta +++ b/physics/CONV/CCC/cu_c3_driver_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_c3_driver_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_c3_sh.F90 b/physics/CONV/CCC/cu_c3_sh.F90 similarity index 100% rename from physics/cu_c3_sh.F90 rename to physics/CONV/CCC/cu_c3_sh.F90 diff --git a/physics/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 similarity index 100% rename from physics/cs_conv.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv.F90 diff --git a/physics/cs_conv.meta b/physics/CONV/Chikira_Sugiyama/cs_conv.meta similarity index 99% rename from physics/cs_conv.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv.meta index fae1c91fe..49e460ed6 100644 --- a/physics/cs_conv.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = cs_conv type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cs_conv_aw_adj.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 similarity index 100% rename from physics/cs_conv_aw_adj.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 diff --git a/physics/cs_conv_aw_adj.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta similarity index 99% rename from physics/cs_conv_aw_adj.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta index 0dada0fd5..54350dbac 100644 --- a/physics/cs_conv_aw_adj.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cs_conv_aw_adj type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cs_conv_post.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_post.F90 similarity index 100% rename from physics/cs_conv_post.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_post.F90 diff --git a/physics/cs_conv_post.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta similarity index 97% rename from physics/cs_conv_post.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_post.meta index 116ffbef4..75de3fca7 100644 --- a/physics/cs_conv_post.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = cs_conv_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cs_conv_pre.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 similarity index 100% rename from physics/cs_conv_pre.F90 rename to physics/CONV/Chikira_Sugiyama/cs_conv_pre.F90 diff --git a/physics/cs_conv_pre.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta similarity index 99% rename from physics/cs_conv_pre.meta rename to physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta index 2decd5f8b..7ce80496b 100644 --- a/physics/cs_conv_pre.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cs_conv_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 similarity index 100% rename from physics/cu_gf_deep.F90 rename to physics/CONV/Grell_Freitas/cu_gf_deep.F90 diff --git a/physics/cu_gf_driver.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 similarity index 100% rename from physics/cu_gf_driver.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver.F90 diff --git a/physics/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta similarity index 99% rename from physics/cu_gf_driver.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver.meta index 8b1a46e2d..d5324f05a 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_gf_driver type = scheme - dependencies = cu_gf_deep.F90,cu_gf_sh.F90,machine.F,physcons.F90 + dependencies = cu_gf_deep.F90,cu_gf_sh.F90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_driver_post.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 similarity index 100% rename from physics/cu_gf_driver_post.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 diff --git a/physics/cu_gf_driver_post.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta similarity index 98% rename from physics/cu_gf_driver_post.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver_post.meta index 48e762cb4..fe2308b1b 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_gf_driver_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_driver_pre.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 similarity index 100% rename from physics/cu_gf_driver_pre.F90 rename to physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 diff --git a/physics/cu_gf_driver_pre.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta similarity index 98% rename from physics/cu_gf_driver_pre.meta rename to physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta index 7fd66d19b..5139cae6d 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_gf_driver_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_gf_sh.F90 b/physics/CONV/Grell_Freitas/cu_gf_sh.F90 similarity index 100% rename from physics/cu_gf_sh.F90 rename to physics/CONV/Grell_Freitas/cu_gf_sh.F90 diff --git a/physics/rascnv.F90 b/physics/CONV/RAS/rascnv.F90 similarity index 100% rename from physics/rascnv.F90 rename to physics/CONV/RAS/rascnv.F90 diff --git a/physics/rascnv.meta b/physics/CONV/RAS/rascnv.meta similarity index 99% rename from physics/rascnv.meta rename to physics/CONV/RAS/rascnv.meta index 5285c830f..f5a707ded 100644 --- a/physics/rascnv.meta +++ b/physics/CONV/RAS/rascnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rascnv type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/samfaerosols.F b/physics/CONV/SAMF/samfaerosols.F similarity index 100% rename from physics/samfaerosols.F rename to physics/CONV/SAMF/samfaerosols.F diff --git a/physics/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f similarity index 100% rename from physics/samfdeepcnv.f rename to physics/CONV/SAMF/samfdeepcnv.f diff --git a/physics/samfdeepcnv.meta b/physics/CONV/SAMF/samfdeepcnv.meta similarity index 99% rename from physics/samfdeepcnv.meta rename to physics/CONV/SAMF/samfdeepcnv.meta index bed4d655d..ec9157ef3 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/CONV/SAMF/samfdeepcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = samfdeepcnv type = scheme - dependencies = funcphys.f90,machine.F,samfaerosols.F,progsigma_calc.f90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f similarity index 100% rename from physics/samfshalcnv.f rename to physics/CONV/SAMF/samfshalcnv.f diff --git a/physics/samfshalcnv.meta b/physics/CONV/SAMF/samfshalcnv.meta similarity index 99% rename from physics/samfshalcnv.meta rename to physics/CONV/SAMF/samfshalcnv.meta index c1fffef58..aab66d625 100644 --- a/physics/samfshalcnv.meta +++ b/physics/CONV/SAMF/samfshalcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = samfshalcnv type = scheme - dependencies = funcphys.f90,machine.F,samfaerosols.F,progsigma_calc.f90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sascnvn.F b/physics/CONV/SAS/sascnvn.F similarity index 100% rename from physics/sascnvn.F rename to physics/CONV/SAS/sascnvn.F diff --git a/physics/sascnvn.meta b/physics/CONV/SAS/sascnvn.meta similarity index 99% rename from physics/sascnvn.meta rename to physics/CONV/SAS/sascnvn.meta index 66e5161ad..fefa2823a 100644 --- a/physics/sascnvn.meta +++ b/physics/CONV/SAS/sascnvn.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sascnvn type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/shalcnv.F b/physics/CONV/SAS/shalcnv.F similarity index 100% rename from physics/shalcnv.F rename to physics/CONV/SAS/shalcnv.F diff --git a/physics/shalcnv.meta b/physics/CONV/SAS/shalcnv.meta similarity index 99% rename from physics/shalcnv.meta rename to physics/CONV/SAS/shalcnv.meta index f554201c5..15324ed08 100644 --- a/physics/shalcnv.meta +++ b/physics/CONV/SAS/shalcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shalcnv type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke.F90 b/physics/CONV/nTiedtke/cu_ntiedtke.F90 similarity index 100% rename from physics/cu_ntiedtke.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke.F90 diff --git a/physics/cu_ntiedtke.meta b/physics/CONV/nTiedtke/cu_ntiedtke.meta similarity index 99% rename from physics/cu_ntiedtke.meta rename to physics/CONV/nTiedtke/cu_ntiedtke.meta index dded8fb20..b425a80ad 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke type = scheme - dependencies = machine.F,physcons.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke_post.F90 b/physics/CONV/nTiedtke/cu_ntiedtke_post.F90 similarity index 100% rename from physics/cu_ntiedtke_post.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke_post.F90 diff --git a/physics/cu_ntiedtke_post.meta b/physics/CONV/nTiedtke/cu_ntiedtke_post.meta similarity index 97% rename from physics/cu_ntiedtke_post.meta rename to physics/CONV/nTiedtke/cu_ntiedtke_post.meta index 703d32b90..9960b6b77 100644 --- a/physics/cu_ntiedtke_post.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cu_ntiedtke_pre.F90 b/physics/CONV/nTiedtke/cu_ntiedtke_pre.F90 similarity index 100% rename from physics/cu_ntiedtke_pre.F90 rename to physics/CONV/nTiedtke/cu_ntiedtke_pre.F90 diff --git a/physics/cu_ntiedtke_pre.meta b/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta similarity index 98% rename from physics/cu_ntiedtke_pre.meta rename to physics/CONV/nTiedtke/cu_ntiedtke_pre.meta index ccb9b7f48..26392f0e6 100644 --- a/physics/cu_ntiedtke_pre.meta +++ b/physics/CONV/nTiedtke/cu_ntiedtke_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cu_ntiedtke_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/progsigma_calc.f90 b/physics/CONV/progsigma_calc.f90 similarity index 100% rename from physics/progsigma_calc.f90 rename to physics/CONV/progsigma_calc.f90 diff --git a/physics/cires_orowam2017.f b/physics/GWD/cires_orowam2017.f similarity index 100% rename from physics/cires_orowam2017.f rename to physics/GWD/cires_orowam2017.f diff --git a/physics/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 similarity index 100% rename from physics/cires_tauamf_data.F90 rename to physics/GWD/cires_tauamf_data.F90 diff --git a/physics/cires_ugwp.F90 b/physics/GWD/cires_ugwp.F90 similarity index 100% rename from physics/cires_ugwp.F90 rename to physics/GWD/cires_ugwp.F90 diff --git a/physics/cires_ugwp.meta b/physics/GWD/cires_ugwp.meta similarity index 99% rename from physics/cires_ugwp.meta rename to physics/GWD/cires_ugwp.meta index d944a635e..cd0192ca7 100644 --- a/physics/cires_ugwp.meta +++ b/physics/GWD/cires_ugwp.meta @@ -3,7 +3,7 @@ type = scheme # DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp-v0! dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 - dependencies=cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F + dependencies=cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,../hooks/machine.F,ugwp_driver_v0.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cires_ugwp_initialize.F90 b/physics/GWD/cires_ugwp_initialize.F90 similarity index 100% rename from physics/cires_ugwp_initialize.F90 rename to physics/GWD/cires_ugwp_initialize.F90 diff --git a/physics/cires_ugwp_module.F90 b/physics/GWD/cires_ugwp_module.F90 similarity index 100% rename from physics/cires_ugwp_module.F90 rename to physics/GWD/cires_ugwp_module.F90 diff --git a/physics/cires_ugwp_post.F90 b/physics/GWD/cires_ugwp_post.F90 similarity index 100% rename from physics/cires_ugwp_post.F90 rename to physics/GWD/cires_ugwp_post.F90 diff --git a/physics/cires_ugwp_post.meta b/physics/GWD/cires_ugwp_post.meta similarity index 99% rename from physics/cires_ugwp_post.meta rename to physics/GWD/cires_ugwp_post.meta index 5add9d43f..dabc40082 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/GWD/cires_ugwp_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cires_ugwp_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cires_ugwp_triggers.F90 b/physics/GWD/cires_ugwp_triggers.F90 similarity index 100% rename from physics/cires_ugwp_triggers.F90 rename to physics/GWD/cires_ugwp_triggers.F90 diff --git a/physics/cires_ugwpv1_initialize.F90 b/physics/GWD/cires_ugwpv1_initialize.F90 similarity index 100% rename from physics/cires_ugwpv1_initialize.F90 rename to physics/GWD/cires_ugwpv1_initialize.F90 diff --git a/physics/cires_ugwpv1_module.F90 b/physics/GWD/cires_ugwpv1_module.F90 similarity index 100% rename from physics/cires_ugwpv1_module.F90 rename to physics/GWD/cires_ugwpv1_module.F90 diff --git a/physics/cires_ugwpv1_oro.F90 b/physics/GWD/cires_ugwpv1_oro.F90 similarity index 100% rename from physics/cires_ugwpv1_oro.F90 rename to physics/GWD/cires_ugwpv1_oro.F90 diff --git a/physics/cires_ugwpv1_solv2.F90 b/physics/GWD/cires_ugwpv1_solv2.F90 similarity index 100% rename from physics/cires_ugwpv1_solv2.F90 rename to physics/GWD/cires_ugwpv1_solv2.F90 diff --git a/physics/cires_ugwpv1_sporo.F90 b/physics/GWD/cires_ugwpv1_sporo.F90 similarity index 100% rename from physics/cires_ugwpv1_sporo.F90 rename to physics/GWD/cires_ugwpv1_sporo.F90 diff --git a/physics/cires_ugwpv1_triggers.F90 b/physics/GWD/cires_ugwpv1_triggers.F90 similarity index 100% rename from physics/cires_ugwpv1_triggers.F90 rename to physics/GWD/cires_ugwpv1_triggers.F90 diff --git a/physics/drag_suite.F90 b/physics/GWD/drag_suite.F90 similarity index 100% rename from physics/drag_suite.F90 rename to physics/GWD/drag_suite.F90 diff --git a/physics/drag_suite.meta b/physics/GWD/drag_suite.meta similarity index 99% rename from physics/drag_suite.meta rename to physics/GWD/drag_suite.meta index 66f320b98..94dddcc93 100644 --- a/physics/drag_suite.meta +++ b/physics/GWD/drag_suite.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = drag_suite type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdc.f b/physics/GWD/gwdc.f similarity index 100% rename from physics/gwdc.f rename to physics/GWD/gwdc.f diff --git a/physics/gwdc.meta b/physics/GWD/gwdc.meta similarity index 99% rename from physics/gwdc.meta rename to physics/GWD/gwdc.meta index 341879b0b..9884d8a62 100644 --- a/physics/gwdc.meta +++ b/physics/GWD/gwdc.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = gwdc type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdc_post.f b/physics/GWD/gwdc_post.f similarity index 100% rename from physics/gwdc_post.f rename to physics/GWD/gwdc_post.f diff --git a/physics/gwdc_post.meta b/physics/GWD/gwdc_post.meta similarity index 99% rename from physics/gwdc_post.meta rename to physics/GWD/gwdc_post.meta index 25415b888..97649d4cf 100644 --- a/physics/gwdc_post.meta +++ b/physics/GWD/gwdc_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = gwdc_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdc_pre.f b/physics/GWD/gwdc_pre.f similarity index 100% rename from physics/gwdc_pre.f rename to physics/GWD/gwdc_pre.f diff --git a/physics/gwdc_pre.meta b/physics/GWD/gwdc_pre.meta similarity index 99% rename from physics/gwdc_pre.meta rename to physics/GWD/gwdc_pre.meta index 63df59cfa..55b0054bd 100644 --- a/physics/gwdc_pre.meta +++ b/physics/GWD/gwdc_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gwdc_pre type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gwdps.f b/physics/GWD/gwdps.f similarity index 100% rename from physics/gwdps.f rename to physics/GWD/gwdps.f diff --git a/physics/gwdps.meta b/physics/GWD/gwdps.meta similarity index 99% rename from physics/gwdps.meta rename to physics/GWD/gwdps.meta index af60886ab..bbe7569d0 100644 --- a/physics/gwdps.meta +++ b/physics/GWD/gwdps.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gwdps type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rayleigh_damp.f b/physics/GWD/rayleigh_damp.f similarity index 100% rename from physics/rayleigh_damp.f rename to physics/GWD/rayleigh_damp.f diff --git a/physics/rayleigh_damp.meta b/physics/GWD/rayleigh_damp.meta similarity index 99% rename from physics/rayleigh_damp.meta rename to physics/GWD/rayleigh_damp.meta index 63025bcff..525acbe8b 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/GWD/rayleigh_damp.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rayleigh_damp type = scheme - dependencies = + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ugwp_driver_v0.F b/physics/GWD/ugwp_driver_v0.F similarity index 100% rename from physics/ugwp_driver_v0.F rename to physics/GWD/ugwp_driver_v0.F diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/GWD/ugwpv1_gsldrag.F90 similarity index 100% rename from physics/ugwpv1_gsldrag.F90 rename to physics/GWD/ugwpv1_gsldrag.F90 diff --git a/physics/ugwpv1_gsldrag.meta b/physics/GWD/ugwpv1_gsldrag.meta similarity index 99% rename from physics/ugwpv1_gsldrag.meta rename to physics/GWD/ugwpv1_gsldrag.meta index 82caa8832..73d7eee1c 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/GWD/ugwpv1_gsldrag.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ugwpv1_gsldrag type = scheme - dependencies = machine.F,drag_suite.F90 + dependencies = ../hooks/machine.F,drag_suite.F90 dependencies = cires_ugwpv1_module.F90,cires_ugwpv1_triggers.F90,cires_ugwpv1_initialize.F90,cires_ugwpv1_solv2.F90 dependencies = cires_ugwpv1_sporo.F90,cires_ugwpv1_oro.F90 ######################################################################## diff --git a/physics/ugwpv1_gsldrag_post.F90 b/physics/GWD/ugwpv1_gsldrag_post.F90 similarity index 100% rename from physics/ugwpv1_gsldrag_post.F90 rename to physics/GWD/ugwpv1_gsldrag_post.F90 diff --git a/physics/ugwpv1_gsldrag_post.meta b/physics/GWD/ugwpv1_gsldrag_post.meta similarity index 99% rename from physics/ugwpv1_gsldrag_post.meta rename to physics/GWD/ugwpv1_gsldrag_post.meta index f8766060c..e1c63102d 100644 --- a/physics/ugwpv1_gsldrag_post.meta +++ b/physics/GWD/ugwpv1_gsldrag_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ugwpv1_gsldrag_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 similarity index 100% rename from physics/unified_ugwp.F90 rename to physics/GWD/unified_ugwp.F90 diff --git a/physics/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta similarity index 99% rename from physics/unified_ugwp.meta rename to physics/GWD/unified_ugwp.meta index 8af99957a..a08ee3960 100644 --- a/physics/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -1,10 +1,10 @@ [ccpp-table-properties] name = unified_ugwp type = scheme - - dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 - dependencies=cires_orowam2017.f, cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F - dependencies=drag_suite.F90 + dependencies = ../hooks/machine.F + dependencies = cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 + dependencies = cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,ugwp_driver_v0.F + dependencies = drag_suite.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/unified_ugwp_post.F90 b/physics/GWD/unified_ugwp_post.F90 similarity index 100% rename from physics/unified_ugwp_post.F90 rename to physics/GWD/unified_ugwp_post.F90 diff --git a/physics/unified_ugwp_post.meta b/physics/GWD/unified_ugwp_post.meta similarity index 99% rename from physics/unified_ugwp_post.meta rename to physics/GWD/unified_ugwp_post.meta index 6da6342df..7784c28ec 100644 --- a/physics/unified_ugwp_post.meta +++ b/physics/GWD/unified_ugwp_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = unified_ugwp_post type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_DCNV_generic_post.F90 b/physics/Interstitials/GFS/GFS_DCNV_generic_post.F90 similarity index 100% rename from physics/GFS_DCNV_generic_post.F90 rename to physics/Interstitials/GFS/GFS_DCNV_generic_post.F90 diff --git a/physics/GFS_DCNV_generic_post.meta b/physics/Interstitials/GFS/GFS_DCNV_generic_post.meta similarity index 99% rename from physics/GFS_DCNV_generic_post.meta rename to physics/Interstitials/GFS/GFS_DCNV_generic_post.meta index 8428752ce..359e580fe 100644 --- a/physics/GFS_DCNV_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_DCNV_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_DCNV_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_DCNV_generic_pre.F90 b/physics/Interstitials/GFS/GFS_DCNV_generic_pre.F90 similarity index 100% rename from physics/GFS_DCNV_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_DCNV_generic_pre.F90 diff --git a/physics/GFS_DCNV_generic_pre.meta b/physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta similarity index 99% rename from physics/GFS_DCNV_generic_pre.meta rename to physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta index ee2050926..46de572f0 100644 --- a/physics/GFS_DCNV_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_DCNV_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_GWD_generic_post.F90 b/physics/Interstitials/GFS/GFS_GWD_generic_post.F90 similarity index 100% rename from physics/GFS_GWD_generic_post.F90 rename to physics/Interstitials/GFS/GFS_GWD_generic_post.F90 diff --git a/physics/GFS_GWD_generic_post.meta b/physics/Interstitials/GFS/GFS_GWD_generic_post.meta similarity index 99% rename from physics/GFS_GWD_generic_post.meta rename to physics/Interstitials/GFS/GFS_GWD_generic_post.meta index 204c16c84..beca39282 100644 --- a/physics/GFS_GWD_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_GWD_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_GWD_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_GWD_generic_pre.F90 b/physics/Interstitials/GFS/GFS_GWD_generic_pre.F90 similarity index 100% rename from physics/GFS_GWD_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_GWD_generic_pre.F90 diff --git a/physics/GFS_GWD_generic_pre.meta b/physics/Interstitials/GFS/GFS_GWD_generic_pre.meta similarity index 99% rename from physics/GFS_GWD_generic_pre.meta rename to physics/Interstitials/GFS/GFS_GWD_generic_pre.meta index 9bcc03300..dbbfc261d 100644 --- a/physics/GFS_GWD_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_GWD_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_GWD_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_MP_generic_post.F90 b/physics/Interstitials/GFS/GFS_MP_generic_post.F90 similarity index 100% rename from physics/GFS_MP_generic_post.F90 rename to physics/Interstitials/GFS/GFS_MP_generic_post.F90 diff --git a/physics/GFS_MP_generic_post.meta b/physics/Interstitials/GFS/GFS_MP_generic_post.meta similarity index 99% rename from physics/GFS_MP_generic_post.meta rename to physics/Interstitials/GFS/GFS_MP_generic_post.meta index 7cd2ca4b5..0ac5c4527 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_MP_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_MP_generic_post type = scheme - dependencies = calpreciptype.f90,machine.F + dependencies = ../../MP/calpreciptype.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_MP_generic_pre.F90 b/physics/Interstitials/GFS/GFS_MP_generic_pre.F90 similarity index 100% rename from physics/GFS_MP_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_MP_generic_pre.F90 diff --git a/physics/GFS_MP_generic_pre.meta b/physics/Interstitials/GFS/GFS_MP_generic_pre.meta similarity index 98% rename from physics/GFS_MP_generic_pre.meta rename to physics/Interstitials/GFS/GFS_MP_generic_pre.meta index a2a4947ef..6d5fd1538 100644 --- a/physics/GFS_MP_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_MP_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_MP_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_PBL_generic_common.F90 b/physics/Interstitials/GFS/GFS_PBL_generic_common.F90 similarity index 100% rename from physics/GFS_PBL_generic_common.F90 rename to physics/Interstitials/GFS/GFS_PBL_generic_common.F90 diff --git a/physics/GFS_PBL_generic_post.F90 b/physics/Interstitials/GFS/GFS_PBL_generic_post.F90 similarity index 100% rename from physics/GFS_PBL_generic_post.F90 rename to physics/Interstitials/GFS/GFS_PBL_generic_post.F90 diff --git a/physics/GFS_PBL_generic_post.meta b/physics/Interstitials/GFS/GFS_PBL_generic_post.meta similarity index 99% rename from physics/GFS_PBL_generic_post.meta rename to physics/Interstitials/GFS/GFS_PBL_generic_post.meta index b20142991..53a769c49 100644 --- a/physics/GFS_PBL_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_PBL_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_PBL_generic_post type = scheme - dependencies = GFS_PBL_generic_common.F90,machine.F + dependencies = GFS_PBL_generic_common.F90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_PBL_generic_pre.F90 b/physics/Interstitials/GFS/GFS_PBL_generic_pre.F90 similarity index 100% rename from physics/GFS_PBL_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_PBL_generic_pre.F90 diff --git a/physics/GFS_PBL_generic_pre.meta b/physics/Interstitials/GFS/GFS_PBL_generic_pre.meta similarity index 99% rename from physics/GFS_PBL_generic_pre.meta rename to physics/Interstitials/GFS/GFS_PBL_generic_pre.meta index a09b34b48..0377582a4 100644 --- a/physics/GFS_PBL_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_PBL_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_PBL_generic_pre type = scheme - dependencies = GFS_PBL_generic_common.F90,machine.F + dependencies = GFS_PBL_generic_common.F90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_SCNV_generic_post.F90 b/physics/Interstitials/GFS/GFS_SCNV_generic_post.F90 similarity index 100% rename from physics/GFS_SCNV_generic_post.F90 rename to physics/Interstitials/GFS/GFS_SCNV_generic_post.F90 diff --git a/physics/GFS_SCNV_generic_post.meta b/physics/Interstitials/GFS/GFS_SCNV_generic_post.meta similarity index 99% rename from physics/GFS_SCNV_generic_post.meta rename to physics/Interstitials/GFS/GFS_SCNV_generic_post.meta index bf6ba394f..963ad4a81 100644 --- a/physics/GFS_SCNV_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_SCNV_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_SCNV_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_SCNV_generic_pre.F90 b/physics/Interstitials/GFS/GFS_SCNV_generic_pre.F90 similarity index 100% rename from physics/GFS_SCNV_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_SCNV_generic_pre.F90 diff --git a/physics/GFS_SCNV_generic_pre.meta b/physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta similarity index 99% rename from physics/GFS_SCNV_generic_pre.meta rename to physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta index eccd547a1..fbd9e47d8 100644 --- a/physics/GFS_SCNV_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_SCNV_generic_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/Interstitials/GFS/GFS_cloud_diagnostics.F90 similarity index 100% rename from physics/GFS_cloud_diagnostics.F90 rename to physics/Interstitials/GFS/GFS_cloud_diagnostics.F90 diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/Interstitials/GFS/GFS_cloud_diagnostics.meta similarity index 98% rename from physics/GFS_cloud_diagnostics.meta rename to physics/Interstitials/GFS/GFS_cloud_diagnostics.meta index 53d1552e6..576c66463 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/Interstitials/GFS/GFS_cloud_diagnostics.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_cloud_diagnostics type = scheme - dependencies = machine.F,radiation_clouds.f + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/radiation_clouds.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_debug.F90 b/physics/Interstitials/GFS/GFS_debug.F90 similarity index 100% rename from physics/GFS_debug.F90 rename to physics/Interstitials/GFS/GFS_debug.F90 diff --git a/physics/GFS_debug.meta b/physics/Interstitials/GFS/GFS_debug.meta similarity index 99% rename from physics/GFS_debug.meta rename to physics/Interstitials/GFS/GFS_debug.meta index 1ad24e1d6..de3f49a6f 100644 --- a/physics/GFS_debug.meta +++ b/physics/Interstitials/GFS/GFS_debug.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_diagtoscreen type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.F90 similarity index 100% rename from physics/GFS_phys_time_vary.fv3.F90 rename to physics/Interstitials/GFS/GFS_phys_time_vary.fv3.F90 diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta similarity index 98% rename from physics/GFS_phys_time_vary.fv3.meta rename to physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta index 363469e91..45125385c 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta @@ -1,8 +1,15 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Interstitials/GFS/gcycle.F90,Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F + dependencies = Radiation/mersenne_twister.f + dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 + dependencies = Land/namelist_soilveg.f,Land/set_soilveg.f,Land/Noahmp/noahmp_tables.f90 + dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f + dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 + dependencies = GWD/cires_tauamf_data.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/GFS/GFS_phys_time_vary.scm.F90 similarity index 100% rename from physics/GFS_phys_time_vary.scm.F90 rename to physics/Interstitials/GFS/GFS_phys_time_vary.scm.F90 diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta similarity index 98% rename from physics/GFS_phys_time_vary.scm.meta rename to physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta index 8b59e4bed..84f22aede 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta @@ -1,8 +1,15 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,cires_tauamf_data.F90,noahmp_tables.f90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F + dependencies = Radiation/mersenne_twister.f + dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 + dependencies = Land/namelist_soilveg.f,Land/set_soilveg.f,Land/Noahmp/noahmp_tables.f90 + dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f + dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 + dependencies = GWD/cires_tauamf_data.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rad_time_vary.fv3.F90 b/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.F90 similarity index 100% rename from physics/GFS_rad_time_vary.fv3.F90 rename to physics/Interstitials/GFS/GFS_rad_time_vary.fv3.F90 diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta similarity index 98% rename from physics/GFS_rad_time_vary.fv3.meta rename to physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta index 19eb41dc2..0759b7e2a 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_rad_time_vary type = scheme - dependencies = machine.F,mersenne_twister.f,radcons.f90 + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/Interstitials/GFS/GFS_rad_time_vary.scm.F90 similarity index 100% rename from physics/GFS_rad_time_vary.scm.F90 rename to physics/Interstitials/GFS/GFS_rad_time_vary.scm.F90 diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta similarity index 98% rename from physics/GFS_rad_time_vary.scm.meta rename to physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta index 19eb41dc2..0759b7e2a 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_rad_time_vary type = scheme - dependencies = machine.F,mersenne_twister.f,radcons.f90 + relative_path = ../../ + dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_radiation_surface.F90 b/physics/Interstitials/GFS/GFS_radiation_surface.F90 similarity index 100% rename from physics/GFS_radiation_surface.F90 rename to physics/Interstitials/GFS/GFS_radiation_surface.F90 diff --git a/physics/GFS_radiation_surface.meta b/physics/Interstitials/GFS/GFS_radiation_surface.meta similarity index 98% rename from physics/GFS_radiation_surface.meta rename to physics/Interstitials/GFS/GFS_radiation_surface.meta index 9d5734706..c18b81d9f 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/Interstitials/GFS/GFS_radiation_surface.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = GFS_radiation_surface type = scheme - dependencies = iounitdef.f,machine.F,radiation_surface.f,set_soilveg_ruc.F90,namelist_soilveg_ruc.F90 + relative_path = ../../ + dependencies = Radiation/iounitdef.f,Radiation/radiation_surface.f + dependencies = Land/RUC/set_soilveg_ruc.F90,Land/RUC/namelist_soilveg_ruc.F90 + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_post.F90 b/physics/Interstitials/GFS/GFS_rrtmg_post.F90 similarity index 100% rename from physics/GFS_rrtmg_post.F90 rename to physics/Interstitials/GFS/GFS_rrtmg_post.F90 diff --git a/physics/GFS_rrtmg_post.meta b/physics/Interstitials/GFS/GFS_rrtmg_post.meta similarity index 97% rename from physics/GFS_rrtmg_post.meta rename to physics/Interstitials/GFS/GFS_rrtmg_post.meta index 5fa6328a7..c84b9da31 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/Interstitials/GFS/GFS_rrtmg_post.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmg_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radsw_param.f + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/iounitdef.f,Radiation/radiation_aerosols.f,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/Interstitials/GFS/GFS_rrtmg_pre.F90 similarity index 100% rename from physics/GFS_rrtmg_pre.F90 rename to physics/Interstitials/GFS/GFS_rrtmg_pre.F90 diff --git a/physics/GFS_rrtmg_pre.meta b/physics/Interstitials/GFS/GFS_rrtmg_pre.meta similarity index 98% rename from physics/GFS_rrtmg_pre.meta rename to physics/Interstitials/GFS/GFS_rrtmg_pre.meta index a8aecdbe0..e0e67c8f5 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/GFS/GFS_rrtmg_pre.meta @@ -1,9 +1,13 @@ [ccpp-table-properties] name = GFS_rrtmg_pre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_radar.F90,module_mp_thompson.F90 - dependencies = module_mp_thompson_make_number_concentrations.F90,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90,radiation_cloud_overlap.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F + dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompsonmodule_mp_thompson_make_number_concentrations.F90 + dependencies = Radiation/iounitdef.f,Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f + dependencies = Radiation/radlw_param.f,Radiation/radsw_param.f,Radiation/radiation_cloud_overlap.F90 + dependencies = Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/Interstitials/GFS/GFS_rrtmg_setup.F90 similarity index 100% rename from physics/GFS_rrtmg_setup.F90 rename to physics/Interstitials/GFS/GFS_rrtmg_setup.F90 diff --git a/physics/GFS_rrtmg_setup.meta b/physics/Interstitials/GFS/GFS_rrtmg_setup.meta similarity index 97% rename from physics/GFS_rrtmg_setup.meta rename to physics/Interstitials/GFS/GFS_rrtmg_setup.meta index adf6d8750..0c199deaa 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/Interstitials/GFS/GFS_rrtmg_setup.meta @@ -1,8 +1,12 @@ [ccpp-table-properties] name = GFS_rrtmg_setup type = scheme - dependencies = iounitdef.f,module_bfmicrophysics.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f - dependencies = module_mp_thompson.F90,radiation_gases.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f,machine.F + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiaiton/iounitdef.f,Radiaiton/RRTMG/radcons.f90,Radiaiton/radiation_aerosols.f + dependencies = Radiaiton/radiation_astronomy.f,Radiaiton/radiation_clouds.f,Radiaiton/radiation_gases.f + dependencies = Radiaiton/radlw_main.F90,Radiaiton/radlw_param.f,Radiaiton/radsw_main.F90,Radiaiton/radsw_param.f + dependencies = MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.F90 similarity index 100% rename from physics/GFS_rrtmgp_cloud_mp.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.F90 diff --git a/physics/GFS_rrtmgp_cloud_mp.meta b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta similarity index 98% rename from physics/GFS_rrtmgp_cloud_mp.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta index b782e73b4..f67259b87 100644 --- a/physics/GFS_rrtmgp_cloud_mp.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = GFS_rrtmgp_cloud_mp type = scheme - dependencies = radiation_tools.F90, radiation_clouds.f, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90, rrtmgp_lw_cloud_optics.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/radiation_tools.F90,Radiation/radiation_clouds.f,Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 + dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90,MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_cloud_overlap.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.F90 similarity index 100% rename from physics/GFS_rrtmgp_cloud_overlap.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.F90 diff --git a/physics/GFS_rrtmgp_cloud_overlap.meta b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta similarity index 98% rename from physics/GFS_rrtmgp_cloud_overlap.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta index cf6a05217..4d9af626d 100644 --- a/physics/GFS_rrtmgp_cloud_overlap.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_cloud_overlap type = scheme - dependencies = radiation_tools.F90, radiation_cloud_overlap.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = Radiation/radiation_tools.F90,Radiation/radiation_cloud_overlap.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_post.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_post.F90 similarity index 100% rename from physics/GFS_rrtmgp_post.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_post.F90 diff --git a/physics/GFS_rrtmgp_post.meta b/physics/Interstitials/GFS/GFS_rrtmgp_post.meta similarity index 98% rename from physics/GFS_rrtmgp_post.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_post.meta index e4bc3e5dc..c21c2ef7c 100644 --- a/physics/GFS_rrtmgp_post.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_post.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,radiation_tools.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 + relative_path = ../../ + dependencies = Radiation/iounitdef.f,hooks/machine.F,Radiation/radiation_aerosols.f + dependencies = Radiation/RRTMG/radlw_param.f,Radiation/radiation_tools.F90,Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 similarity index 99% rename from physics/GFS_rrtmgp_pre.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 index 009eb8c38..b76f93659 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 @@ -9,7 +9,6 @@ module GFS_rrtmgp_pre use funcphys, only: fpvs use module_radiation_astronomy, only: coszmn use module_radiation_gases, only: NF_VGAS, getgases, getozn - use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg,cmp_tlev use rrtmgp_lw_gas_optics, only: lw_gas_props diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/Interstitials/GFS/GFS_rrtmgp_pre.meta similarity index 98% rename from physics/GFS_rrtmgp_pre.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_pre.meta index abb07b825..ae67ef51b 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_pre.meta @@ -1,8 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_pre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_gases.f,radiation_tools.F90,rrtmg_lw_cloud_optics.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/iounitdef.f,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_gases.f,Radiation/radiation_tools.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/Interstitials/GFS/GFS_rrtmgp_setup.F90 similarity index 100% rename from physics/GFS_rrtmgp_setup.F90 rename to physics/Interstitials/GFS/GFS_rrtmgp_setup.F90 diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/Interstitials/GFS/GFS_rrtmgp_setup.meta similarity index 97% rename from physics/GFS_rrtmgp_setup.meta rename to physics/Interstitials/GFS/GFS_rrtmgp_setup.meta index c4f7cfaa5..5d21e1910 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/Interstitials/GFS/GFS_rrtmgp_setup.meta @@ -1,8 +1,10 @@ [ccpp-table-properties] name = GFS_rrtmgp_setup type = scheme - dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,radiation_aerosols.f,radiation_astronomy.f - dependencies = module_mp_thompson.F90,radiation_gases.f + relative_path = ../../ + dependencies = hooks/machine.F,MP/Thompson/module_mp_thompson.F90 + dependencies = Radiation/iounitdef.f,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_gases.f,Radiation/radiation_astronomy.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_stochastics.F90 b/physics/Interstitials/GFS/GFS_stochastics.F90 similarity index 100% rename from physics/GFS_stochastics.F90 rename to physics/Interstitials/GFS/GFS_stochastics.F90 diff --git a/physics/GFS_stochastics.meta b/physics/Interstitials/GFS/GFS_stochastics.meta similarity index 99% rename from physics/GFS_stochastics.meta rename to physics/Interstitials/GFS/GFS_stochastics.meta index 796f4ddf7..6c55a09de 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/Interstitials/GFS/GFS_stochastics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_stochastics type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F [ccpp-arg-table] name = GFS_stochastics_init diff --git a/physics/GFS_suite_interstitial_1.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_1.F90 similarity index 100% rename from physics/GFS_suite_interstitial_1.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_1.F90 diff --git a/physics/GFS_suite_interstitial_1.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_1.meta similarity index 99% rename from physics/GFS_suite_interstitial_1.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_1.meta index a465ed320..295ffdf2e 100644 --- a/physics/GFS_suite_interstitial_1.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_1.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_1 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_2.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_2.F90 similarity index 100% rename from physics/GFS_suite_interstitial_2.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_2.F90 diff --git a/physics/GFS_suite_interstitial_2.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_2.meta similarity index 99% rename from physics/GFS_suite_interstitial_2.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_2.meta index 1f4300574..de4db5f9f 100644 --- a/physics/GFS_suite_interstitial_2.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_2.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_2 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_3.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_3.F90 similarity index 100% rename from physics/GFS_suite_interstitial_3.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_3.F90 diff --git a/physics/GFS_suite_interstitial_3.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_3.meta similarity index 99% rename from physics/GFS_suite_interstitial_3.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_3.meta index e8f9fe889..22f57e354 100644 --- a/physics/GFS_suite_interstitial_3.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_3.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_3 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_4.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_4.F90 similarity index 100% rename from physics/GFS_suite_interstitial_4.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_4.F90 diff --git a/physics/GFS_suite_interstitial_4.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_4.meta similarity index 98% rename from physics/GFS_suite_interstitial_4.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_4.meta index 92870d95f..c0df52f1a 100644 --- a/physics/GFS_suite_interstitial_4.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_4.meta @@ -2,7 +2,9 @@ [ccpp-table-properties] name = GFS_suite_interstitial_4 type = scheme - dependencies = machine.F,module_mp_thompson_make_number_concentrations.F90 + relative_path = ../../ + dependencies = hooks/machine.F + dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_5.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_5.F90 similarity index 100% rename from physics/GFS_suite_interstitial_5.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_5.F90 diff --git a/physics/GFS_suite_interstitial_5.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_5.meta similarity index 98% rename from physics/GFS_suite_interstitial_5.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_5.meta index 9d32160a1..511137901 100644 --- a/physics/GFS_suite_interstitial_5.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_5.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_5 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_phys_reset.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.F90 similarity index 100% rename from physics/GFS_suite_interstitial_phys_reset.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.F90 diff --git a/physics/GFS_suite_interstitial_phys_reset.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta similarity index 96% rename from physics/GFS_suite_interstitial_phys_reset.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta index adebbc833..947a1950f 100644 --- a/physics/GFS_suite_interstitial_phys_reset.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_phys_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_interstitial_rad_reset.F90 b/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.F90 similarity index 100% rename from physics/GFS_suite_interstitial_rad_reset.F90 rename to physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.F90 diff --git a/physics/GFS_suite_interstitial_rad_reset.meta b/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta similarity index 96% rename from physics/GFS_suite_interstitial_rad_reset.meta rename to physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta index 91fd8cba7..aaaff02f5 100644 --- a/physics/GFS_suite_interstitial_rad_reset.meta +++ b/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_suite_interstitial_rad_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_stateout_reset.F90 b/physics/Interstitials/GFS/GFS_suite_stateout_reset.F90 similarity index 100% rename from physics/GFS_suite_stateout_reset.F90 rename to physics/Interstitials/GFS/GFS_suite_stateout_reset.F90 diff --git a/physics/GFS_suite_stateout_reset.meta b/physics/Interstitials/GFS/GFS_suite_stateout_reset.meta similarity index 98% rename from physics/GFS_suite_stateout_reset.meta rename to physics/Interstitials/GFS/GFS_suite_stateout_reset.meta index fa4111e6b..b84d10691 100644 --- a/physics/GFS_suite_stateout_reset.meta +++ b/physics/Interstitials/GFS/GFS_suite_stateout_reset.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_reset type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_suite_stateout_update.F90 b/physics/Interstitials/GFS/GFS_suite_stateout_update.F90 similarity index 100% rename from physics/GFS_suite_stateout_update.F90 rename to physics/Interstitials/GFS/GFS_suite_stateout_update.F90 diff --git a/physics/GFS_suite_stateout_update.meta b/physics/Interstitials/GFS/GFS_suite_stateout_update.meta similarity index 99% rename from physics/GFS_suite_stateout_update.meta rename to physics/Interstitials/GFS/GFS_suite_stateout_update.meta index 580482b71..8a0d784f2 100644 --- a/physics/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/GFS/GFS_suite_stateout_update.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_update type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites_inter.F90 b/physics/Interstitials/GFS/GFS_surface_composites_inter.F90 similarity index 100% rename from physics/GFS_surface_composites_inter.F90 rename to physics/Interstitials/GFS/GFS_surface_composites_inter.F90 diff --git a/physics/GFS_surface_composites_inter.meta b/physics/Interstitials/GFS/GFS_surface_composites_inter.meta similarity index 99% rename from physics/GFS_surface_composites_inter.meta rename to physics/Interstitials/GFS/GFS_surface_composites_inter.meta index 36af0ef5a..ef3005583 100644 --- a/physics/GFS_surface_composites_inter.meta +++ b/physics/Interstitials/GFS/GFS_surface_composites_inter.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_composites_inter type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites_post.F90 b/physics/Interstitials/GFS/GFS_surface_composites_post.F90 similarity index 100% rename from physics/GFS_surface_composites_post.F90 rename to physics/Interstitials/GFS/GFS_surface_composites_post.F90 diff --git a/physics/GFS_surface_composites_post.meta b/physics/Interstitials/GFS/GFS_surface_composites_post.meta similarity index 99% rename from physics/GFS_surface_composites_post.meta rename to physics/Interstitials/GFS/GFS_surface_composites_post.meta index a78610cc7..35b54544a 100644 --- a/physics/GFS_surface_composites_post.meta +++ b/physics/Interstitials/GFS/GFS_surface_composites_post.meta @@ -2,7 +2,8 @@ [ccpp-table-properties] name = GFS_surface_composites_post type = scheme - dependencies = machine.F,sfc_diff.f + relative_path = ../../ + dependencies = hooks/machine.F,SFC_Layer/GFS_sfc/sfc_diff.f ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/Interstitials/GFS/GFS_surface_composites_pre.F90 similarity index 100% rename from physics/GFS_surface_composites_pre.F90 rename to physics/Interstitials/GFS/GFS_surface_composites_pre.F90 diff --git a/physics/GFS_surface_composites_pre.meta b/physics/Interstitials/GFS/GFS_surface_composites_pre.meta similarity index 99% rename from physics/GFS_surface_composites_pre.meta rename to physics/Interstitials/GFS/GFS_surface_composites_pre.meta index d6b9003fe..33e2f0523 100644 --- a/physics/GFS_surface_composites_pre.meta +++ b/physics/Interstitials/GFS/GFS_surface_composites_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_composites_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_generic_post.F90 b/physics/Interstitials/GFS/GFS_surface_generic_post.F90 similarity index 100% rename from physics/GFS_surface_generic_post.F90 rename to physics/Interstitials/GFS/GFS_surface_generic_post.F90 diff --git a/physics/GFS_surface_generic_post.meta b/physics/Interstitials/GFS/GFS_surface_generic_post.meta similarity index 99% rename from physics/GFS_surface_generic_post.meta rename to physics/Interstitials/GFS/GFS_surface_generic_post.meta index 9658be7d8..2c28b17d7 100644 --- a/physics/GFS_surface_generic_post.meta +++ b/physics/Interstitials/GFS/GFS_surface_generic_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_generic_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_generic_pre.F90 b/physics/Interstitials/GFS/GFS_surface_generic_pre.F90 similarity index 100% rename from physics/GFS_surface_generic_pre.F90 rename to physics/Interstitials/GFS/GFS_surface_generic_pre.F90 diff --git a/physics/GFS_surface_generic_pre.meta b/physics/Interstitials/GFS/GFS_surface_generic_pre.meta similarity index 99% rename from physics/GFS_surface_generic_pre.meta rename to physics/Interstitials/GFS/GFS_surface_generic_pre.meta index d78988787..63fb9b96c 100644 --- a/physics/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/GFS/GFS_surface_generic_pre.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_surface_generic_pre type = scheme - dependencies = machine.F,surface_perturbation.F90 + relative_path = ../../ + dependencies = hooks/machine.F,Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_loop_control_part1.F90 b/physics/Interstitials/GFS/GFS_surface_loop_control_part1.F90 similarity index 100% rename from physics/GFS_surface_loop_control_part1.F90 rename to physics/Interstitials/GFS/GFS_surface_loop_control_part1.F90 diff --git a/physics/GFS_surface_loop_control_part1.meta b/physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta similarity index 97% rename from physics/GFS_surface_loop_control_part1.meta rename to physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta index f178320ee..4bf962f6e 100644 --- a/physics/GFS_surface_loop_control_part1.meta +++ b/physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_loop_control_part1 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_surface_loop_control_part2.F90 b/physics/Interstitials/GFS/GFS_surface_loop_control_part2.F90 similarity index 100% rename from physics/GFS_surface_loop_control_part2.F90 rename to physics/Interstitials/GFS/GFS_surface_loop_control_part2.F90 diff --git a/physics/GFS_surface_loop_control_part2.meta b/physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta similarity index 98% rename from physics/GFS_surface_loop_control_part2.meta rename to physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta index 7c9bc7408..ba19bf437 100644 --- a/physics/GFS_surface_loop_control_part2.meta +++ b/physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_loop_control_part2 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.F90 similarity index 100% rename from physics/GFS_time_vary_pre.fv3.F90 rename to physics/Interstitials/GFS/GFS_time_vary_pre.fv3.F90 diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta similarity index 98% rename from physics/GFS_time_vary_pre.fv3.meta rename to physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta index 3ec92287a..c6dd95bce 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_time_vary_pre type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/GFS/GFS_time_vary_pre.scm.F90 similarity index 100% rename from physics/GFS_time_vary_pre.scm.F90 rename to physics/Interstitials/GFS/GFS_time_vary_pre.scm.F90 diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta similarity index 98% rename from physics/GFS_time_vary_pre.scm.meta rename to physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta index 20708c51e..af9afcdfe 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_time_vary_pre type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/aerinterp.F90 b/physics/Interstitials/GFS/aerinterp.F90 similarity index 100% rename from physics/aerinterp.F90 rename to physics/Interstitials/GFS/aerinterp.F90 diff --git a/physics/cnvc90.f b/physics/Interstitials/GFS/cnvc90.f similarity index 100% rename from physics/cnvc90.f rename to physics/Interstitials/GFS/cnvc90.f diff --git a/physics/cnvc90.meta b/physics/Interstitials/GFS/cnvc90.meta similarity index 98% rename from physics/cnvc90.meta rename to physics/Interstitials/GFS/cnvc90.meta index 9728266d4..bbf161eb5 100644 --- a/physics/cnvc90.meta +++ b/physics/Interstitials/GFS/cnvc90.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = cnvc90 type = scheme - dependencies = + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/dcyc2t3.f b/physics/Interstitials/GFS/dcyc2t3.f similarity index 100% rename from physics/dcyc2t3.f rename to physics/Interstitials/GFS/dcyc2t3.f diff --git a/physics/dcyc2t3.meta b/physics/Interstitials/GFS/dcyc2t3.meta similarity index 99% rename from physics/dcyc2t3.meta rename to physics/Interstitials/GFS/dcyc2t3.meta index 65b05f4b3..95b3f341b 100644 --- a/physics/dcyc2t3.meta +++ b/physics/Interstitials/GFS/dcyc2t3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = dcyc2t3 type = scheme - dependencies = machine.F,physcons.F90 + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/gcycle.F90 b/physics/Interstitials/GFS/gcycle.F90 similarity index 100% rename from physics/gcycle.F90 rename to physics/Interstitials/GFS/gcycle.F90 diff --git a/physics/iccn_def.F b/physics/Interstitials/GFS/iccn_def.F similarity index 100% rename from physics/iccn_def.F rename to physics/Interstitials/GFS/iccn_def.F diff --git a/physics/iccninterp.F90 b/physics/Interstitials/GFS/iccninterp.F90 similarity index 100% rename from physics/iccninterp.F90 rename to physics/Interstitials/GFS/iccninterp.F90 diff --git a/physics/maximum_hourly_diagnostics.F90 b/physics/Interstitials/GFS/maximum_hourly_diagnostics.F90 similarity index 100% rename from physics/maximum_hourly_diagnostics.F90 rename to physics/Interstitials/GFS/maximum_hourly_diagnostics.F90 diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/Interstitials/GFS/maximum_hourly_diagnostics.meta similarity index 99% rename from physics/maximum_hourly_diagnostics.meta rename to physics/Interstitials/GFS/maximum_hourly_diagnostics.meta index e9d0876d2..0c2d1bcbe 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/Interstitials/GFS/maximum_hourly_diagnostics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = maximum_hourly_diagnostics type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/phys_tend.F90 b/physics/Interstitials/GFS/phys_tend.F90 similarity index 100% rename from physics/phys_tend.F90 rename to physics/Interstitials/GFS/phys_tend.F90 diff --git a/physics/phys_tend.meta b/physics/Interstitials/GFS/phys_tend.meta similarity index 98% rename from physics/phys_tend.meta rename to physics/Interstitials/GFS/phys_tend.meta index 0f78af20b..d2a7bcf6b 100644 --- a/physics/phys_tend.meta +++ b/physics/Interstitials/GFS/phys_tend.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = phys_tend type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/Interstitials/GFS/scm_sfc_flux_spec.F90 similarity index 100% rename from physics/scm_sfc_flux_spec.F90 rename to physics/Interstitials/GFS/scm_sfc_flux_spec.F90 diff --git a/physics/scm_sfc_flux_spec.meta b/physics/Interstitials/GFS/scm_sfc_flux_spec.meta similarity index 99% rename from physics/scm_sfc_flux_spec.meta rename to physics/Interstitials/GFS/scm_sfc_flux_spec.meta index 52722f1c4..85bf403ad 100644 --- a/physics/scm_sfc_flux_spec.meta +++ b/physics/Interstitials/GFS/scm_sfc_flux_spec.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = scm_sfc_flux_spec type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfcsub.F b/physics/Interstitials/GFS/sfcsub.F similarity index 100% rename from physics/sfcsub.F rename to physics/Interstitials/GFS/sfcsub.F diff --git a/physics/sgscloud_radpost.F90 b/physics/Interstitials/GFS/sgscloud_radpost.F90 similarity index 100% rename from physics/sgscloud_radpost.F90 rename to physics/Interstitials/GFS/sgscloud_radpost.F90 diff --git a/physics/sgscloud_radpost.meta b/physics/Interstitials/GFS/sgscloud_radpost.meta similarity index 98% rename from physics/sgscloud_radpost.meta rename to physics/Interstitials/GFS/sgscloud_radpost.meta index 6ad91d496..046531a0a 100644 --- a/physics/sgscloud_radpost.meta +++ b/physics/Interstitials/GFS/sgscloud_radpost.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sgscloud_radpost type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sgscloud_radpre.F90 b/physics/Interstitials/GFS/sgscloud_radpre.F90 similarity index 100% rename from physics/sgscloud_radpre.F90 rename to physics/Interstitials/GFS/sgscloud_radpre.F90 diff --git a/physics/sgscloud_radpre.meta b/physics/Interstitials/GFS/sgscloud_radpre.meta similarity index 98% rename from physics/sgscloud_radpre.meta rename to physics/Interstitials/GFS/sgscloud_radpre.meta index d5341bcd4..c9fd5950c 100644 --- a/physics/sgscloud_radpre.meta +++ b/physics/Interstitials/GFS/sgscloud_radpre.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = sgscloud_radpre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_clouds.f,module_mp_thompson.F90 + relative_path = ../../ + dependencies = tools/funcphys.f90,Radiation/iounitdef.f,hooks/machine.F,hooks/physcons.F90 + dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 + dependencies = Radiation/radiation_clouds.f,MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/clm_lake.f90 b/physics/Land/CLM_lake/clm_lake.f90 similarity index 100% rename from physics/clm_lake.f90 rename to physics/Land/CLM_lake/clm_lake.f90 diff --git a/physics/clm_lake.meta b/physics/Land/CLM_lake/clm_lake.meta similarity index 99% rename from physics/clm_lake.meta rename to physics/Land/CLM_lake/clm_lake.meta index bbaaded16..49564f66c 100644 --- a/physics/clm_lake.meta +++ b/physics/Land/CLM_lake/clm_lake.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = clm_lake type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/flake.F90 b/physics/Land/Flake/flake.F90 similarity index 100% rename from physics/flake.F90 rename to physics/Land/Flake/flake.F90 diff --git a/physics/flake_driver.F90 b/physics/Land/Flake/flake_driver.F90 similarity index 100% rename from physics/flake_driver.F90 rename to physics/Land/Flake/flake_driver.F90 diff --git a/physics/flake_driver.meta b/physics/Land/Flake/flake_driver.meta similarity index 99% rename from physics/flake_driver.meta rename to physics/Land/Flake/flake_driver.meta index e665dc962..8b295bc27 100644 --- a/physics/flake_driver.meta +++ b/physics/Land/Flake/flake_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = flake_driver type = scheme - dependencies = flake.F90,machine.F + dependencies = ../../hooks/machine.F,flake.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/lsm_noah.f b/physics/Land/Noah/lsm_noah.f similarity index 100% rename from physics/lsm_noah.f rename to physics/Land/Noah/lsm_noah.f diff --git a/physics/lsm_noah.meta b/physics/Land/Noah/lsm_noah.meta similarity index 99% rename from physics/lsm_noah.meta rename to physics/Land/Noah/lsm_noah.meta index e059a22c6..2dc612d5b 100644 --- a/physics/lsm_noah.meta +++ b/physics/Land/Noah/lsm_noah.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = lsm_noah type = scheme - dependencies = funcphys.f90,machine.F,set_soilveg.f,sflx.f,surface_perturbation.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F + dependencies = ../set_soilveg.f,sflx.f,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sflx.f b/physics/Land/Noah/sflx.f similarity index 100% rename from physics/sflx.f rename to physics/Land/Noah/sflx.f diff --git a/physics/surface_perturbation.F90 b/physics/Land/Noah/surface_perturbation.F90 similarity index 100% rename from physics/surface_perturbation.F90 rename to physics/Land/Noah/surface_perturbation.F90 diff --git a/physics/module_sf_noahmp_glacier.F90 b/physics/Land/Noahmp/module_sf_noahmp_glacier.F90 similarity index 100% rename from physics/module_sf_noahmp_glacier.F90 rename to physics/Land/Noahmp/module_sf_noahmp_glacier.F90 diff --git a/physics/module_sf_noahmplsm.F90 b/physics/Land/Noahmp/module_sf_noahmplsm.F90 similarity index 100% rename from physics/module_sf_noahmplsm.F90 rename to physics/Land/Noahmp/module_sf_noahmplsm.F90 diff --git a/physics/noahmp_tables.f90 b/physics/Land/Noahmp/noahmp_tables.f90 similarity index 100% rename from physics/noahmp_tables.f90 rename to physics/Land/Noahmp/noahmp_tables.f90 diff --git a/physics/noahmpdrv.F90 b/physics/Land/Noahmp/noahmpdrv.F90 similarity index 100% rename from physics/noahmpdrv.F90 rename to physics/Land/Noahmp/noahmpdrv.F90 diff --git a/physics/noahmpdrv.meta b/physics/Land/Noahmp/noahmpdrv.meta similarity index 99% rename from physics/noahmpdrv.meta rename to physics/Land/Noahmp/noahmpdrv.meta index 820da5740..55a787cd7 100644 --- a/physics/noahmpdrv.meta +++ b/physics/Land/Noahmp/noahmpdrv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = funcphys.f90,machine.F,sfc_diff.f,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,set_soilveg.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,../set_soilveg.f ######################################################################## [ccpp-arg-table] diff --git a/physics/noahmptable.tbl b/physics/Land/Noahmp/noahmptable.tbl similarity index 100% rename from physics/noahmptable.tbl rename to physics/Land/Noahmp/noahmptable.tbl diff --git a/physics/lsm_ruc.F90 b/physics/Land/RUC/lsm_ruc.F90 similarity index 100% rename from physics/lsm_ruc.F90 rename to physics/Land/RUC/lsm_ruc.F90 diff --git a/physics/lsm_ruc.meta b/physics/Land/RUC/lsm_ruc.meta similarity index 99% rename from physics/lsm_ruc.meta rename to physics/Land/RUC/lsm_ruc.meta index 34a5b8a8b..f02d6de67 100644 --- a/physics/lsm_ruc.meta +++ b/physics/Land/RUC/lsm_ruc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = lsm_ruc type = scheme - dependencies = machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 + dependencies = ../../hooks/machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_sf_ruclsm.F90 b/physics/Land/RUC/module_sf_ruclsm.F90 similarity index 100% rename from physics/module_sf_ruclsm.F90 rename to physics/Land/RUC/module_sf_ruclsm.F90 diff --git a/physics/module_soil_pre.F90 b/physics/Land/RUC/module_soil_pre.F90 similarity index 100% rename from physics/module_soil_pre.F90 rename to physics/Land/RUC/module_soil_pre.F90 diff --git a/physics/namelist_soilveg_ruc.F90 b/physics/Land/RUC/namelist_soilveg_ruc.F90 similarity index 100% rename from physics/namelist_soilveg_ruc.F90 rename to physics/Land/RUC/namelist_soilveg_ruc.F90 diff --git a/physics/set_soilveg_ruc.F90 b/physics/Land/RUC/set_soilveg_ruc.F90 similarity index 100% rename from physics/set_soilveg_ruc.F90 rename to physics/Land/RUC/set_soilveg_ruc.F90 diff --git a/physics/namelist_soilveg.f b/physics/Land/namelist_soilveg.f similarity index 100% rename from physics/namelist_soilveg.f rename to physics/Land/namelist_soilveg.f diff --git a/physics/set_soilveg.f b/physics/Land/set_soilveg.f similarity index 100% rename from physics/set_soilveg.f rename to physics/Land/set_soilveg.f diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 similarity index 100% rename from physics/module_MP_FER_HIRES.F90 rename to physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 diff --git a/physics/mp_fer_hires.F90 b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 similarity index 100% rename from physics/mp_fer_hires.F90 rename to physics/MP/Ferrier_Aligo/mp_fer_hires.F90 diff --git a/physics/mp_fer_hires.meta b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta similarity index 99% rename from physics/mp_fer_hires.meta rename to physics/MP/Ferrier_Aligo/mp_fer_hires.meta index 9f7c63d4d..0f7be213e 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_fer_hires type = scheme - dependencies = machine.F,module_MP_FER_HIRES.F90 + dependencies = ../../hooks/machine.F,module_MP_FER_HIRES.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFDL_parse_tracers.F90 b/physics/MP/GFDL/GFDL_parse_tracers.F90 similarity index 100% rename from physics/GFDL_parse_tracers.F90 rename to physics/MP/GFDL/GFDL_parse_tracers.F90 diff --git a/physics/fv_sat_adj.F90 b/physics/MP/GFDL/fv_sat_adj.F90 similarity index 100% rename from physics/fv_sat_adj.F90 rename to physics/MP/GFDL/fv_sat_adj.F90 diff --git a/physics/fv_sat_adj.meta b/physics/MP/GFDL/fv_sat_adj.meta similarity index 99% rename from physics/fv_sat_adj.meta rename to physics/MP/GFDL/fv_sat_adj.meta index 5cdc96358..8c3c9be42 100644 --- a/physics/fv_sat_adj.meta +++ b/physics/MP/GFDL/fv_sat_adj.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = fv_sat_adj type = scheme - dependencies = machine.F,module_gfdl_cloud_microphys.F90,module_mp_radar.F90,multi_gases.F90,physcons.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,module_gfdl_cloud_microphys.F90,multi_gases.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/gfdl_cloud_microphys.F90 b/physics/MP/GFDL/gfdl_cloud_microphys.F90 similarity index 100% rename from physics/gfdl_cloud_microphys.F90 rename to physics/MP/GFDL/gfdl_cloud_microphys.F90 diff --git a/physics/gfdl_cloud_microphys.meta b/physics/MP/GFDL/gfdl_cloud_microphys.meta similarity index 99% rename from physics/gfdl_cloud_microphys.meta rename to physics/MP/GFDL/gfdl_cloud_microphys.meta index 5e752b473..35b216d4a 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/MP/GFDL/gfdl_cloud_microphys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gfdl_cloud_microphys type = scheme - dependencies = machine.F,module_mp_radar.F90,module_gfdl_cloud_microphys.F90 + dependencies = ../../hooks/machine.F,module_gfdl_cloud_microphys.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/gfdl_sfc_layer.F90 b/physics/MP/GFDL/gfdl_sfc_layer.F90 similarity index 100% rename from physics/gfdl_sfc_layer.F90 rename to physics/MP/GFDL/gfdl_sfc_layer.F90 diff --git a/physics/gfdl_sfc_layer.meta b/physics/MP/GFDL/gfdl_sfc_layer.meta similarity index 99% rename from physics/gfdl_sfc_layer.meta rename to physics/MP/GFDL/gfdl_sfc_layer.meta index f1c7a4ce2..a64fe277c 100644 --- a/physics/gfdl_sfc_layer.meta +++ b/physics/MP/GFDL/gfdl_sfc_layer.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = gfdl_sfc_layer type = scheme - dependencies = machine.F,module_sf_exchcoef.f90,namelist_soilveg_ruc.F90,noahmp_tables.f90 + dependencies = ../../hooks/machine.F,../SFC_Layer/module_sf_exchcoef.f90,../../Land/RUC/namelist_soilveg_ruc.F90,../../Land/Noahmp/noahmp_tables.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 similarity index 100% rename from physics/module_gfdl_cloud_microphys.F90 rename to physics/MP/GFDL/module_gfdl_cloud_microphys.F90 diff --git a/physics/module_sf_exchcoef.f90 b/physics/MP/GFDL/module_sf_exchcoef.f90 similarity index 100% rename from physics/module_sf_exchcoef.f90 rename to physics/MP/GFDL/module_sf_exchcoef.f90 diff --git a/physics/multi_gases.F90 b/physics/MP/GFDL/multi_gases.F90 similarity index 100% rename from physics/multi_gases.F90 rename to physics/MP/GFDL/multi_gases.F90 diff --git a/physics/aer_cloud.F b/physics/MP/Morrison_Gettelman/aer_cloud.F similarity index 100% rename from physics/aer_cloud.F rename to physics/MP/Morrison_Gettelman/aer_cloud.F diff --git a/physics/aerclm_def.F b/physics/MP/Morrison_Gettelman/aerclm_def.F similarity index 100% rename from physics/aerclm_def.F rename to physics/MP/Morrison_Gettelman/aerclm_def.F diff --git a/physics/cldmacro.F b/physics/MP/Morrison_Gettelman/cldmacro.F similarity index 100% rename from physics/cldmacro.F rename to physics/MP/Morrison_Gettelman/cldmacro.F diff --git a/physics/cldwat2m_micro.F b/physics/MP/Morrison_Gettelman/cldwat2m_micro.F similarity index 100% rename from physics/cldwat2m_micro.F rename to physics/MP/Morrison_Gettelman/cldwat2m_micro.F diff --git a/physics/m_micro.F90 b/physics/MP/Morrison_Gettelman/m_micro.F90 similarity index 100% rename from physics/m_micro.F90 rename to physics/MP/Morrison_Gettelman/m_micro.F90 diff --git a/physics/m_micro.meta b/physics/MP/Morrison_Gettelman/m_micro.meta similarity index 99% rename from physics/m_micro.meta rename to physics/MP/Morrison_Gettelman/m_micro.meta index a9b5ec4db..4b6df18c7 100644 --- a/physics/m_micro.meta +++ b/physics/MP/Morrison_Gettelman/m_micro.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = m_micro type = scheme - dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,machine.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,physcons.F90,wv_saturation.F,machine.F + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,wv_saturation.F ######################################################################## [ccpp-arg-table] diff --git a/physics/m_micro_post.F90 b/physics/MP/Morrison_Gettelman/m_micro_post.F90 similarity index 100% rename from physics/m_micro_post.F90 rename to physics/MP/Morrison_Gettelman/m_micro_post.F90 diff --git a/physics/m_micro_post.meta b/physics/MP/Morrison_Gettelman/m_micro_post.meta similarity index 99% rename from physics/m_micro_post.meta rename to physics/MP/Morrison_Gettelman/m_micro_post.meta index 684ac3f21..88a4325e7 100644 --- a/physics/m_micro_post.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = m_micro_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/m_micro_pre.F90 b/physics/MP/Morrison_Gettelman/m_micro_pre.F90 similarity index 100% rename from physics/m_micro_pre.F90 rename to physics/MP/Morrison_Gettelman/m_micro_pre.F90 diff --git a/physics/m_micro_pre.meta b/physics/MP/Morrison_Gettelman/m_micro_pre.meta similarity index 99% rename from physics/m_micro_pre.meta rename to physics/MP/Morrison_Gettelman/m_micro_pre.meta index 7ac592833..b8cd2ac32 100644 --- a/physics/m_micro_pre.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = m_micro_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/micro_mg2_0.F90 b/physics/MP/Morrison_Gettelman/micro_mg2_0.F90 similarity index 100% rename from physics/micro_mg2_0.F90 rename to physics/MP/Morrison_Gettelman/micro_mg2_0.F90 diff --git a/physics/micro_mg3_0.F90 b/physics/MP/Morrison_Gettelman/micro_mg3_0.F90 similarity index 100% rename from physics/micro_mg3_0.F90 rename to physics/MP/Morrison_Gettelman/micro_mg3_0.F90 diff --git a/physics/micro_mg_utils.F90 b/physics/MP/Morrison_Gettelman/micro_mg_utils.F90 similarity index 100% rename from physics/micro_mg_utils.F90 rename to physics/MP/Morrison_Gettelman/micro_mg_utils.F90 diff --git a/physics/wv_saturation.F b/physics/MP/Morrison_Gettelman/wv_saturation.F similarity index 100% rename from physics/wv_saturation.F rename to physics/MP/Morrison_Gettelman/wv_saturation.F diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/MP/NSSL/module_mp_nssl_2mom.F90 similarity index 100% rename from physics/module_mp_nssl_2mom.F90 rename to physics/MP/NSSL/module_mp_nssl_2mom.F90 diff --git a/physics/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 similarity index 100% rename from physics/mp_nssl.F90 rename to physics/MP/NSSL/mp_nssl.F90 diff --git a/physics/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta similarity index 99% rename from physics/mp_nssl.meta rename to physics/MP/NSSL/mp_nssl.meta index 6bbf92c73..ff7c82223 100644 --- a/physics/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_nssl type = scheme - dependencies = machine.F,module_mp_nssl_2mom.F90 + dependencies = ../../hooks/machine.F,module_mp_nssl_2mom.F90 [ccpp-arg-table] name = mp_nssl_init diff --git a/physics/module_mp_radar.F90 b/physics/MP/Thompson/module_mp_radar.F90 similarity index 100% rename from physics/module_mp_radar.F90 rename to physics/MP/Thompson/module_mp_radar.F90 diff --git a/physics/module_mp_thompson.F90 b/physics/MP/Thompson/module_mp_thompson.F90 similarity index 100% rename from physics/module_mp_thompson.F90 rename to physics/MP/Thompson/module_mp_thompson.F90 diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 similarity index 100% rename from physics/module_mp_thompson_make_number_concentrations.F90 rename to physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 diff --git a/physics/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 similarity index 100% rename from physics/mp_thompson.F90 rename to physics/MP/Thompson/mp_thompson.F90 diff --git a/physics/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta similarity index 99% rename from physics/mp_thompson.meta rename to physics/MP/Thompson/mp_thompson.meta index 691698281..c3795e10e 100644 --- a/physics/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_thompson type = scheme - dependencies = machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 + dependencies = ../../hooks/machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/mp_thompson_post.F90 b/physics/MP/Thompson/mp_thompson_post.F90 similarity index 100% rename from physics/mp_thompson_post.F90 rename to physics/MP/Thompson/mp_thompson_post.F90 diff --git a/physics/mp_thompson_post.meta b/physics/MP/Thompson/mp_thompson_post.meta similarity index 98% rename from physics/mp_thompson_post.meta rename to physics/MP/Thompson/mp_thompson_post.meta index 82b035e99..43e89b29c 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/MP/Thompson/mp_thompson_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_thompson_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/mp_thompson_pre.F90 b/physics/MP/Thompson/mp_thompson_pre.F90 similarity index 100% rename from physics/mp_thompson_pre.F90 rename to physics/MP/Thompson/mp_thompson_pre.F90 diff --git a/physics/mp_thompson_pre.meta b/physics/MP/Thompson/mp_thompson_pre.meta similarity index 97% rename from physics/mp_thompson_pre.meta rename to physics/MP/Thompson/mp_thompson_pre.meta index 12e812bb3..563eb2809 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/MP/Thompson/mp_thompson_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mp_thompson_pre type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/zhaocarr_gscond.f b/physics/MP/Zhao_Carr/zhaocarr_gscond.f similarity index 100% rename from physics/zhaocarr_gscond.f rename to physics/MP/Zhao_Carr/zhaocarr_gscond.f diff --git a/physics/zhaocarr_gscond.meta b/physics/MP/Zhao_Carr/zhaocarr_gscond.meta similarity index 98% rename from physics/zhaocarr_gscond.meta rename to physics/MP/Zhao_Carr/zhaocarr_gscond.meta index 493397722..ed57ca909 100644 --- a/physics/zhaocarr_gscond.meta +++ b/physics/MP/Zhao_Carr/zhaocarr_gscond.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = zhaocarr_gscond type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/zhaocarr_precpd.f b/physics/MP/Zhao_Carr/zhaocarr_precpd.f similarity index 100% rename from physics/zhaocarr_precpd.f rename to physics/MP/Zhao_Carr/zhaocarr_precpd.f diff --git a/physics/zhaocarr_precpd.meta b/physics/MP/Zhao_Carr/zhaocarr_precpd.meta similarity index 98% rename from physics/zhaocarr_precpd.meta rename to physics/MP/Zhao_Carr/zhaocarr_precpd.meta index 67f1a530b..86e6c7d67 100644 --- a/physics/zhaocarr_precpd.meta +++ b/physics/MP/Zhao_Carr/zhaocarr_precpd.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = zhaocarr_precpd type = scheme - dependencies = funcphys.f90,machine.F,physcons.F90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/calpreciptype.f90 b/physics/MP/calpreciptype.f90 similarity index 100% rename from physics/calpreciptype.f90 rename to physics/MP/calpreciptype.f90 diff --git a/physics/gfs_phy_tracer_config.F b/physics/NOTUSED/gfs_phy_tracer_config.F similarity index 100% rename from physics/gfs_phy_tracer_config.F rename to physics/NOTUSED/gfs_phy_tracer_config.F diff --git a/physics/gocart_tracer_config_stub.f b/physics/NOTUSED/gocart_tracer_config_stub.f similarity index 100% rename from physics/gocart_tracer_config_stub.f rename to physics/NOTUSED/gocart_tracer_config_stub.f diff --git a/physics/rrtmg_lw_pre.F90 b/physics/NOTUSED/rrtmg_lw_pre.F90 similarity index 100% rename from physics/rrtmg_lw_pre.F90 rename to physics/NOTUSED/rrtmg_lw_pre.F90 diff --git a/physics/rrtmg_lw_pre.meta b/physics/NOTUSED/rrtmg_lw_pre.meta similarity index 100% rename from physics/rrtmg_lw_pre.meta rename to physics/NOTUSED/rrtmg_lw_pre.meta diff --git a/physics/hedmf.f b/physics/PBL/HEDMF/hedmf.f similarity index 100% rename from physics/hedmf.f rename to physics/PBL/HEDMF/hedmf.f diff --git a/physics/hedmf.meta b/physics/PBL/HEDMF/hedmf.meta similarity index 99% rename from physics/hedmf.meta rename to physics/PBL/HEDMF/hedmf.meta index c2d873065..be0c83741 100644 --- a/physics/hedmf.meta +++ b/physics/PBL/HEDMF/hedmf.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = hedmf type = scheme - dependencies = funcphys.f90,machine.F,mfpbl.f,physcons.F90,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../../hooks/physcons.F90,../mfpbl.f,../tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/module_BL_MYJPBL.F90 b/physics/PBL/MYJ/module_BL_MYJPBL.F90 similarity index 100% rename from physics/module_BL_MYJPBL.F90 rename to physics/PBL/MYJ/module_BL_MYJPBL.F90 diff --git a/physics/myjpbl_wrapper.F90 b/physics/PBL/MYJ/myjpbl_wrapper.F90 similarity index 100% rename from physics/myjpbl_wrapper.F90 rename to physics/PBL/MYJ/myjpbl_wrapper.F90 diff --git a/physics/myjpbl_wrapper.meta b/physics/PBL/MYJ/myjpbl_wrapper.meta similarity index 99% rename from physics/myjpbl_wrapper.meta rename to physics/PBL/MYJ/myjpbl_wrapper.meta index 427088b86..281396eed 100644 --- a/physics/myjpbl_wrapper.meta +++ b/physics/PBL/MYJ/myjpbl_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = myjpbl_wrapper type = scheme - dependencies = module_BL_MYJPBL.F90 + dependencies = ../../hooks/machine.F,module_BL_MYJPBL.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/bl_mynn_common.f90 b/physics/PBL/MYNN_EDMF/bl_mynn_common.f90 similarity index 100% rename from physics/bl_mynn_common.f90 rename to physics/PBL/MYNN_EDMF/bl_mynn_common.f90 diff --git a/physics/module_bl_mynn.F90 b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 similarity index 100% rename from physics/module_bl_mynn.F90 rename to physics/PBL/MYNN_EDMF/module_bl_mynn.F90 diff --git a/physics/mynnedmf_wrapper.F90 b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 similarity index 100% rename from physics/mynnedmf_wrapper.F90 rename to physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 diff --git a/physics/mynnedmf_wrapper.meta b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta similarity index 99% rename from physics/mynnedmf_wrapper.meta rename to physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta index ec4706aba..8e88d9620 100644 --- a/physics/mynnedmf_wrapper.meta +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mynnedmf_wrapper type = scheme - dependencies = machine.F,module_bl_mynn.F90,physcons.F90,bl_mynn_common.f90 + dependencies = ../../hooks/machine.F,module_bl_mynn.F90,bl_mynn_common.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/mfscu.f b/physics/PBL/SATMEDMF/mfscu.f similarity index 100% rename from physics/mfscu.f rename to physics/PBL/SATMEDMF/mfscu.f diff --git a/physics/mfscuq.f b/physics/PBL/SATMEDMF/mfscuq.f similarity index 100% rename from physics/mfscuq.f rename to physics/PBL/SATMEDMF/mfscuq.f diff --git a/physics/satmedmfvdif.F b/physics/PBL/SATMEDMF/satmedmfvdif.F similarity index 100% rename from physics/satmedmfvdif.F rename to physics/PBL/SATMEDMF/satmedmfvdif.F diff --git a/physics/satmedmfvdif.meta b/physics/PBL/SATMEDMF/satmedmfvdif.meta similarity index 99% rename from physics/satmedmfvdif.meta rename to physics/PBL/SATMEDMF/satmedmfvdif.meta index 3609ed50f..b94e74d6c 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = satmedmfvdif type = scheme - dependencies = funcphys.f90,machine.F,mfpblt.f,mfscu.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpblt.f,mfscu.f,../tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F similarity index 100% rename from physics/satmedmfvdifq.F rename to physics/PBL/SATMEDMF/satmedmfvdifq.F diff --git a/physics/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta similarity index 99% rename from physics/satmedmfvdifq.meta rename to physics/PBL/SATMEDMF/satmedmfvdifq.meta index b6680dccb..ff718f138 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = satmedmfvdifq type = scheme - dependencies = funcphys.f90,machine.F,mfpbltq.f,mfscuq.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpbltq.f,mfscuq.f,../tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/moninshoc.f b/physics/PBL/SHOC/moninshoc.f similarity index 100% rename from physics/moninshoc.f rename to physics/PBL/SHOC/moninshoc.f diff --git a/physics/moninshoc.meta b/physics/PBL/SHOC/moninshoc.meta similarity index 99% rename from physics/moninshoc.meta rename to physics/PBL/SHOC/moninshoc.meta index dca5736f5..474689ea0 100644 --- a/physics/moninshoc.meta +++ b/physics/PBL/SHOC/moninshoc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = moninshoc type = scheme - dependencies = funcphys.f90,machine.F,mfpbl.f,tridi.f + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpbl.f,../tridi.f ######################################################################## [ccpp-arg-table] diff --git a/physics/shoc.F90 b/physics/PBL/SHOC/shoc.F90 similarity index 100% rename from physics/shoc.F90 rename to physics/PBL/SHOC/shoc.F90 diff --git a/physics/shoc.meta b/physics/PBL/SHOC/shoc.meta similarity index 99% rename from physics/shoc.meta rename to physics/PBL/SHOC/shoc.meta index 984c6aec5..a1550ce11 100644 --- a/physics/shoc.meta +++ b/physics/PBL/SHOC/shoc.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shoc type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ysuvdif.F90 b/physics/PBL/YSU/ysuvdif.F90 similarity index 100% rename from physics/ysuvdif.F90 rename to physics/PBL/YSU/ysuvdif.F90 diff --git a/physics/ysuvdif.meta b/physics/PBL/YSU/ysuvdif.meta similarity index 99% rename from physics/ysuvdif.meta rename to physics/PBL/YSU/ysuvdif.meta index 0007197bd..20e96a92d 100644 --- a/physics/ysuvdif.meta +++ b/physics/PBL/YSU/ysuvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ysuvdif type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/mfpbl.f b/physics/PBL/mfpbl.f similarity index 100% rename from physics/mfpbl.f rename to physics/PBL/mfpbl.f diff --git a/physics/mfpblt.f b/physics/PBL/mfpblt.f similarity index 100% rename from physics/mfpblt.f rename to physics/PBL/mfpblt.f diff --git a/physics/mfpbltq.f b/physics/PBL/mfpbltq.f similarity index 100% rename from physics/mfpbltq.f rename to physics/PBL/mfpbltq.f diff --git a/physics/shinhongvdif.F90 b/physics/PBL/saYSU/shinhongvdif.F90 similarity index 100% rename from physics/shinhongvdif.F90 rename to physics/PBL/saYSU/shinhongvdif.F90 diff --git a/physics/shinhongvdif.meta b/physics/PBL/saYSU/shinhongvdif.meta similarity index 99% rename from physics/shinhongvdif.meta rename to physics/PBL/saYSU/shinhongvdif.meta index dcd3b96cd..8b1d48605 100644 --- a/physics/shinhongvdif.meta +++ b/physics/PBL/saYSU/shinhongvdif.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = shinhongvdif type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/tridi.f b/physics/PBL/tridi.f similarity index 100% rename from physics/tridi.f rename to physics/PBL/tridi.f diff --git a/physics/iounitdef.f b/physics/Radiation/RRTMG/iounitdef.f similarity index 100% rename from physics/iounitdef.f rename to physics/Radiation/RRTMG/iounitdef.f diff --git a/physics/module_bfmicrophysics.f b/physics/Radiation/RRTMG/module_bfmicrophysics.f similarity index 100% rename from physics/module_bfmicrophysics.f rename to physics/Radiation/RRTMG/module_bfmicrophysics.f diff --git a/physics/rad_sw_pre.F90 b/physics/Radiation/RRTMG/rad_sw_pre.F90 similarity index 100% rename from physics/rad_sw_pre.F90 rename to physics/Radiation/RRTMG/rad_sw_pre.F90 diff --git a/physics/rad_sw_pre.meta b/physics/Radiation/RRTMG/rad_sw_pre.meta similarity index 96% rename from physics/rad_sw_pre.meta rename to physics/Radiation/RRTMG/rad_sw_pre.meta index ccbdbf74b..9d14c6ffc 100644 --- a/physics/rad_sw_pre.meta +++ b/physics/Radiation/RRTMG/rad_sw_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rad_sw_pre type = scheme - dependencies = iounitdef.f,machine.F + dependencies = iounitdef.f,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/radcons.f90 b/physics/Radiation/RRTMG/radcons.f90 similarity index 100% rename from physics/radcons.f90 rename to physics/Radiation/RRTMG/radcons.f90 diff --git a/physics/radlw_datatb.f b/physics/Radiation/RRTMG/radlw_datatb.f similarity index 100% rename from physics/radlw_datatb.f rename to physics/Radiation/RRTMG/radlw_datatb.f diff --git a/physics/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 similarity index 100% rename from physics/radlw_main.F90 rename to physics/Radiation/RRTMG/radlw_main.F90 diff --git a/physics/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta similarity index 99% rename from physics/radlw_main.meta rename to physics/Radiation/RRTMG/radlw_main.meta index 3dccc97b3..f7c80fb20 100644 --- a/physics/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_lw type = scheme - dependencies = machine.F,mersenne_twister.f,physcons.F90,radlw_datatb.f,radlw_param.f + dependencies = ../../hooks/machine.F,../mersenne_twister.f,../../hooks/physcons.F90,radlw_datatb.f,radlw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/radlw_param.f b/physics/Radiation/RRTMG/radlw_param.f similarity index 100% rename from physics/radlw_param.f rename to physics/Radiation/RRTMG/radlw_param.f diff --git a/physics/radlw_param.meta b/physics/Radiation/RRTMG/radlw_param.meta similarity index 100% rename from physics/radlw_param.meta rename to physics/Radiation/RRTMG/radlw_param.meta diff --git a/physics/radsw_datatb.f b/physics/Radiation/RRTMG/radsw_datatb.f similarity index 100% rename from physics/radsw_datatb.f rename to physics/Radiation/RRTMG/radsw_datatb.f diff --git a/physics/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 similarity index 100% rename from physics/radsw_main.F90 rename to physics/Radiation/RRTMG/radsw_main.F90 diff --git a/physics/radsw_main.meta b/physics/Radiation/RRTMG/radsw_main.meta similarity index 99% rename from physics/radsw_main.meta rename to physics/Radiation/RRTMG/radsw_main.meta index 1edb6fcac..2169a26f0 100644 --- a/physics/radsw_main.meta +++ b/physics/Radiation/RRTMG/radsw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_sw type = scheme - dependencies = machine.F,mersenne_twister.f,physcons.F90,radsw_datatb.f,radsw_param.f + dependencies = ../../hooks/machine.F,../mersenne_twister.f,../../hooks/physcons.F90,radsw_datatb.f,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/radsw_param.f b/physics/Radiation/RRTMG/radsw_param.f similarity index 100% rename from physics/radsw_param.f rename to physics/Radiation/RRTMG/radsw_param.f diff --git a/physics/radsw_param.meta b/physics/Radiation/RRTMG/radsw_param.meta similarity index 100% rename from physics/radsw_param.meta rename to physics/Radiation/RRTMG/radsw_param.meta diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 similarity index 100% rename from physics/rrtmg_lw_cloud_optics.F90 rename to physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 diff --git a/physics/rrtmg_lw_post.F90 b/physics/Radiation/RRTMG/rrtmg_lw_post.F90 similarity index 100% rename from physics/rrtmg_lw_post.F90 rename to physics/Radiation/RRTMG/rrtmg_lw_post.F90 diff --git a/physics/rrtmg_lw_post.meta b/physics/Radiation/RRTMG/rrtmg_lw_post.meta similarity index 99% rename from physics/rrtmg_lw_post.meta rename to physics/Radiation/RRTMG/rrtmg_lw_post.meta index 7f219c24f..6ed7c2365 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/Radiation/RRTMG/rrtmg_lw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_lw_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 similarity index 100% rename from physics/rrtmg_sw_cloud_optics.F90 rename to physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 diff --git a/physics/rrtmg_sw_post.F90 b/physics/Radiation/RRTMG/rrtmg_sw_post.F90 similarity index 100% rename from physics/rrtmg_sw_post.F90 rename to physics/Radiation/RRTMG/rrtmg_sw_post.F90 diff --git a/physics/rrtmg_sw_post.meta b/physics/Radiation/RRTMG/rrtmg_sw_post.meta similarity index 99% rename from physics/rrtmg_sw_post.meta rename to physics/Radiation/RRTMG/rrtmg_sw_post.meta index 6a9f4efb5..9914051ce 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/Radiation/RRTMG/rrtmg_sw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_sw_post type = scheme - dependencies = machine.F,radsw_param.f + dependencies = ../../hooks/machine.F,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_aerosol_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 similarity index 100% rename from physics/rrtmgp_aerosol_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 diff --git a/physics/rrtmgp_aerosol_optics.meta b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta similarity index 98% rename from physics/rrtmgp_aerosol_optics.meta rename to physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta index cc9eb1cc2..0847877d6 100644 --- a/physics/rrtmgp_aerosol_optics.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_aerosol_optics type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radiation_tools.F90 + dependencies = ../iounitdef.f,../../hooks/machine.F,../radiation_aerosols.f,../radiation_tools.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 similarity index 100% rename from physics/rrtmgp_lw_cloud_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 similarity index 100% rename from physics/rrtmgp_lw_gas_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 diff --git a/physics/rrtmgp_lw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 similarity index 100% rename from physics/rrtmgp_lw_main.F90 rename to physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 diff --git a/physics/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta similarity index 98% rename from physics/rrtmgp_lw_main.meta rename to physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index fd96eb14b..011376985 100644 --- a/physics/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -1,12 +1,13 @@ [ccpp-table-properties] name = rrtmgp_lw_main type = scheme - dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + dependencies = ../../hooks/machine.F,../radiation_tools.F90,../mersenne_twister.f + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 dependencies = rte-rrtmgp/rte/mo_source_functions.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90 + dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90,rrtmgp_sampling.F90 + dependencies = ../../GFS/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sampling.F90 b/physics/Radiation/RRTMGP/rrtmgp_sampling.F90 similarity index 100% rename from physics/rrtmgp_sampling.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sampling.F90 diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 similarity index 100% rename from physics/rrtmgp_sw_cloud_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 similarity index 100% rename from physics/rrtmgp_sw_gas_optics.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 diff --git a/physics/rrtmgp_sw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 similarity index 100% rename from physics/rrtmgp_sw_main.F90 rename to physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 diff --git a/physics/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta similarity index 98% rename from physics/rrtmgp_sw_main.meta rename to physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index dbb93a5df..932e2195e 100644 --- a/physics/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -1,12 +1,13 @@ [ccpp-table-properties] name = rrtmgp_sw_main type = scheme - dependencies = machine.F,radiation_tools.F90,GFS_rrtmgp_pre.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + dependencies = ../../hooks/machine.F,../radiation_tools.F90,../mersenne_twister.f + dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 dependencies = rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - dependencies = mersenne_twister.f,rrtmgp_sampling.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90 + dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90,rrtmgp_sampling.F90 + dependencies = ../../GFS/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/mersenne_twister.f b/physics/Radiation/mersenne_twister.f similarity index 100% rename from physics/mersenne_twister.f rename to physics/Radiation/mersenne_twister.f diff --git a/physics/radiation_aerosols.f b/physics/Radiation/radiation_aerosols.f similarity index 100% rename from physics/radiation_aerosols.f rename to physics/Radiation/radiation_aerosols.f diff --git a/physics/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f similarity index 100% rename from physics/radiation_astronomy.f rename to physics/Radiation/radiation_astronomy.f diff --git a/physics/radiation_cloud_overlap.F90 b/physics/Radiation/radiation_cloud_overlap.F90 similarity index 100% rename from physics/radiation_cloud_overlap.F90 rename to physics/Radiation/radiation_cloud_overlap.F90 diff --git a/physics/radiation_clouds.f b/physics/Radiation/radiation_clouds.f similarity index 100% rename from physics/radiation_clouds.f rename to physics/Radiation/radiation_clouds.f diff --git a/physics/radiation_gases.f b/physics/Radiation/radiation_gases.f similarity index 100% rename from physics/radiation_gases.f rename to physics/Radiation/radiation_gases.f diff --git a/physics/radiation_surface.f b/physics/Radiation/radiation_surface.f similarity index 100% rename from physics/radiation_surface.f rename to physics/Radiation/radiation_surface.f diff --git a/physics/radiation_tools.F90 b/physics/Radiation/radiation_tools.F90 similarity index 100% rename from physics/radiation_tools.F90 rename to physics/Radiation/radiation_tools.F90 diff --git a/physics/date_def.f b/physics/SFC_Layer/GFS_sfc/date_def.f similarity index 100% rename from physics/date_def.f rename to physics/SFC_Layer/GFS_sfc/date_def.f diff --git a/physics/module_nst_model.f90 b/physics/SFC_Layer/GFS_sfc/module_nst_model.f90 similarity index 100% rename from physics/module_nst_model.f90 rename to physics/SFC_Layer/GFS_sfc/module_nst_model.f90 diff --git a/physics/module_nst_parameters.f90 b/physics/SFC_Layer/GFS_sfc/module_nst_parameters.f90 similarity index 100% rename from physics/module_nst_parameters.f90 rename to physics/SFC_Layer/GFS_sfc/module_nst_parameters.f90 diff --git a/physics/module_nst_water_prop.f90 b/physics/SFC_Layer/GFS_sfc/module_nst_water_prop.f90 similarity index 100% rename from physics/module_nst_water_prop.f90 rename to physics/SFC_Layer/GFS_sfc/module_nst_water_prop.f90 diff --git a/physics/sfc_cice.f b/physics/SFC_Layer/GFS_sfc/sfc_cice.f similarity index 100% rename from physics/sfc_cice.f rename to physics/SFC_Layer/GFS_sfc/sfc_cice.f diff --git a/physics/sfc_cice.meta b/physics/SFC_Layer/GFS_sfc/sfc_cice.meta similarity index 99% rename from physics/sfc_cice.meta rename to physics/SFC_Layer/GFS_sfc/sfc_cice.meta index 796fb2f5d..52fa28a3d 100644 --- a/physics/sfc_cice.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_cice.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_cice type = scheme - dependencies = machine.F + relative_path = ../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diag.f b/physics/SFC_Layer/GFS_sfc/sfc_diag.f similarity index 100% rename from physics/sfc_diag.f rename to physics/SFC_Layer/GFS_sfc/sfc_diag.f diff --git a/physics/sfc_diag.meta b/physics/SFC_Layer/GFS_sfc/sfc_diag.meta similarity index 99% rename from physics/sfc_diag.meta rename to physics/SFC_Layer/GFS_sfc/sfc_diag.meta index a16290b58..6a82c2c61 100644 --- a/physics/sfc_diag.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_diag.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diag type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diag_post.F90 b/physics/SFC_Layer/GFS_sfc/sfc_diag_post.F90 similarity index 100% rename from physics/sfc_diag_post.F90 rename to physics/SFC_Layer/GFS_sfc/sfc_diag_post.F90 diff --git a/physics/sfc_diag_post.meta b/physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta similarity index 98% rename from physics/sfc_diag_post.meta rename to physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta index c50d3c4dc..8c74e2154 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diag_post type = scheme - dependencies = machine.F + relative_path = ../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_diff.f b/physics/SFC_Layer/GFS_sfc/sfc_diff.f similarity index 100% rename from physics/sfc_diff.f rename to physics/SFC_Layer/GFS_sfc/sfc_diff.f diff --git a/physics/sfc_diff.meta b/physics/SFC_Layer/GFS_sfc/sfc_diff.meta similarity index 99% rename from physics/sfc_diff.meta rename to physics/SFC_Layer/GFS_sfc/sfc_diff.meta index eb30b8c50..b9f0c4f84 100644 --- a/physics/sfc_diff.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_diff.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_diff type = scheme - dependencies = machine.F + relative_path = ../../ + dependencies = hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_nst.f b/physics/SFC_Layer/GFS_sfc/sfc_nst.f similarity index 100% rename from physics/sfc_nst.f rename to physics/SFC_Layer/GFS_sfc/sfc_nst.f diff --git a/physics/sfc_nst.meta b/physics/SFC_Layer/GFS_sfc/sfc_nst.meta similarity index 99% rename from physics/sfc_nst.meta rename to physics/SFC_Layer/GFS_sfc/sfc_nst.meta index dc35ec959..131daaab0 100644 --- a/physics/sfc_nst.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_nst.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_nst type = scheme - dependencies = date_def.f,funcphys.f90,machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = date_def.f,../../tools/funcphys.f90,../../hooks/machine.F,module_nst_model.f90,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_nst_post.f b/physics/SFC_Layer/GFS_sfc/sfc_nst_post.f similarity index 100% rename from physics/sfc_nst_post.f rename to physics/SFC_Layer/GFS_sfc/sfc_nst_post.f diff --git a/physics/sfc_nst_post.meta b/physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta similarity index 98% rename from physics/sfc_nst_post.meta rename to physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta index 7f66118e9..caa487384 100644 --- a/physics/sfc_nst_post.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = sfc_nst_post type = scheme - dependencies = machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = ../../hooks/machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_nst_pre.f b/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.f similarity index 100% rename from physics/sfc_nst_pre.f rename to physics/SFC_Layer/GFS_sfc/sfc_nst_pre.f diff --git a/physics/sfc_nst_pre.meta b/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta similarity index 97% rename from physics/sfc_nst_pre.meta rename to physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta index 88788ff5c..e9cdef0d1 100644 --- a/physics/sfc_nst_pre.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = sfc_nst_pre type = scheme - dependencies = machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 + dependencies = ../../hooks/machine.F,module_nst_parameters.f90,module_nst_water_prop.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_ocean.F b/physics/SFC_Layer/GFS_sfc/sfc_ocean.F similarity index 100% rename from physics/sfc_ocean.F rename to physics/SFC_Layer/GFS_sfc/sfc_ocean.F diff --git a/physics/sfc_ocean.meta b/physics/SFC_Layer/GFS_sfc/sfc_ocean.meta similarity index 99% rename from physics/sfc_ocean.meta rename to physics/SFC_Layer/GFS_sfc/sfc_ocean.meta index 15812e723..ea575a071 100644 --- a/physics/sfc_ocean.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_ocean.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_ocean type = scheme - dependencies = funcphys.f90,machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/sfc_sice.f b/physics/SFC_Layer/GFS_sfc/sfc_sice.f similarity index 100% rename from physics/sfc_sice.f rename to physics/SFC_Layer/GFS_sfc/sfc_sice.f diff --git a/physics/sfc_sice.meta b/physics/SFC_Layer/GFS_sfc/sfc_sice.meta similarity index 99% rename from physics/sfc_sice.meta rename to physics/SFC_Layer/GFS_sfc/sfc_sice.meta index 75aab21a4..7277c0511 100644 --- a/physics/sfc_sice.meta +++ b/physics/SFC_Layer/GFS_sfc/sfc_sice.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = sfc_sice type = scheme - dependencies = funcphys.f90,machine.F + relative_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/module_SF_JSFC.F90 b/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 similarity index 100% rename from physics/module_SF_JSFC.F90 rename to physics/SFC_Layer/MYJ/module_SF_JSFC.F90 diff --git a/physics/myjsfc_wrapper.F90 b/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 similarity index 100% rename from physics/myjsfc_wrapper.F90 rename to physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 diff --git a/physics/myjsfc_wrapper.meta b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta similarity index 99% rename from physics/myjsfc_wrapper.meta rename to physics/SFC_Layer/MYJ/myjsfc_wrapper.meta index 40b6b78f3..9805db619 100644 --- a/physics/myjsfc_wrapper.meta +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = myjsfc_wrapper type = scheme - dependencies = module_SF_JSFC.F90 + dependencies = ../../hooks/machine.f,module_SF_JSFC.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/module_sf_mynn.F90 b/physics/SFC_Layer/MYNN/module_sf_mynn.F90 similarity index 100% rename from physics/module_sf_mynn.F90 rename to physics/SFC_Layer/MYNN/module_sf_mynn.F90 diff --git a/physics/mynnsfc_wrapper.F90 b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 similarity index 100% rename from physics/mynnsfc_wrapper.F90 rename to physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 diff --git a/physics/mynnsfc_wrapper.meta b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta similarity index 99% rename from physics/mynnsfc_wrapper.meta rename to physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta index d89cc5d35..a76df3790 100644 --- a/physics/mynnsfc_wrapper.meta +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mynnsfc_wrapper type = scheme - dependencies = machine.F,module_sf_mynn.F90 + dependencies = ../../hooks/machine.F,module_sf_mynn.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/h2o_def.f b/physics/h2o_photo/h2o_def.f similarity index 100% rename from physics/h2o_def.f rename to physics/h2o_photo/h2o_def.f diff --git a/physics/h2o_def.meta b/physics/h2o_photo/h2o_def.meta similarity index 94% rename from physics/h2o_def.meta rename to physics/h2o_photo/h2o_def.meta index 17f0f8779..3bb9bf94d 100644 --- a/physics/h2o_def.meta +++ b/physics/h2o_photo/h2o_def.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = h2o_def type = module - dependencies = machine.F + dependencies = ../../hooks/machine.F [ccpp-arg-table] name = h2o_def diff --git a/physics/h2ointerp.f90 b/physics/h2o_photo/h2ointerp.f90 similarity index 100% rename from physics/h2ointerp.f90 rename to physics/h2o_photo/h2ointerp.f90 diff --git a/physics/h2ophys.f b/physics/h2o_photo/h2ophys.f similarity index 100% rename from physics/h2ophys.f rename to physics/h2o_photo/h2ophys.f diff --git a/physics/h2ophys.meta b/physics/h2o_photo/h2ophys.meta similarity index 98% rename from physics/h2ophys.meta rename to physics/h2o_photo/h2ophys.meta index afe50bda1..d8a9eabab 100644 --- a/physics/h2ophys.meta +++ b/physics/h2o_photo/h2ophys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = h2ophys type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/machine.F b/physics/hooks/machine.F similarity index 100% rename from physics/machine.F rename to physics/hooks/machine.F diff --git a/physics/machine.meta b/physics/hooks/machine.meta similarity index 100% rename from physics/machine.meta rename to physics/hooks/machine.meta diff --git a/physics/physcons.F90 b/physics/hooks/physcons.F90 similarity index 100% rename from physics/physcons.F90 rename to physics/hooks/physcons.F90 diff --git a/physics/ozinterp.f90 b/physics/o3_photo/ozinterp.f90 similarity index 100% rename from physics/ozinterp.f90 rename to physics/o3_photo/ozinterp.f90 diff --git a/physics/ozne_def.f b/physics/o3_photo/ozne_def.f similarity index 100% rename from physics/ozne_def.f rename to physics/o3_photo/ozne_def.f diff --git a/physics/ozne_def.meta b/physics/o3_photo/ozne_def.meta similarity index 95% rename from physics/ozne_def.meta rename to physics/o3_photo/ozne_def.meta index 3cad9c14d..3123892bb 100644 --- a/physics/ozne_def.meta +++ b/physics/o3_photo/ozne_def.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozne_def type = module - dependencies = machine.F + dependencies = ../../hooks/machine.F [ccpp-arg-table] name = ozne_def diff --git a/physics/ozphys.f b/physics/o3_photo/ozphys.f similarity index 100% rename from physics/ozphys.f rename to physics/o3_photo/ozphys.f diff --git a/physics/ozphys.meta b/physics/o3_photo/ozphys.meta similarity index 99% rename from physics/ozphys.meta rename to physics/o3_photo/ozphys.meta index 485e2a491..631dcb332 100644 --- a/physics/ozphys.meta +++ b/physics/o3_photo/ozphys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozphys type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/ozphys_2015.f b/physics/o3_photo/ozphys_2015.f similarity index 100% rename from physics/ozphys_2015.f rename to physics/o3_photo/ozphys_2015.f diff --git a/physics/ozphys_2015.meta b/physics/o3_photo/ozphys_2015.meta similarity index 99% rename from physics/ozphys_2015.meta rename to physics/o3_photo/ozphys_2015.meta index 8bce7defe..7da8cdf27 100644 --- a/physics/ozphys_2015.meta +++ b/physics/o3_photo/ozphys_2015.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozphys_2015 type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp deleted file mode 160000 index 0dc54f5ec..000000000 --- a/physics/rte-rrtmgp +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 0dc54f5ecaeb1e1e342efd1e02d0bcd41737bde2 diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 50f7afae7..339f6ca03 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90 + dependencies = machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index bf2fddd60..5bf86c6bd 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 + dependencies = machine.F,dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/funcphys.f90 b/physics/tools/funcphys.f90 similarity index 100% rename from physics/funcphys.f90 rename to physics/tools/funcphys.f90 diff --git a/physics/get_phi_fv3.F90 b/physics/tools/get_phi_fv3.F90 similarity index 100% rename from physics/get_phi_fv3.F90 rename to physics/tools/get_phi_fv3.F90 diff --git a/physics/get_phi_fv3.meta b/physics/tools/get_phi_fv3.meta similarity index 97% rename from physics/get_phi_fv3.meta rename to physics/tools/get_phi_fv3.meta index cbca14080..5c162c746 100644 --- a/physics/get_phi_fv3.meta +++ b/physics/tools/get_phi_fv3.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = get_phi_fv3 type = scheme - dependencies = machine.F,physcons.F90 + dependencies = ../hooks/machine.F,../hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/get_prs_fv3.F90 b/physics/tools/get_prs_fv3.F90 similarity index 100% rename from physics/get_prs_fv3.F90 rename to physics/tools/get_prs_fv3.F90 diff --git a/physics/get_prs_fv3.meta b/physics/tools/get_prs_fv3.meta similarity index 98% rename from physics/get_prs_fv3.meta rename to physics/tools/get_prs_fv3.meta index c26f5c308..4cdad7566 100644 --- a/physics/get_prs_fv3.meta +++ b/physics/tools/get_prs_fv3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = get_prs_fv3 type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] From 53eda4d0e2af5d8ded2182b08fd9fbafa1b55114 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 5 Sep 2023 15:11:58 +0000 Subject: [PATCH 022/132] Address comments from review. --- physics/CONV/{CCC => C3}/cu_c3_deep.F90 | 0 physics/CONV/{CCC => C3}/cu_c3_driver.F90 | 0 physics/CONV/{CCC => C3}/cu_c3_driver.meta | 0 physics/CONV/{CCC => C3}/cu_c3_driver_post.F90 | 0 physics/CONV/{CCC => C3}/cu_c3_driver_post.meta | 0 physics/CONV/{CCC => C3}/cu_c3_driver_pre.F90 | 0 physics/CONV/{CCC => C3}/cu_c3_driver_pre.meta | 0 physics/CONV/{CCC => C3}/cu_c3_sh.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_common.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_cloud_diagnostics.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_cloud_diagnostics.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_debug.F90 | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_debug.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.fv3.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.fv3.meta | 2 +- .../{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.scm.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.scm.meta | 2 +- .../{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.fv3.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.fv3.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.scm.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.scm.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_radiation_surface.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_radiation_surface.meta | 2 +- .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_post.F90 | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_post.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_pre.F90 | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_pre.meta | 2 +- .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_setup.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_setup.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_mp.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_mp.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_overlap.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_overlap.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_post.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_pre.F90 | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_setup.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_setup.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_stochastics.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_stochastics.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_1.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_1.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_2.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_2.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_3.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_3.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_4.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_4.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_5.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_5.meta | 0 .../GFS_suite_interstitial_phys_reset.F90 | 0 .../GFS_suite_interstitial_phys_reset.meta | 0 .../GFS_suite_interstitial_rad_reset.F90 | 0 .../GFS_suite_interstitial_rad_reset.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_reset.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_reset.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_update.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_update.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_inter.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_inter.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_pre.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_post.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_post.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_pre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_pre.meta | 0 .../GFS_surface_loop_control_part1.F90 | 0 .../GFS_surface_loop_control_part1.meta | 0 .../GFS_surface_loop_control_part2.F90 | 0 .../GFS_surface_loop_control_part2.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.fv3.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.fv3.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.scm.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.scm.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/aerinterp.F90 | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/cnvc90.f | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/cnvc90.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/dcyc2t3.f | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/dcyc2t3.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/gcycle.F90 | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/iccn_def.F | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/iccninterp.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/maximum_hourly_diagnostics.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/maximum_hourly_diagnostics.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/phys_tend.F90 | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/phys_tend.meta | 0 .../{GFS => UFS_SCM_NEPTUNE}/scm_sfc_flux_spec.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/scm_sfc_flux_spec.meta | 0 physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sfcsub.F | 0 .../{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpost.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpost.meta | 0 .../Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpre.F90 | 0 .../{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpre.meta | 0 physics/{MP => SFC_Layer}/GFDL/gfdl_sfc_layer.F90 | 0 physics/{MP => SFC_Layer}/GFDL/gfdl_sfc_layer.meta | 3 ++- physics/SFC_Layer/{GFS_sfc => UFS}/date_def.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_model.f90 | 0 physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_parameters.f90 | 0 physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_water_prop.f90 | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag_post.F90 | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag_post.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diff.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diff.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_post.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_post.meta | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_pre.f | 0 physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_pre.meta | 0 physics/{Land/CLM_lake => SFC_Models/Lake/CLM}/clm_lake.f90 | 0 physics/{Land/CLM_lake => SFC_Models/Lake/CLM}/clm_lake.meta | 0 physics/{Land => SFC_Models/Lake}/Flake/flake.F90 | 0 physics/{Land => SFC_Models/Lake}/Flake/flake_driver.F90 | 0 physics/{Land => SFC_Models/Lake}/Flake/flake_driver.meta | 0 physics/{ => SFC_Models}/Land/Noah/lsm_noah.f | 0 physics/{ => SFC_Models}/Land/Noah/lsm_noah.meta | 0 physics/{ => SFC_Models}/Land/Noah/sflx.f | 0 physics/{ => SFC_Models}/Land/Noah/surface_perturbation.F90 | 0 .../{ => SFC_Models}/Land/Noahmp/module_sf_noahmp_glacier.F90 | 0 physics/{ => SFC_Models}/Land/Noahmp/module_sf_noahmplsm.F90 | 0 physics/{ => SFC_Models}/Land/Noahmp/noahmp_tables.f90 | 0 physics/{ => SFC_Models}/Land/Noahmp/noahmpdrv.F90 | 0 physics/{ => SFC_Models}/Land/Noahmp/noahmpdrv.meta | 0 physics/{ => SFC_Models}/Land/Noahmp/noahmptable.tbl | 0 physics/{ => SFC_Models}/Land/RUC/lsm_ruc.F90 | 0 physics/{ => SFC_Models}/Land/RUC/lsm_ruc.meta | 0 physics/{ => SFC_Models}/Land/RUC/module_sf_ruclsm.F90 | 0 physics/{ => SFC_Models}/Land/RUC/module_soil_pre.F90 | 0 physics/{ => SFC_Models}/Land/RUC/namelist_soilveg_ruc.F90 | 0 physics/{ => SFC_Models}/Land/RUC/set_soilveg_ruc.F90 | 0 physics/{ => SFC_Models}/Land/namelist_soilveg.f | 0 physics/{ => SFC_Models}/Land/set_soilveg.f | 0 .../{SFC_Layer/GFS_sfc => SFC_Models/Ocean/UFS}/sfc_ocean.F | 0 .../{SFC_Layer/GFS_sfc => SFC_Models/Ocean/UFS}/sfc_ocean.meta | 0 .../{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_cice.f | 0 .../GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_cice.meta | 0 .../{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_sice.f | 0 .../GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_sice.meta | 0 163 files changed, 6 insertions(+), 5 deletions(-) rename physics/CONV/{CCC => C3}/cu_c3_deep.F90 (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver.F90 (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver.meta (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver_post.F90 (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver_post.meta (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver_pre.F90 (100%) rename physics/CONV/{CCC => C3}/cu_c3_driver_pre.meta (100%) rename physics/CONV/{CCC => C3}/cu_c3_sh.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_DCNV_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_GWD_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_MP_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_common.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_PBL_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_SCNV_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_cloud_diagnostics.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_cloud_diagnostics.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_debug.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_debug.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.fv3.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.fv3.meta (99%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.scm.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_phys_time_vary.scm.meta (99%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.fv3.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.fv3.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.scm.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rad_time_vary.scm.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_radiation_surface.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_radiation_surface.meta (99%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_pre.meta (99%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_setup.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmg_setup.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_mp.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_mp.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_overlap.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_cloud_overlap.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_setup.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_rrtmgp_setup.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_stochastics.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_stochastics.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_1.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_1.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_2.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_2.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_3.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_3.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_4.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_4.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_5.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_5.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_phys_reset.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_phys_reset.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_rad_reset.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_interstitial_rad_reset.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_reset.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_reset.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_update.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_suite_stateout_update.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_inter.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_inter.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_composites_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_post.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_post.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_pre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_generic_pre.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_loop_control_part1.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_loop_control_part1.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_loop_control_part2.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_surface_loop_control_part2.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.fv3.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.fv3.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.scm.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/GFS_time_vary_pre.scm.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/aerinterp.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/cnvc90.f (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/cnvc90.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/dcyc2t3.f (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/dcyc2t3.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/gcycle.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/iccn_def.F (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/iccninterp.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/maximum_hourly_diagnostics.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/maximum_hourly_diagnostics.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/phys_tend.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/phys_tend.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/scm_sfc_flux_spec.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/scm_sfc_flux_spec.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sfcsub.F (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpost.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpost.meta (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpre.F90 (100%) rename physics/Interstitials/{GFS => UFS_SCM_NEPTUNE}/sgscloud_radpre.meta (100%) rename physics/{MP => SFC_Layer}/GFDL/gfdl_sfc_layer.F90 (100%) rename physics/{MP => SFC_Layer}/GFDL/gfdl_sfc_layer.meta (99%) rename physics/SFC_Layer/{GFS_sfc => UFS}/date_def.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_model.f90 (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_parameters.f90 (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/module_nst_water_prop.f90 (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag_post.F90 (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diag_post.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diff.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_diff.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_post.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_post.meta (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_pre.f (100%) rename physics/SFC_Layer/{GFS_sfc => UFS}/sfc_nst_pre.meta (100%) rename physics/{Land/CLM_lake => SFC_Models/Lake/CLM}/clm_lake.f90 (100%) rename physics/{Land/CLM_lake => SFC_Models/Lake/CLM}/clm_lake.meta (100%) rename physics/{Land => SFC_Models/Lake}/Flake/flake.F90 (100%) rename physics/{Land => SFC_Models/Lake}/Flake/flake_driver.F90 (100%) rename physics/{Land => SFC_Models/Lake}/Flake/flake_driver.meta (100%) rename physics/{ => SFC_Models}/Land/Noah/lsm_noah.f (100%) rename physics/{ => SFC_Models}/Land/Noah/lsm_noah.meta (100%) rename physics/{ => SFC_Models}/Land/Noah/sflx.f (100%) rename physics/{ => SFC_Models}/Land/Noah/surface_perturbation.F90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/module_sf_noahmp_glacier.F90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/module_sf_noahmplsm.F90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/noahmp_tables.f90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/noahmpdrv.F90 (100%) rename physics/{ => SFC_Models}/Land/Noahmp/noahmpdrv.meta (100%) rename physics/{ => SFC_Models}/Land/Noahmp/noahmptable.tbl (100%) rename physics/{ => SFC_Models}/Land/RUC/lsm_ruc.F90 (100%) rename physics/{ => SFC_Models}/Land/RUC/lsm_ruc.meta (100%) rename physics/{ => SFC_Models}/Land/RUC/module_sf_ruclsm.F90 (100%) rename physics/{ => SFC_Models}/Land/RUC/module_soil_pre.F90 (100%) rename physics/{ => SFC_Models}/Land/RUC/namelist_soilveg_ruc.F90 (100%) rename physics/{ => SFC_Models}/Land/RUC/set_soilveg_ruc.F90 (100%) rename physics/{ => SFC_Models}/Land/namelist_soilveg.f (100%) rename physics/{ => SFC_Models}/Land/set_soilveg.f (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/Ocean/UFS}/sfc_ocean.F (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/Ocean/UFS}/sfc_ocean.meta (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_cice.f (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_cice.meta (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_sice.f (100%) rename physics/{SFC_Layer/GFS_sfc => SFC_Models/SeaIce/CICE}/sfc_sice.meta (100%) diff --git a/physics/CONV/CCC/cu_c3_deep.F90 b/physics/CONV/C3/cu_c3_deep.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_deep.F90 rename to physics/CONV/C3/cu_c3_deep.F90 diff --git a/physics/CONV/CCC/cu_c3_driver.F90 b/physics/CONV/C3/cu_c3_driver.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_driver.F90 rename to physics/CONV/C3/cu_c3_driver.F90 diff --git a/physics/CONV/CCC/cu_c3_driver.meta b/physics/CONV/C3/cu_c3_driver.meta similarity index 100% rename from physics/CONV/CCC/cu_c3_driver.meta rename to physics/CONV/C3/cu_c3_driver.meta diff --git a/physics/CONV/CCC/cu_c3_driver_post.F90 b/physics/CONV/C3/cu_c3_driver_post.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_driver_post.F90 rename to physics/CONV/C3/cu_c3_driver_post.F90 diff --git a/physics/CONV/CCC/cu_c3_driver_post.meta b/physics/CONV/C3/cu_c3_driver_post.meta similarity index 100% rename from physics/CONV/CCC/cu_c3_driver_post.meta rename to physics/CONV/C3/cu_c3_driver_post.meta diff --git a/physics/CONV/CCC/cu_c3_driver_pre.F90 b/physics/CONV/C3/cu_c3_driver_pre.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_driver_pre.F90 rename to physics/CONV/C3/cu_c3_driver_pre.F90 diff --git a/physics/CONV/CCC/cu_c3_driver_pre.meta b/physics/CONV/C3/cu_c3_driver_pre.meta similarity index 100% rename from physics/CONV/CCC/cu_c3_driver_pre.meta rename to physics/CONV/C3/cu_c3_driver_pre.meta diff --git a/physics/CONV/CCC/cu_c3_sh.F90 b/physics/CONV/C3/cu_c3_sh.F90 similarity index 100% rename from physics/CONV/CCC/cu_c3_sh.F90 rename to physics/CONV/C3/cu_c3_sh.F90 diff --git a/physics/Interstitials/GFS/GFS_DCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_DCNV_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_DCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_DCNV_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_DCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_DCNV_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_DCNV_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_GWD_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_GWD_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_GWD_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_GWD_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_GWD_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_GWD_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_GWD_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_GWD_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_MP_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_MP_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_MP_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_MP_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_MP_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_MP_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_MP_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_MP_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_common.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_common.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_PBL_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_PBL_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_SCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_SCNV_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_SCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_SCNV_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_SCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_SCNV_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_SCNV_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_cloud_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_cloud_diagnostics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 diff --git a/physics/Interstitials/GFS/GFS_cloud_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_cloud_diagnostics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta diff --git a/physics/Interstitials/GFS/GFS_debug.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_debug.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 diff --git a/physics/Interstitials/GFS/GFS_debug.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_debug.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta diff --git a/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_phys_time_vary.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 diff --git a/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta similarity index 99% rename from physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 45125385c..2aec034fd 100644 --- a/physics/Interstitials/GFS/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -6,7 +6,7 @@ dependencies = Interstitials/GFS/gcycle.F90,Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 - dependencies = Land/namelist_soilveg.f,Land/set_soilveg.f,Land/Noahmp/noahmp_tables.f90 + dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 diff --git a/physics/Interstitials/GFS/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_phys_time_vary.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 diff --git a/physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta similarity index 99% rename from physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index 84f22aede..d033c889b 100644 --- a/physics/Interstitials/GFS/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -6,7 +6,7 @@ dependencies = Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 - dependencies = Land/namelist_soilveg.f,Land/set_soilveg.f,Land/Noahmp/noahmp_tables.f90 + dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 diff --git a/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rad_time_vary.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 diff --git a/physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rad_time_vary.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta diff --git a/physics/Interstitials/GFS/GFS_rad_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rad_time_vary.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 diff --git a/physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rad_time_vary.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta diff --git a/physics/Interstitials/GFS/GFS_radiation_surface.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_radiation_surface.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 diff --git a/physics/Interstitials/GFS/GFS_radiation_surface.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta similarity index 99% rename from physics/Interstitials/GFS/GFS_radiation_surface.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta index c18b81d9f..79837d0bf 100644 --- a/physics/Interstitials/GFS/GFS_radiation_surface.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta @@ -3,7 +3,7 @@ type = scheme relative_path = ../../ dependencies = Radiation/iounitdef.f,Radiation/radiation_surface.f - dependencies = Land/RUC/set_soilveg_ruc.F90,Land/RUC/namelist_soilveg_ruc.F90 + dependencies = SFC_Models/Land/RUC/set_soilveg_ruc.F90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 dependencies = hooks/machine.F ######################################################################## diff --git a/physics/Interstitials/GFS/GFS_rrtmg_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmg_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta similarity index 99% rename from physics/Interstitials/GFS/GFS_rrtmg_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index e0e67c8f5..af95daf52 100644 --- a/physics/Interstitials/GFS/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -7,7 +7,7 @@ dependencies = Radiation/iounitdef.f,Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f dependencies = Radiation/radlw_param.f,Radiation/radsw_param.f,Radiation/radiation_cloud_overlap.F90 - dependencies = Land/Noah/surface_perturbation.F90 + dependencies = SFC_Models/Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/GFS/GFS_rrtmg_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_setup.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmg_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmg_setup.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_cloud_mp.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_cloud_overlap.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_setup.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 diff --git a/physics/Interstitials/GFS/GFS_rrtmgp_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_rrtmgp_setup.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta diff --git a/physics/Interstitials/GFS/GFS_stochastics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_stochastics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 diff --git a/physics/Interstitials/GFS/GFS_stochastics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_stochastics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_1.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_1.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_1.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_1.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_2.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_2.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_2.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_2.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_4.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_4.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_4.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_4.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_5.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_5.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_5.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_5.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_phys_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_interstitial_rad_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta diff --git a/physics/Interstitials/GFS/GFS_suite_stateout_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_stateout_reset.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_stateout_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_stateout_reset.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.meta diff --git a/physics/Interstitials/GFS/GFS_suite_stateout_update.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_stateout_update.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 diff --git a/physics/Interstitials/GFS/GFS_suite_stateout_update.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_suite_stateout_update.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta diff --git a/physics/Interstitials/GFS/GFS_surface_composites_inter.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_inter.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_composites_inter.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_inter.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta diff --git a/physics/Interstitials/GFS/GFS_surface_composites_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_composites_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta diff --git a/physics/Interstitials/GFS/GFS_surface_composites_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_composites_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_composites_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta diff --git a/physics/Interstitials/GFS/GFS_surface_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_generic_post.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_generic_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta diff --git a/physics/Interstitials/GFS/GFS_surface_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_generic_pre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_generic_pre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta diff --git a/physics/Interstitials/GFS/GFS_surface_loop_control_part1.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_loop_control_part1.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_loop_control_part1.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.meta diff --git a/physics/Interstitials/GFS/GFS_surface_loop_control_part2.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_loop_control_part2.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.F90 diff --git a/physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_surface_loop_control_part2.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.meta diff --git a/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_time_vary_pre.fv3.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 diff --git a/physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_time_vary_pre.fv3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta diff --git a/physics/Interstitials/GFS/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 similarity index 100% rename from physics/Interstitials/GFS/GFS_time_vary_pre.scm.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 diff --git a/physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta similarity index 100% rename from physics/Interstitials/GFS/GFS_time_vary_pre.scm.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta diff --git a/physics/Interstitials/GFS/aerinterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/aerinterp.F90 similarity index 100% rename from physics/Interstitials/GFS/aerinterp.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/aerinterp.F90 diff --git a/physics/Interstitials/GFS/cnvc90.f b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f similarity index 100% rename from physics/Interstitials/GFS/cnvc90.f rename to physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f diff --git a/physics/Interstitials/GFS/cnvc90.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta similarity index 100% rename from physics/Interstitials/GFS/cnvc90.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta diff --git a/physics/Interstitials/GFS/dcyc2t3.f b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f similarity index 100% rename from physics/Interstitials/GFS/dcyc2t3.f rename to physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f diff --git a/physics/Interstitials/GFS/dcyc2t3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta similarity index 100% rename from physics/Interstitials/GFS/dcyc2t3.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta diff --git a/physics/Interstitials/GFS/gcycle.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 similarity index 100% rename from physics/Interstitials/GFS/gcycle.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 diff --git a/physics/Interstitials/GFS/iccn_def.F b/physics/Interstitials/UFS_SCM_NEPTUNE/iccn_def.F similarity index 100% rename from physics/Interstitials/GFS/iccn_def.F rename to physics/Interstitials/UFS_SCM_NEPTUNE/iccn_def.F diff --git a/physics/Interstitials/GFS/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 similarity index 100% rename from physics/Interstitials/GFS/iccninterp.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 diff --git a/physics/Interstitials/GFS/maximum_hourly_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 similarity index 100% rename from physics/Interstitials/GFS/maximum_hourly_diagnostics.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 diff --git a/physics/Interstitials/GFS/maximum_hourly_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta similarity index 100% rename from physics/Interstitials/GFS/maximum_hourly_diagnostics.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta diff --git a/physics/Interstitials/GFS/phys_tend.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/phys_tend.F90 similarity index 100% rename from physics/Interstitials/GFS/phys_tend.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/phys_tend.F90 diff --git a/physics/Interstitials/GFS/phys_tend.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/phys_tend.meta similarity index 100% rename from physics/Interstitials/GFS/phys_tend.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/phys_tend.meta diff --git a/physics/Interstitials/GFS/scm_sfc_flux_spec.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 similarity index 100% rename from physics/Interstitials/GFS/scm_sfc_flux_spec.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 diff --git a/physics/Interstitials/GFS/scm_sfc_flux_spec.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta similarity index 100% rename from physics/Interstitials/GFS/scm_sfc_flux_spec.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.meta diff --git a/physics/Interstitials/GFS/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F similarity index 100% rename from physics/Interstitials/GFS/sfcsub.F rename to physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F diff --git a/physics/Interstitials/GFS/sgscloud_radpost.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.F90 similarity index 100% rename from physics/Interstitials/GFS/sgscloud_radpost.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.F90 diff --git a/physics/Interstitials/GFS/sgscloud_radpost.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.meta similarity index 100% rename from physics/Interstitials/GFS/sgscloud_radpost.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.meta diff --git a/physics/Interstitials/GFS/sgscloud_radpre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 similarity index 100% rename from physics/Interstitials/GFS/sgscloud_radpre.F90 rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 diff --git a/physics/Interstitials/GFS/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta similarity index 100% rename from physics/Interstitials/GFS/sgscloud_radpre.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta diff --git a/physics/MP/GFDL/gfdl_sfc_layer.F90 b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 similarity index 100% rename from physics/MP/GFDL/gfdl_sfc_layer.F90 rename to physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 diff --git a/physics/MP/GFDL/gfdl_sfc_layer.meta b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta similarity index 99% rename from physics/MP/GFDL/gfdl_sfc_layer.meta rename to physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta index a64fe277c..b0d613eed 100644 --- a/physics/MP/GFDL/gfdl_sfc_layer.meta +++ b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = gfdl_sfc_layer type = scheme - dependencies = ../../hooks/machine.F,../SFC_Layer/module_sf_exchcoef.f90,../../Land/RUC/namelist_soilveg_ruc.F90,../../Land/Noahmp/noahmp_tables.f90 + relative_path = ../../ + dependencies = hooks/machine.F,SFC_Layer/module_sf_exchcoef.f90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90,Land/Noahmp/noahmp_tables.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Layer/GFS_sfc/date_def.f b/physics/SFC_Layer/UFS/date_def.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/date_def.f rename to physics/SFC_Layer/UFS/date_def.f diff --git a/physics/SFC_Layer/GFS_sfc/module_nst_model.f90 b/physics/SFC_Layer/UFS/module_nst_model.f90 similarity index 100% rename from physics/SFC_Layer/GFS_sfc/module_nst_model.f90 rename to physics/SFC_Layer/UFS/module_nst_model.f90 diff --git a/physics/SFC_Layer/GFS_sfc/module_nst_parameters.f90 b/physics/SFC_Layer/UFS/module_nst_parameters.f90 similarity index 100% rename from physics/SFC_Layer/GFS_sfc/module_nst_parameters.f90 rename to physics/SFC_Layer/UFS/module_nst_parameters.f90 diff --git a/physics/SFC_Layer/GFS_sfc/module_nst_water_prop.f90 b/physics/SFC_Layer/UFS/module_nst_water_prop.f90 similarity index 100% rename from physics/SFC_Layer/GFS_sfc/module_nst_water_prop.f90 rename to physics/SFC_Layer/UFS/module_nst_water_prop.f90 diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diag.f b/physics/SFC_Layer/UFS/sfc_diag.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diag.f rename to physics/SFC_Layer/UFS/sfc_diag.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diag.meta rename to physics/SFC_Layer/UFS/sfc_diag.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diag_post.F90 b/physics/SFC_Layer/UFS/sfc_diag_post.F90 similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diag_post.F90 rename to physics/SFC_Layer/UFS/sfc_diag_post.F90 diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta b/physics/SFC_Layer/UFS/sfc_diag_post.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diag_post.meta rename to physics/SFC_Layer/UFS/sfc_diag_post.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diff.f rename to physics/SFC_Layer/UFS/sfc_diff.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_diff.meta rename to physics/SFC_Layer/UFS/sfc_diff.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst.f b/physics/SFC_Layer/UFS/sfc_nst.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst.f rename to physics/SFC_Layer/UFS/sfc_nst.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst.meta rename to physics/SFC_Layer/UFS/sfc_nst.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst_post.f b/physics/SFC_Layer/UFS/sfc_nst_post.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst_post.f rename to physics/SFC_Layer/UFS/sfc_nst_post.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta b/physics/SFC_Layer/UFS/sfc_nst_post.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst_post.meta rename to physics/SFC_Layer/UFS/sfc_nst_post.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.f b/physics/SFC_Layer/UFS/sfc_nst_pre.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst_pre.f rename to physics/SFC_Layer/UFS/sfc_nst_pre.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta b/physics/SFC_Layer/UFS/sfc_nst_pre.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_nst_pre.meta rename to physics/SFC_Layer/UFS/sfc_nst_pre.meta diff --git a/physics/Land/CLM_lake/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 similarity index 100% rename from physics/Land/CLM_lake/clm_lake.f90 rename to physics/SFC_Models/Lake/CLM/clm_lake.f90 diff --git a/physics/Land/CLM_lake/clm_lake.meta b/physics/SFC_Models/Lake/CLM/clm_lake.meta similarity index 100% rename from physics/Land/CLM_lake/clm_lake.meta rename to physics/SFC_Models/Lake/CLM/clm_lake.meta diff --git a/physics/Land/Flake/flake.F90 b/physics/SFC_Models/Lake/Flake/flake.F90 similarity index 100% rename from physics/Land/Flake/flake.F90 rename to physics/SFC_Models/Lake/Flake/flake.F90 diff --git a/physics/Land/Flake/flake_driver.F90 b/physics/SFC_Models/Lake/Flake/flake_driver.F90 similarity index 100% rename from physics/Land/Flake/flake_driver.F90 rename to physics/SFC_Models/Lake/Flake/flake_driver.F90 diff --git a/physics/Land/Flake/flake_driver.meta b/physics/SFC_Models/Lake/Flake/flake_driver.meta similarity index 100% rename from physics/Land/Flake/flake_driver.meta rename to physics/SFC_Models/Lake/Flake/flake_driver.meta diff --git a/physics/Land/Noah/lsm_noah.f b/physics/SFC_Models/Land/Noah/lsm_noah.f similarity index 100% rename from physics/Land/Noah/lsm_noah.f rename to physics/SFC_Models/Land/Noah/lsm_noah.f diff --git a/physics/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta similarity index 100% rename from physics/Land/Noah/lsm_noah.meta rename to physics/SFC_Models/Land/Noah/lsm_noah.meta diff --git a/physics/Land/Noah/sflx.f b/physics/SFC_Models/Land/Noah/sflx.f similarity index 100% rename from physics/Land/Noah/sflx.f rename to physics/SFC_Models/Land/Noah/sflx.f diff --git a/physics/Land/Noah/surface_perturbation.F90 b/physics/SFC_Models/Land/Noah/surface_perturbation.F90 similarity index 100% rename from physics/Land/Noah/surface_perturbation.F90 rename to physics/SFC_Models/Land/Noah/surface_perturbation.F90 diff --git a/physics/Land/Noahmp/module_sf_noahmp_glacier.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 similarity index 100% rename from physics/Land/Noahmp/module_sf_noahmp_glacier.F90 rename to physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 diff --git a/physics/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 similarity index 100% rename from physics/Land/Noahmp/module_sf_noahmplsm.F90 rename to physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 diff --git a/physics/Land/Noahmp/noahmp_tables.f90 b/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 similarity index 100% rename from physics/Land/Noahmp/noahmp_tables.f90 rename to physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 diff --git a/physics/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 similarity index 100% rename from physics/Land/Noahmp/noahmpdrv.F90 rename to physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 diff --git a/physics/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta similarity index 100% rename from physics/Land/Noahmp/noahmpdrv.meta rename to physics/SFC_Models/Land/Noahmp/noahmpdrv.meta diff --git a/physics/Land/Noahmp/noahmptable.tbl b/physics/SFC_Models/Land/Noahmp/noahmptable.tbl similarity index 100% rename from physics/Land/Noahmp/noahmptable.tbl rename to physics/SFC_Models/Land/Noahmp/noahmptable.tbl diff --git a/physics/Land/RUC/lsm_ruc.F90 b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 similarity index 100% rename from physics/Land/RUC/lsm_ruc.F90 rename to physics/SFC_Models/Land/RUC/lsm_ruc.F90 diff --git a/physics/Land/RUC/lsm_ruc.meta b/physics/SFC_Models/Land/RUC/lsm_ruc.meta similarity index 100% rename from physics/Land/RUC/lsm_ruc.meta rename to physics/SFC_Models/Land/RUC/lsm_ruc.meta diff --git a/physics/Land/RUC/module_sf_ruclsm.F90 b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 similarity index 100% rename from physics/Land/RUC/module_sf_ruclsm.F90 rename to physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 diff --git a/physics/Land/RUC/module_soil_pre.F90 b/physics/SFC_Models/Land/RUC/module_soil_pre.F90 similarity index 100% rename from physics/Land/RUC/module_soil_pre.F90 rename to physics/SFC_Models/Land/RUC/module_soil_pre.F90 diff --git a/physics/Land/RUC/namelist_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 similarity index 100% rename from physics/Land/RUC/namelist_soilveg_ruc.F90 rename to physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 diff --git a/physics/Land/RUC/set_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 similarity index 100% rename from physics/Land/RUC/set_soilveg_ruc.F90 rename to physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 diff --git a/physics/Land/namelist_soilveg.f b/physics/SFC_Models/Land/namelist_soilveg.f similarity index 100% rename from physics/Land/namelist_soilveg.f rename to physics/SFC_Models/Land/namelist_soilveg.f diff --git a/physics/Land/set_soilveg.f b/physics/SFC_Models/Land/set_soilveg.f similarity index 100% rename from physics/Land/set_soilveg.f rename to physics/SFC_Models/Land/set_soilveg.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_ocean.F b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_ocean.F rename to physics/SFC_Models/Ocean/UFS/sfc_ocean.F diff --git a/physics/SFC_Layer/GFS_sfc/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_ocean.meta rename to physics/SFC_Models/Ocean/UFS/sfc_ocean.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_cice.f b/physics/SFC_Models/SeaIce/CICE/sfc_cice.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_cice.f rename to physics/SFC_Models/SeaIce/CICE/sfc_cice.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_cice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_cice.meta rename to physics/SFC_Models/SeaIce/CICE/sfc_cice.meta diff --git a/physics/SFC_Layer/GFS_sfc/sfc_sice.f b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_sice.f rename to physics/SFC_Models/SeaIce/CICE/sfc_sice.f diff --git a/physics/SFC_Layer/GFS_sfc/sfc_sice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta similarity index 100% rename from physics/SFC_Layer/GFS_sfc/sfc_sice.meta rename to physics/SFC_Models/SeaIce/CICE/sfc_sice.meta From 26ca9f9c3d08aa5ddc5cb414c1a0377d1fb5fae2 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 6 Sep 2023 10:57:28 -0600 Subject: [PATCH 023/132] Renamed file --- ...s_diagnostics.F90 => GFS_physics_post.F90} | 30 +++++++++---------- ...diagnostics.meta => GFS_physics_post.meta} | 6 ++-- physics/ozphys_2015.F90 | 1 + 3 files changed, 19 insertions(+), 18 deletions(-) rename physics/{GFS_physics_diagnostics.F90 => GFS_physics_post.F90} (81%) rename physics/{GFS_physics_diagnostics.meta => GFS_physics_post.meta} (97%) diff --git a/physics/GFS_physics_diagnostics.F90 b/physics/GFS_physics_post.F90 similarity index 81% rename from physics/GFS_physics_diagnostics.F90 rename to physics/GFS_physics_post.F90 index 0c6197bc2..d034c1999 100644 --- a/physics/GFS_physics_diagnostics.F90 +++ b/physics/GFS_physics_post.F90 @@ -1,20 +1,20 @@ ! ########################################################################################### -!> \file GFS_physics_diagnostics.F90 +!> \file GFS_physics_post.F90 !! ! ########################################################################################### -module GFS_physics_diagnostics +module GFS_physics_post use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec implicit none - public GFS_physics_diagnostics_init, GFS_physics_diagnostics_run + public GFS_physics_post_init, GFS_physics_post_run contains ! ########################################################################################### -! SUBROUTINE GFS_physics_diagnostics_init +! SUBROUTINE GFS_physics_post_init ! ########################################################################################### -!! \section arg_table_GFS_physics_diagnostics_init Argument Table -!! \htmlinclude GFS_physics_diagnostics_init.html +!! \section arg_table_GFS_physics_post_init Argument Table +!! \htmlinclude GFS_physics_post_init.html !! - subroutine GFS_physics_diagnostics_init(errmsg, errflg) + subroutine GFS_physics_post_init(errmsg, errflg) ! Outputs character(len=*), intent(out) :: & @@ -22,15 +22,15 @@ subroutine GFS_physics_diagnostics_init(errmsg, errflg) integer, intent(out) :: & errflg ! CCPP error flag - end subroutine GFS_physics_diagnostics_init + end subroutine GFS_physics_post_init ! ########################################################################################### -! SUBROUTINE GFS_physics_diagnostics_run +! SUBROUTINE GFS_physics_post_run ! ########################################################################################### -!! \section arg_table_GFS_physics_diagnostics_run Argument Table -!! \htmlinclude GFS_physics_diagnostics_run.html +!! \section arg_table_GFS_physics_post_run Argument Table +!! \htmlinclude GFS_physics_post_run.html !! - subroutine GFS_physics_diagnostics_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip_ozmix, & + subroutine GFS_physics_post_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip_ozmix, & ip_temp, ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, dtend,& errmsg, errflg) ! Inputs @@ -69,7 +69,7 @@ subroutine GFS_physics_diagnostics_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip ! ####################################################################################### ! - ! Ozone physics diagnostics + ! Ozone physics diagnostic ! ! ####################################################################################### idtend = dtidx(100+ntoz,ip_prod_loss) @@ -92,6 +92,6 @@ subroutine GFS_physics_diagnostics_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_ohoz endif - end subroutine GFS_physics_diagnostics_run + end subroutine GFS_physics_post_run -end module GFS_physics_diagnostics +end module GFS_physics_post diff --git a/physics/GFS_physics_diagnostics.meta b/physics/GFS_physics_post.meta similarity index 97% rename from physics/GFS_physics_diagnostics.meta rename to physics/GFS_physics_post.meta index b6036b0c9..8b5120b9e 100644 --- a/physics/GFS_physics_diagnostics.meta +++ b/physics/GFS_physics_post.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] - name = GFS_physics_diagnostics + name = GFS_physics_post type = scheme dependencies = machine.F ######################################################################## [ccpp-arg-table] - name = GFS_physics_diagnostics_init + name = GFS_physics_post_init type = scheme [errmsg] standard_name = ccpp_error_message @@ -25,7 +25,7 @@ ######################################################################## [ccpp-arg-table] - name = GFS_physics_diagnostics_run + name = GFS_physics_post_run type = scheme [nCol] standard_name = horizontal_loop_extent diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 index 9898c71e4..47386bd6e 100644 --- a/physics/ozphys_2015.F90 +++ b/physics/ozphys_2015.F90 @@ -17,6 +17,7 @@ module ozphys_2015 !! \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by Naval !! Research Laboratory through CHEM2D chemistry model !! (McCormack et al. (2006) \cite mccormack_et_al_2006). +!! (https://doi.org/10.5194/acp-6-4943-2006) !! !> \section genal_ozphys_2015 GFS ozphys_2015_run General Algorithm !> - This code assumes that both prsl and po3 are from bottom to top From c0ec619536bd29740627cb2dc1da106b61dd435c Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Tue, 19 Sep 2023 02:36:14 +0000 Subject: [PATCH 024/132] Added tendency limiter for mesosphere and horizontal wave number filter for orographic gravity wave drag in UGWP -- Issue #95 --- physics/drag_suite.F90 | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 22f122e71..ff68f4216 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -460,6 +460,8 @@ subroutine drag_suite_run( & real(kind=kind_phys), parameter :: ce = 0.8 real(kind=kind_phys), parameter :: cg = 0.5 real(kind=kind_phys), parameter :: sgmalolev = 0.5 ! max sigma lvl for dtfac + real(kind=kind_phys), parameter :: plolevmeso = 70.0 ! pres lvl for mesosphere OGWD reduction (Pa) + real(kind=kind_phys), parameter :: facmeso = 0.5 ! fractional velocity reduction for OGWD integer,parameter :: kpblmin = 2 ! @@ -472,7 +474,7 @@ subroutine drag_suite_run( & rcsks,wdir,ti,rdz,tem2,dw2,shr2, & bvf2,rdelks,wtkbj,tem,gfobnv,hd,fro, & rim,temc,tem1,efact,temv,dtaux,dtauy, & - dtauxb,dtauyb,eng0,eng1 + dtauxb,dtauyb,eng0,eng1,ksmax,dtfac_meso ! logical :: ldrag(im),icrilv(im), & flag(im),kloop1(im) @@ -887,6 +889,14 @@ subroutine drag_suite_run( & ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0 ldrag(i) = ldrag(i) .or. ulow(i).eq.1.0 ldrag(i) = ldrag(i) .or. var_stoch(i) .le. 0.0 +! Check if mesoscale gravity waves will propagate vertically or be evanescent +! and not impart a drag force -- consider the maximum sub-grid horizontal +! topographic wavelength to be one-half the horizontal grid spacing -- calculate +! ksmax accordingly + ksmax = 4.0*pi/dx(i) ! based on wavelength = 0.5*dx(i) + if ( bnv2(i,1).gt.0.0 ) then + ldrag(i) = ldrag(i) .or. sqrt(bnv2(i,1))*rulow(i).lt.ksmax + endif ! ! set all ri low level values to the low level value ! @@ -1106,7 +1116,19 @@ subroutine drag_suite_run( & enddo ! do k = kts,km - taud_ms(i,k) = taud_ms(i,k)*dtfac(i)* ls_taper(i) *(1.-rstoch(i)) + + ! Check if well into mesosphere -- if so, perform similar reduction of + ! velocity tendency due to mesoscale GWD to prevent sudden reversal of + ! wind direction (similar to above) + dtfac_meso = 1.0 + if (prsl(i,k).le.plolevmeso) then + if (taud_ms(i,k).ne.0.) & + dtfac_meso = min(dtfac_meso,facmeso*abs(velco(i,k) & + /(deltim*rcs*taud_ms(i,k)))) + end if + + taud_ms(i,k) = taud_ms(i,k)*dtfac(i)*dtfac_meso* & + ls_taper(i) *(1.-rstoch(i)) taud_bl(i,k) = taud_bl(i,k)*dtfac(i)* ls_taper(i) *(1.-rstoch(i)) dtaux = taud_ms(i,k) * xn(i) From f324aa52e64b325965b1552916c733946610ddd2 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Fri, 22 Sep 2023 20:21:45 -0500 Subject: [PATCH 025/132] Update variable name in mp_nssl.F90 --- physics/mp_nssl.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_nssl.F90 b/physics/mp_nssl.F90 index b81afaafb..aacf4c3dd 100644 --- a/physics/mp_nssl.F90 +++ b/physics/mp_nssl.F90 @@ -134,7 +134,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! write(0,*) 'call nssl_2mom_init' CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=ipc,mixphase=0, & - ihvol=ihailv,nssl_ehw0=nssl_ehw0_in,nssl_ehlw0=nssl_ehlw0_in,errmsg=errmsg, & + ihvol=ihailv,nssl_ehw0=nssl_ehw0,nssl_ehlw0=nssl_ehlw0,errmsg=errmsg, & nssl_alphar=nssl_alphar, & nssl_alphah=nssl_alphah, & nssl_alphahl=nssl_alphahl, & From fda90e0d45e13458d89425ec9bb4d1ef454e1fa8 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Sat, 23 Sep 2023 16:19:01 -0500 Subject: [PATCH 026/132] Update for NSSL 2/3-moment cloud physics --- physics/module_mp_nssl_2mom.F90 | 1157 +++++++++++++++++++++---------- 1 file changed, 795 insertions(+), 362 deletions(-) diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/module_mp_nssl_2mom.F90 index 6439d81d3..72ff9b1b1 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/module_mp_nssl_2mom.F90 @@ -8,7 +8,7 @@ !--------------------------------------------------------------------- -! code snapshot: "Apr 10 2023" at "13:17:29" +! code snapshot: "Sep 22 2023" at "22:01:53" !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! IMPORTANT: Best results are attained using the 5th-order WENO (Weighted Essentially Non-Oscillatory) advection option (4) for scalars: @@ -33,9 +33,7 @@ !! !! Added info on graupel density and soaking is in Mansell and Ziegler (2013, JAS) !! -!! Average graupel particle density is predicted, which affects fall speed as well. -!! Hail density prediction is by default disabled in this version, but may be enabled -!! at some point if there is interest. +!! Average graupel and hail particle densities are predicted, which affects fall speed as well. !! !! Maintainer: Ted Mansell, National Severe Storms Laboratory !! @@ -76,6 +74,13 @@ ! ! !--------------------------------------------------------------------- +! Apr. 2023 +! - Update to 3-moment for rain, graupel, and hail +! - Change default graupel/hail fall speeds to icdx/icdxhl=6 (Milbrandt & Morrison 2013) +! and also set default ehw0=0.9 and ehlw0=0.9 to compensate for lower fall speeds. +! - Change default hail conversion to ihlcnh=-1, and then =1 for 2-mom or =3 for 3-mom, +! using wet growth diameter to convert large graupel +!--------------------------------------------------------------------- ! Sept. 2021: ! Fixes: ! Restored previous formulation of snow reflectivity, as it was realized that the last change incorrectly assumed a fixed @@ -225,7 +230,7 @@ MODULE module_mp_nssl_2mom real, private :: rho_qr = 1000., cnor = 8.0e5 ! cnor is set in namelist!! rain params real, private :: rho_qs = 100., cnos = 3.0e6 ! set in namelist!! snow params real, private :: rho_qh = 500., cnoh = 4.0e5 ! set in namelist!! graupel params - real, private :: rho_qhl= 900., cnohl = 4.0e4 ! set in namelist!! hail params + real, private :: rho_qhl= 800., cnohl = 4.0e4 ! set in namelist!! hail params real, private :: hdnmn = 170.0 ! minimum graupel density (for variable density graupel) real, private :: hldnmn = 500.0 ! minimum hail density (for variable density hail) @@ -287,8 +292,10 @@ MODULE module_mp_nssl_2mom real, private :: graupelfallfac = 1.0 ! factor to adjust graupel fall speed real, private :: hailfallfac = 1.0 ! factor to adjust hail fall speed integer, private :: icefallopt = 3 ! 1= default, 2 = Ferrier ice fall speed; 3 = adjusted Ferrier (slightly high Vt) - integer, private :: icdx = 3 ! (graupel) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. - integer, private :: icdxhl = 3 ! (hail) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + integer, private :: icdx = 6 ! (graupel) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + ! 6= Milbrandt and Morrison (2013) density-based fall speed + integer, private :: icdxhl = 6 ! (hail) 0=Ferrier; 1=leave drag coef. cd fixed; 2=vary by density, 4=set by user with cdxmin,cdxmax,etc. + ! 6= Milbrandt and Morrison (2013) density-based fall speed real :: axh = 75.7149, bxh = 0.5 real :: axf = 75.7149, bxf = 0.5 real :: axhl = 206.984, bxhl = 0.6384 @@ -340,7 +347,7 @@ MODULE module_mp_nssl_2mom ! (first nucleation is done with a KW sat. adj. step) integer, private :: issfilt = 0 ! flag to turn on filtering of supersaturation field integer, private :: icnuclimit = 0 ! limit droplet nucleation based on Konwar et al. (2012) and Chandrakar et al. (2016) - integer, private :: irenuc = 2 ! =1 to always allow renucleation of droplets within the cloud + integer, private :: irenuc = 2 ! =1 to always allow renucleation of droplets within the cloud (do no use, obsolete) ! =2 renucleation following Twomey/Cohard&Pinty ! =7 New renucleation that requires prediction of the number of activated nuclei ! i.e., not only at cloud base @@ -439,6 +446,7 @@ MODULE module_mp_nssl_2mom real , private :: ehs0 = 0.1, ehs1 = 0.1 ! graupel-snow coll. eff. parameters: ehs0*exp(ehs1*min(temcg(mgs),0.0)) ! set ehs1 = 0 to get a constant value of ehs0 integer :: iessopt = 1 ! 1 = Original (no factor); 2 = factor based on wvel; 3 = factor based on SSI + ! 4 = as 3 but sets min factor of 0.1 and goes to full value at 0.5% SSI real , private :: ess0 = 0.5, ess1 = 0.05 ! snow aggregation coefficients: ess0*exp(ess1*min(temcg(mgs),0.0)) ! set ess1 = 0 to get a constant value of ess0 real , private :: esstem1 = -15. ! lower temperature where snow aggregation turns on @@ -535,17 +543,18 @@ MODULE module_mp_nssl_2mom real, parameter :: alpharmax = 8. ! limited for rwvent calculation - integer, private :: ihlcnh = 1 ! which graupel -> hail conversion to use + integer, private :: ihlcnh = -1 ! which graupel -> hail conversion to use ! 1 = Milbrandt and Yau (2005) using Ziegler 1985 wet growth diameter ! 2 = Straka and Mansell (2005) conversion using size threshold ! 3 = Conversion using wet growth diameter real, private :: hlcnhdia = 1.e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 1 option. real, private :: hlcnhqmin = 0.1e-3 ! minimum graupel mass content for graupel -> hail conversion (ihlcnh = 1) - real , private :: hldia1 = 20.0e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 2 option. - integer :: incwet = 0 ! flag to do wet growth only on D > D_wet + real , private :: hldia1 = 10.0e-3 ! threshold diameter for graupel -> hail conversion for ihlcnh = 2 option. + integer, private :: incwet = 0 ! flag to do wet growth only on D > D_wet integer, private :: iusedw = 0 ! flag to use experimental wet growth ice diameter for gr -> hl conversion (=1 turns on) real , private :: dwmin = 5.0e-3 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) real , private :: dwetmin = 5.0e-3 ! Minimum diameter with iusedw (can stay at 0 or be set to something larger) + real , private :: dwmax = 15.e-3 ! for ihlcnh, always convert this size and larger whether or not there is wet growth real , private :: dwtempmin = 242. ! lowest temperature to allow wet growth conversion to hail real , private :: dwehwmin = 0. ! Minimum ehw to use to find wet growth diameter (if > ehw0, then wet growth diam becomes smaller) real , private :: dg0thresh = 0.15 ! graupel wet growth diameter above which we say do not bother @@ -576,7 +585,7 @@ MODULE module_mp_nssl_2mom ! = 2 DTD mass-weighted version based on MY code ! = 3 Milbrandt version (from Cohard and Pinty code integer :: dmropt = 0 ! extra option for crcnw - integer :: dmhlopt = 1 ! options for graupel -> conversion + integer :: dmhlopt = 0 ! options for graupel -> hail conversion integer :: irescalerainopt = 3 ! 0 = default option ! 1 = qx(mgs,lc) > qxmin(lc) ! 2 = qx(mgs,lc) > qxmin(lc) .and. wvel(mgs) < 3.0 @@ -593,7 +602,7 @@ MODULE module_mp_nssl_2mom integer :: ivhmltsoak = 1 ! 0=off, 1=on : flag to simulate soaking (graupel/hail) during melting ! when liquid fraction is not predicted - logical :: iwetsoak = .true. ! soak and freeze during wet growth or not + logical, private :: iwetsoak = .true. ! soak and freeze during wet growth or not integer, private :: ioldlimiter = 0 ! test switch for new(=0) or old(=1) size limiter at the end of GS for 3-moment categories integer, private :: isnowfall = 2 ! Option for choosing between snow fall speed parameters ! 1 = original Zrnic et al. (Mansell et al. 2010) @@ -800,7 +809,7 @@ MODULE module_mp_nssl_2mom double precision gmoi(0:ngm0) ! ,gmod(0:ngm1,0:ngm2),gmdi(0:ngm1,0:ngm2) integer, parameter :: nqiacralpha = 300 !480 ! 240 ! 120 ! 15 - integer, parameter :: nqiacrratio = 100 ! 500 !50 ! 25 + integer, parameter :: nqiacrratio = 400 ! 500 !50 ! 25 ! real, parameter :: maxratiolu = 25. real, parameter :: maxratiolu = 100. ! 25. real, parameter :: maxalphalu = 15. @@ -899,7 +908,7 @@ MODULE module_mp_nssl_2mom ! parameter( xvcmn=4.188e-18 ) ! mks min volume = 3 micron radius real, parameter :: xvcmn=0.523599*(2.*cwradn)**3 ! mks min volume = 2.5 micron radius - real, parameter :: xvcmx=0.523599*(2.*xcradmx)**3 ! mks min volume = 2.5 micron radius + real, parameter :: xvcmx=0.523599*(2.*xcradmx)**3 ! mks max volume = 60 micron radius real, parameter :: cwmasn = 1000.*xvcmn ! minimum mass, defined by radius of 5.0e-6 real, parameter :: cwmasx = 1000.*xvcmx ! maximum mass, defined by radius of 50.0e-6 real, parameter :: cwmasn5 = 1000.*0.523599*(2.*5.0e-6)**3 ! 5.23e-13 @@ -947,7 +956,7 @@ MODULE module_mp_nssl_2mom real :: cp = 1004.0, rd = 287.04 real :: rw = 461.5 ! gas const. for water vapor REAL, PRIVATE :: cpl = 4190.0 - REAL, PRIVATE :: cpigb = 2106.0 + REAL, PRIVATE :: cpigb = 2106.0 real :: cpi real :: cap real :: tfrcbw @@ -962,8 +971,8 @@ MODULE module_mp_nssl_2mom ! GHB: Needed for eqtset=2 in cm1 ! REAL, PRIVATE :: cv = cp - rd - real, private, parameter :: cv = 717.0 ! specific heat at constant volume - air - REAL, PRIVATE, parameter :: cvv = 1408.5 + real, private, parameter :: cv = 717.0 ! specific heat at constant volume - air + REAL, PRIVATE, parameter :: cvv = 1408.5 ! GHB real, parameter :: bfnu0 = (rnu + 2.0)/(rnu + 1.0) @@ -992,6 +1001,8 @@ MODULE module_mp_nssl_2mom logical, parameter :: do_satadj_for_wrfchem = .true. + integer, parameter :: ac_opt = 0 ! option flag for alternate aerosol (for NUWRF only) + logical, private :: nuaccoinp = .false. ! Note to users: Many of these options are for development and not guaranteed to perform well. ! Some may not be functional depending on the version of the code. @@ -1101,7 +1112,7 @@ MODULE module_mp_nssl_2mom rescale_low_alphah, & rescale_low_alphahl, & rescale_high_alpha, & - ihlcnh, hldia1,iusedw, dwehwmin, dwmin, dwtempmin, & + ihlcnh, hldia1,iusedw, dwehwmin, dwmin, dwmax, dwtempmin, dg0thresh, & icvhl2h, hldnmn,hdnmn, & hlcnhdia, hlcnhqmin, & isedonly, & @@ -1194,13 +1205,14 @@ SUBROUTINE nssl_2mom_init_const( & RETURN END SUBROUTINE nssl_2mom_init_const + + ! ##################################################################### ! ##################################################################### !>\ingroup mod_nsslmp !! NSSL MP setup routine (sets local options and array indices) SUBROUTINE nssl_2mom_init( & & ims,ime, jms,jme, kms,kme, nssl_params, ipctmp, mixphase,ihvol,idoniconlytmp, & - & igvol, & & nssl_graupelfallfac, & & nssl_hailfallfac, & & nssl_ehw0, & @@ -1214,6 +1226,7 @@ SUBROUTINE nssl_2mom_init( & & nssl_alphah, & & nssl_alphahl, & & nssl_alphar, & + & nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on, ccn_is_ccna, & & errmsg, errflg, & & infileunit, & & myrank, mpiroot & @@ -1233,9 +1246,11 @@ SUBROUTINE nssl_2mom_init( & & nssl_alphahl, & & nssl_alphar integer, intent(in), optional :: & - & nssl_icdx, igvol, & + & nssl_icdx, & & nssl_icdxhl, myrank, mpiroot, & & nssl_ufccn + logical, intent(in), optional :: nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on + integer, intent(inout), optional :: ccn_is_ccna integer, intent(in),optional :: infileunit @@ -1243,16 +1258,20 @@ SUBROUTINE nssl_2mom_init( & character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg integer, intent(in), optional :: ims,ime, jms,jme, kms,kme + real, intent(in), dimension(20), optional :: nssl_params - integer, intent(in) :: ipctmp,mixphase,ihvol + integer, intent(in) :: ipctmp,mixphase + integer, optional, intent(in) :: ihvol logical, optional, intent(in) :: idoniconlytmp integer :: igvol_local = 1 logical :: wrote_namelist = .false. logical :: wrf_dm_on_monitor + integer :: hail_on = -1, density_on = -1, icecrystals_on = 1 + integer :: ccn_on = -1 double precision :: arg real :: temq @@ -1277,9 +1296,37 @@ SUBROUTINE nssl_2mom_init( & turn_on_ccna = .false. turn_on_cina = .false. - IF ( present( igvol ) ) THEN - igvol_local = igvol +! IF ( present( igvol ) ) THEN +! igvol_local = igvol +! ENDIF + + IF ( present( nssl_hail_on ) ) THEN + IF ( nssl_hail_on ) THEN + hail_on = 1 + ELSE + hail_on = 0 + ENDIF + ENDIF + + IF ( present( nssl_density_on ) ) THEN + IF ( nssl_density_on ) THEN + density_on = 1 + ELSE + density_on = 0 + ENDIF ENDIF + + IF ( present( nssl_icecrystals_on ) ) THEN + IF ( nssl_icecrystals_on ) THEN + icecrystals_on = 1 + ELSE + icecrystals_on = 0 + ! renucfrac = 1.0 ! why was this set to 1? + ffrzs = 1.0 + ENDIF + ENDIF + + ! ! set some global values from namelist input ! @@ -1295,7 +1342,6 @@ SUBROUTINE nssl_2mom_init( & rho_qh = nssl_params(8) rho_qhl = nssl_params(9) rho_qs = nssl_params(10) - IF ( Nint(nssl_params(13)) == 1 ) THEN ! hack to switch CCN field to CCNA (activated ccn) ! invertccn = .true. @@ -1306,29 +1352,56 @@ SUBROUTINE nssl_2mom_init( & IF ( present(nssl_ufccn) ) iufccn = nssl_ufccn ENDIF - + alphar = nssl_params(15) ! ipelec = Nint(nssl_params(11)) ! isaund = Nint(nssl_params(12)) + + IF ( present(nssl_graupelfallfac) ) graupelfallfac = nssl_graupelfallfac IF ( present(nssl_hailfallfac) ) hailfallfac = nssl_hailfallfac - IF ( present(nssl_ehw0) ) ehw0 = nssl_ehw0 - IF ( present(nssl_ehlw0) ) ehlw0 = nssl_ehlw0 + IF ( present(nssl_ehw0) ) THEN + IF ( nssl_ehw0 > 0.0 ) ehw0 = nssl_ehw0 + ENDIF + IF ( present(nssl_ehlw0) ) THEN + IF ( nssl_ehlw0 > 0.0 ) ehlw0 = nssl_ehlw0 + ENDIF IF ( present(nssl_icdx) ) icdx = nssl_icdx IF ( present(nssl_icdxhl) ) icdxhl = nssl_icdxhl IF ( present(nssl_icefallfac) ) icefallfac = nssl_icefallfac IF ( present(nssl_snowfallfac) ) snowfallfac = nssl_snowfallfac - IF ( present(nssl_cccn) ) ccn = nssl_cccn - IF ( present(nssl_alphah) ) alphah = nssl_alphah - IF ( present(nssl_alphahl) ) alphahl = nssl_alphahl - IF ( present(nssl_alphar) ) alphar = nssl_alphar + IF ( present(nssl_cccn) ) THEN + IF (nssl_cccn > 1 ) ccn = nssl_cccn + ENDIF + IF ( present(nssl_alphah) ) THEN + IF ( nssl_alphah > -1. ) alphah = nssl_alphah + ENDIF + IF ( present(nssl_alphahl) ) THEN + IF ( nssl_alphahl > -1. ) alphahl = nssl_alphahl + ENDIF + IF ( present(nssl_alphar) ) THEN + IF ( nssl_alphar > -1.0 ) alphar = nssl_alphar + ENDIF + + ipconc = ipctmp + + IF ( ipconc < 5 ) THEN + ihlcnh = 0 + ENDIF + IF ( ihlcnh <= 0 ) THEN + IF ( ipconc == 5 ) THEN + ihlcnh = 3 + ELSEIF ( ipconc >= 6 ) THEN + ihlcnh = 3 + ENDIF + ENDIF - IF ( .true. ) THEN ! set to true to enable internal namelist read + IF ( .false. ) THEN ! set to true to enable internal namelist read open(15,file='input.nml',status='old',form='formatted',action='read') rewind(15) read(15,NML=nssl_mp_params,iostat=istat) @@ -1359,8 +1432,34 @@ SUBROUTINE nssl_2mom_init( & ENDIF ENDIF + IF ( present( nssl_ccn_on ) ) THEN + IF ( nssl_ccn_on ) THEN + ccn_on = 1 + ELSE + ccn_on = 0 + irenuc = 2 + ENDIF + ENDIF + IF ( irenuc >= 5 ) THEN turn_on_ccna = .true. + IF ( present( nssl_ccn_on ) ) THEN + IF ( .not. nssl_ccn_on ) THEN + errmsg = 'NSSL_MP Error: Must have nssl_ccn_on=1 for irenuc >= 5!' + errflg = 1 + return + ENDIF + ENDIF + ENDIF + + IF ( present( ccn_is_ccna ) .and. ccn_on == 1 ) THEN + IF ( ccn_is_ccna > 0 ) THEN + turn_on_ccna = .true. + ELSE + IF ( irenuc >= 5 ) THEN + ccn_is_ccna = 1 + ENDIF + ENDIF ENDIF cwccn = ccn @@ -1374,25 +1473,42 @@ SUBROUTINE nssl_2mom_init( & lh = lh + 1 lhl = lhl + 1 ENDIF - IF ( ihvol <= -1 .or. ihvol == 2 ) THEN - IF ( ihvol == -1 .or. ihvol == -2 ) THEN - lhab = lhab - 1 ! turns off hail - lhl = 0 - ! past me thought it would be a good idea to change graupel factors when hail is off.... - ! ehw0 = 0.75 - ! iehw = 2 - ! dfrz = Max( dfrz, 0.5e-3 ) - ENDIF - IF ( ihvol == -2 .or. ihvol == 2 ) THEN ! ice crystals are turned off - ! a value of 2? means to turn off ice crystals but turn on hail - renucfrac = 1.0 - ffrzs = 1.0 - ! idoci = 0 ! try this later + IF ( hail_on == -1 ) THEN ! hail_on is not set + hail_on = 1 + IF ( ihvol <= -1 .or. ihvol == 2 ) THEN + IF ( ihvol == -1 .or. ihvol == -2 ) THEN + lhab = lhab - 1 ! turns off hail + lhl = 0 + hail_on = 0 + ! past me thought it would be a good idea to change graupel factors when hail is off.... + ! ehw0 = 0.75 + ! iehw = 2 + ! dfrz = Max( dfrz, 0.5e-3 ) + ENDIF + IF ( ihvol == -2 .or. ihvol == 2 .or. icecrystals_on == 0 ) THEN ! ice crystals are turned off + ! a value of 2? means to turn off ice crystals but turn on hail + ! renucfrac = 1.0 ! why? + ffrzs = 1.0 + ! idoci = 0 ! try this later + ENDIF + ENDIF + + ELSE ! hail_on is set + IF ( hail_on == 0 ) THEN + lhab = lhab - 1 ! turns off hail + lhl = 0 + ELSE + ! assume default that hail is on ENDIF ENDIF + + IF ( density_on == -1 ) THEN ! density flag not set, so default is to predict it + density_on = 1 + ENDIF + IF ( iresetmoments == 0 ) iresetmoments = 1 ! lhl -! write(0,*) 'wrf_init: lhab,lhl = ',lhab,lhl +! write(0,*) 'wrf_init: lhab,lhl,hail_on,density_on = ',lhab,lhl,hail_on,density_on ! IF ( ipelec > 0 ) idonic = .true. @@ -1551,8 +1667,6 @@ SUBROUTINE nssl_2mom_init( & qiacrratio(0,:) = 1.0 - isub = Min( 0, Max(-1,ihvol) ) ! is -1 or 0 - lccn = 0 lccnuf = 0 lccna = 0 @@ -1576,14 +1690,13 @@ SUBROUTINE nssl_2mom_init( & ! lccn = 9 - ipconc = ipctmp IF ( ipconc == 0 ) THEN - IF ( ihvol >= 0 ) THEN + IF ( hail_on == 1 ) THEN ! turn on graupel density for 1-moment scheme lvh = 9 ltmp = 9 denscale(lvh) = 1 - ELSE ! no hail + ELSE ! no hail, 'LFO' scheme ltmp = lhab lhl = 0 ENDIF @@ -1601,17 +1714,17 @@ SUBROUTINE nssl_2mom_init( & lns = ltmp+5 !13 lnh = ltmp+6 !14 ltmp = lnh - IF ( ihvol >= 0 ) THEN + IF ( hail_on == 1 ) THEN ltmp = ltmp + 1 lnhl = ltmp ! lhab+7 ! 15 ENDIF - IF ( igvol_local >= 1 ) THEN + IF ( density_on >= 1 ) THEN ltmp = ltmp + 1 lvh = ltmp ! lhab+8 + isub ! 16 + isub ! isub adjusts to 15 if hail is off ! ltmp = lvh ENDIF denscale(lccn:ltmp) = 1 - IF ( ihvol >= 1 ) THEN + IF ( density_on == 1 .and. hail_on == 1 ) THEN ltmp = ltmp + 1 lvhl = ltmp ! ltmp = lvhl @@ -1647,13 +1760,13 @@ SUBROUTINE nssl_2mom_init( & ltmp = ltmp + 1 lnhl = ltmp ! lhab+7 ! 15 ENDIF - IF ( igvol_local >= 1 ) THEN + IF ( density_on == 1 ) THEN ltmp = ltmp + 1 lvh = ltmp ! lhab+8 + isub ! 16 + isub ! isub adjusts to 15 if hail is off ENDIF ! ltmp = lvh denscale(lccn:ltmp) = 1 - IF ( ihvol >= 1 ) THEN + IF ( density_on == 1 .and. hail_on == 1 ) THEN ltmp = ltmp + 1 lvhl = ltmp ! ltmp = lvhl @@ -1673,19 +1786,14 @@ SUBROUTINE nssl_2mom_init( & lzh = ltmp ltmp = ltmp + 1 lzr = ltmp - ltmp = ltmp + 1 IF ( lhl > 1 ) THEN ltmp = ltmp + 1 lzhl = ltmp ENDIF + ! write(0,*) 'ipcon,lzr = ',ipconc,lzr,lzh,lzhl ENDIF ! ltmp = lvh ! denscale(lccn:lvh) = 1 - IF ( ihvol >= 1 ) THEN - lvhl = ltmp+1 - ltmp = lvhl - denscale(lvhl) = 1 - ENDIF IF ( mixedphase ) THEN ltmp = ltmp + 1 lsw = ltmp @@ -1705,7 +1813,8 @@ SUBROUTINE nssl_2mom_init( & - + ! write(0,*) 'wrf_init: lh,lhl,lzh,lzhl = ',lh,lhl,lzh,lzhl + ! write(0,*) 'wrf_init: ipconc = ',ipconc ! write(0,*) 'wrf_init: irenuc, turn_on_ccna = ',irenuc, turn_on_ccna IF ( turn_on_ccna ) THEN ltmp = ltmp + 1 @@ -2171,19 +2280,24 @@ END SUBROUTINE nssl_2mom_init !! Driver subroutine that copies state data to local 2D arrays for microphysics calls SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw, chl, & cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, & + f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl, & cnuf, f_cnuf, & zrw, zhw, zhl, f_zrw, f_zhw, f_zhl, f_vhw, f_vhl, & qsw, qhw, qhlw, & tt, th, pii, p, w, dn, dz, dtp, itimestep, & + is_theta_or_temp, & ntmul, ntcnt, lastloop, & RAINNC,RAINNCV, & dx, dy, & axtra, & SNOWNC, SNOWNCV, GRPLNC, GRPLNCV, & SR,HAILNC, HAILNCV, & + hail_maxk1, hail_max2d, nwp_diagnostics, & tkediss, & re_cloud, re_ice, re_snow, re_rain, & + re_graup, re_hail, & has_reqc, has_reqi, has_reqs, has_reqr, & + has_reqg, has_reqh, & rainncw2, rainnci2, & dbz, vzf,compdbz, & rscghis_2d,rscghis_2dp,rscghis_2dn, & @@ -2217,6 +2331,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw + + implicit none @@ -2234,6 +2350,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw zrw, zhw, zhl, & qsw, qhw, qhlw, & qi,qhl,ccw,crw,cci,csw,chw,chl,vhw,vhl + integer, optional, intent(in) :: is_theta_or_temp logical, optional, intent(in) :: f_zrw, f_zhw, f_zhl, f_vhw, f_vhl ! not used yet real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: dbz, vzf, cn, cna, cni, cnuf real, dimension(ims:ime, jms:jme), optional, intent(inout):: compdbz @@ -2268,16 +2385,21 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout) :: axtra ! WRF variables - real, dimension(ims:ime, jms:jme), intent(inout):: & + real, dimension(ims:ime, jms:jme) :: & RAINNC,RAINNCV ! accumulated precip (NC) and rate (NCV) real, dimension(ims:ime, jms:jme), optional, intent(inout):: & SNOWNC,SNOWNCV,GRPLNC,GRPLNCV,SR ! accumulated precip (NC) and rate (NCV) real, dimension(ims:ime, jms:jme), optional, intent(inout):: & HAILNC,HAILNCV ! accumulated precip (NC) and rate (NCV) + real, dimension(ims:ime, jms:jme), optional, intent(inout) :: hail_maxk1, hail_max2d + integer, optional, intent(in) :: nwp_diagnostics +! for cm1, set nproctot=44 (or as needed) to get domain total rates integer, parameter :: nproc = 1 - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(INOUT):: re_cloud, re_ice, re_snow, re_rain + double precision :: proctot(nproc),proctotmpi(nproc) + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(INOUT):: re_cloud, re_ice, re_snow, & + re_rain, re_graup, re_hail REAL, DIMENSION(ims:ime, kms:kme, jms:jme), optional, INTENT(IN):: tkediss - INTEGER, INTENT(IN), optional :: has_reqc, has_reqi, has_reqs, has_reqr + INTEGER, INTENT(IN), optional :: has_reqc, has_reqi, has_reqs, has_reqr, has_reqg, has_reqh real, dimension(ims:ime, jms:jme), intent(out), optional :: & rainncw2, rainnci2 ! liquid rain, ice, accumulation rates real, optional, intent(in) :: dx,dy @@ -2286,6 +2408,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw integer, intent(in), optional :: ntmul, ntcnt logical, optional, intent(in) :: lastloop logical, optional, intent(in) :: diagflag, f_cna, f_cn, f_cina, f_cnuf + logical, optional, intent(in) :: f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl integer, optional, intent(in) :: ipelectmp, ke_diag ! CCPP error handling @@ -2298,7 +2421,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw LOGICAL :: flag_qndrop ! wrf-chem LOGICAL :: flag_qnifa , flag_qnwfa logical :: flag_cnuf = .false. + logical :: flag_ccn = .false. + logical :: flag_qi = .true. + logical :: has_reqg_local = .false., has_reqh_local = .false. logical :: flag + logical :: nwp_diagflag = .false. real :: cinchange, t7max,testmax,wmax ! 20130903 acd_ck_washout start @@ -2323,9 +2450,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(its:ite, kts:kte) :: rainprod2d, evapprod2d,tke2d real, dimension(its:ite, 1, kts:kte, na) :: an, ancuten real, dimension(its:ite, 1, kts:kte, nxtra) :: axtra2d + real, dimension(its:ite, 1, kts:kte, 3) :: alpha2d real, dimension(its:ite, 1, kts:kte) :: t0,t1,t2,t3,t4,t5,t6,t7,t8,t9 real, dimension(its:ite, 1, kts:kte) :: dn1,t00,t77,ssat,pn,wn,dz2d,dz2dinv,dbz2d,vzf2d real, dimension(its:ite, 1, na) :: xfall + real, dimension(its:ite, 1) :: hailmax1d,hailmaxk1 real, dimension(kts:kte, nproc) :: thproclocal integer, parameter :: nor = 0, ng = 0 integer :: nx,ny,nz,ngs @@ -2374,15 +2503,6 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw integer :: loopcnt, loopmax, outerloopcnt logical :: lastlooptmp -#ifdef MPI - -#if defined(MPI) - integer, parameter :: ntot = 50 - double precision mpitotindp(ntot), mpitotoutdp(ntot) - INTEGER :: mpi_error_code = 1 -#endif -#endif - ! ------------------------------------------------------------------- @@ -2397,11 +2517,35 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw flag_qnifa = .false. flag_qnwfa = .false. flag_cnuf = .false. + flag_ccn = .false. + nwp_diagflag = .false. IF ( PRESENT ( nssl_progn ) ) flag_qndrop = nssl_progn IF ( present ( f_cnuf ) ) flag_cnuf = f_cnuf + IF ( present ( nwp_diagnostics ) ) nwp_diagflag = ( nwp_diagnostics > 0 ) + + IF ( present ( f_cn ) .and. present( cn ) ) THEN + flag_ccn = f_cn + ELSEIF ( present( cn ) ) THEN + flag_ccn = .true. + ENDIF + + IF ( present( f_qi ) ) THEN + flag_qi = f_qi + ELSE + IF ( ffrzs < 1.0 ) THEN + flag_qi = .true. + ELSE + flag_qi = .false. + ENDIF + ENDIF + + IF ( .not. flag_qi .and. ffrzs < 1.0 ) ffrzs = 1.0 + IF ( PRESENT ( has_reqg ) ) has_reqg_local = has_reqg > 0 + IF ( PRESENT ( has_reqh ) ) has_reqh_local = has_reqh > 0 + loopmax = 1 outerloopcnt = 1 lastlooptmp = .true. @@ -2411,7 +2555,13 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw lastlooptmp = lastloop ENDIF - ! --- + + has_wetscav = .false. + IF ( wrfchem_flag > 0 ) THEN + IF ( PRESENT( wetscav_on ) ) THEN + has_wetscav = wetscav_on + ENDIF + ENDIF IF ( present( f_cna ) ) THEN f_cnatmp = f_cna @@ -2462,8 +2612,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw nx = ite-its+1 ny = 1 ! set up as 2D slabs nz = kte-kts+1 + ngs = Max(nz,64) - IF ( .not. present( cn ) ) THEN + IF ( .not. flag_ccn ) THEN renucfrac = 1.0 ENDIF @@ -2527,30 +2678,32 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw DO jy = jts,jye - xfall(:,:,:) = 0.0 - ! write(0,*) 'N2M: load an, jy,lccn = ',jy,lccn,qccn IF ( present( pcc2 ) .and. makediag ) THEN axtra2d(its:ite,1,kts:kte,:) = 0.0 ENDIF + IF ( nwp_diagflag ) THEN + alpha2d(its:ite,1,kts:kte,1) = alphar + alpha2d(its:ite,1,kts:kte,2) = alphah + alpha2d(its:ite,1,kts:kte,3) = alphahl + ENDIF + + ! copy from 3D array to 2D slab DO kz = kts,kte DO ix = its,ite - IF ( present( tt ) ) THEN an(ix,1,kz,lt) = tt(ix,kz,jy)/pii(ix,kz,jy) ELSE an(ix,1,kz,lt) = th(ix,kz,jy) ENDIF - - an(ix,1,kz,lv) = qv(ix,kz,jy) an(ix,1,kz,lc) = qc(ix,kz,jy) an(ix,1,kz,lr) = qr(ix,kz,jy) - IF ( present( qi ) ) THEN + IF ( flag_qi ) THEN an(ix,1,kz,li) = qi(ix,kz,jy) ELSE an(ix,1,kz,li) = 0.0 @@ -2561,7 +2714,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lccn > 1 ) THEN IF ( is_aerosol_aware .and. flag_qnwfa ) THEN ! - ELSEIF ( present( cn ) ) THEN + ELSEIF ( flag_ccn ) THEN IF ( lccna > 1 .and. .not. ( present( cna ) .and. f_cnatmp ) ) THEN an(ix,1,kz,lccna) = cn(ix,kz,jy) an(ix,1,kz,lccn) = qccn ! cn(ix,kz,jy) @@ -2690,6 +2843,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! ssival = Min(t8s,max(an(ix,1,kz,lv),0.0))/t9s ! qv/qvi + if ( ssival .gt. 1.0 ) then ! IF ( icenucopt == 1 ) THEN @@ -2750,7 +2904,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! naer needs units of cm**-3, so mult by 1.e-6 ! dp1 = 1.e3*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * (1.e-6*cin*dn(ix,1,kz))**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) - dp1 = 1.e3*dn1(ix,1,kz)/rho00*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * (1.e-6*naer)**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) + tmp = 1.e-6*naer + dp1 = 1.e3*dn1(ix,1,kz)/rho00*0.0000594*(273.16 - t0(ix,1,kz))**3.33 * tmp**(0.0264*(273.16 - t0(ix,1,kz)) + 0.0033) t7(ix,1,kz) = Min(dp1, 1.0d30) ELSE @@ -2767,16 +2922,12 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ! ix ENDDO ! kz - has_wetscav = .false. - IF ( wrfchem_flag > 0 ) THEN - IF ( PRESENT( wetscav_on ) ) THEN - has_wetscav = wetscav_on - IF ( has_wetscav ) THEN - IF ( PRESENT( rainprod ) ) rainprod2d(its:ite,kts:kte) = 0 - IF ( PRESENT( evapprod ) ) evapprod2d(its:ite,kts:kte) = 0 - ENDIF - ENDIF - ENDIF + IF ( wrfchem_flag > 0 ) THEN + IF ( has_wetscav ) THEN + IF ( PRESENT( rainprod ) ) rainprod2d(its:ite,kts:kte) = 0 + IF ( PRESENT( evapprod ) ) evapprod2d(its:ite,kts:kte) = 0 + ENDIF + ENDIF ! transform from number mixing ratios to number conc. @@ -2917,9 +3068,6 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! ENDIF ! .false. - - ngs = 128 - IF ( isedonly /= 1 ) THEN ! call nssl_2mom_gs: main gather-scatter routine to calculate microphysics @@ -2940,11 +3088,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! & ln,ipc,lvol,lz,lliq, & & cdx, & & xdn0,dbz2d,tke2d, & - & thproclocal,nproc,dx1,dy1, & + & thproclocal,nproc,dx1,dy1,ngs, & & timevtcalc,axtra2d, makediag & - & ,has_wetscav, rainprod2d, evapprod2d & + & ,has_wetscav, rainprod2d, evapprod2d, alpha2d & & ,errmsg,errflg & - & ,elec2,its,ids,ide,jds,jde,ngs & + & ,elec2,its,ids,ide,jds,jde & & ) @@ -2967,9 +3115,10 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & ,dz2d & & ,t0,t9 & & ,an,dn1,t77 & - & ,pn,wn & + & ,pn,wn & + & ,ngs & & ,axtra2d, makediag & - & ,ssat,t00,t77,flag_qndrop,ngs) + & ,ssat,t00,t77,flag_qndrop) ! recalculate dn1 after temperature changes DO kz = kts,kte @@ -2985,14 +3134,12 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ! loopcnt=1,loopmax - IF ( present( pcc2 ) .and. makediag ) THEN DO kz = kts,kte DO ix = its,ite ! example of using the 'axtra2d' array to get rates out of the microphysics routine for output. ! Search for 'axtra' to find example code below ! pcc2(ix,kz,jy) = axtra2d(ix,1,kz,1) - ENDDO ENDDO ENDIF @@ -3056,7 +3203,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw call calc_eff_radius & & (nx,ny,nz,na,jy & & ,nor,nor & - & ,t1=t1,t2=t2,t3=t3,t4=t4 & + & ,t1=t1,t2=t2,t3=t3,t4=t4,t5=t5,t6=t6,f_t5=has_reqg_local, f_t6=has_reqh_local & & ,an=an,dn=dn1 ) DO kz = kts,kte @@ -3078,12 +3225,46 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDIF ENDIF + + IF ( present(has_reqg) .and. present( re_graup ) ) THEN + IF ( has_reqg /= 0 ) THEN + DO kz = kts,kte + DO ix = its,ite + re_graup(ix,kz,jy) = MAX(50.E-6, MIN(t5(ix,1,kz), 10.E-3)) + ENDDO + ENDDO + ENDIF + ENDIF + + IF ( present(has_reqh) .and. present( re_hail ) ) THEN + IF ( has_reqh /= 0 ) THEN + DO kz = kts,kte + DO ix = its,ite + re_hail(ix,kz,jy) = MAX(50.E-6, MIN(t5(ix,1,kz), 40.E-3)) + ENDDO + ENDDO + ENDIF + ENDIF ENDIF ENDIF + IF ( present( hail_maxk1 ) .and. present( hail_max2d ) .and. nwp_diagflag ) THEN + DO ix = its,ite + hailmax1d(ix,1) = hail_max2d(ix,jy) + hailmaxk1(ix,1) = hail_maxk1(ix,jy) + ENDDO + call hailmaxd(dtp,nx,ny,nz,an,na,nor,nor,alpha2d,dn1, & + hailmax1d,hailmaxk1,1 ) + + DO ix = its,ite + hail_max2d(ix,jy) = hailmax1d(ix,1) + hail_maxk1(ix,jy) = hailmaxk1(ix,1) + ENDDO +! ENDIF + ENDIF ! transform concentrations back to mixing ratios DO il = lnb,na @@ -3111,14 +3292,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw qv(ix,kz,jy) = an(ix,1,kz,lv) qc(ix,kz,jy) = an(ix,1,kz,lc) qr(ix,kz,jy) = an(ix,1,kz,lr) - IF ( present(qi) ) qi(ix,kz,jy) = an(ix,1,kz,li) + IF ( flag_qi ) qi(ix,kz,jy) = an(ix,1,kz,li) qs(ix,kz,jy) = an(ix,1,kz,ls) qh(ix,kz,jy) = an(ix,1,kz,lh) IF ( lhl > 1 ) qhl(ix,kz,jy) = an(ix,1,kz,lhl) IF ( lccn > 1 .and. is_aerosol_aware .and. flag_qnwfa ) THEN ! not used here - ELSEIF ( present( cn ) .and. lccn > 1 .and. .not. flag_qndrop) THEN + ELSEIF ( flag_ccn .and. lccn > 1 .and. .not. flag_qndrop) THEN IF ( lccna > 1 .and. .not. ( present( cna ) .and. f_cnatmp ) ) THEN cn(ix,kz,jy) = Max(0.0, an(ix,1,kz,lccna) ) ELSE @@ -3185,7 +3366,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDDO - + + ENDDO ! jy @@ -3824,8 +4006,242 @@ Function delabk(ba,bb,nua,nub,mua,mub,k) RETURN END Function delabk + + + +! ####################################################################### +! HAILMAXD - calculated maximum expected hail size +! ####################################################################### +!>\ingroup mod_nsslmp +!! Hail max size subroutine. + subroutine hailmaxd(dtp,nx,ny,nz,an,na,nor,norz,alpha2d,dn, & + & hailmax1d,hailmaxk1,jslab ) +! +! Calculate maximum hail size from the tail of of the distribution. The value +! of thresh_conc sets the minimum concentration in the integral over (Dmax, Inf). +! This uses the lookup tables for incomplete gamma functions and simply search for +! the expected value (and linearly interpolate) on D. +! +! Written by ERM 7/2023 +! +! +! + implicit none + + integer nx,ny,nz,nor,norz,ngt,jgs,na,ia + integer id ! =1 use density, =0 no density +! integer :: its,ite ! x-range to calculate + integer ng1 + parameter(ng1 = 1) + + real an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) + real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + +! real gz(-nor+ng1:nz+nor),z1d(-nor+ng1:nz+nor,4) + real dtp + real alpha2d(-nor+1:nx+nor,1,-norz+1:nz+norz,3) ! array for PSD shape parameters + real :: hailmax1d(nx,ny),hailmaxk1(nx,ny) + integer infdo + integer jslab ! which line of xfall to use + + integer ix,jy,kz,ndfall,n,k,il,in + double precision :: tmp, ratio, del, g1palp + real, parameter :: dz = 200. + + real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) + + real :: rhovtzx(nz,nx) + + real :: alp, diam, diam1, hwdn + +! real, parameter :: cmin = 0.001 ! threshold number per m^3 for maximum diamter (threshold from diag_nwp) + DOUBLE PRECISION, PARAMETER:: thresh_conc = 0.0005d0 ! number conc. of graupel/hail per cubic meter + real :: cwchtmp,cwchltmp, maxdia + +!----------------------------------------------------------------------------- + + integer :: ixb, jyb, kzb + integer :: ixe, jye, kze + integer :: plo, phi + integer :: ialp, i, j + + logical :: debug_mpi = .TRUE. + +! ################################################################### + + + IF ( lh > 1 ) THEN + cwchtmp = ((3. + dnu(lh))*(2. + dnu(lh))*(1.0 + dnu(lh)))**(-1./3.) + ENDIF + IF ( lhl > 1 ) THEN + cwchltmp = ((3. + dnu(lhl))*(2. + dnu(lhl))*(1.0 + dnu(lhl)))**(-1./3.) + ENDIF + + + kzb = 1 + kze = nz + + ixb = 1 ! aliased its + ixe = nx ! aliased ite + + + jy = jslab + jgs = jy + + +! hailmax1d(:,jy) = 0.0 +! hailmaxk1(:,jy) = 0.0 + + if ( ndebug .gt. 0 ) write(0,*) 'dbg = 3a' + + +! first graupel, even if hail is also predicted, since graupel can sometime be large on its own + IF ( lh > 1 .and. lnh > 1 ) THEN + DO kz = kzb,kze + DO ix = ixb,ixe + IF ( an(ix,jy,kz,lh) .gt. qxmin(lh) .and. an(ix,jy,kz,lnh) .gt. thresh_conc ) THEN + IF ( lvh .gt. 1 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh) + ELSE + hwdn = rho_qh + ENDIF + tmp = 1. + alpha2d(ix,1,kz,2) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = dn(ix,jy,kz)*an(ix,jy,kz,lh)/(hwdn*an(ix,jy,kz,lnh)) + diam = (6.0*tmp/(3.14159))**(1./3.) + IF ( lzh > 1 ) THEN ! 3moment + cwchtmp = ((3. + alpha2d(ix,1,kz,2))*(2. + alpha2d(ix,1,kz,2))*(1.0 + alpha2d(ix,1,kz,2)))**(-1./3.) + ENDIF + diam1 = diam*cwchtmp ! characteristic diameter, i.e., 1/lambda + ! want cxd1 = thresh_conc + ! tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + ! cxd1 = cx(mgs,lh)*(tmp)/g1palp + ! tmp = thresh_conc*g1palp/cx + ! + tmp = thresh_conc*g1palp/an(ix,jy,kz,lnh) + alp = alpha2d(ix,1,kz,2) + ! gamxinflu(i,j,luindex,ilh) + j = Int(Max(0.0,Min(maxalphalu,alp))*dqiacralphainv) + ratio = 0.0 + maxdia = 0.0 + ! eventually could replace with bisection search, but final value of i is usually small + ! compared to nqiacrratio + DO i = 0,nqiacrratio-1 + IF ( gamxinflu(i,j,1,1) >= tmp .and. tmp >= gamxinflu(i+1,j,1,1) ) THEN + ! interpolate here for FWIW + ratio = i*dqiacrratio + del = tmp - gamxinflu(i,j,1,1) + ratio = (float(i) + del/(gamxinflu(i+1,j,1,1) - gamxinflu(i,j,1,1)))*dqiacrratio + exit + ENDIF + ENDDO + + IF ( ratio > 0.0 ) THEN + maxdia = ratio*diam1 ! units of m + ENDIF + + IF ( kz == kzb ) THEN + hailmaxk1(ix,jy) = Max( maxdia, hailmaxk1(ix,jy) ) +! IF ( maxdia > 0.1 ) THEN +! IF ( an(ix,jy,kz,lh) > 1.e-4 ) THEN +! write(0,*) 'maxdia,tmp,alp,ratio,diam,diam1= ',maxdia,tmp,alp,ratio,diam*100.,diam1*100. +! write(0,*) 'hwdn, cxhl, qx, g1palp = ',hwdn, an(ix,jy,kz,lnhl), an(ix,jy,kz,lhl), g1palp +! write(0,*) 'j,gamxinflu(0,2,4) = ',j,gamxinflu(0,j,1,1),gamxinflu(2,j,1,1), & +! gamxinflu(4,j,1,1) +! ENDIF + ENDIF + + hailmax1d(ix,jy) = Max(maxdia, hailmax1d(ix,jy) ) + + ! + + ENDIF + + ENDDO + ENDDO + + ENDIF ! lh + +! And diam for hail if present + IF ( lhl > 1 .and. lnhl > 1 ) THEN + DO kz = kzb,kze + DO ix = ixb,ixe + IF ( an(ix,jy,kz,lhl) .gt. qxmin(lhl) .and. an(ix,jy,kz,lnhl) .gt. thresh_conc ) THEN + IF ( lvhl .gt. 1 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl) + ELSE + hwdn = rho_qhl + ENDIF + + tmp = 1. + alpha2d(ix,1,kz,3) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/(hwdn*an(ix,jy,kz,lnhl)) + diam = (6.0*tmp/(3.14159))**(1./3.) + IF ( lzhl > 1 ) THEN ! 3moment + cwchltmp = ((3. + alpha2d(ix,1,kz,3))*(2. + alpha2d(ix,1,kz,3))*(1.0 + alpha2d(ix,1,kz,3)))**(-1./3.) + ENDIF + diam1 = diam*cwchltmp ! characteristic diameter, i.e., 1/lambda + ! want cxd1 = thresh_conc + ! tmp = gaminterp(ratio,alpha(mgs,lh),1,1) + ! cxd1 = cx(mgs,lh)*(tmp)/g1palp + ! tmp = thresh_conc*g1palp/cx + ! + tmp = thresh_conc*g1palp/an(ix,jy,kz,lnhl) + alp = alpha2d(ix,1,kz,3) + ! gamxinflu(i,j,luindex,ilh) + j = Int(Max(0.0,Min(maxalphalu,alp))*dqiacralphainv) + ratio = 0.0 + maxdia = 0.0 + ! eventually could replace with bisection search, but final value of i is usually small + ! compared to nqiacrratio + DO i = 0,nqiacrratio-1 + IF ( gamxinflu(i,j,1,1) >= tmp .and. tmp >= gamxinflu(i+1,j,1,1) ) THEN + ! interpolate here for FWIW + ratio = i*dqiacrratio + del = tmp - gamxinflu(i,j,1,1) + ratio = (float(i) + del/(gamxinflu(i+1,j,1,1) - gamxinflu(i,j,1,1)))*dqiacrratio + exit + ENDIF + ENDDO + + IF ( ratio > 0.0 ) THEN + maxdia = ratio*diam1 ! units of m + ENDIF + + IF ( kz == kzb ) THEN + hailmaxk1(ix,jy) = Max( maxdia, hailmaxk1(ix,jy) ) +! IF ( maxdia > 0.1 ) THEN +! IF ( an(ix,jy,kz,lhl) > 1.e-4 ) THEN +! write(0,*) 'maxdia,tmp,alp,ratio,diam,diam1= ',maxdia,tmp,alp,ratio,diam*100.,diam1*100. +! write(0,*) 'hwdn, cxhl, qx, g1palp = ',hwdn, an(ix,jy,kz,lnhl), an(ix,jy,kz,lhl), g1palp +! write(0,*) 'j,gamxinflu(0,2,4) = ',j,gamxinflu(0,j,1,1),gamxinflu(2,j,1,1), & +! gamxinflu(4,j,1,1) +! ENDIF + ENDIF + + hailmax1d(ix,jy) = Max(maxdia, hailmax1d(ix,jy) ) + + ! + + ENDIF + + ENDDO + ENDDO + + ENDIF + + + END SUBROUTINE HAILMAXD +! ####################################################################### +! ####################################################################### !>\ingroup mod_nsslmp !! Sedimentation driver subroutine. Calls fallout column by column subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & @@ -4872,9 +5288,6 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & an(ix,jy,kz,lnr) = nrx ! *dninv ! convert to number mixing ratio - IF ( lzr > 1 ) THEN ! set reflectivity moment - an(ix,jy,kz,lzr) = 36.*g1r*dn(ix,kz)**2*q**2/(pi**2*xdnr**2*nrx) ! *dninv - ENDIF ELSEIF ( an(ix,jy,kz,lr) <= qxmin(lr) .or. & ( an(ix,jy,kz,lnr) <= cxmin .and. an(ix,jy,kz,lr) <= qxmin_init(lr)) ) THEN an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lr) @@ -4883,6 +5296,15 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & ENDIF ENDIF + IF ( lzr > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lr) > qxmin_init(lr) .and. an(ix,jy,kz,lzr) < zxmin .and. & + an(ix,jy,kz,lnr) > cxmin ) THEN + q = an(ix,jy,kz,lr) + nrx = an(ix,jy,kz,lnr) + an(ix,jy,kz,lzr) = 36.*g1r*dn(ix,kz)**2*q**2/(pi**2*xdnr**2*nrx) ! *dninv + ENDIF + ENDIF + ! snow IF ( lns > 1 ) THEN IF ( an(ix,jy,kz,lns) <= 0.1*cxmin .and. an(ix,jy,kz,ls) > qxmin_init(ls) ) THEN @@ -4936,9 +5358,6 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & an(ix,jy,kz,lvh) = 0.0 ENDIF - IF ( lzh > 1 ) THEN ! set reflectivity moment - an(ix,jy,kz,lzh) = 36.*g1h*dn(ix,kz)**2*q**2/(pi**2*xdnh**2*nrx) ! *dninv - ENDIF ELSEIF ( an(ix,jy,kz,lh) <= qxmin(lh) .or. & ( an(ix,jy,kz,lnh) <= cxmin .and. an(ix,jy,kz,lh) <= qxmin_init(lh)) ) THEN @@ -4948,6 +5367,15 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & ENDIF ENDIF + IF ( lzh > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lh) > qxmin_init(lh) .and. an(ix,jy,kz,lzh) < zxmin .and. & + an(ix,jy,kz,lnh) > cxmin ) THEN + q = an(ix,jy,kz,lh) + nrx = an(ix,jy,kz,lnh) + an(ix,jy,kz,lzh) = 36.*g1h*dn(ix,kz)**2*q**2/(pi**2*xdnh**2*nrx) ! *dninv + ENDIF + ENDIF + ! hail IF ( lnhl > 1 .and. lhl > 1 ) THEN @@ -4968,10 +5396,6 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & an(ix,jy,kz,lnhl) = nrx ! *dninv ! convert to number mixing ratio - IF ( lzhl > 1 ) THEN ! set reflectivity moment - an(ix,jy,kz,lzhl) = 36.*g1hl*dn(ix,kz)**2*q**2/(pi**2*xdnhl**2*nrx) ! *dninv - ENDIF - ELSEIF ( an(ix,jy,kz,lhl) <= qxmin(lhl) .or. & ( an(ix,jy,kz,lnhl) <= cxmin .and. an(ix,jy,kz,lhl) <= qxmin_init(lhl)) ) THEN @@ -4980,6 +5404,15 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & ENDIF ENDIF + + IF ( lzhl > 1 ) THEN ! set reflectivity moment + IF ( an(ix,jy,kz,lhl) > qxmin_init(lhl) .and. an(ix,jy,kz,lzhl) < zxmin .and. & + an(ix,jy,kz,lnhl) > cxmin ) THEN + q = an(ix,jy,kz,lhl) + nrx = an(ix,jy,kz,lnhl) + an(ix,jy,kz,lzhl) = 36.*g1hl*dn(ix,kz)**2*q**2/(pi**2*xdnhl**2*nrx) ! *dninv + ENDIF + ENDIF ! ENDIF @@ -5250,7 +5683,7 @@ END subroutine calcnfromcuten SUBROUTINE calc_eff_radius & & (nx,ny,nz,na,jyslab & & ,nor,norz & - & ,t1,t2,t3,t4 & + & ,t1,t2,t3,t4,t5,t6, f_t5,f_t6 & & ,qcw,qci,qsw,qrw & & ,ccw,cci,csw,crw & & ,an,dn ) @@ -5272,6 +5705,9 @@ SUBROUTINE calc_eff_radius & real,optional :: t2(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) real,optional :: t3(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) real,optional :: t4(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t5(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real,optional :: t6(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + logical, optional :: f_t5, f_t6 ! flags to fill t5/t6 for graupel/hail real, optional :: an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) @@ -7495,7 +7931,7 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*1000.*1000) an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN ! have mass and concentration but no reflectivity, so set reflectivity, using default alpha g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) chw = cx(mgs,il) @@ -7511,7 +7947,7 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN ! How did this happen? ! set values according to dBZ of -10, or Z = 0.1 ! write(91,*) 'alpha = ',alpha(mgs,il) @@ -7710,7 +8146,7 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & ! zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/chw zx(mgs,il) = Min(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN ! How did this happen? ! write(91,*) 'ziegfall: something screwy with moments: il = ',il ! write(91,*) 'q,n,z = ', 1.e3*qx(mgs,il),cx(mgs,il),zx(mgs,il) @@ -7737,7 +8173,7 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & ENDIF ENDIF - IF ( qx(mgs,il) .gt. qxmin(il) .and. cx(mgs,il) .gt. 0.0 ) THEN + IF ( qx(mgs,il) .gt. qxmin(il) .and. cx(mgs,il) .gt. cxmin ) THEN chw = cx(mgs,il) qr = qx(mgs,il) z = zx(mgs,il) @@ -9003,8 +9439,9 @@ SUBROUTINE NUCOND & & ,t0,t9 & & ,an,dn,p2 & & ,pn,w & + & ,ngs & & ,axtra,io_flag & - & ,ssfilt,t00,t77,flag_qndrop,ngs & + & ,ssfilt,t00,t77,flag_qndrop & & ) @@ -9061,6 +9498,7 @@ SUBROUTINE NUCOND & logical :: io_flag real :: dv + real :: ccnefactwo, sstmp, cn1, cnuctmp ! ! declarations microphysics and for gather/scatter @@ -9069,7 +9507,6 @@ SUBROUTINE NUCOND & real, parameter :: cwmas20 = 1000.*0.523599*(2.*20.e-6)**3 ! mass of 20-micron radius droplet, for sat. adj. integer nxmpb,nzmpb,nxz integer mgs,ngs,numgs,inumgs -! parameter (ngs=1 ) integer ngscnt,igs(ngs),kgs(ngs) integer kgsp(ngs),kgsm(ngs) integer nsvcnt @@ -9088,6 +9525,7 @@ SUBROUTINE NUCOND & real ccnc(ngs), ccna(ngs), cnuc(ngs), cwnccn(ngs) + real :: ccnc_nu(ngs), ccnc_ac(ngs), ccnc_co(ngs) real ccncuf(ngs) real sscb ! 'cloud base' SS threshold parameter ( sscb = 2.0 ) @@ -9100,7 +9538,7 @@ SUBROUTINE NUCOND & integer ifilt ! =1 to filter ssat, =0 to set ssfilt=ssat parameter ( ifilt = 0 ) real temp1,temp2 ! ,ssold - real :: ssmax(ngs) ! maximum SS experienced by a parcel + real :: ssmax(ngs) ! maximum SS experienced by a parcel real ssmx real dnnet,dqnet ! real cnu,rnu,snu,cinu @@ -9224,7 +9662,6 @@ SUBROUTINE NUCOND & integer :: count - ! ------------------------------------------------------------------------------- itile = nxi jtile = ny @@ -9238,6 +9675,7 @@ SUBROUTINE NUCOND & kzbeg = 1 nzbeg = 1 + IF ( ac_opt > 0 ) ccnefactwo = (1.63e-3/(cck * beta(3./2., cck/2.)))**(1.0/(cck + 2.0)) f5 = 237.3 * 17.27 * 2.5e6 / cp ! combined constants for rain condensation (Soong and Ogura 73) jy = 1 @@ -9463,12 +9901,16 @@ SUBROUTINE NUCOND & ELSE ssmax(mgs) = 0.0 ENDIF - IF ( lccn .gt. 1 ) THEN - ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + IF ( lccn .gt. 1 .and. ac_opt == 0 ) THEN + IF ( lccnuf .gt. 1 .and. i_uf_or_ccn > 0 ) THEN + ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + an(igs(mgs),jy,kgs(mgs),lccnuf) + ELSE + ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + ENDIF ELSE ccnc(mgs) = cwnccn(mgs) ENDIF - IF ( lccnuf .gt. 1 ) THEN + IF ( lccnuf .gt. 1 .and. i_uf_or_ccn == 0 ) THEN ccncuf(mgs) = an(igs(mgs),jy,kgs(mgs),lccnuf) ELSE ccncuf(mgs) = 0.0 @@ -9534,7 +9976,7 @@ SUBROUTINE NUCOND & il = lr DO mgs = 1,ngscnt - IF ( zx(mgs,il) <= 0.0 ) THEN + IF ( zx(mgs,il) <= zxmin ) THEN qx(mgs,lv) = qx(mgs,lv) + qx(mgs,il) qx(mgs,il) = 0.0 cx(mgs,il) = 0.0 @@ -9577,7 +10019,7 @@ SUBROUTINE NUCOND & ENDIF ! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN ! have mass and concentration but no reflectivity, so set reflectivity, using default alpha IF ( imurain == 3 ) THEN g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) @@ -9593,7 +10035,7 @@ SUBROUTINE NUCOND & ENDIF - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN ! How did this happen? ! set values according to dBZ of -10, or Z = 0.1 ! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 @@ -9773,6 +10215,8 @@ SUBROUTINE NUCOND & ssfkp1(mgs) = ssfilt(igs(mgs),jgs,Min(nz-1,kgs(mgs)+1)) ssfkm1(mgs) = ssfilt(igs(mgs),jgs,Max(1,kgs(mgs)-1)) +! IF ( wvel(mgs) /= 0.0 ) write(0,*) 'mgs,wvel1,ssf = ',mgs,wvel(mgs),ssf(mgs) + ENDDO @@ -9782,7 +10226,7 @@ SUBROUTINE NUCOND & ! cloud water variables ! - if ( ndebug .gt. 0 )write(0,*) 'ICEZVD_DR: Set cloud water variables' + if ( ndebug .gt. 0 ) write(0,*) 'ICEZVD_DR: Set cloud water variables' do mgs = 1,ngscnt xv(mgs,lc) = 0.0 @@ -9914,15 +10358,14 @@ SUBROUTINE NUCOND & ENDIF qx(mgs,lc) = 0. IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN - IF ( .not. invertccn ) THEN - ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) - ELSE - ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) - ENDIF - ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + ELSEIF ( irenuc <= 2 ) THEN + IF ( .not. invertccn ) THEN + ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) + ELSE + ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) + ENDIF ENDIF ENDIF cx(mgs,lc) = 0. @@ -9932,7 +10375,9 @@ SUBROUTINE NUCOND & qx(mgs,lc) = qx(mgs,lc) - QEVAP IF ( qx(mgs,lc) .le. 0. ) THEN IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + ELSEIF ( irenuc <= 2 ) THEN ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) ! ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) IF ( .not. invertccn ) THEN @@ -9941,15 +10386,14 @@ SUBROUTINE NUCOND & ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ENDIF ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) - ENDIF ENDIF cx(mgs,lc) = 0. ELSE tmp = 0.9*QEVAP*cx(mgs,lc)/qctmp ! let droplets get smaller but also remove some. A factor of 1.0 would maintain same size IF ( restoreccn ) THEN - IF ( irenuc <= 2 ) THEN + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) - restoreccnfrac*tmp + ELSEIF ( irenuc <= 2 ) THEN ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + tmp ) ) ! ccnc(mgs) = ccnc(mgs) + tmp IF ( .not. invertccn ) THEN @@ -9958,9 +10402,6 @@ SUBROUTINE NUCOND & ccnc(mgs) = ccnc(mgs) + restoreccnfrac*tmp ENDIF ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - restoreccnfrac*tmp - ENDIF ENDIF cx(mgs,lc) = cx(mgs,lc) - tmp ENDIF @@ -10300,7 +10741,8 @@ SUBROUTINE NUCOND & ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 5.0 .and. ccnc(mgs) > 0.1*cwnccn(mgs) ) THEN ! this one works ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 ) THEN ! test -- fails ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. ccnc(mgs) > 0.1*cwnccn(mgs)) THEN ! test -- is OK - IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. ccnc(mgs) > 0.05*cwnccn(mgs)) THEN ! test + IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. & + ( ccnc(mgs) > 0.05*cwnccn(mgs) .or. ( ac_opt > 0 .and. ccnc_ac(mgs) - cx(mgs,lc) > 0.0 ) ) ) THEN ! test ! IF ( ssf(mgs) > ssmx ) THEN ! original condition CALL QVEXCESS(ngs,mgs,qwvp,qv0,qx(1,lc),pres,thetap,theta0,dcloud, & & pi0,tabqvs,nqsat,fqsat,cbw,fcqv1,felvcp,ssmx,pk,ngscnt) @@ -10311,7 +10753,7 @@ SUBROUTINE NUCOND & ELSE dcloud = 0.0 ENDIF - + thetap(mgs) = thetap(mgs) + felvcp(mgs)*DCLOUD/(pi0(mgs)) qwvp(mgs) = qwvp(mgs) - DCLOUD qx(mgs,lc) = qx(mgs,lc) + DCLOUD @@ -10336,11 +10778,16 @@ SUBROUTINE NUCOND & IF ( .not. flag_qndrop ) THEN ! { do not calculate number of droplets if using wrf-chem + IF ( ac_opt == 0 ) THEN + cnuctmp = cnuc(mgs) + ELSE + cnuctmp = ccnc_ac(mgs) + ENDIF ! IF ( ssmax(mgs) .lt. sscb .and. qx(mgs,lc) .gt. qxmin(lc)) THEN IF ( dcloud .gt. qxmin(lc) .and. wvel(mgs) > 0.0) THEN ! CN(mgs) = CCNE*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 - CN(mgs) = CCNE0*cnuc(mgs)**(2./(2.+cck))*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 + CN(mgs) = CCNE0*cnuctmp**(2./(2.+cck))*wvel(mgs)**cnexp ! *Min(1.0,1./dtp) ! 0.3465 IF ( ny .le. 2 .and. cn(mgs) .gt. 0.0 & & .and. ncdebug .ge. 1 ) THEN write(iunit,*) 'CN: ',cn(mgs)*1.e-6, cx(mgs,lc)*1.e-6, qx(mgs,lc)*1.e3, & @@ -10362,12 +10809,16 @@ SUBROUTINE NUCOND & ENDIF IF ( cn(mgs) .gt. 0.0 ) THEN - IF ( cn(mgs) .gt. ccnc(mgs) ) THEN - cn(mgs) = ccnc(mgs) -! ccnc(mgs) = 0.0 + IF ( ac_opt == 0 ) THEN + IF ( cn(mgs) .gt. ccnc(mgs) ) THEN + cn(mgs) = ccnc(mgs) +! ccnc(mgs) = 0.0 + ENDIF + ELSE + cn(mgs) = Min( cn(mgs), ccnc_ac(mgs) ) ENDIF ! cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - IF ( irenuc <= 2 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + IF ( irenuc <= 2 .and. lccna < 1 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) ccna(mgs) = ccna(mgs) + cn(mgs) ENDIF @@ -10413,7 +10864,8 @@ SUBROUTINE NUCOND & DSSDZ=0. r2dzm=0.50/dz3d(igs(mgs),jy,kgs(mgs)) - IF ( irenuc >= 0 .and. .not. flag_qndrop) THEN ! turn off nucleation when flag_qndrop (using WRF-CHEM for activation) + + IF ( irenuc >= 0 .and. ac_opt == 0 .and. .not. flag_qndrop ) THEN ! turn off nucleation when flag_qndrop (using WRF-CHEM for activation) IF ( irenuc < 2 ) THEN !{ @@ -10490,6 +10942,7 @@ SUBROUTINE NUCOND & ! nucleation CN(mgs) = Min(cn(mgs), ccnc(mgs)) cn(mgs) = Min(cn(mgs), 0.5*dqc/cwmasn) ! limit the nucleation mass to half of the condensation mass + CN(mgs) = Min( CN(mgs), Max(0.0, (cnuc(mgs) - ccna(mgs) )) ) IF ( .false. .and. ny <= 2 ) THEN write(0,*) 'i,k, cwmasn = ',igs(mgs),kgs(mgs),cwmasn @@ -10517,7 +10970,7 @@ SUBROUTINE NUCOND & cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + IF ( lccna < 1 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) ELSEIF ( irenuc == 3 ) THEN !} { ! Phillips Donner Garner 2007 @@ -10704,17 +11157,22 @@ SUBROUTINE NUCOND & ! 6/13/2016: Phillips et al. appears not to decrement CCN, but only increments CCNa. ! This would allow an initially non-homogeneous (vertically, e.g.) initial value of CCN/rho_air ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) - ELSEIF ( irenuc == 7 ) THEN !} { + ELSEIF ( irenuc == 7 .or. irenuc == 17 ) THEN !} { ! simple Twomey scheme but limit activation to try to do most activation near cloud base, but keep some CCN available for renuclation ! if (ndebug .gt. 0) write(0,*) 'ICEZVD_DR: Cloud reNucleation, wvel = ',wvel(mgs) cn(mgs) = 0.0 + IF ( irenuc == 7 ) THEN + frac = 0.9 + ELSE + frac = 0.98 + ENDIF ! IF ( ccna(mgs) < 0.7*cnuc(mgs) .and. ccnc(mgs) > 0.69*cnuc(mgs) - ccna(mgs)) THEN ! here, assume we are near cloud base and use Twomey formulation - IF ( ccna(mgs) < 0.9*cnuc(mgs) ) THEN ! { here, assume we are near cloud base and use Twomey formulation - CN(mgs) = Min( 0.91*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 + IF ( ccna(mgs) < frac*cnuc(mgs) ) THEN ! { here, assume we are near cloud base and use Twomey formulation + CN(mgs) = Min( (frac+0.01)*cnuc(mgs), CCNE0*cnuc(mgs)**(2./(2.+cck))*Max(0.0,wvel(mgs))**cnexp )! *Min(1.0,1./dtp) ! 0.3465 ! IF ( cn(mgs) + ccna(mgs) > 0.71*cnuc ) THEN ! prevent this branch from activating more than 70% of CCN - CN(mgs) = Min( CN(mgs), Max(0.0, (0.9*cnuc(mgs) - ccna(mgs) )) ) + CN(mgs) = Min( CN(mgs), Max(0.0, (frac*cnuc(mgs) - ccna(mgs) )) ) ! CN(mgs) = Min( CN(mgs), Max(0.0, 0.71*ccnc(mgs) - ccna(mgs) ) ) ! write(0,*) '1: k,cn = ',kgs(mgs),cn(mgs),ssf(mgs) !! IF ( ccncuf(mgs) > 0.0 .and. cn(mgs) < 1.e-3 .and. ssmax(mgs) > 1.0 ) THEN @@ -10854,7 +11312,7 @@ SUBROUTINE NUCOND & IF ( cn(mgs) > 0.0 ) THEN cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + ! ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) ! create some small droplets at minimum size (CP 2000), although it adds very little liquid @@ -10873,8 +11331,6 @@ SUBROUTINE NUCOND & ccna(mgs) = ccna(mgs) + cn(mgs) - - ENDIF ! irenuc >= 0 .and. .not. flag_qndrop IF( cx(mgs,lc) .GT. 0. .AND. qx(mgs,lc) .LE. qxmin(lc)) cx(mgs,lc)=0. @@ -10927,7 +11383,11 @@ SUBROUTINE NUCOND & ELSEIF ( imaxsupopt == 4 ) THEN cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmas20,xmas(mgs,lc)) ) ) ENDIF - ccnc(mgs) = Max( 0.0, ccnc(mgs) - cn(mgs) ) + IF ( lccna > 1 ) THEN + ccna(mgs) = ccna(mgs) + cn(mgs) + ELSE + ccnc(mgs) = Max( 0.0, ccnc(mgs) - cn(mgs) ) + ENDIF cx(mgs,lc) = cx(mgs,lc) + cn(mgs) ENDIF @@ -11041,10 +11501,12 @@ SUBROUTINE NUCOND & IF ( ipconc .ge. 2 ) THEN an(igs(mgs),jy,kgs(mgs),lnc) = Max(cx(mgs,lc) , 0.0) IF ( lss > 1 ) an(igs(mgs),jy,kgs(mgs),lss) = Max( 0.0, ssmax(mgs) ) - IF ( lccn .gt. 1 ) THEN - an(igs(mgs),jy,kgs(mgs),lccn) = Max(0.0, ccnc(mgs) ) + IF ( ac_opt == 0 ) THEN + IF ( lccn .gt. 1 .and. lccna .lt. 1 ) THEN + an(igs(mgs),jy,kgs(mgs),lccn) = Max(0.0, ccnc(mgs) ) + ENDIF ENDIF - IF ( lccnuf .gt. 1 ) THEN + IF ( lccnuf .gt. 1 .and. .not. ( lccna .gt. 1 .and. i_uf_or_ccn > 0 ) ) THEN an(igs(mgs),jy,kgs(mgs),lccnuf) = Max(0.0, ccncuf(mgs) ) ENDIF IF ( lccna .gt. 1 ) THEN @@ -11522,20 +11984,25 @@ SUBROUTINE NUCOND & an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lc) an(ix,jy,kz,lc)= 0.0 IF ( ipconc .ge. 2 ) THEN - IF ( lccn .gt. 1 ) THEN - an(ix,jy,kz,lccn) = & - & an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) + IF ( lccn .gt. 1 .or. ac_opt == 1 ) THEN + IF ( irenuc < 5 .and. lccna <= 1 ) THEN + IF ( ac_opt == 0 ) THEN + an(ix,jy,kz,lccn) = an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) + ENDIF + ELSEIF ( lccna > 1 ) THEN + an(ix,jy,kz,lccna) = Max( 0.0, an(ix,jy,kz,lccna) - Max(0.0,an(ix,jy,kz,lnc)) ) + ENDIF ENDIF an(ix,jy,kz,lnc) = 0.0 IF ( lccn > 1 ) an(ix,jy,kz,lccn) = Max( 0.0, an(ix,jy,kz,lccn) ) - IF ( lccna > 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value + IF ( lccna > 0 .and. ac_opt == 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value IF ( restoreccn ) THEN tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) IF ( an(ix,jy,kz,lccna) > 1. .and. tmp < qxmin(li) ) an(ix,jy,kz,lccna) = an(ix,jy,kz,lccna)*Exp(-dtp/ccntimeconst) ENDIF - ELSEIF ( lccn > 1 .and. restoreccn ) THEN + ELSEIF ( lccn > 1 .and. restoreccn .and. ac_opt == 0 ) THEN ! in this case, we are treating the ccn field as ccna tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) ! IF ( ny == 2 .and. ix == nx/2 ) THEN @@ -11599,11 +12066,11 @@ subroutine nssl_2mom_gs & ! & ln,ipc,lvol,lz,lliq, & & cdx, & & xdn0,tmp3d,tkediss & - & ,thproc,numproc,dx1,dy1 & + & ,thproc,numproc,dx1,dy1,ngs & & ,timevtcalc,axtra,io_flag & - & , has_wetscav,rainprod2d, evapprod2d & + & , has_wetscav,rainprod2d, evapprod2d, alpha2d & & ,errmsg,errflg & - & ,elec,its,ids,ide,jds,jde,ngs & + & ,elec,its,ids,ide,jds,jde & & ) @@ -11689,6 +12156,11 @@ subroutine nssl_2mom_gs & real rainprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz) real evapprod2d(-nor+1:nx+nor,-norz+ng1:nz+norz) + + real :: alpha2d(-nor+1:nx+nor,-norz+ng1:nz+norz,3) + + real, parameter :: tfrdry = 243.15 + logical lrescalelow(lc:lhab) real tkediss(-nor+1:nx+nor,-norz+ng1:nz+norz) real axtra(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz,nxtra) @@ -11835,7 +12307,6 @@ subroutine nssl_2mom_gs & ! integer nxmpb,nzmpb,nxz integer jgs,mgs,ngs,numgs -! parameter (ngs=1 ) !500) integer, parameter :: ngsz = 500 integer ntt parameter (ntt=300) @@ -12215,13 +12686,12 @@ subroutine nssl_2mom_gs & real qrcnw(ngs), qwcnr(ngs) real zrcnw(ngs),zracr(ngs),zracw(ngs),zrcev(ngs) - real qracw(ngs) ! qwacr(ngs), real qiacw(ngs) !, qwaci(ngs) real qsacw(ngs) ! ,qwacs(ngs), real qhacw(ngs) ! qwach(ngs), - real :: qhlacw(ngs), qxacwtmp, qxacrtmp ! + real :: qhlacw(ngs), qxacwtmp, qxacrtmp, qxacitmp, qxacstmp ! real vhacw(ngs), vsacw(ngs), vhlacw(ngs), vhlacr(ngs) real qfcev(ngs) @@ -12287,7 +12757,8 @@ subroutine nssl_2mom_gs & real zfmlr(ngs), zfdsv(ngs), zfsbv(ngs), zhlcnf(ngs), zfshr(ngs), zfshrr(ngs) real zhmlrtmp,zhmlr0inf,zhlmlr0inf real zhmlrr(ngs),zhlmlrr(ngs),zhshrr(ngs),zhlshrr(ngs),zfmlrr(ngs) - real zsmlr(ngs), zsmlrr(ngs), zsshr(ngs), zsshrr(ngs) +! real zsmlr(ngs) + real zsmlrr(ngs), zsshr(ngs), zsshrr(ngs) real zhcns(ngs), zhcni(ngs) real zhwdn(ngs), zfwdn(ngs) ! change in Z due to density changes real zhldn(ngs) ! change in Z due to density changes @@ -12664,6 +13135,7 @@ subroutine nssl_2mom_gs & real :: term1,term2,term3,term4 real :: qaacw ! combined qsacw-qhacw for WSM6 variation + real :: cwchtmp real, parameter :: c1r=19.0, c2r=0.6, c3r=1.8, c4r=17.0 ! rain real, parameter :: c1h=5.5, c2h=0.7, c3h=4.5, c4h=8.5 ! Graupel @@ -12993,7 +13465,6 @@ subroutine nssl_2mom_gs & do ix = nxmpb,itile pqs(1) = t00(ix,jy,kz) -! pqs(kz) = t00(ix,jy,kz) theta(1) = an(ix,jy,kz,lt) temg(1) = t0(ix,jy,kz) @@ -13011,22 +13482,8 @@ subroutine nssl_2mom_gs & qss(1) = qvs(1) -! IF ( jy .eq. 1 .and. ix .eq. 24 ) THEN -! write(91,*) 'kz,qv,th: ',kz,an(ix,jy,kz,lv),an(ix,jy,kz,lt),pqs(kz),tabqvs(ltemq),qvs(kz) -! ENDIF - if ( temg(1) .lt. tfr ) then -! if( qcw(kz) .le. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = qis(kz) -! if( qcw(kz) .gt. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = (qcw(kz)*qvs(kz) + qci(kz)*qis(kz)) / -! > (qcw(kz) + qci(kz)) - qss(1) = qis(1) - else -! IF ( an(ix,jy,kz,lv) .gt. qss(kz) ) THEN -! write(iunit,*) 'qss exceeded at ',ix,jy,kz,qss(kz),an(ix,jy,kz,lv),temg(kz) -! write(iunit,*) 'other temg = ',theta(kz)*(pinit(kz)+p2(ix,jy,kz)) -! ENDIF + qss(1) = qis(1) end if ! ishail = .false. @@ -13316,7 +13773,6 @@ subroutine nssl_2mom_gs & - ! ! 6th moments ! @@ -13622,20 +14078,54 @@ subroutine nssl_2mom_gs & end do - IF ( ipconc == 5 .and. imydiagalpha > 1 ) THEN + IF ( ipconc == 5 .and. imydiagalpha == 2 ) THEN + cwchtmp = ((3. + dnu(lh))*(2. + dnu(lh))*(1.0 + dnu(lh)))**(-1./3.) + DO mgs = 1,ngscnt !IF ( igs(mgs) == 19 ) write(0,*) 'k,qr,qh,cr,ch = ',kgs(mgs),qx(mgs,lr),cx(mgs,lr),qx(mgs,lh),cx(mgs,lh) IF ( qx(mgs,lr) .gt. qxmin(lr) .and. cx(mgs,lr) > cxmin ) THEN xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(xdn(mgs,lr)*cx(mgs,lr)) ! xdia(mgs,lr,3) = (xv(mgs,lr)*6.0*cwc1)**(1./3.) - alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) + ! alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alpr,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lr),xdia(mgs,lr,3)*1000. + + ! M&M-C 2010: + tmp = 4. + alphar + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 1. + alphar + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = (x/y)**(1./3.)*xdia(mgs,lr,3)*cwchtmp + + alpha(mgs,lr) = Min(15., 11.8*(1000.*tmp - 0.7)**2 + 2.) ENDIF IF ( qx(mgs,lh) .gt. qxmin(lh) .and. cx(mgs,lh) > cxmin ) THEN +! MY 2005: xv(mgs,lh) = rho0(mgs)*qx(mgs,lh)/(xdn(mgs,lh)*cx(mgs,lh)) ! xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.) ! mwfac*xdia(mgs,lh,1) ! (xv(mgs,lh)*cwc0*6.0)**(1./3.) - alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) +! alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) + + ! M&M-C 2010: + tmp = 4. + dnu(lh) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = 1. + dnu(lh) + i = Int(dgami*(tmp)) + del = tmp - dgam*i + y = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami + + tmp = (x/y)**(1./3.)*xdia(mgs,lh,3)*cwchtmp + + alpha(mgs,lh) = Min(15., 11.8*(1000.*tmp - 0.7)**2 + 2.) + ! alphan(mgs,lh) = alpha(mgs,lh) ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alph,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lh),xdia(mgs,lh,3)*1000. il = lh @@ -13731,6 +14221,8 @@ subroutine nssl_2mom_gs & ! CALL cld_cpu('Z-MOMENT-1') + IF ( ipconc >= 6 ) THEN + ! set base g1x in case rain is not 3-moment IF ( ipconc >= 6 .and. imurain == 3 ) THEN il = lr @@ -13825,7 +14317,7 @@ subroutine nssl_2mom_gs & qr = qx(mgs,il) cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2) ! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN ! have mass and concentration but no reflectivity, so set reflectivity, using default alpha g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) chw = cx(mgs,il) @@ -13833,7 +14325,7 @@ subroutine nssl_2mom_gs & zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN ! How did this happen? ! set values according to dBZ of -10, or Z = 0.1 ! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 @@ -13850,7 +14342,6 @@ subroutine nssl_2mom_gs & IF ( zx(mgs,lr) > 0.0 ) THEN xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) vr = xv(mgs,lr) -! z = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) qr = qx(mgs,lr) nrx = cx(mgs,lr) z = zx(mgs,lr) @@ -13862,7 +14353,6 @@ subroutine nssl_2mom_gs & IF ( z .gt. 0.0 ) THEN ! alpha(mgs,lr) = 3. alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. -! print*,'kz, alp, alpha(kz) = ',kz,alp,alpha(kz),rd,z,xv DO i = 1,20 IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) @@ -13991,6 +14481,7 @@ subroutine nssl_2mom_gs & ! CALL cld_cpu('Z-MOMENT-1r') ENDIF ! } + ENDIF ! ipconc >= 6 ! Find shape parameters for graupel and hail IF ( ipconc .ge. 6 ) THEN @@ -14073,7 +14564,7 @@ subroutine nssl_2mom_gs & ! cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/z cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > cxmin ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > cxmin ) THEN ! have mass and concentration but no reflectivity, so set reflectivity, using default alpha ! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & ! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) @@ -14086,7 +14577,7 @@ subroutine nssl_2mom_gs & zx(mgs,il) = Max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN ! How did this happen? ! set values according to dBZ of -10, or Z = 0.1 ! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 @@ -14740,7 +15231,6 @@ subroutine nssl_2mom_gs & ! eiw(mgs) = 0.0 eii(mgs) = 0.0 - ehsclsn(mgs) = 0.0 ehiclsn(mgs) = 0.0 ehlsclsn(mgs) = 0.0 @@ -14975,7 +15465,7 @@ subroutine nssl_2mom_gs & fac = fac*(ssi(mgs) - 1.0)/0.02 ehsfac(mgs) = (ssi(mgs) - 1.0)/0.02 ENDIF - ELSEIF ( iessopt == 4 ) THEN ! factor based on ice supersat + ELSEIF ( iessopt == 4 ) THEN ! factor based on ice supersat; very roughly based on Hosler et al. 1957 (J. Met.) IF ( ssi(mgs) <= 1.0 ) THEN fac = 0.1 ehsfac(mgs) = 0.1 @@ -15339,6 +15829,7 @@ subroutine nssl_2mom_gs & do mgs = 1,ngscnt qraci(mgs) = 0.0 craci(mgs) = 0.0 + qracs(mgs) = 0.0 IF ( eri(mgs) .gt. 0.0 .and. iacr .ge. 1 .and. xdia(mgs,lr,3) .gt. 2.*rwradmn ) THEN IF ( ipconc .ge. 3 ) THEN @@ -15386,7 +15877,7 @@ subroutine nssl_2mom_gs & ! IF ( ipconc < 3 ) THEN do mgs = 1,ngscnt - qracs(mgs) = 0.0 + qracs(mgs) = 0.0 IF ( ers(mgs) .gt. 0.0 .and. ipconc < 3 ) THEN IF ( lwsm6 .and. ipconc == 0 ) THEN vt = vt2ave(mgs) @@ -16666,7 +17157,7 @@ subroutine nssl_2mom_gs & ! Ziegler (1985) autoconversion ! ! - IF ( ipconc .ge. 2 .and. ircnw /= -1) THEN ! DTD: added flag for autoconversion. If -1, turns off autoconversion + IF ( ipconc .ge. 2 ) THEN if (ndebug .gt. 0 ) write(0,*) 'conc 26a' DO mgs = 1,ngscnt @@ -16749,6 +17240,7 @@ subroutine nssl_2mom_gs & IF ( crcnw(mgs) < 1.e-30 ) qrcnw(mgs) = 0.0 + IF ( ipconc >= 6 ) THEN IF ( lzr > 1 .and. qrcnw(mgs) > 0.0 ) THEN ! vr = rho0(mgs)*qrcnw(mgs)/(1000.*crcnw(mgs)) ! zrcnw(mgs) = 36.*(xnu(lr)+2.0)*crcnw(mgs)*vr**2/((xnu(lr)+1.0)*pi**2) @@ -16788,6 +17280,7 @@ subroutine nssl_2mom_gs & endif ! z = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/((alpha(mgs,lr)+1.0)*pi**2) ENDIF + ENDIF ! ipconc >= 6 ! IF ( crcnw(mgs) .gt. cautn(mgs) .and. crcnw(mgs) .gt. 1.0 ) ! : THEN ! write(0,*) 'crcnw,cautn ',crcnw(mgs)/cautn(mgs), @@ -16998,7 +17491,7 @@ subroutine nssl_2mom_gs & ELSE !{ - IF ( lzr > 1 ) THEN + IF ( ipconc >= 6 .and. lzr > 1 ) THEN ! interpolate along x, i.e., ratio; tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1)) @@ -17016,7 +17509,7 @@ subroutine nssl_2mom_gs & crfrzs(mgs) = crfrz(mgs) qrfrzs(mgs) = qrfrz(mgs) - IF ( lzr > 1 ) THEN + IF ( ipconc >= 6 .and. lzr > 1 ) THEN zrfrzs(mgs) = zrfrz(mgs) zrfrzf(mgs) = 0. ENDIF @@ -17031,7 +17524,7 @@ subroutine nssl_2mom_gs & crfrzf(mgs) = 0.0 qrfrzf(mgs) = 0.0 - IF ( lzr > 1 ) THEN + IF (ipconc >= 6 .and. lzr > 1 ) THEN zrfrzs(mgs) = zrfrz(mgs) zrfrzf(mgs) = 0. ENDIF @@ -17074,7 +17567,7 @@ subroutine nssl_2mom_gs & crfrzs(mgs) = crfrzs(mgs) - crfrzf(mgs) qrfrzs(mgs) = qrfrzs(mgs) - qrfrzf(mgs) - IF ( lzr > 1 ) THEN + IF ( ipconc >= 6 .and. lzr > 1 ) THEN zrfrzs(mgs) = zrfrz(mgs) ! interpolate along x, i.e., ratio; tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) @@ -17103,7 +17596,7 @@ subroutine nssl_2mom_gs & crfrz(mgs) = fac*crfrz(mgs) crfrzs(mgs) = fac*crfrzs(mgs) crfrzf(mgs) = fac*crfrzf(mgs) - IF ( lzr > 1 ) THEN + IF ( ipconc >= 6 .and. lzr > 1 ) THEN zrfrz(mgs) = fac*zrfrz(mgs) zrfrzf(mgs) = fac*zrfrzf(mgs) ENDIF @@ -17651,7 +18144,7 @@ subroutine nssl_2mom_gs & x = 1. + alpha(mgs,lr) - IF ( lzr > 1 ) THEN ! 3 moment + IF ( ipconc >= 6 .and. lzr > 1 ) THEN ! 3 moment tmp = 1. + alpr ! alpha(mgs,lr) i = Int(dgami*(tmp)) del = tmp - dgam*i @@ -17676,6 +18169,7 @@ subroutine nssl_2mom_gs & & 0.308*fvent(mgs)*y* & & Sqrt(ax(lr)*rhovt(mgs))*(vent1/vent2) + rwventz(mgs) = 0.0 ! rwventz(mgs) = & ! & 0.78*x + & @@ -17694,6 +18188,7 @@ subroutine nssl_2mom_gs & & *(xdia(mgs,lr,1)**((1.0+br)/2.0)) ) + IF ( ipconc >= 7 ) THEN alpr = Min(alpharmax,alpha(mgs,lr) ) tmp = alpr + 5.5 + br/2. @@ -17708,7 +18203,7 @@ subroutine nssl_2mom_gs & & 0.308*fvent(mgs)* & & Sqrt(ax(lr)*rhovt(mgs))*(y/gf1palp(mgs))*(xdia(mgs,lr,1)**((1.0+br)/2.0)) - + ENDIF ENDIF ! iferwisventr @@ -17752,6 +18247,9 @@ subroutine nssl_2mom_gs & hwventa = (0.78)*gmoi(igmhwa) hwventb = (0.308)*gmoi(igmhwb) ! hwventc = (4.0*gr/(3.0*cdx(lh)))**(0.25) + hwvent(:) = 0.0 + hwventy(:) = 0.0 + do mgs = 1,ngscnt IF ( qx(mgs,lh) .gt. qxmin(lh) ) THEN hwventc = (4.0*gr/(3.0*cdxgs(mgs,lh)))**(0.25) @@ -17909,7 +18407,7 @@ subroutine nssl_2mom_gs & vffzf(:) = 0.0 vhlfzhl(:) = 0.0 qsfzs(:) = 0.0 - zsmlr(:) = 0.0 +! zsmlr(:) = 0.0 zhmlr(:) = 0.0 zhmlrr(:) = 0.0 zsmlrr(:) = 0.0 @@ -18110,20 +18608,8 @@ subroutine nssl_2mom_gs & ! ENDIF - - IF ( lzr .gt. 1 .and. qx(mgs,ls) > qxmin(ls) ) THEN - tmp = qx(mgs,ls)/cx(mgs,ls) -! alp = Max( -0.8, alpha(mgs,lh) ) - alp = xnu(ls) - g1 = 36.*(alp+2.0)/((alp+1.0)*pi**2) - - zsmlr(mgs) = g1*(rho0(mgs)/(xdn(mgs,ls)))**2*( tmp * qsmlr(mgs) ) -! zhmlr(mgs) = (xdn0(lr)/(xdn(mgs,lh)))**2*( zx(mgs,lh) * qhmlr(mgs) ) - - ENDIF - IF ( chmlr(mgs) < 0.0 .and. (ibinhmlr < 1 .or. lzh < 1) ) THEN ! { already done if ibinhmlr > 0 - IF ( lzr .gt. 1 .and. lzh < 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN ! Only compute if rain is 3-moment but graupel is not, otherwise is computed later + IF ( ipconc >= 6 .and. lzr .gt. 1 .and. lzh < 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN ! Only compute if rain is 3-moment but graupel is not, otherwise is computed later tmp = qx(mgs,lh)/cx(mgs,lh) alp = alpha(mgs,lh) g1 = g1x(mgs,lh) ! (6.0 + alp)*(5.0 + alp)*(4.0 + alp)/((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) @@ -18236,7 +18722,7 @@ subroutine nssl_2mom_gs & ENDIF !} - IF ( lzhl .gt. 1 .and. ibinhlmlr <= 0 ) THEN + IF ( ipconc >= 8 .and. lzhl .gt. 1 .and. ibinhlmlr <= 0 ) THEN IF ( cx(mgs,lhl) > 0.0 ) THEN tmp = qx(mgs,lhl)/cx(mgs,lhl) @@ -18575,6 +19061,9 @@ subroutine nssl_2mom_gs & qsdpv(mgs) = 0.0 ENDIF + qhsbv(mgs) = 0.0 + qhdpv(mgs) = 0.0 + IF ( qx(mgs,lh) > qxmin(lh) ) THEN IF ( temg(mgs) < tfr .or. .not. qhmlr(mgs) < 0.0 ) THEN ! no liquid from melting, so evaporation is greater. Thus can calculate sublimation rate qhsbv(mgs) = max( min(qhdsv(mgs), 0.0), -qhmxd(mgs) ) @@ -18587,12 +19076,14 @@ subroutine nssl_2mom_gs & ! & evapfac*min( & ! & fmlt1e(mgs)*cx(mgs,lh)*hwvent(mgs)*xdia(mgs,lh,1), 0.0 ) - qhcev(mgs) = evapfac* & - & 2.0*pi*(qx(mgs,lv)-qss0(mgs))*cx(mgs,lh)*xdia(mgs,lh,1)*hwvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) + qhcev(mgs) = evapfac*2.0*pi*(qx(mgs,lv)-qss0(mgs))* & + & cx(mgs,lh)*xdia(mgs,lh,1)*hwvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) - qhcev(mgs) = max(qhcev(mgs), -qhmxd(mgs)) + qhcev(mgs) = max(qhcev(mgs), -qhmxd(mgs)) + IF ( temg(mgs) > tfr ) qhcev(mgs) = Min(0.0, qhcev(mgs) ) ENDIF + ENDIF qhlsbv(mgs) = 0.0 @@ -18605,10 +19096,11 @@ subroutine nssl_2mom_gs & ENDIF IF ( qhlmlr(mgs) < 0.0 .and. .not. mixedphase ) THEN ! Liquid is forming, so find the evaporation that was subtracted from melting (if it is not condensing) - qhlcev(mgs) = evapfac* & - & 2.0*pi*(qx(mgs,lv)-qss0(mgs))*cx(mgs,lhl)*xdia(mgs,lhl,1)*hlvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) + qhlcev(mgs) = evapfac*2.0*pi*(qx(mgs,lv)-qss0(mgs))* & + & cx(mgs,lhl)*xdia(mgs,lhl,1)*hlvent(mgs)/(qss0(mgs)*(fav(mgs)+fbv(mgs))) qhlcev(mgs) = max(qhlcev(mgs), -qhlmxd(mgs)) + IF ( temg(mgs) > tfr ) qhlcev(mgs) = Min(0.0, qhlcev(mgs) ) ENDIF ENDIF @@ -18777,7 +19269,7 @@ subroutine nssl_2mom_gs & ! do mgs = 1,ngscnt - IF ( temg(mgs) < tfr ) THEN + IF ( tfrdry < temg(mgs) .and. temg(mgs) < tfr ) THEN ! ! qswet(mgs) = ! > ( xdia(mgs,ls,1)*swvent(mgs)*cx(mgs,ls)*fwet1(mgs) @@ -18815,7 +19307,6 @@ subroutine nssl_2mom_gs & qhwet(mgs) = qhdry(mgs) qhlwet(mgs) = qhldry(mgs) - ENDIF ! ! qhlwet(mgs) = qhldry(mgs) @@ -19222,14 +19713,22 @@ subroutine nssl_2mom_gs & ELSE IF (((qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 & .and. temg(mgs) .gt. dwtempmin ) .or. ( wetgrowth(mgs) .and. qx(mgs,lh) > hlcnhqmin ) ) THEN - dw = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*ehw(mgs)*qx(mgs,lc) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) - dwr = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) +! dw = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*ehw(mgs)*qx(mgs,lc) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) +! dwr = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & +! 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) + x = 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & + 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 + IF ( x > 1.e-20 ) THEN + arg = Min(70.0, (-temcg(mgs)/x )) ! prevent overflow of the exp function in 32 bit + dwr = 0.01*(exp(arg) - 1.0) + ELSE + dwr = 1.e30 + ENDIF d = dwr - IF ( dwr < 0.2 .and. dwr > 0.0 ) THEN + IF ( dwr < 0.2 .and. dwr > 0.0 .and. rho0(mgs)*(qx(mgs,lc)+qx(mgs,lr)) > 1.e-4 ) THEN + sqrtrhovt = Sqrt( rhovt(mgs) ) fventh = sqrtrhovt*(fpndl(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) fventm = sqrtrhovt*(fschm(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) - sqrtrhovt = Sqrt( rhovt(mgs) ) ltemq = (tfr-163.15)/fqsat+1.5 qvs0 = pqs(mgs)*tabqvs(ltemq) denomdp = felf(mgs) + fcw(mgs)*temcg(mgs) @@ -19242,6 +19741,7 @@ subroutine nssl_2mom_gs & h4 = ehr(mgs)* qx(mgs,lr) ! iterate to find minimum diameter for wet growth. Start with value of dwr DO n = 1,10 + d = Max(d, 1.e-4) dold = d vth = axx(mgs,lh)*d**bxx(mgs,lh) x2 = fventh*sqrtrhovt*Sqrt(d*vth) @@ -19266,32 +19766,26 @@ subroutine nssl_2mom_gs & ELSE - d = 8.*ah*h1*dtpinv/ & + ! Based on Farley and Orville (1986), eq. 5-9 but neglecting the Ci*(T0-Ts) term in (8) since we want Ts=T0 + ! Simplified mass rates as dm_w/dt = pi/4*d**2*(Vh - Vc)*rhoair*qc*ehw, etc. + d = 8.*ah*h1/ & ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs)*denomdp + & Max(0.001,vth - vtxbar(mgs,li,1))*h2) + ENDIF -! write(0,*) 'iter,d,dwr = ',n,d,dwr -! write(91,*) 'parts = ',( -ah*ftka*temcg - ah*felv*fwvdf*dn(i,j,k)*(qvamb - qvs0) ),( Max(0.001,vth - 0.01*vwmw)*ehw* qcmks*dn(i,j,k)/denominv + Max(0.001,vth - 0.01*vimw)*ehi*qimks*dn(i,j,k)*fci*temcg) -!! write(91,*) 'partsr = ',( -ah*ftka*temcg - ah*felv*fwvdf*dn(i,j,k)*(qvamb - qvs0) ),( ( Max(0.001,vth - 0.01*vwmw)*ehw* qcmks + Max(0.001,vth - 0.01*vrmw)*ehr* qrmks) *dn(i,j,k)/denominv + & -!! Max(0.001,vth - 0.01*vimw)*ehi*qimks*dn(i,j,k)*fci*temcg) -! write(91,*) 'parts2 = ',vth - IF ( Abs(dold - d)/dold < 0.05 .or. ( n > 3 .and. d > dg0thresh ) ) EXIT ENDDO ENDIF - dg0(mgs) = Max( d, dwmin ) -! IF ( .false. .and. ny == 2 .and. dwr < 0.5 .and. dwr > 0. ) THEN -! write(0,*) 'i,k,dg0 = ',igs(mgs), kgs(mgs), dg0(mgs) -! write(0,*) 'h1,h2,h3,h4 = ',h1,h2,h3,h4 -! write(0,*) 'dw,dwr = ',dw,dwr -! write(0,*) 'wetgrowth = ',wetgrowth(mgs) -! write(0,*) 'temc,Dh, Dhl = ',temcg(mgs),xdia(mgs,lh,3),xdia(mgs,lhl,3) -! ENDIF + dg0(mgs) = Min( dwmax, Max( d, dwmin ) ) ELSE - dg0(mgs) = dg0thresh + 0.0001 + IF ( qx(mgs,lh) > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 ) THEN + dg0(mgs) = dwmax + ELSE + dg0(mgs) = dg0thresh + 0.0001 + ENDIF ENDIF IF ( ihlcnh == 3 .and. (qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin & @@ -19301,10 +19795,6 @@ subroutine nssl_2mom_gs & ENDIF ENDIF -! write(0,*) 'notwet growth graupel,hail,Dw,Dwr = ',wetgrowth(mgs) , wetgrowthhl(mgs), dh0 ,tmp,tmp1 -! write(0,*) 'temc,Dh, Dhl = ',temcg(mgs),xdia(mgs,lh,3),xdia(mgs,lhl,3) -! write(0,*) 'qc,qi = ', qx(mgs,lc) , qx(mgs,li) - wtest = (dg0(mgs) > 0.0 .and. dg0(mgs) < dg0thresh ) @@ -19339,18 +19829,6 @@ subroutine nssl_2mom_gs & tmp = qhacw(mgs) + qhacr(mgs) + qhaci(mgs) + qhacs(mgs) ! qtmp = Min( 1.0, xdia(mgs,lh,3)/(2.0*dh0) )*(tmp) qtmp = Min( 100.0, xdia(mgs,lh,3)/(2.0*dh0) )*(tmp) -! IF ( .false. .and. qx(mgs,lhl) + qtmp*dtp .lt. 0.5e-3 ) THEN -! hdia1 = Max(dh0, xdia(mgs,lh,3) ) -! qtmp = qtmp + Min(qxmxd(mgs,lh), Max( 0.0, & -! & ((pi*xdn(mgs,lh)*cx(mgs,lh)) / (6.0*rho0(mgs)*dtp)) & -! & *exp(-hdia1/xdia(mgs,lh,1)) & -! & *( (hdia1**3) + 3.0*(hdia1**2)*xdia(mgs,lh,1) & -! & + 6.0*(hdia1)*(xdia(mgs,lh,1)**2) + 6.0*(xdia(mgs,lh,1)**3) ) ) ) - -! ENDIF - -! qhlcnh(mgs) = Min( 0.5*(qx(mgs,lh))+tmp, xdia(mgs,lh,3)/(2.0*dh0)*(tmp) ) -! qhlcnh(mgs) = Min( qxmxd(mgs,lh), xdia(mgs,lh,3)/(2.0*dh0)*(tmp) ) qhlcnh(mgs) = Min( qxmxd(mgs,lh), qtmp ) IF ( ipconc .ge. 5 ) THEN !{ @@ -19360,8 +19838,6 @@ subroutine nssl_2mom_gs & chlcnhhl(mgs) = Min( cxmxd(mgs,lh), rho0(mgs)*qhlcnh(mgs)/(pi*xdn(mgs,lh)*dh0**3/6.0) ) r = rho0(mgs)*qhlcnh(mgs)/(xdn(mgs,lh)*xv(mgs,lh)) ! number of graupel particles at mean volume diameter -! chlcnh(mgs) = Min( Max( 1./8.*r , chlcnh(mgs)), r ) -! chlcnh(mgs) = Min( chlcnh(mgs), r ) chlcnh(mgs) = Max( chlcnhhl(mgs), r ) ENDIF !} @@ -19395,11 +19871,10 @@ subroutine nssl_2mom_gs & qxd1 = qx(mgs,lh)*(tmp2) qhlcnh(mgs) = dtpinv*qxd1 flim = 1.0 -! tmp3 = Min( dtp*(qfacw(mgs) + qfacr(mgs) ), qxmxd(mgs,lf) ) tmp3 = qxmxd(mgs,lh) IF (qxd1 > tmp3 ) THEN - flim = tmp3/(qxd1) - qhlcnh(mgs) = flim*qhlcnh(mgs) +! flim = tmp3/(qxd1) +! qhlcnh(mgs) = flim*qhlcnh(mgs) ENDIF @@ -19416,10 +19891,10 @@ subroutine nssl_2mom_gs & chlcnhhl(mgs) = chlcnh(mgs) IF ( qx(mgs,lhl) > qxmin(lhl) .and. dmhlopt > 0 ) THEN - dh0 = rho0(mgs)*qhlcnh(mgs)/chlcnhhl(mgs) - IF ( dh0 < xmas(mgs,lhl) ) THEN + tmp = rho0(mgs)*qhlcnh(mgs)/chlcnhhl(mgs) + IF ( tmp < xmas(mgs,lhl) ) THEN ! dh0 = ( qxd1*dh0 + qx(mgs,lhl)*xmas(mgs,lhl))/( qxd1 + qx(mgs,lhl)) ! weighted average - dh0 = (( qxd1*dh0**(1./3.) + qx(mgs,lhl)*xmas(mgs,lhl)**(1./3.))/( qxd1 + qx(mgs,lhl)))**3 ! weighted average + dh0 = (( qxd1*tmp**(1./3.) + qx(mgs,lhl)*xmas(mgs,lhl)**(1./3.))/( qxd1 + qx(mgs,lhl)))**3 ! weighted average chlcnhhl(mgs) = Min( chlcnhhl(mgs), rho0(mgs)*qhlcnh(mgs)/dh0 ) ELSE ! dh0 = Max( dh0, xmas(mgs,lhl) ) ! when enough hail is established, do not dilute the size @@ -19428,7 +19903,7 @@ subroutine nssl_2mom_gs & ! reflectivity - IF ( lzh > 1 .and. lzhl > 1 ) THEN + IF ( ipconc >= 6 .and. lzh > 1 .and. lzhl > 1 ) THEN tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) zxd1 = flim*zx(mgs,lh)*(tmp3) zhlcnh(mgs) = dtpinv*zxd1 @@ -19440,17 +19915,6 @@ subroutine nssl_2mom_gs & qhlcnh(mgs) = 0.0 ENDIF -! IF ( cxd1 < 0.0 .or. qxd1 < 0.0 ) THEN -! write(0,*) 'cxd1,qxd1 = ',cxd1,qxd1 -! write(0,*) 'dw,temcg = ',dw,temcg(mgs),ratio -! ENDIF - -! write(0,*) 'dw,temcg = ',dw,temcg(mgs),ratio -! write(0,*) 'qhlcnh,qh = ',qhlcnh(mgs),qx(mgs,lh),qxd1 -! write(0,*) 'chlcnh,ch = ',chlcnh(mgs),cx(mgs,lh),cxd1 -! write(0,*) 'zhlcnh,zh = ',zhlcnh(mgs),zx(mgs,lh),zxd1 -! write(0,*) 'tmp1,2,3 = ',tmp,tmp2,tmp3 - vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh) vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/Max(xdnmn(lhl), xdn(mgs,lh)) @@ -19494,17 +19958,6 @@ subroutine nssl_2mom_gs & ELSE zxd1 = 0 ENDIF -! IF ( cxd1 < 0.0 .or. qxd1 < 0.0 ) THEN -! write(0,*) 'cxd1,qxd1 = ',cxd1,qxd1 -! write(0,*) 'dw,temcg = ',dw,temcg(mgs),ratio -! ENDIF - -! write(0,*) 'dw,temcg = ',dw,temcg(mgs),ratio -! write(0,*) 'qhlcnh,qh = ',qhlcnh(mgs),qx(mgs,lh),qxd1 -! write(0,*) 'chlcnh,ch = ',chlcnh(mgs),cx(mgs,lh),cxd1 -! write(0,*) 'zhlcnh,zh = ',zhlcnh(mgs),zx(mgs,lh),zxd1 -! write(0,*) 'tmp1,2,3 = ',tmp,tmp2,tmp3 - vhlcnh(mgs) = rho0(mgs)*qhlcnh(mgs)/xdn(mgs,lh) vhlcnhl(mgs) = rho0(mgs)*qhlcnh(mgs)/Max(xdnmn(lhl), xdn(mgs,lh)) @@ -20765,6 +21218,14 @@ subroutine nssl_2mom_gs & pqlwlghld(:) = 0.0 pqlwhli(:) = 0.0 pqlwhld(:) = 0.0 + IF ( ipconc > 5 ) THEN + pzhwi(:) = 0.0 + pzhwd(:) = 0.0 + pzrwi(:) = 0.0 + pzrwd(:) = 0.0 + pzhli(:) = 0.0 + pzhld(:) = 0.0 + ENDIF ! @@ -21337,8 +21798,8 @@ subroutine nssl_2mom_gs & ! zhshr(mgs) = (xdn0(lr)/(xdn(mgs,lh)))**2*( zx(mgs,lh) * qhshr(mgs) ) - qtmp = qhdpv(mgs) + qhcev(mgs) - ctmp = chdpv(mgs) + chcev(mgs) + qtmp = qhdpv(mgs) + qhcev(mgs) + qhsbv(mgs) + ctmp = chdpv(mgs) + chcev(mgs) + chsbv(mgs) zhdsv(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( tmp ) * qtmp - tmp**2 * ctmp ) @@ -21484,7 +21945,6 @@ subroutine nssl_2mom_gs & pzhwd(mgs) = 0.0 & & + (1-il5(mgs))*zhmlr(mgs) & & + zhshr(mgs) & -! > + il5(mgs)*chsbv(mgs) & & + Min( 0.0, zhdsv(mgs) ) & & - il5(mgs)*zhlcnh(mgs) @@ -21674,7 +22134,7 @@ subroutine nssl_2mom_gs & zrachl(mgs) = 0.0 zsshr(mgs) = 0.0 zsshrr(mgs) = 0.0 - zsmlr(mgs) = 0.0 +! zsmlr(mgs) = 0.0 zsmlrr(mgs) = 0.0 IF ( qx(mgs,ls) .gt. qxmin(ls) .and. ( csmlr(mgs) /= 0.0 .or. csshr(mgs) /= 0.0 .or. & @@ -21682,8 +22142,8 @@ subroutine nssl_2mom_gs & tmp = qx(mgs,ls)/cx(mgs,ls) g1 = 36.*(xnu(ls)+2.0)/((xnu(ls)+1.0)*pi**2) IF ( .not. mixedphase ) THEN - zsmlr(mgs) = (xdn(mgs,ls)/xdn(mgs,lr))**2*g1*(rho0(mgs)/(xdn(mgs,ls)))**2* & - & ( 2.*tmp * qsmlr(mgs) - tmp**2 * csmlr(mgs) ) +! zsmlr(mgs) = (xdn(mgs,ls)/xdn(mgs,lr))**2*g1*(rho0(mgs)/(xdn(mgs,ls)))**2* & +! & ( 2.*tmp * qsmlr(mgs) - tmp**2 * csmlr(mgs) ) IF ( csmlrr(mgs) /= 0.0 ) THEN z1 = g1smlr*(6.*rho0(mgs)/(pi*xdn(mgs,lr)))**2*( qsmlr(mgs)**2/ csmlrr(mgs) ) @@ -22534,7 +22994,6 @@ subroutine nssl_2mom_gs & end do end if - IF ( has_wetscav ) THEN DO mgs = 1,ngscnt evapprod2d(igs(mgs),kgs(mgs)) = -(qrcev(mgs) + qssbv(mgs) + qhsbv(mgs) + qhlsbv(mgs)) @@ -22776,41 +23235,9 @@ subroutine nssl_2mom_gs & tqvcon = temg(mgs)-cbw ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) -! IF ( ltemq .lt. 1 .or. ltemq .gt. nqsat ) THEN -! C$PAR CRITICAL SECTION -! write(iunit,*) 'out of range ltemq!',temgtmp,temg(mgs), -! : thetap(mgs),theta0(mgs),pres(mgs),theta(mgs), -! : ltemq,igs(mgs),jy,kgs(mgs) -! write(iunit,*) an(igs(mgs),jy,kgs(mgs),lt), -! : ab(igs(mgs),jy,kgs(mgs),lt), -! : t0(igs(mgs),jy,kgs(mgs)) -! write(iunit,*) fcc3(mgs),qx(mgs,lc),qitmp(mgs),dtp,ptem(mgs) -! STOP -! C$PAR END CRITICAL SECTION -! END IF + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) qis(mgs) = pqs(mgs)*tabqis(ltemq) -! qss(kz) = qvs(kz) -! if ( temg(kz) .lt. tfr ) then -! if( qcw(kz) .le. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = qis(kz) -! if( qcw(kz) .gt. qxmin(lc) .and. qci(kz) .gt. qxmin(li)) -! > qss(kz) = (qcw(kz)*qvs(kz) + qci(kz)*qis(kz)) / -! > (qcw(kz) + qci(kz)) -! qss(kz) = qis(kz) -! end if -! dont get enough condensation with qcw .le./.gt. qxmin(lc) -! if ( temg(mgs) .lt. tfr ) then -! if( qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) ) -! > qss(mgs) = qvs(mgs) -! if( qx(mgs,lc) .eq. 0.0 .and. qitmp(mgs) .gt. qxmin(li)) -! > qss(mgs) = qis(mgs) -! if( qx(mgs,lc) .gt. 0.0 .and. qitmp(mgs) .gt. qxmin(li)) -! > qss(mgs) = (qx(mgs,lc)*qvs(mgs) + qitmp(mgs)*qis(mgs)) / -! > (qx(mgs,lc) + qitmp(mgs)) -! else -! qss(mgs) = qvs(mgs) -! end if qss(mgs) = qvs(mgs) if ( temg(mgs) .lt. tfr ) then if( qx(mgs,lc) .ge. 0.0 .and. qitmp(mgs) .le. qxmin(li) ) & @@ -23049,7 +23476,6 @@ subroutine nssl_2mom_gs & - if (ndebug .gt. 0 ) write(0,*) 'gs 11' do mgs = 1,ngscnt @@ -23212,7 +23638,7 @@ subroutine nssl_2mom_gs & qr = qx(mgs,il) cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(z*xdn(mgs,lr)**2) ! an(igs(mgs),jgs,kgs(mgs),ln(il)) = zx(mgs,il) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN ! have mass and concentration but no reflectivity, so set reflectivity, using default alpha g1 = 36.*(alpha(mgs,lr)+2.0)/((alpha(mgs,lr)+1.0)*pi**2) chw = cx(mgs,il) @@ -23220,7 +23646,7 @@ subroutine nssl_2mom_gs & zx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(qr)*qr/(xdn(mgs,lr)**2*chw) an(igs(mgs),jgs,kgs(mgs),lz(lr)) = zx(mgs,lr) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN ! How did this happen? ! set values according to dBZ of -10, or Z = 0.1 ! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 @@ -23237,7 +23663,6 @@ subroutine nssl_2mom_gs & IF ( zx(mgs,lr) > 0.0 ) THEN xv(mgs,lr) = rho0(mgs)*qx(mgs,lr)/(1000.*cx(mgs,lr)) vr = xv(mgs,lr) -! z = 36.*(alpha(kz)+2.0)*a(ix,jy,kz,lnr)*vr**2/((alpha(kz)+1.0)*pi**2) qr = qx(mgs,lr) nrx = cx(mgs,lr) z = zx(mgs,lr) @@ -23247,9 +23672,7 @@ subroutine nssl_2mom_gs & ! determine shape parameter alpha by iteration IF ( z .gt. 0.0 ) THEN -! alpha(mgs,lr) = 3. alp = 36.*(alpha(mgs,lr)+2.0)*nrx*vr**2/(z*pi**2) - 1. -! write(0,*) 'kz, alp, alpha(kz) = ',kz,alp,alpha(kz),rd,z,xv DO i = 1,20 IF ( Abs(alp - alpha(mgs,lr)) .lt. 0.01 ) EXIT alpha(mgs,lr) = Max( rnumin, Min( rnumax, alp ) ) @@ -23425,7 +23848,7 @@ subroutine nssl_2mom_gs & cx(mgs,il) = g1*dn(igs(mgs),jy,kgs(mgs))**2*(6.*qr)**2/(z*(pi*xdn(mgs,il))**2) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) > 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) > 0.0 ) THEN ! have mass and concentration but no reflectivity, so set reflectivity, using default alpha ! g1 = (6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & ! & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))) @@ -23438,7 +23861,7 @@ subroutine nssl_2mom_gs & zx(mgs,il) = Max(zxmin*1.1, g1*dn(igs(mgs),jy,kgs(mgs))**2*(6*qr)**2/(chw*(pi*xdn(mgs,il))**2) ) an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) - ELSEIF ( zx(mgs,il) <= 0.0 .and. cx(mgs,il) <= 0.0 ) THEN + ELSEIF ( zx(mgs,il) <= zxmin .and. cx(mgs,il) <= 0.0 ) THEN ! How did this happen? ! set values according to dBZ of -10, or Z = 0.1 ! 0.1 = 1.e18*0.224*an(ix,jy,kz,lzh)*(hwdn/rwdn)**2 @@ -23580,6 +24003,16 @@ subroutine nssl_2mom_gs & ENDIF !} + IF ( lzr > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),1) = Max(alphamin, Min(alphamax, alpha(mgs,lr) )) + ENDIF + IF ( lzh > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),2) = Max(alphamin, Min(alphamax, alpha(mgs,lh) )) + ENDIF + IF ( lzhl > 1 ) THEN + alpha2d(igs(mgs),kgs(mgs),3) = Max(alphamin, Min(alphamax, alpha(mgs,lhl) )) + ENDIF + IF ( il == lhl .and. lnhlf > 1 ) THEN ! update chxf in case cx has changed chxf(mgs,lhl) = frac*cx(mgs,lhl) @@ -23608,7 +24041,7 @@ subroutine nssl_2mom_gs & ENDIF ! } } - + ENDIF ! }} ENDIF ! } From 0cb137e1822f076e98a468edc8a386fc280c225a Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Sun, 24 Sep 2023 15:49:28 -0500 Subject: [PATCH 027/132] Update NSSL documentation and references for 3-moment option --- physics/docs/library.bib | 17 +++++++++++------ physics/docs/pdftxt/NSSLMICRO.txt | 4 ++-- physics/docs/pdftxt/suite_input.nml.txt | 3 ++- 3 files changed, 15 insertions(+), 9 deletions(-) diff --git a/physics/docs/library.bib b/physics/docs/library.bib index 34bb54e8f..4260fc3c2 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -3760,8 +3760,6 @@ @inproceedings{yudin_et_al_2019 @article{mansell_2013, author = {Edward R. Mansell and Conrad L. Ziegler}, - date-added = {2015-02-26 22:32:59 +0000}, - date-modified = {2020-02-10 23:06:41 +0000}, doi = {10.1175/JAS-D-12-0264.1}, journal = {Journal of the Atmospheric Sciences}, keywords = {storm electrification, microphysics 2-moment}, @@ -3774,8 +3772,6 @@ @article{mansell_2013 @article{mansell_2010, author = {Edward R. Mansell}, - date-added = {2011-02-22 10:34:11 -0600}, - date-modified = {2011-02-22 10:35:34 -0600}, doi = {10.1175/2010JAS3341.1}, journal = {Journal of the Atmospheric Sciences}, keywords = {advection, microphysics 2-moment}, @@ -3787,8 +3783,6 @@ @article{mansell_2010 @article{mansell_etal_2010, author = {E. R. Mansell and C. L. Ziegler and E. C. Bruning}, - date-added = {2007-08-20 15:44:13 -0500}, - date-modified = {2010-04-13 16:55:16 -0500}, doi = {10.1175/2009JAS2965.1}, journal = {Journal of the Atmospheric Sciences}, keywords = {storm electrification, microphysics 2-moment}, @@ -3798,6 +3792,17 @@ @article{mansell_etal_2010 year = {2010}, bdsk-url-1 = {https://doi.org/10.1175/2009JAS2965.1}} +@article{mansell:2020, + Author = {Edward R. Mansell and Dawson, II, Daniel T. and Jerry M. Straka}, + Doi = {10.1175/JAS-D-19-0268.1}, + Journal = jas, + Keywords = {microphysics 3-moment}, + Pages = {3361-3385}, + Title = {Bin-emulating Hail Melting in 3-moment bulk microphysics}, + Volume = {77}, + Year = {2020}, + Bdsk-Url-1 = {https://dx.doi.org/10.1175/JAS-D-12-0264.1}, + @inproceedings{yudin_et_al_2020, author = {Yudin, V. A. and Yang, F. and Karol, S. I. and Fuller-Rowell T. J. and Kubaryk, A. and Juang, H. and Kar, S. and Alpert, J. C. and Li, Z.}, booktitle = {1st UFS Users' Workshop}, diff --git a/physics/docs/pdftxt/NSSLMICRO.txt b/physics/docs/pdftxt/NSSLMICRO.txt index 3d35c9fd2..44d1f069b 100644 --- a/physics/docs/pdftxt/NSSLMICRO.txt +++ b/physics/docs/pdftxt/NSSLMICRO.txt @@ -2,7 +2,7 @@ \page NSSLMICRO_page NSSL 2-moment Cloud Microphysics Scheme \section nssl2m_descrp Description -The NSSL two-moment bulk microphysical parameterization scheme that describes form and phase changes among a range of liquid and ice hydrometeors, as described in Mansell et al. (2010) \cite Mansell_etal_2010 and Mansell and Ziegler (2013) \cite Mansell_2013. The microphysical parameterization predicts the mass mixing ratio and number concentration of cloud droplets, raindrops, cloud ice crystals (columns), snow particles (including large crystals and aggregates), graupel, and (optionally) hail. +The NSSL 2/3-moment bulk microphysical parameterization scheme that describes form and phase changes among a range of liquid and ice hydrometeors, as described in Mansell et al. (2010) \cite Mansell_etal_2010, Mansell and Ziegler (2013) \cite Mansell_2013, and Mansell et al. (2020) \cite Mansell_etal_2020. The microphysical parameterization predicts the mass mixing ratio and number concentration of cloud droplets, raindrops, cloud ice crystals (columns), snow particles (including large crystals and aggregates), graupel, and (optionally) hail. Optionally, a third moment (reflectivity or 6th moment) of rain, graupel, and hail can be activated. The graupel and hail particle densities are also calculated by predicting the total particle volume. The graupel category therefore emulates a range of characteristics from high-density frozen drops (includes small hail) to low-density graupel (from rimed ice crystals/snow) in its size and density spectrum. The hail category is designed to simulate larger hail sizes. Hail is only produced from higher-density large graupel. @@ -10,7 +10,7 @@ Hydrometeor size distributions are assumed to follow a gamma functional form. Mi Cloud concentration nuclei (CCN) concentration is predicted as in Mansell et al. (2010) \cite Mansell_etal_2010 with a bulk activation spectrum approximating small aerosols. The model tracks the number of unactivated CCN, and the local CCN concentration is depleted as droplets are activated, either at cloud base or in cloud. The CCN are subjected to advection and subgrid turbulent mixing but have no other interactions with hydrometeors; for example, scavenging by raindrops is omitted. CCN are restored by droplet evaporation and by a gradual regeneration when no hydrometeors are present. Aerosol sensitivity is enhanced by explicitly treating droplet condensation instead of using a saturation adjustment. Supersaturation (within reason) is allowed to persist in updraft with low droplet concentration. -Excessive size sorting (common in 2-moment schemes) is effectively controlled by an adaptive breakup method that prevents reflectivity growth by sedimentation (Mansell 2010 \cite Mansell_2010). +Excessive size sorting (common in 2-moment schemes) is effectively controlled by an adaptive breakup method that prevents reflectivity growth by sedimentation (Mansell 2010 \cite Mansell_2010). Activating the 3-moment scheme provides a natural sedimentation feedback that narrows the size spectrum as size-sorting procedes without the the artificial breakup induced by the 2-moment scheme. The NSSL scheme is designed with deep (severe) convection in mind at grid spacings of up to 4 km, but can also be run at larger grid spacing as needed for nesting etc. It is also able to capture non-severe and winter weather. diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index e986fc322..c4bb5003b 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -54,7 +54,7 @@ show some variables in the namelist that must match the SDF.
  • 10: Morrison-Gettelman microphysics scheme
  • 11: GFDL microphysics scheme
  • 17: NSSL microphysics scheme with background CCN -
  • 18: NSSL microphysics scheme with predicted CCN (compatibility) +
  • 18: NSSL microphysics scheme with predicted CCN (compatibility: 18 = 17 + nssl_ccn_on=.true.) 99 \b Parameters \b related \b to \b radiation \b scheme \b options @@ -406,6 +406,7 @@ show some variables in the namelist that must match the SDF. nssl_ehw0_in mp_nssl constant or max assumed graupel-droplet collection efficiency 0.9 nssl_ehlw0_in mp_nssl constant or max assumed hail-droplet collection efficiency 0.9 nssl_hail_on mp_nssl NSSL flag to activate the hail category .false. +nssl_3moment mp_nssl NSSL flag to activate 3-moment for rain/graupel (and hail if activated).false. nssl_ccn_on mp_nssl NSSL flag to activate the CCN category .true. nssl_invertccn mp_nssl NSSL flag to treat CCN as activated or unactivated .true. nssl_ehw0 mp_nssl NSSL graupel-droplet collection efficiency 0.9 From 9b9f55320455a3bca522f1c059b2919922bee2c4 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Sun, 24 Sep 2023 16:33:05 -0500 Subject: [PATCH 028/132] module_mp_nssl_2mom.F90 : set ngs with constant --- physics/module_mp_nssl_2mom.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/module_mp_nssl_2mom.F90 index 72ff9b1b1..a373ddaf9 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/module_mp_nssl_2mom.F90 @@ -2612,7 +2612,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw nx = ite-its+1 ny = 1 ! set up as 2D slabs nz = kte-kts+1 - ngs = Max(nz,64) + ngs = 64 IF ( .not. flag_ccn ) THEN renucfrac = 1.0 From 6ee6df60ca69743bab195fc4b04a891e91bdaeaf Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Mon, 25 Sep 2023 12:33:46 -0500 Subject: [PATCH 029/132] module_mp_nssl_2mom.F90: removed unneeded lines --- physics/module_mp_nssl_2mom.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/module_mp_nssl_2mom.F90 index a373ddaf9..a40a62f02 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/module_mp_nssl_2mom.F90 @@ -21238,7 +21238,6 @@ subroutine nssl_2mom_gs & pqwvi(mgs) = & & -Min(0.0, qrcev(mgs)) & & -Min(0.0, qhcev(mgs)) & - & -Min(0.0, qfcev(mgs)) & & -Min(0.0, qhlcev(mgs)) & & -Min(0.0, qscev(mgs)) & ! > +il5(mgs)*(-qhsbv(mgs) - qhlsbv(mgs) ) & @@ -21249,7 +21248,6 @@ subroutine nssl_2mom_gs & pqwvd(mgs) = & & -Max(0.0, qrcev(mgs)) & & -Max(0.0, qhcev(mgs)) & - & -Max(0.0, qfcev(mgs)) & & -Max(0.0, qhlcev(mgs)) & & -Max(0.0, qscev(mgs)) & & +il5(mgs)*(-qiint(mgs) & From a110a5b93bce92bab083fdaa07bd21ba5cae8720 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 27 Sep 2023 14:04:50 -0600 Subject: [PATCH 030/132] Getting real close... --- physics/GFS_phys_time_vary.fv3.F90 | 105 ++++-- physics/GFS_phys_time_vary.fv3.meta | 83 ++++- physics/GFS_rrtmg_pre.F90 | 19 +- physics/GFS_rrtmg_pre.meta | 39 +-- physics/GFS_rrtmg_setup.F90 | 26 +- physics/GFS_rrtmg_setup.meta | 30 +- physics/GFS_rrtmgp_pre.F90 | 22 +- physics/GFS_rrtmgp_pre.meta | 35 +- physics/GFS_rrtmgp_setup.F90 | 20 +- physics/GFS_rrtmgp_setup.meta | 30 +- physics/module_ozphys.F90 | 476 ++++++++++++++++++++++++++++ physics/module_ozphys.meta | 24 ++ physics/ozphys_2015.F90 | 126 +++----- physics/ozphys_2015.meta | 62 +--- physics/ozphys_time_vary.F90 | 165 ---------- physics/ozphys_time_vary.meta | 200 ------------ physics/radiation_gases.f | 313 ++---------------- physics/rrtmgp_lw_main.F90 | 1 - 18 files changed, 815 insertions(+), 961 deletions(-) create mode 100644 physics/module_ozphys.F90 create mode 100644 physics/module_ozphys.meta delete mode 100644 physics/ozphys_time_vary.F90 delete mode 100644 physics/ozphys_time_vary.meta diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index d82f22399..af2dd9b00 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -10,10 +10,12 @@ module GFS_phys_time_vary use omp_lib #endif - use machine, only : kind_phys + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec use mersenne_twister, only: random_setseed, random_number + use module_ozphys, only: ty_ozphys + use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol @@ -64,9 +66,9 @@ module GFS_phys_time_vary !>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm !> @{ subroutine GFS_phys_time_vary_init ( & - me, master, h2o_phys, iaerclm, iccn, iaermdl, iflip, im, levs, & + me, master, ntoz, h2o_phys, iaerclm, iccn, iaermdl, iflip, im, levs, & nx, ny, idate, xlat_d, xlon_d, & - jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + jindx1_o3, jindx2_o3, ddy_o3, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -79,12 +81,12 @@ subroutine GFS_phys_time_vary_init ( smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & lkm, use_lake_model, lakefrac, lakedepth, iopt_lake, iopt_lake_clm, iopt_lake_flake, & - lakefrac_threshold, lakedepth_threshold, errmsg, errflg) + lakefrac_threshold, lakedepth_threshold, ozphys, errmsg, errflg) implicit none ! Interface variables - integer, intent(in) :: me, master, iccn, iflip, im, nx, ny, levs, iaermdl + integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny, levs, iaermdl logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start integer, intent(in) :: idate(:), iopt_lake, iopt_lake_clm, iopt_lake_flake real(kind_phys), intent(in) :: fhour, lakefrac_threshold, lakedepth_threshold @@ -93,8 +95,8 @@ subroutine GFS_phys_time_vary_init ( integer, intent(in) :: lkm integer, intent(inout) :: use_lake_model(:) real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) - integer, intent(inout) :: jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(inout) :: ddy_h(:) + integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(in) :: h2opl(:,:,:) integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) @@ -113,6 +115,7 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: min_seaice, fice(:) real(kind_phys), intent(in) :: landfrac(:) real(kind_phys), intent(inout) :: weasd(:) + type(ty_ozphys), intent(in) :: ozphys ! NoahMP - only allocated when NoahMP is used integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound @@ -200,21 +203,30 @@ subroutine GFS_phys_time_vary_init ( jamax=-999 !$OMP parallel num_threads(nthrds) default(none) & -!$OMP shared (me,master,h2o_phys,im,nx,ny,levs,idate) & +!$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,levs,idate) & !$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & !$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & !$OMP shared (iamin, iamax, jamin, jamax) & !$OMP shared (iaerclm,iaermdl,ntrcaer,aer_nm,iflip,iccn) & -!$OMP shared (jindx1_h,jindx2_h,ddy_h) & +!$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & !$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & !$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & !$OMP shared (do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau) & !$OMP shared (isot,ivegsrc,nlunit,sncovr,sncovr_ice,lsm,lsm_ruc) & !$OMP shared (min_seaice,fice,landfrac,vtype,weasd,snupx,salp_data) & +!$OMP shared (ozphys) & !$OMP private (ix,i,j,rsnow,vegtyp) !$OMP sections +!$OMP section +!> - Setup spatial interpolation indices for ozone physics. + if (ntoz > 0) then + !$OMP CRITICAL + call ozphys%setup_forcing(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + !$OMP END CRITICAL + endif + !$OMP section !> - Call read_h2odata() to read stratospheric water vapor data call read_h2odata (h2o_phys, me, master) @@ -710,8 +722,8 @@ end subroutine GFS_phys_time_vary_init !> @{ subroutine GFS_phys_time_vary_timestep_init ( & me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, nscyc, h2o_phys, iaerclm, iccn, clstp, & - jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & + imfdeepcnv, cal_pre, random_clds, nscyc, ntoz, h2o_phys, iaerclm, iccn, clstp, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, fn_nml, & imap, jmap, prsl, seed0, rann, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, lsoil_lsm,& @@ -719,21 +731,21 @@ subroutine GFS_phys_time_vary_timestep_init ( lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, & tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype,scolor, shdmin, shdmax, snowd, & - cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, & + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & - nsswr, imfdeepcnv, iccn, nscyc, iflip + nsswr, imfdeepcnv, iccn, nscyc, ntoz, iflip integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm real(kind_phys), intent(out) :: clstp - integer, intent(in) :: jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in) :: ddy_h(:) - real(kind_phys), intent(inout) :: h2opl(:,:,:) + integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) @@ -749,6 +761,7 @@ subroutine GFS_phys_time_vary_timestep_init ( integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) + type(ty_ozphys), intent(in) :: ozphys ! For gcycle only integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil @@ -771,10 +784,13 @@ subroutine GFS_phys_time_vary_timestep_init ( integer, intent(out) :: errflg ! Local variables - integer :: i, j, k, iseed, iskip, ix - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(cny) - real(kind=kind_phys) :: rndval(cnx*cny*nrcm) + integer :: i, j, k, iseed, iskip, ix, idat(8), jdat(8), iday, j1, j2, nc, n1, n2, jdow, & + jdoy, jday, w3kindreal, w3kindint + real(kind_phys) :: wrk(1), tem, tx1, tx2, rjday + real(kind_phys) :: rannie(cny) + real(kind_phys) :: rndval(cnx*cny*nrcm) + real(kind_dbl_prec) :: rinc(5) + real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' @@ -790,15 +806,56 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP parallel num_threads(nthrds) default(none) & !$OMP shared(kdt,nsswr,lsswr,clstp,imfdeepcnv,cal_pre,random_clds) & !$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval) & -!$OMP shared(rann,im,isc,jsc,imap,jmap,me,idate) & -!$OMP shared(h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & +!$OMP shared(rann,im,isc,jsc,imap,jmap,ntoz,me,idate,jindx1_o3,jindx2_o3) & +!$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & -!$OMP shared(ddy_j2tau,tau_amf,iflip) & -!$OMP private(iseed,iskip,i,j,k) +!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys) & +!$OMP private(iseed,iskip,i,j,rjday,idat,rinc,w3kindreal,w3kindint,jdat)& +!$OMP private(jdow,jdoy,jday,rinc4,n1,n2) !$OMP sections +!$OMP section +!> - Compute temporal interpolation indices for updating gas concentrations. + idat=0 + idat(1)=idate(4) + idat(2)=idate(2) + idat(3)=idate(3) + idat(5)=idate(1) + rinc=0. + rinc(2)=fhour + call w3kind(w3kindreal,w3kindint) + if(w3kindreal==4) then + rinc4=rinc + CALL w3movdat(rinc4,idat,jdat) + else + CALL w3movdat(rinc,idat,jdat) + endif + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + if (rjday < ozphys%time(1)) rjday = rjday + 365. + + n2 = ozphys%ntime + 1 + do j=2,ozphys%ntime + if (rjday < ozphys%time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime + + !> - Update ozone concentration. + if (ntoz > 0) then + !$OMP CRITICAL + call ozphys%update_forcing(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) + !$OMP END CRITICAL + endif + !$OMP section !--- switch for saving convective clouds - cnvc90.f diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 6ef6e226c..bf5a3fa04 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -2,7 +2,7 @@ name = GFS_phys_time_vary type = scheme dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90 + dependencies = namelist_soilveg.f,set_soilveg.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90,module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -72,6 +72,36 @@ dimensions = () type = integer intent = in + intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in +[jindx1_o3] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[jindx2_o3] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[ddy_o3] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in [nx] standard_name = number_of_points_in_x_direction_for_this_MPI_rank long_name = number of points in x direction for this MPI rank @@ -932,6 +962,13 @@ type = real kind = kind_phys intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1107,6 +1144,13 @@ dimensions = () type = integer intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in [h2o_phys] standard_name = flag_for_stratospheric_water_vapor_physics long_name = flag for stratospheric water vapor physics @@ -1136,6 +1180,36 @@ type = real kind = kind_phys intent = out +[jindx1_o3] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[jindx2_o3] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[ddy_o3] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_dimension,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) + type = real + kind = kind_phys + intent = inout [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -1868,6 +1942,13 @@ type = real kind = kind_phys intent = inout +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index f2183919f..69be4f8d0 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -45,8 +45,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& gasvmr_ccl4, gasvmr_cfc113, aerodp,ext550, clouds6, clouds7, clouds8, & clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, & faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, rrfs_sd, & - aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, latsozc, levozc, & - blatc, dphiozc, errmsg, errflg) + aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, ozphys, & + errmsg, errflg) use machine, only: kind_phys @@ -54,7 +54,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& use funcphys, only: fpvs use module_radiation_astronomy,only: coszmn ! sol_init, sol_update - use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update, + use module_radiation_gases, only: NF_VGAS, getgases ! gas_init, gas_update, use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update, & NSPC1 use module_radiation_clouds, only: NF_CLDS, & ! cld_init @@ -81,6 +81,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& make_IceNumber, & make_DropletNumber, & make_RainNumber + ! For NRL Ozone + use module_ozphys, only: ty_ozphys implicit none integer, intent(in) :: im, levs, lm, lmk, lmp, ltp, & @@ -102,8 +104,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& imp_physics_mg, imp_physics_wsm6, & imp_physics_nssl, & imp_physics_fer_hires, & - yearlen, icloud, iaermdl, iaerflg, & - latsozc, levozc + yearlen, icloud, iaermdl, iaerflg integer, intent(in) :: & iovr, & ! choice of cloud-overlap method @@ -134,7 +135,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& integer, intent(in) :: spp_rad real(kind_phys), intent(in) :: spp_wts_rad(:,:) - real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con, blatc, dphiozc + real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con real(kind=kind_phys), intent(in) :: con_eps, epsm1, fvirt, rog, rocp, con_rd, con_pi, con_g, con_ttp, con_thgni real(kind=kind_phys), dimension(:), intent(in) :: xlat_d, xlat, xlon, & @@ -252,6 +253,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& integer :: iflag integer :: islmsk + ! For NRL Ozone + type(ty_ozphys),intent(in) :: ozphys + integer :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte @@ -422,7 +426,6 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& !> - Get layer ozone mass mixing ratio (if use ozone climatology data, -!! call getozn()). if (ntoz > 0) then ! interactive ozone generation do k=1,lmk @@ -431,7 +434,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& enddo enddo else ! climatological ozone - call getozn (prslk1, xlat, im, lmk, top_at_1, latsozc, levozc, blatc, dphiozc, olyr) + call ozphys%oz_clim(xlat, prslk1, con_pi, olyr) endif ! end_if_ntoz !> - Call coszmn(), to compute cosine of zenith angle (only when SW is called) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 038f59c27..a29b0ac3c 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -2,7 +2,7 @@ name = GFS_rrtmg_pre type = scheme dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_radar.F90,module_mp_thompson.F90 - dependencies = module_mp_thompson_make_number_concentrations.F90,radcons.f90,radiation_aerosols.f + dependencies = module_mp_thompson_make_number_concentrations.F90,radcons.f90,radiation_aerosols.f,module_ozphys.F90 dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90,radiation_cloud_overlap.F90 ######################################################################## @@ -247,6 +247,13 @@ dimensions = () type = integer intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [iaermdl] standard_name = control_for_aerosol_radiation_scheme long_name = control of aerosol scheme in radiation @@ -1503,36 +1510,6 @@ dimensions = () type = integer intent = in -[latsozc] - standard_name = number_of_latitudes_in_ozone_climotology_data - long_name = number of latitude in ozone climotology data - units = count - dimensions = () - type = integer - intent = in -[levozc] - standard_name = number_of_levels_in_ozone_climotology_data - long_name = number of levels in ozone climotology data - units = count - dimensions = () - type = integer - intent = in -[dphiozc] - standard_name = ozone_data_parameter_1 - long_name = ozone data parameter 1 - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[blatc] - standard_name = ozone_data_parameter_2 - long_name = ozone data parameter 2 - units = none - dimensions = () - type = real - kind = kind_phys - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 30917b961..908a364dc 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -7,7 +7,7 @@ module GFS_rrtmg_setup use machine, only: kind_phys - + use module_ozphys, only: ty_ozphys implicit none public GFS_rrtmg_setup_init, GFS_rrtmg_setup_timestep_init, GFS_rrtmg_setup_finalize @@ -44,7 +44,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & iaermdl, iaerflg, aeros_file, con_pi, con_t0c, con_c, con_boltz, & con_plnk, con_solr_2008, con_solr_2002, con_g, con_rd, co2usr_file, & co2cyc_file, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, isubclw,& - iswmode, latsozp, levozp, timeozp, ipsd0, ltp, lextop, errmsg, errflg) + iswmode, ipsd0, ltp, lextop, errmsg, errflg) ! ================= subprogram documentation block ================ ! ! ! ! subprogram: GFS_rrtmg_setup_init - a subprogram to initialize radiation ! @@ -155,8 +155,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & integer, intent(in) :: levr, ictm, isol, ico2, iaer, ntcw, num_p3d, & ltp, npdf3d, ntoz, iovr, iovr_rand, iovr_maxrand, iovr_max, & iovr_dcorr, iovr_exp, iovr_exprand, icliq_sw, imp_physics, & - iflip, me, rad_hr_units, icliq_lw, isubcsw, isubclw, iswmode, & - latsozp, levozp, timeozp + iflip, me, rad_hr_units, icliq_lw, isubcsw, isubclw, iswmode integer, intent(in) :: idate(:) logical, intent(in) :: lcrick, lcnorm, lnoprec, do_RRTMGP, lalw1bd, & inc_minor_gas, lextop @@ -219,8 +218,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & con_pi ) call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, & con_pi, con_t0c, con_c, con_boltz, con_plnk, errflg, errmsg) - call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, ntoz, & - con_pi, latsozp, levozp, timeozp, errflg, errmsg) + call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) call cld_init ( si, levr, imp_physics, me, con_g, con_rd, errflg, errmsg) call rlwinit ( me, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & @@ -246,7 +244,8 @@ end subroutine GFS_rrtmg_setup_init !! subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & lsswr, me, iaermdl, iaerflg, isol, aeros_file, slag, sdec, cdec, & - solcon, con_pi, co2dat_file, co2gbl_file, ictm, ico2, ntoz, errmsg, errflg) + solcon, con_pi, co2dat_file, co2gbl_file, ictm, ico2, ntoz, ozphys,& + errmsg, errflg) implicit none @@ -259,6 +258,7 @@ subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & logical, intent(in) :: lsswr integer, intent(in) :: me integer, intent(in) :: iaermdl, iaerflg, isol, ictm, ico2, ntoz + type(ty_ozphys), intent(inout) :: ozphys character(len=26), intent(in) :: aeros_file, co2dat_file, co2gbl_file real(kind=kind_phys), intent(out) :: slag real(kind=kind_phys), intent(out) :: sdec @@ -279,7 +279,7 @@ subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & errflg = 0 call radupdate(idate,jdate,deltsw,deltim,lsswr,me,iaermdl, iaerflg,isol,aeros_file,& - slag,sdec,cdec,solcon,con_pi,co2dat_file,co2gbl_file,ictm,ico2,ntoz,errflg,errmsg) + slag,sdec,cdec,solcon,con_pi,co2dat_file,co2gbl_file,ictm,ico2,ntoz,ozphys,errflg,errmsg) end subroutine GFS_rrtmg_setup_timestep_init @@ -327,7 +327,7 @@ end subroutine GFS_rrtmg_setup_finalize !----------------------------------- subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& iaerflg, isol, aeros_file, slag,sdec,cdec,solcon, con_pi, & - co2dat_file,co2gbl_file, ictm, ico2, ntoz, errflg, errmsg) + co2dat_file,co2gbl_file, ictm, ico2, ntoz, ozphys, errflg, errmsg) !................................... ! ================= subprogram documentation block ================ ! @@ -371,6 +371,7 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& ! --- inputs: integer, intent(in) :: idate(:), jdate(:), me, iaermdl, iaerflg, isol, ictm, ntoz, ico2 + type(ty_ozphys),intent(inout) :: ozphys logical, intent(in) :: lsswr character(len=26),intent(in) :: aeros_file,co2dat_file,co2gbl_file @@ -463,8 +464,11 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& lco2_chg = .false. endif - call gas_update ( kyear,kmon,kday,khour,loz1st,lco2_chg, me, co2dat_file, & - co2gbl_file, ictm, ico2, ntoz, errflg, errmsg ) + call gas_update ( kyear,kmon,kday,khour,lco2_chg, me, co2dat_file, & + co2gbl_file, ictm, ico2, errflg, errmsg ) + if (ntoz == 0) then + call ozphys%update_clim(kmon, kday, khour, loz1st) + endif if ( loz1st ) loz1st = .false. diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index f92d6f8db..35713757b 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -2,7 +2,7 @@ name = GFS_rrtmg_setup type = scheme dependencies = iounitdef.f,module_bfmicrophysics.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f - dependencies = module_mp_thompson.F90,radiation_gases.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f,machine.F + dependencies = module_mp_thompson.F90,radiation_gases.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f,machine.F,module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -173,27 +173,6 @@ dimensions = () type = integer intent = in -[levozp] - standard_name = number_of_levels_in_ozone_climotology_data - long_name = number of levels in ozone climotology data - units = count - dimensions = () - type = integer - intent = in -[timeozp] - standard_name = number_of_times_in_ozone_climotology_data - long_name = number of times in ozone climotology data - units = count - dimensions = () - type = integer - intent = in -[latsozp] - standard_name = number_of_latitudes_in_ozone_climotology_data - long_name = number of latitude in ozone climotology data - units = count - dimensions = () - type = integer - intent = in [icliq_sw] standard_name = control_for_shortwave_radiation_liquid_clouds long_name = sw optical property for liquid clouds @@ -530,6 +509,13 @@ dimensions = () type = integer intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = inout [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index dd72a6a1c..9dcc002a0 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -8,7 +8,8 @@ module GFS_rrtmgp_pre use machine, only: kind_phys use funcphys, only: fpvs use module_radiation_astronomy, only: coszmn - use module_radiation_gases, only: NF_VGAS, getgases, getozn + use module_radiation_gases, only: NF_VGAS, getgases + use module_ozphys, only: ty_ozphys use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg,cmp_tlev use rrtmgp_lw_gas_optics, only: lw_gas_props @@ -117,25 +118,23 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl vmr_n2o, vmr_co2, tsfg, tsfa, qs_lay, q_lay, tv_lay, & relhum, deltaZ, deltaZc, deltaP, active_gases_array, & tsfc_radtime, coszen, coszdg, top_at_1, iSFC, iTOA, nDay, idxday, semis, & - sfc_emiss_byband, ico2, latsozc, levozc, blatc, dphiozc, con_pi, errmsg, errflg) + sfc_emiss_byband, ico2, ozphys, con_pi, errmsg, errflg) - ! Inputs + ! Inputs integer, intent(in) :: & me, & ! MPI rank nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers ico2, & ! Flag for co2 radiation scheme - i_o3, & ! Index into tracer array for ozone - latsozc, & ! - levozc + i_o3 ! Index into tracer array for ozone + type(ty_ozphys),intent(in) :: & + ozphys logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad ! Call LW radiation real(kind_phys), intent(in) :: & fhswr, & ! Frequency of SW radiation call. - fhlwr, & ! Frequency of LW radiation call. - blatc, & ! - dphiozc + fhlwr ! Frequency of LW radiation call. real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravitational constant con_rd, & ! Physical constant: gas-constant for dry air @@ -353,9 +352,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl enddo enddo ! OR Use climatological ozone data - else - call getozn (prslk(1:NCOL,:), xlat, nCol, nLev, top_at_1, latsozc, levozc, blatc, & - dphiozc, o3_lay) + else + call ozphys%oz_clim(xlat, prslk, con_pi, o3_lay) endif ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 1a96eee1b..4e2aa3a56 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_pre type = scheme dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_gases.f,radiation_tools.F90,rrtmg_lw_cloud_optics.F90 + dependencies = radiation_astronomy.f,radiation_gases.f,radiation_tools.F90,rrtmg_lw_cloud_optics.F90,module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -503,35 +503,12 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout -[latsozc] - standard_name = number_of_latitudes_in_ozone_climotology_data - long_name = number of latitude in ozone climotology data - units = count - dimensions = () - type = integer - intent = in -[levozc] - standard_name = number_of_levels_in_ozone_climotology_data - long_name = number of levels in ozone climotology data - units = count - dimensions = () - type = integer - intent = in -[dphiozc] - standard_name = ozone_data_parameter_1 - long_name = ozone data parameter 1 - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[blatc] - standard_name = ozone_data_parameter_2 - long_name = ozone data parameter 2 - units = none +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed dimensions = () - type = real - kind = kind_phys + type = ty_ozphys intent = in [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 7b5479e60..3e4f57d13 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -6,6 +6,7 @@ module GFS_rrtmgp_setup use module_radiation_astronomy, only : sol_init, sol_update use module_radiation_aerosols, only : aer_init, aer_update use module_radiation_gases, only : gas_init, gas_update + use module_ozphys, only : ty_ozphys implicit none public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_timestep_init, GFS_rrtmgp_setup_finalize @@ -37,7 +38,7 @@ module GFS_rrtmgp_setup subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & - ntcw, ntoz, iovr, latsozp, levozp, timeozp, isubc_sw, isubc_lw, lalw1bd, idate, & + ntcw, ntoz, iovr, isubc_sw, isubc_lw, lalw1bd, idate, & me, aeros_file, iaermdl, iaerflg, con_pi, con_t0c, con_c, con_boltz, con_plnk, & solar_file, con_solr_2008, con_solr_2002, co2usr_file, co2cyc_file, ipsd0, & errmsg, errflg) @@ -57,8 +58,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, con_pi, con_t0c, con_c, con_boltz, con_plnk, con_solr_2008, con_solr_2002 real(kind_phys), dimension(:), intent(in) :: & si - integer, intent(in) :: levr, ictm, isol, ico2, iaer, & - ntcw, ntoz, iovr, isubc_sw, isubc_lw, latsozp, levozp, timeozp, me + integer, intent(in) :: levr, ictm, isol, ico2, iaer, ntcw, ntoz, iovr, isubc_sw, isubc_lw, me logical, intent(in) :: & lalw1bd integer, intent(in), dimension(:) :: & @@ -129,8 +129,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, call sol_init ( me, isol, solar_file, con_solr_2008, con_solr_2002, con_pi ) call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, con_t0c, & con_c, con_boltz, con_plnk, errflg, errmsg) - call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, ntoz, con_pi, latsozp, & - levozp, timeozp, errflg, errmsg ) + call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) if ( me == 0 ) then print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' @@ -149,7 +148,7 @@ end subroutine GFS_rrtmgp_setup_init !! subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad, me, & iaermdl, aeros_file, isol, slag, sdec, cdec, solcon, con_pi, co2dat_file, & - co2gbl_file, ictm, ico2, ntoz, errmsg, errflg) + co2gbl_file, ictm, ico2, ntoz, ozphys, errmsg, errflg) ! Inputs integer, intent(in) :: idate(:) @@ -161,7 +160,7 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad integer, intent(in) :: me integer, intent(in) :: iaermdl,isol,ictm,ico2,ntoz character(len=26), intent(in) :: aeros_file,co2dat_file,co2gbl_file - + type(ty_ozphys),intent(inout) :: ozphys ! Outputs real(kind_phys), intent(out) :: slag real(kind_phys), intent(out) :: sdec @@ -241,8 +240,11 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad else lco2_chg = .false. endif - call gas_update (kyear, kmon, kday, khour, loz1st, lco2_chg, me, co2dat_file, & - co2gbl_file, ictm, ico2, ntoz, errflg, errmsg ) + call gas_update (kyear, kmon, kday, khour, lco2_chg, me, co2dat_file, co2gbl_file, ictm,& + ico2, errflg, errmsg ) + if (ntoz == 0) then + call ozphys%update_clim(kmon, kday, khour, loz1st) + endif if ( loz1st ) loz1st = .false. diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index c8ed60650..96f7e24e7 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_setup type = scheme dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,radiation_aerosols.f,radiation_astronomy.f - dependencies = module_mp_thompson.F90,radiation_gases.f + dependencies = module_mp_thompson.F90,radiation_gases.f,module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -266,27 +266,6 @@ dimensions = () type = integer intent = inout -[levozp] - standard_name = number_of_levels_in_ozone_climotology_data - long_name = number of levels in ozone climotology data - units = count - dimensions = () - type = integer - intent = in -[timeozp] - standard_name = number_of_times_in_ozone_climotology_data - long_name = number of times in ozone climotology data - units = count - dimensions = () - type = integer - intent = in -[latsozp] - standard_name = number_of_latitudes_in_ozone_climotology_data - long_name = number of latitude in ozone climotology data - units = count - dimensions = () - type = integer - intent = in [iaermdl] standard_name = control_for_aerosol_radiation_scheme long_name = control of aerosol scheme in radiation @@ -410,6 +389,13 @@ dimensions = () type = integer intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = inout [iaermdl] standard_name = control_for_aerosol_radiation_scheme long_name = control of aerosol scheme in radiation diff --git a/physics/module_ozphys.F90 b/physics/module_ozphys.F90 new file mode 100644 index 000000000..966d27113 --- /dev/null +++ b/physics/module_ozphys.F90 @@ -0,0 +1,476 @@ +! ######################################################################################### +!> \section arg_table_module_ozphys Argument table +!! \htmlinclude module_ozphys.html +!! +! ######################################################################################### +module module_ozphys + use machine, only : kind_phys + use funcphys, only : fpkapx + implicit none + + public ty_ozphys + +! ######################################################################################### +!> \section arg_table_ty_ozphys Argument Table +!! \htmlinclude ty_ozphys.html +!! +!! All data field are ordered from surface-to-toa (j=1=isfc) +!! +! ######################################################################################### + type ty_ozphys + ! Prognostic ozone. + integer :: nlat !< Number of latitudes. + integer :: nlev !< Number of vertical layers. + integer :: ntime !< Number of times. + integer :: ncf !< Number of coefficients. + real(kind_phys), allocatable :: lat(:) !< Latitude. + real(kind_phys), allocatable :: pres(:) !< Pressure levels. + real(kind_phys), allocatable :: po3(:) !< Natural log pressure of levels. + real(kind_phys), allocatable :: time(:) !< Time. + real(kind_phys), allocatable :: data(:,:,:,:) !< Ozone forcing data (raw) + ! Climotological ozone. + integer :: nlatc !< Number of latitudes. + integer :: nlevc !< Number of vertical layers. + integer :: ntimec !< Number of times. + real(kind_phys) :: blatc !< Parameter for ozone climotology + real(kind_phys) :: dphiozc !< Parameter for ozone climotology + real(kind_phys), allocatable :: pkstr(:) !< + real(kind_phys), allocatable :: pstr(:) !< + real(kind_phys), allocatable :: datac(:,:,:) !< Ozone climotological data + integer :: k1oz !< Lower interpolation index in datac(dim=3), time dim + integer :: k2oz !< Upper interpolation index in datac(dim=3), time dim + real(kind_phys) :: facoz !< Parameter for ozone climotology + contains + procedure, public :: load_forcing + procedure, public :: load_clim + procedure, public :: setup_forcing + procedure, public :: update_forcing + procedure, public :: update_clim + procedure, public :: oz_prog_2015 + procedure, public :: oz_prog_2006 + procedure, public :: oz_clim + end type ty_ozphys + +contains + ! ######################################################################################### + ! Procedure (type-bound) for loading ozone forcing data. + ! ######################################################################################### + function load_forcing(this, file, fileID) result (err_message) + class(ty_ozphys), intent(inout) :: this + integer, intent(in) :: fileID + character(len=*), intent(in) :: file + character(len=128) :: err_message + integer :: i1, i2, i3 + real(kind=4), dimension(:), allocatable :: lat4, pres4, time4, tempin + real(kind=4) :: blatc4 + + ! Get dimensions from data file + open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian') + read (fileID) this%ncf, this%nlat, this%nlev, this%ntime + rewind(fileID) + + allocate (this%lat(this%nlat)) + allocate (this%pres(this%nlev)) + allocate (this%po3(this%nlev)) + allocate (this%time(this%ntime+1)) + allocate (this%data(this%nlat,this%nlev,this%ncf,this%ntime)) + + allocate(lat4(this%nlat), pres4(this%nlev), time4(this%ntime+1)) + read (fileID) this%ncf, this%nlat, this%nlev, this%ntime, lat4, pres4, time4 + + ! Store + this%pres(:) = pres4(:) + this%po3(:) = log(100.0*this%pres(:)) ! from mb to ln(Pa) + this%lat(:) = lat4(:) + this%time(:) = time4(:) + deallocate(lat4, pres4, time4) + + allocate(tempin(this%nlat)) + do i1=1,this%ntime + do i2=1,this%ncf + do i3=1,this%nlev + read(fileID) tempin + this%data(:,i3,i2,i1) = tempin(:) + enddo + enddo + enddo + deallocate(tempin) + close(fileID) + + end function load_forcing + + ! ######################################################################################### + ! Procedure for setting up interpolation indices between data and model grid. + ! ######################################################################################### + subroutine setup_forcing(this, lat, idx1, idx2, idxh) + class(ty_ozphys), intent(in) :: this + real(kind_phys), intent(in) :: lat(:) + integer, intent(out) :: idx1(:), idx2(:) + real(kind_phys), intent(out) :: idxh(:) + integer :: i,j + + do j=1,size(lat) + idx2(j) = this%nlat + 1 + do i=1,this%nlat + if (lat(j) < this%lat(i)) then + idx2(j) = i + exit + endif + enddo + idx1(j) = max(idx2(j)-1,1) + idx2(j) = min(idx2(j),this%nlat) + if (idx2(j) .ne. idx1(j)) then + idxh(j) = (lat(j) - this%lat(idx1(j))) / (this%lat(idx2(j)) - this%lat(idx1(j))) + else + idxh(j) = 1.0 + endif + enddo + + end subroutine setup_forcing + + ! ######################################################################################### + ! Procedure (type-bound) for updating ozone data. + ! ######################################################################################### + subroutine update_forcing(this, idx1, idx2, idxh, rjday, idxt1, idxt2, ozpl) + class(ty_ozphys), intent(in) :: this + integer, intent(in) :: idx1(:), idx2(:) + real(kind_phys), intent(in) :: idxh(:) + real(kind_phys), intent(in) :: rjday + integer, intent(in) :: idxt1, idxt2 + real(kind_phys), intent(out) :: ozpl(:,:,:) + integer :: nc, l, j, j1, j2 + real(kind_phys) :: tem, tx1, tx2 + + tx1 = (this%time(idxt2) - rjday) / (this%time(idxt2) - this%time(idxt1)) + tx2 = 1.0 - tx1 + + do nc=1,this%ncf + do l=1,this%nlev + do j=1,size(ozpl(:,1,1)) + j1 = idx1(j) + j2 = idx2(j) + tem = 1.0 - idxh(j) + ozpl(j,l,nc) = tx1*(tem*this%data(j1,l,nc,idxt1)+idxh(j)*this%data(j2,l,nc,idxt1)) & + + tx2*(tem*this%data(j1,l,nc,idxt2)+idxh(j)*this%data(j2,l,nc,idxt2)) + enddo + enddo + enddo + + end subroutine update_forcing + + ! ######################################################################################### + ! Procedure (type-bound) for NRL prognostic ozone (2015). + ! ######################################################################################### + subroutine oz_prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, do3_dt_ozmx, & + do3_dt_temp, do3_dt_ohoz) + class(ty_ozphys), intent(in) :: this + real(kind_phys),intent(in) :: & + con_1ovg ! Physical constant: One divided by gravitational acceleration (m-1 s2) + real(kind_phys), intent(in) :: & + dt ! Model timestep (sec) + real(kind_phys), intent(in), dimension(:,:) :: & + p, & ! Model Pressure (Pa) + t, & ! Model temperature (K) + dp ! Model layer thickness (Pa) + real(kind_phys), intent(in), dimension(:,:,:) :: & + ozpl ! Ozone forcing data + real(kind_phys), intent(inout), dimension(:,:) :: & + oz ! Ozone concentration updated by physics + real(kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect + + integer :: k, kmax, kmin, iLev, iCol, nCol, nLev, iCf + logical, dimension(size(p,1)) :: flg + real(kind_phys) :: pmax, pmin, tem, temp + real(kind_phys), dimension(size(p,1)) :: wk1, wk2, wk3, ozib + real(kind_phys), dimension(size(p,1),this%ncf) :: prod + real(kind_phys), dimension(size(p,1),size(p,2)) :: ozi + real(kind_phys), dimension(size(p,1),size(p,2)+1) :: colo3, coloz + + ! Dimensions + nCol = size(p,1) + nLev = size(p,2) + + ! Temporaries + ozi = oz + + colo3(:,nLev+1) = 0.0 + coloz(:,nLev+1) = 0.0 + + do iLev=nLev,1,-1 + pmin = 1.0e10 + pmax = -1.0e10 + + do iCol=1,nCol + wk1(iCol) = log(p(iCol,iLev)) + pmin = min(wk1(iCol), pmin) + pmax = max(wk1(iCol), pmax) + prod(iCol,:) = 0._kind_phys + enddo + kmax = 1 + kmin = 1 + do k=1,this%nlev-1 + if (pmin < this%po3(k)) kmax = k + if (pmax < this%po3(k)) kmin = k + enddo + ! + do k=kmin,kmax + temp = 1.0 / (this%po3(k) - this%po3(k+1)) + do iCol=1,nCol + flg(iCol) = .false. + if (wk1(iCol) < this%po3(k) .and. wk1(iCol) >= this%po3(k+1)) then + flg(iCol) = .true. + wk2(iCol) = (wk1(iCol) - this%po3(k+1)) * temp + wk3(iCol) = 1.0 - wk2(iCol) + endif + enddo + do iCf=1,this%ncf + do iCol=1,nCol + if (flg(iCol)) then + prod(iCol,iCf) = wk2(iCol) * ozpl(iCol,k,iCf) + wk3(iCol) * ozpl(iCol,k+1,iCf) + endif + enddo + enddo + enddo + + do iCf=1,this%ncf + do iCol=1,nCol + if (wk1(iCol) < this%po3(this%nlev)) then + prod(iCol,iCf) = ozpl(iCol,this%nlev,iCf) + endif + if (wk1(iCol) >= this%po3(1)) then + prod(iCol,iCf) = ozpl(iCol,1,iCf) + endif + enddo + enddo + do iCol=1,nCol + colo3(iCol,iLev) = colo3(iCol,iLev+1) + ozi(iCol,iLev) * dp(iCol,iLev)*con_1ovg + coloz(iCol,iLev) = coloz(iCol,iLev+1) + prod(iCol,6) * dp(iCol,iLev)*con_1ovg + prod(iCol,2) = min(prod(iCol,2), 0.0) + enddo + do iCol=1,nCol + ozib(iCol) = ozi(iCol,iLev) ! no filling + tem = prod(iCol,1) - prod(iCol,2) * prod(iCol,6) & + + prod(iCol,3) * (t(iCol,iLev) - prod(iCol,5)) & + + prod(iCol,4) * (colo3(iCol,iLev)-coloz(iCol,iLev)) + oz(iCol,iLev) = (ozib(iCol) + tem*dt) / (1.0 - prod(iCol,2)*dt) + enddo + + ! Diagnostics (optional) + if (associated(do3_dt_prd)) do3_dt_prd(:,iLev) = (prod(:,1)-prod(:,2)*prod(:,6))*dt + if (associated(do3_dt_ozmx)) do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) + if (associated(do3_dt_temp)) do3_dt_temp(:,iLev) = prod(:,3)*(t(:,iLev)-prod(:,5))*dt + if (associated(do3_dt_ohoz)) do3_dt_ohoz(:,iLev) = prod(:,4) * (colo3(:,iLev)-coloz(:,iLev))*dt + enddo + + return + end subroutine oz_prog_2015 + + ! ######################################################################################### + ! Procedure (type-bound) for NRL prognostic ozone (2006). + ! ######################################################################################### + subroutine oz_prog_2006(this) + class(ty_ozphys), intent(in) :: this + return + end subroutine oz_prog_2006 + + ! ######################################################################################### + ! Procedure (type-bound) for NRL updating climotological ozone. + ! Build this up from getozn. + ! ######################################################################################### + subroutine oz_clim(this, lat, prslk, con_pi, oz) + class(ty_ozphys), intent(in) :: this + real(kind_phys), intent(in) :: & + con_pi ! Physics constant: Pi + real(kind_phys), intent(in), dimension(:) :: & + lat ! Grid latitude + real(kind_phys), intent(in), dimension(:,:) :: & + prslk ! Exner function + real(kind_phys), intent(out), dimension(:,:) :: & + oz ! Ozone concentration updated by climotology + + integer :: nCol, iCol, nLev, iLev, j, j1, j2, l, ll + real(kind_phys) :: elte, deglat, tem, tem1, tem2, tem3, tem4, temp + real(kind_phys), allocatable :: o3i(:,:),wk1(:) + logical :: top_at_1 + + nCol = size(prslk(:,1)) + nLev = size(prslk(1,:)) + allocate(o3i(nCol, this%nlevc),wk1(nCol)) + + ! What is vertical ordering? + top_at_1 = (prslk(1,1) .lt. prslk(1, nLev)) + + elte = this%blatc + (this%nlatc-1)*this%dphiozc + + do iCol = 1, nCol + deglat = lat(iCol) * 180.0 / con_pi + if (deglat > this%blatc .and. deglat < elte) then + tem1 = (deglat - this%blatc) / this%dphiozc + 1 + j1 = tem1 + j2 = j1 + 1 + tem1 = tem1 - j1 + elseif (deglat <= this%blatc) then + j1 = 1 + j2 = 1 + tem1 = 1.0 + elseif (deglat >= elte) then + j1 = this%nlatc + j2 = this%nlatc + tem1 = 1.0 + endif + + tem2 = 1.0 - tem1 + do j = 1, this%nlevc + tem3 = tem2*this%datac(j1,j,this%k1oz) + tem1*this%datac(j2,j,this%k1oz) + tem4 = tem2*this%datac(j1,j,this%k2oz) + tem1*this%datac(j2,j,this%k2oz) + o3i(iCol,j) = tem4*this%facoz + tem3*(1.0 - this%facoz) + enddo + enddo + + do iLev = 1, nLev + ll = iLev + if (.not. top_at_1) ll = nLev - iLev + 1 + + do iCol = 1, nCol + wk1(iCol) = prslk(iCol,ll) + enddo + + do j = 1, this%nlevc-1 + temp = 1.0 / (this%pkstr(j+1) - this%pkstr(j)) + do iCol = 1, nCol + if (wk1(iCol) > this%pkstr(j) .and. wk1(iCol) <= this%pkstr(j+1)) then + tem = (this%pkstr(j+1) - wk1(iCol)) * temp + oz(iCol,ll) = tem * o3i(iCol,j) + (1.0 - tem) * o3i(iCol,j+1) + endif + enddo + enddo + + do iCol = 1, nCol + if (wk1(iCol) > this%pkstr(this%nlevc)) oz(iCol,ll) = o3i(iCol,this%nlevc) + if (wk1(iCol) < this%pkstr(1)) oz(iCol,ll) = o3i(iCol,1) + enddo + enddo + + return + end subroutine oz_clim + + ! ######################################################################################### + ! Procedure (type-bound) for loading ozone climo data. + ! ######################################################################################### + function load_clim(this, file, fileID) result (err_message) + class(ty_ozphys), intent(inout) :: this + integer, intent(in) :: fileID + character(len=*), intent(in) :: file + character(len=128) :: err_message + + ! Locals + real(kind=4) :: blatc4 + integer :: iLev, iLat, imo + real(kind=4), allocatable :: o3clim4(:,:,:), pstr4(:) + integer, allocatable :: imond(:), ilatt(:,:) + + open(unit=fileID,file=trim(file), form='unformatted', convert='big_endian') + read (fileID,end=101) this%nlatc, this%nlevc, this%ntimec, blatc4 +101 if (this%nlevc < 10 .or. this%nlevc > 100) then + rewind (fileID) + this%nlevc = 17 + this%nlatc = 18 + this%blatc = -85.0 + else + this%blatc = blatc4 + endif + this%nlat = 2 + this%nlev = 1 + this%ntimec = 1 + this%ncf = 0 + this%dphiozc = -(this%blatc+this%blatc)/(this%nlatc-1) + + allocate (o3clim4(this%nlatc,this%nlevc,12), pstr4(this%nlevc), imond(12), ilatt(this%nlatc,12) ) + + allocate (this%pkstr(this%nlevc), this%pstr(this%nlevc), this%datac(this%nlatc,this%nlevc,12)) + if ( this%nlevc == 17 ) then ! For the operational ozone climatology + do iLev = 1, this%nlevc + read (fileID,15) pstr4(iLev) +15 format(f10.3) + enddo + + do imo = 1, 12 + do iLat = 1, this%nlatc + read (fileID,16) imond(imo), ilatt(iLat,imo), (o3clim4(iLat,iLev,imo),iLev=1,10) +16 format(i2,i4,10f6.2) + read (fileID,20) (o3clim4(iLat,iLev,imo),iLev=11,this%nlevc) +20 format(6x,10f6.2) + enddo + enddo + else ! For newer ozone climatology + read (fileID) + do iLev = 1, this%nlevc + read (fileID) pstr4(iLev) + enddo + + do imo = 1, 12 + do iLev = 1, this%nlevc + read (fileID) (o3clim4(iLat,iLev,imo),iLat=1,this%nlatc) + enddo + enddo + endif ! end if_this%nlevc_block + + do imo = 1, 12 + do iLev = 1, this%nlevc + do iLat = 1, this%nlatc + this%datac(iLat,iLev,imo) = o3clim4(iLat,iLev,imo) * 1.655e-6 + enddo + enddo + enddo + + do iLev = 1, this%nlevc + this%pstr(iLev) = pstr4(iLev) + this%pkstr(iLev) = fpkapx(this%pstr(iLev)*100.0) + enddo + + end function load_clim + + ! ######################################################################################### + ! Procedure (type-bound) for updating ozone climotological data. + ! ######################################################################################### + subroutine update_clim(this, imon, iday, ihour, loz1st) + class(ty_ozphys), intent(inout) :: this + integer, intent(in) :: imon, iday, ihour + logical, intent(in) :: loz1st + + integer :: midmon=15, midm=15, midp=45, id + integer, parameter, dimension(13) :: mdays = (/31,28,31,30,31,30,31,31,30,31,30,31,30/) + logical :: change + + midmon = mdays(imon)/2 + 1 + change = loz1st .or. ( (iday==midmon) .and. (ihour==0) ) + + if ( change ) then + if ( iday < midmon ) then + this%k1oz = mod(imon+10, 12) + 1 + midm = mdays(this%k1oz)/2 + 1 + this%k2oz = imon + midp = mdays(this%k1oz) + midmon + else + this%k1oz = imon + midm = midmon + this%k2oz = mod(imon, 12) + 1 + midp = mdays(this%k2oz)/2 + 1 + mdays(this%k1oz) + endif + endif + + if (iday < midmon) then + id = iday + mdays(this%k1oz) + else + id = iday + endif + + this%facoz = float(id - midm) / float(midp - midm) + + end subroutine update_clim + +end module module_ozphys diff --git a/physics/module_ozphys.meta b/physics/module_ozphys.meta new file mode 100644 index 000000000..2922d16d7 --- /dev/null +++ b/physics/module_ozphys.meta @@ -0,0 +1,24 @@ +[ccpp-table-properties] + name = ty_ozphys + type = ddt + dependencies = + +[ccpp-arg-table] + name = ty_ozphys + type = ddt + +######################################################################## +[ccpp-table-properties] + name = module_ozphys + type = module + dependencies = machine.F,funcphys.f90 + +[ccpp-arg-table] + name = module_ozphys + type = module +[ty_ozphys] + standard_name = ty_ozphys + long_name = definition of type ty_ozphys + units = DDT + dimensions = () + type = ty_ozphys \ No newline at end of file diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 index 47386bd6e..1478d0d6e 100644 --- a/physics/ozphys_2015.F90 +++ b/physics/ozphys_2015.F90 @@ -3,89 +3,57 @@ !! ! ########################################################################################### module ozphys_2015 - use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec + use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec + use module_ozphys, only: ty_ozphys implicit none - public ozphys_2015_init, ozphys_2015_run + public ozphys_2015_run contains ! ########################################################################################### !>\defgroup GFS_ozphys_2015 GFS Ozone Photochemistry (2015) Module !! This module contains the CCPP-compliant Ozone 2015 photochemistry scheme. !> @{ -!> The operational GFS currently parameterizes ozone production and -!! destruction based on monthly mean coefficients ( -!! \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by Naval -!! Research Laboratory through CHEM2D chemistry model +!> The operational GFS currently parameterizes ozone production and destruction based on +!! monthly mean coefficients ( \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by +!! Naval Research Laboratory through CHEM2D chemistry model !! (McCormack et al. (2006) \cite mccormack_et_al_2006). !! (https://doi.org/10.5194/acp-6-4943-2006) !! !> \section genal_ozphys_2015 GFS ozphys_2015_run General Algorithm -!> - This code assumes that both prsl and po3 are from bottom to top -!! as are all other variables. -!> - This code is specifically for NRL parameterization and -!! climatological T and O3 are in location 5 and 6 of oz_data array +!> - This code assumes that both 2D fields are ordered from bottom to top. +!> - This code is specifically for NRL parameterization and climatological T and O3 are in +! location 5 and 6 of ozpl array !!\author June 2015 - Shrinivas Moorthi !!\modified May 2023 - Dustin Swales ! ########################################################################################### -! ########################################################################################### -! SUBROUTINE ozphys_2015_init -! ########################################################################################### -!! \section arg_table_ozphys_2015_init Argument Table -!! \htmlinclude ozphys_2015_init.html -!! - subroutine ozphys_2015_init(oz_phys, errmsg, errflg) - ! Inputs - logical, intent(in) :: & - oz_phys - ! Outputs - character(len=*), intent(out) :: & - errmsg - integer, intent(out) :: & - errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Sanity check - if (.not.oz_phys) then - write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' - errflg = 1 - return - endif - - end subroutine ozphys_2015_init - ! ########################################################################################### ! SUBROUTINE ozphys_2015_run ! ########################################################################################### !! \section arg_table_ozphys_2015_run Argument Table !! \htmlinclude ozphys_2015_run.html !! - subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_data, & - pl_coeff, delp, con_1ovg, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) + subroutine ozphys_2015_run (oz_phys, ozphys, nCol, nLev, dt, oz, tin, prsl, ozpl, & + delp, con_1ovg, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) ! Inputs logical, intent(in) :: & oz_phys ! Flag for ozone_physics_2015 scheme. + type(ty_ozphys),intent(in) :: & + ozphys real(kind_phys),intent(in) :: & con_1ovg ! Physical constant: One divided by gravitational acceleration (m-1 s2) integer, intent(in) :: & - im, & ! Horizontal dimension - levs, & ! Number of vertical layers - ko3, & ! Number of vertical layers in ozone forcing data - pl_coeff ! Number of coefficients in ozone forcing data + nCol, & ! Horizontal dimension + nLev ! Number of vertical layers real(kind_phys), intent(in) :: & dt ! Physics timestep (seconds) - real(kind_phys), intent(in), dimension(:) :: & - po3 ! Natural log of ozone forcing data pressure levels real(kind_phys), intent(in), dimension(:,:) :: & prsl, & ! Air-pressure (Pa) tin, & ! Temperature of new-state (K) delp ! Difference between mid-layer pressures (Pa) real(kind_phys), intent(in), dimension(:,:,:) :: & - oz_data ! Ozone forcing data + ozpl ! Ozone forcing data ! Outputs (optional) real(kind=kind_phys), intent(inout), dimension(:,:), pointer, optional :: & @@ -96,26 +64,26 @@ subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_d ! Outputs real(kind=kind_phys), intent(inout), dimension(:,:) :: & - oz ! Ozone concentration updated by physics + oz ! Ozone concentration updated by physics character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag + errflg ! CCPP error flag ! Locals integer :: k, kmax, kmin, l, i, j - logical, dimension(im) :: flg + logical, dimension(nCol) :: flg real(kind_phys) :: pmax, pmin, tem, temp - real(kind_phys), dimension(im) :: wk1, wk2, wk3, ozib - real(kind_phys), dimension(im,pl_coeff) :: prod - real(kind_phys), dimension(im,levs) :: ozi - real(kind_phys), dimension(im,levs+1) :: colo3, coloz + real(kind_phys), dimension(nCol) :: wk1, wk2, wk3, ozib + real(kind_phys), dimension(nCol,ozphys%ncf) :: prod + real(kind_phys), dimension(nCol,nLev) :: ozi + real(kind_phys), dimension(nCol,nLev+1) :: colo3, coloz ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - ! Sanity checkt + ! Sanity checks if (.not.oz_phys) then write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' errflg = 1 @@ -125,14 +93,14 @@ subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_d ! Temporaries ozi = oz - colo3(:,levs+1) = 0.0 - coloz(:,levs+1) = 0.0 + colo3(:,nLev+1) = 0.0 + coloz(:,nLev+1) = 0.0 - do l=levs,1,-1 + do l=nLev,1,-1 pmin = 1.0e10 pmax = -1.0e10 - do i=1,im + do i=1,nCol wk1(i) = log(prsl(i,l)) pmin = min(wk1(i), pmin) pmax = max(wk1(i), pmax) @@ -140,46 +108,46 @@ subroutine ozphys_2015_run (oz_phys, im, levs, ko3, dt, oz, tin, po3, prsl, oz_d enddo kmax = 1 kmin = 1 - do k=1,ko3-1 - if (pmin < po3(k)) kmax = k - if (pmax < po3(k)) kmin = k + do k=1,ozphys%nlev-1 + if (pmin < ozphys%po3(k)) kmax = k + if (pmax < ozphys%po3(k)) kmin = k enddo ! do k=kmin,kmax - temp = 1.0 / (po3(k) - po3(k+1)) - do i=1,im + temp = 1.0 / (ozphys%po3(k) - ozphys%po3(k+1)) + do i=1,nCol flg(i) = .false. - if (wk1(i) < po3(k) .and. wk1(i) >= po3(k+1)) then + if (wk1(i) < ozphys%po3(k) .and. wk1(i) >= ozphys%po3(k+1)) then flg(i) = .true. - wk2(i) = (wk1(i) - po3(k+1)) * temp + wk2(i) = (wk1(i) - ozphys%po3(k+1)) * temp wk3(i) = 1.0 - wk2(i) endif enddo - do j=1,pl_coeff - do i=1,im + do j=1,ozphys%ncf + do i=1,nCol if (flg(i)) then - prod(i,j) = wk2(i) * oz_data(i,k,j) + wk3(i) * oz_data(i,k+1,j) + prod(i,j) = wk2(i) * ozpl(i,k,j) + wk3(i) * ozpl(i,k+1,j) endif enddo enddo enddo - do j=1,pl_coeff - do i=1,im - if (wk1(i) < po3(ko3)) then - prod(i,j) = oz_data(i,ko3,j) + do j=1,ozphys%ncf + do i=1,nCol + if (wk1(i) < ozphys%po3(ozphys%nlev)) then + prod(i,j) = ozpl(i,ozphys%nlev,j) endif - if (wk1(i) >= po3(1)) then - prod(i,j) = oz_data(i,1,j) + if (wk1(i) >= ozphys%po3(1)) then + prod(i,j) = ozpl(i,1,j) endif enddo enddo - do i=1,im + do i=1,nCol colo3(i,l) = colo3(i,l+1) + ozi(i,l) * delp(i,l)*con_1ovg coloz(i,l) = coloz(i,l+1) + prod(i,6) * delp(i,l)*con_1ovg prod(i,2) = min(prod(i,2), 0.0) enddo - do i=1,im + do i=1,nCol ozib(i) = ozi(i,l) ! no filling tem = prod(i,1) - prod(i,2) * prod(i,6) + prod(i,3) * (tin(i,l) - prod(i,5)) & + prod(i,4) * (colo3(i,l)-coloz(i,l)) diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 1d8fba74e..ca2d56e4e 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] name = ozphys_2015 type = scheme - dependencies = machine.F + dependencies = machine.F,module_ozphys.F90 ######################################################################## [ccpp-arg-table] - name = ozphys_2015_init + name = ozphys_2015_run type = scheme [oz_phys] standard_name = flag_for_nrl_2015_ozone_scheme @@ -14,54 +14,27 @@ dimensions = () type = logical intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = ozphys_2015_run - type = scheme -[oz_phys] - standard_name = flag_for_nrl_2015_ozone_scheme - long_name = flag for new (2015) ozone physics - units = flag +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed dimensions = () - type = logical + type = ty_ozphys intent = in -[im] +[nCol] standard_name = horizontal_loop_extent long_name = horizontal loop extent units = count dimensions = () type = integer intent = in -[levs] +[nLev] standard_name = vertical_layer_dimension long_name = number of vertical layers units = count dimensions = () type = integer intent = in -[ko3] - standard_name = number_of_levels_in_ozone_data - long_name = number of vertical layers in ozone forcing data - units = count - dimensions = () - type = integer - intent = in [dt] standard_name = timestep_for_physics long_name = physics time step @@ -86,14 +59,6 @@ type = real kind = kind_phys intent = in -[po3] - standard_name = natural_log_of_ozone_data_pressure_levels - long_name = natural log of ozone forcing data pressure levels - units = 1 - dimensions = (number_of_levels_in_ozone_data) - type = real - kind = kind_phys - intent = in [prsl] standard_name = air_pressure long_name = mid-layer pressure @@ -102,7 +67,7 @@ type = real kind = kind_phys intent = in -[oz_data] +[ozpl] standard_name = ozone_forcing long_name = ozone forcing data units = mixed @@ -110,13 +75,6 @@ type = real kind = kind_phys intent = in -[pl_coeff] - standard_name = number_of_coefficients_in_ozone_data - long_name = number of coefficients in ozone forcing data - units = count - dimensions = () - type = integer - intent = in [delp] standard_name = air_pressure_difference_between_midlayers long_name = difference between mid-layer pressures diff --git a/physics/ozphys_time_vary.F90 b/physics/ozphys_time_vary.F90 deleted file mode 100644 index ddac1dcd4..000000000 --- a/physics/ozphys_time_vary.F90 +++ /dev/null @@ -1,165 +0,0 @@ -! ########################################################################################### -!> \file ozphys_time_vary.F90 -!! -! ########################################################################################### -module ozphys_time_vary - use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec - implicit none - public ozphys_time_vary_init, ozphys_time_vary_timestep_init -contains - -! ########################################################################################### -!>\defgroup GFS Ozone Data Module -!! This module updates the ozone data used by physics. -!> @{ -!> \section arg_table_ozphys_time_vary_init Argument Table -!! \htmlinclude ozphys_time_vary_init.html -!! -! ########################################################################################### - subroutine ozphys_time_vary_init(nPts, latsozp, oz_lat, dlat, jindx1, jindx2, ddy, & - errmsg, errflg) - ! Inputs - integer, intent(in) :: & - nPts, & ! Horizontal dimension - latsozp ! Number of latitudes in ozone data - real(kind_phys), intent(in), dimension(:) :: & - oz_lat, & ! Latitudes of ozone data - dlat ! Latitudes of grid - ! Outputs - integer, intent(inout), dimension(:) :: & - jindx1, & ! Interpolation index (low) for ozone data - jindx2 ! Interpolation index (high) for ozone data - real(kind_phys), intent(inout), dimension(:) :: & - ddy ! Interpolation high index for ozone data - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - - ! Local - integer i,j - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Set indices - do j=1,nPts - jindx2(j) = latsozp + 1 - do i=1,latsozp - if (dlat(j) < oz_lat(i)) then - jindx2(j) = i - exit - endif - enddo - jindx1(j) = max(jindx2(j)-1,1) - jindx2(j) = min(jindx2(j),latsozp) - if (jindx2(j) .ne. jindx1(j)) then - ddy(j) = (dlat(j) - oz_lat(jindx1(j))) / (oz_lat(jindx2(j)) - oz_lat(jindx1(j))) - else - ddy(j) = 1.0 - endif - enddo - - end subroutine ozphys_time_vary_init - -! ########################################################################################### -!> \section arg_table_ozphys_time_vary_timestep_init Argument Table -!! \htmlinclude ozphys_time_vary_timestep_init.html -!! -! ########################################################################################### - subroutine ozphys_time_vary_timestep_init(nPts, idate, fhour, jindx1, jindx2, latsozp, & - levozp, oz_coeff, timeoz, ozplin, oz_time, oz_lat, ddy, oz_data, errmsg, errflg) - ! Inputs - integer, intent(in) :: & - nPts, & ! Horizontal dimension - latsozp, & ! Number of latitudes in ozone data - levozp, & ! Number of vertical layers in ozone data - oz_coeff, & ! Number of coefficients in ozone data - timeoz ! Number of times in ozone data - integer, intent(in),dimension(:) :: & - idate, & ! Initial date with different size and ordering - jindx1, & ! Interpolation index (low) for ozone - jindx2 ! Interpolation index (high) for ozone - real(kind_phys), intent(in) :: & - fhour ! Forecast hour - real(kind_phys), intent(in), dimension(:) :: & - ddy, & ! Interpolation high index for ozone data - oz_lat, & ! Latitudes for ozone data - oz_time ! Time for ozone data - real(kind_phys), intent(in), dimension(:,:,:,:) :: & - ozplin ! Ozone data - - ! Outputs - real(kind_phys), intent(inout), dimension(:,:,:) :: & - oz_data ! Ozone forcing data - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - - ! Local - integer :: idat(8),jdat(8),iday,j,j1,j2,l,nc,n1,n2,jdow,jdoy,& - jday,w3kindreal,w3kindint - real(kind_phys) :: tem, tx1, tx2, rjday - real(kind_dbl_prec) :: rinc(5) - real(kind_sngl_prec) :: rinc4(5) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! - idat=0 - idat(1)=idate(4) - idat(2)=idate(2) - idat(3)=idate(3) - idat(5)=idate(1) - rinc=0. - rinc(2)=fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL w3movdat(rinc4,idat,jdat) - else - CALL w3movdat(rinc,idat,jdat) - endif - ! - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jdat,jdow,jdoy,jday) - rjday = jdoy + jdat(5) / 24. - IF (RJDAY < oz_time(1)) RJDAY = RJDAY + 365. - ! - n2 = timeoz + 1 - do j=2,timeoz - if (rjday < oz_time(j)) then - n2 = j - exit - endif - enddo - n1 = n2 - 1 - - tx1 = (oz_time(n2) - rjday) / (oz_time(n2) - oz_time(n1)) - tx2 = 1.0 - tx1 - - if (n2 > timeoz) n2 = n2 - timeoz - ! - do nc=1,oz_coeff - do L=1,levozp - do J=1,npts - J1 = jindx1(J) - J2 = jindx2(J) - TEM = 1.0 - ddy(J) - oz_data(j,L,nc) = tx1*(TEM*ozplin(J1,L,nc,n1)+ddy(J)*ozplin(J2,L,nc,n1)) & - + tx2*(TEM*ozplin(J1,L,nc,n2)+ddy(J)*ozplin(J2,L,nc,n2)) - enddo - enddo - enddo - - return - - end subroutine ozphys_time_vary_timestep_init -!> @} -end module ozphys_time_vary diff --git a/physics/ozphys_time_vary.meta b/physics/ozphys_time_vary.meta deleted file mode 100644 index 75b8b8e4f..000000000 --- a/physics/ozphys_time_vary.meta +++ /dev/null @@ -1,200 +0,0 @@ -[ccpp-table-properties] - name = ozphys_time_vary - type = scheme - dependencies = machine.F - -######################################################################## -[ccpp-arg-table] - name = ozphys_time_vary_init - type = scheme -[nPts] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[latsozp] - standard_name = number_of_latitudes_in_ozone_data - long_name = number of latitude in ozone data - units = count - dimensions = () - type = integer - intent = in -[oz_lat] - standard_name = ozone_data_latitude - long_name = ozone data latitude - units = deg - dimensions = (number_of_latitudes_in_ozone_data) - type = real - kind = kind_phys - intent = in -[dlat] - standard_name = latitude_in_degree - long_name = latitude in degree north - units = degree_north - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[jindx1] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout -[jindx2] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout -[ddy] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = ozphys_time_vary_timestep_init - type = scheme -[nPts] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[idate] - standard_name = date_and_time_at_model_initialization_in_united_states_order - long_name = initial date with different size and ordering - units = none - dimensions = (4) - type = integer - intent = in -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in -[jindx1] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[jindx2] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[latsozp] - standard_name = number_of_latitudes_in_ozone_data - long_name = number of latitude in ozone data - units = count - dimensions = () - type = integer - intent = in -[levozp] - standard_name = number_of_levels_in_ozone_data - long_name = number of levels in ozone data - units = count - dimensions = () - type = integer - intent = in -[oz_coeff] - standard_name = number_of_coefficients_in_ozone_data - long_name = number of coefficients in ozone data - units = count - dimensions = () - type = integer - intent = in -[timeoz] - standard_name = number_of_times_in_ozone_data - long_name = number of times in ozone data - units = count - dimensions = () - type = integer - intent = in -[ozplin] - standard_name = ozone_data - long_name = ozone data - units = 1 - dimensions = (number_of_latitudes_in_ozone_data,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data,number_of_times_in_ozone_data) - type = real - kind = kind_phys - intent = in -[oz_time] - standard_name = ozone_data_time - long_name = ozone data time - units = none - dimensions = (13) - type = real - kind = kind_phys - intent = in -[oz_lat] - standard_name = ozone_data_latitude - long_name = ozone data latitude - units = deg - dimensions = (number_of_latitudes_in_ozone_data) - type = real - kind = kind_phys - intent = in -[ddy] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in -[oz_data] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_dimension,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/radiation_gases.f b/physics/radiation_gases.f index 5f017598f..4c626b348 100644 --- a/physics/radiation_gases.f +++ b/physics/radiation_gases.f @@ -1,17 +1,14 @@ !> \file radiation_gases.f -!! This file contains routines that set up ozone climatological -!! profiles and other constant gas profiles, such as co2, ch4, n2o, -!! o2, and those of cfc gases. All data are entered as mixing ratio -!! by volume, except ozone which is mass mixing ratio (g/g). +!! This file contains routines that set up gas profiles, such as co2, +!! ch4, n2o, o2, and those of cfc gases. All data are entered as mixing +!! ratio by volume ! ========================================================== !!!!! ! 'module_radiation_gases' description !!!!! ! ========================================================== !!!!! ! ! -! set up ozone climatological profiles and other constant gas ! -! profiles, such as co2, ch4, n2o, o2, and those of cfc gases. All ! -! data are entered as mixing ratio by volume, except ozone which is ! -! mass mixing ratio (g/g). ! +! set up constant gas profiles, such as co2, ch4, n2o, o2, and those ! +! of cfc gases. All data are entered as mixing ratio by volume ! ! ! ! in the module, the externally callabe subroutines are : ! ! ! @@ -23,16 +20,10 @@ ! ! ! 'gas_update' -- read in data and update with time ! ! input: ! -! ( iyear, imon, iday, ihour, loz1st, ldoco2, me ) ! +! ( iyear, imon, iday, ihour, ldoco2, me ) ! ! output: ! ! ( errflg, errmsg ) ! ! ! -! 'getozn' -- setup climatological ozone profile ! -! input: ! -! ( prslk,xlat, ! -! IMAX, LM ) ! -! output: ! -! ( o3mmr ) ! ! ! ! 'getgases' -- setup constant gas profiles for LW and SW ! ! input: ! @@ -47,7 +38,6 @@ ! 'module module_iounitdef' in 'iounitdef.f' ! ! ! ! unit used for radiative active gases: ! -! ozone : mass mixing ratio (g/g) ! ! co2 : volume mixing ratio (p/p) ! ! n2o : volume mixing ratio (p/p) ! ! ch4 : volume mixing ratio (p/p) ! @@ -81,15 +71,6 @@ ! seasonal cycle calculations ! ! aug 2011 - y-t hou fix a bug in subr getgases doing vertical ! ! co2 mapping. (for top_at_1 case, not affact opr). ! -! aug 2012 - y-t hou modified subr getozn. moved the if-first ! -! block to subr gas_init to ensure threading safe in ! -! climatology ozone applications. (not affect gfs) ! -! also changed the initialization subr into two parts:! -! 'gas_init' is called at the start of run to set up ! -! module parameters; and 'gas_update' is called within! -! the time loop to check and update data sets. defined! -! the climatology ozone parameters k1oz,k2oz,facoz as ! -! module variables and are set in subr 'gas_update' ! ! nov 2012 - y-t hou modified control parameters thru module ! ! 'physparam'. ! ! jan 2013 - z. janjic/y. hou modified ilon (longitude index) ! @@ -105,10 +86,8 @@ !> \defgroup module_radiation_gases_mod Radiation Gases Module !> @{ -!> This module sets up ozone climatological profiles and other constant -!! gas profiles, such as co2, ch4, n2o, o2, and those of cfc gases. All -!! data are entered as mixing ratio by volume, except ozone which is -!! mass mixing ratio (g/g). +!> This module sets up constant gas profiles, such as co2, ch4, n2o, o2, +!! and those of cfc gases. All data are entered as mixing ratio by volume. !!\image html rad_gas_AGGI.png "Figure 1: Atmospheric radiative forcing, relative to 1750, by long-lived greenhouse gases and the 2016 update of the NOAA Annual Greenhouse Gas Index (AGGI)" !! NOAA Annual Greenhouse Gas Index (AGGI) shows that from 1990 to 2016, !! radiative forcing by long-lived greenhouse gases (LLGHGs) increased by @@ -121,10 +100,6 @@ !!\n ICO2=1: use observed global annual mean value !!\n ICO2=2: use observed monthly 2-d data table in \f$15^o\f$ horizontal resolution !! -!! O3 Distribution (namelist control parameter -\b NTOZ): -!!\n NTOZ=0: use seasonal and zonal averaged climatological ozone -!!\n NTOZ>0: use 3-D prognostic ozone -!! !! Trace Gases (currently using the global mean climatology in unit of ppmv): !! \f$CH_4-1.50\times10^{-6}\f$; !! \f$N_2O-0.31\times10^{-6}\f$; @@ -137,8 +112,8 @@ !! !!\version NCEP-Radiation_gases v5.1 Nov 2012 -!> This module sets up ozone climatological profiles and other constant gas -!! profiles, such as co2, ch4, n2o, o2, and those of cfc gases. +!> This module sets up constant gas rofiles, such as co2, ch4, n2o, o2, and those +!! of cfc gases. module module_radiation_gases use machine, only : kind_phys, kind_io4 use funcphys, only : fpkapx @@ -179,22 +154,8 @@ module module_radiation_gases ! gfdl 1999 value real (kind=kind_phys), parameter :: f113vmr_def= 8.2000e-11 -! --- ozone seasonal climatology parameters defined in module ozne_def -! - 4x5 ozone data parameter -! integer, parameter :: JMR=45, LOZ=17 -! real (kind=kind_phys), parameter :: blte=-86.0, dlte=4.0 -! - geos ozone data -! integer, parameter :: JMR=18, LOZ=17 -! real (kind=kind_phys), parameter :: blte=-85.0, dlte=10.0 - ! --- module variables to be set in subroutin gas_init and/or gas_update -! variables for climatology ozone (ioznflg = 0) - - real (kind=kind_phys), allocatable :: pkstr(:), o3r(:,:,:) - integer :: k1oz = 0, k2oz = 0 - real (kind=kind_phys) :: facoz = 0.0 - ! arrays for co2 2-d monthly data and global mean values from observed data real (kind=kind_phys), allocatable :: co2vmr_sav(:,:,:) @@ -209,33 +170,30 @@ module module_radiation_gases ! --- public interfaces - public gas_init, gas_update, getgases, getozn + public gas_init, gas_update, getgases ! ================= contains ! ================= -!> This subroutine sets up ozone, co2, etc. parameters. If climatology -!! ozone then read in monthly ozone data. +!> This subroutine sets up co2, etc. parameters. !!\param me print message control flag !!\param co2usr_file co2 user defined data table !!\param co2cyc_file co2 climotology monthly cycle data table !!\param ictmflg data ic time/date control flag !!\param ico2flg co2 data source control flag -!!\param ioznflg ozone data control flag !!\param con_pi physical constant Pi !!\param errflg error flag !!\param errmsg error message !>\section gas_init_gen gas_init General Algorithm !----------------------------------- subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & - & ictmflg, ioznflg, con_pi, JMR, LOZ, timeozc, errflg, errmsg) + & ictmflg, con_pi, errflg, errmsg) ! =================================================================== ! ! ! -! gas_init sets up ozone, co2, etc. parameters. if climatology ozone ! -! then read in monthly ozone data. ! +! gas_init sets up co2, etc. parameters. ! ! ! ! inputs: ! ! me - print message control flag ! @@ -256,9 +214,6 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & ! further data extrapolation. ! ! =yyyy1: use yyyy data for the fcst. if needed, do ! ! extrapolation to match the fcst time. ! -! ioznflg - ozone data control flag ! -! =0: use climatological ozone profile ! -! >0: use interactive ozone profile ! ! co2usr_file - external co2 user defined data table ! ! co2cyc_file - external co2 climotology monthly cycle data table ! ! con_pi - physical constant Pi ! @@ -267,9 +222,6 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & ! errflg - error flag ! ! errmsg - error message ! ! ! -! internal module variables: ! -! pkstr, o3r - arrays for climatology ozone data ! -! ! ! usage: call gas_init ! ! ! ! subprograms called: none ! @@ -279,8 +231,7 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & implicit none ! --- inputs: - integer, intent(in) :: me, ictmflg, ioznflg, ico2flg - integer, intent(in) :: JMR, LOZ, timeozc + integer, intent(in) :: me, ictmflg, ico2flg character(len=26),intent(in) :: co2usr_file,co2cyc_file real(kind=kind_phys), intent(in) :: con_pi @@ -291,10 +242,7 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & ! --- locals: real (kind=kind_phys), dimension(IMXCO2,JMXCO2) :: co2dat real (kind=kind_phys) :: co2g1, co2g2 - real (kind=kind_phys) :: pstr(LOZ) - real (kind=kind_io4) :: o3clim4(JMR,LOZ,12), pstr4(LOZ) - integer :: imond(12), ilat(JMR,12) integer :: i, j, k, iyr, imo logical :: file_exist, lextpl character :: cline*100, cform*8 @@ -316,78 +264,6 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & kyrsav = 0 kmonsav = 1 -! --- ... climatology ozone data section - - if ( ioznflg > 0 ) then - if ( me == 0 ) then - print *,' - Using interactive ozone distribution' - endif - else - if ( timeozc /= 12 ) then - print *,' - Using climatology ozone distribution' - print *,' timeozc=',timeozc, ' is not monthly mean', & - & ' - job aborting in subroutin gas_init!!!' - errflg = 1 - errmsg = 'ERROR(gas_init): Climatological o3 distribution '// & - & 'is not monthly mean' - return - endif - - allocate (pkstr(LOZ), o3r(JMR,LOZ,12)) - rewind NIO3CLM - - if ( LOZ == 17 ) then ! For the operational ozone climatology - do k = 1, LOZ - read (NIO3CLM,15) pstr4(k) - 15 format(f10.3) - enddo - - do imo = 1, 12 - do j = 1, JMR - read (NIO3CLM,16) imond(imo), ilat(j,imo), & - & (o3clim4(j,k,imo),k=1,10) - 16 format(i2,i4,10f6.2) - read (NIO3CLM,20) (o3clim4(j,k,imo),k=11,LOZ) - 20 format(6x,10f6.2) - enddo - enddo - else ! For newer ozone climatology - read (NIO3CLM) - do k = 1, LOZ - read (NIO3CLM) pstr4(k) - enddo - - do imo = 1, 12 - do k = 1, LOZ - read (NIO3CLM) (o3clim4(j,k,imo),j=1,JMR) - enddo - enddo - endif ! end if_LOZ_block -! - do imo = 1, 12 - do k = 1, LOZ - do j = 1, JMR - o3r(j,k,imo) = o3clim4(j,k,imo) * 1.655e-6 - enddo - enddo - enddo - - do k = 1, LOZ - pstr(k) = pstr4(k) - enddo - - if ( me == 0 ) then - print *,' - Using climatology ozone distribution' - print *,' Found ozone data for levels pstr=', & - & (pstr(k),k=1,LOZ) -! print *,' O3=',(o3r(15,k,1),k=1,LOZ) - endif - - do k = 1, LOZ - pkstr(k) = fpkapx(pstr(k)*100.0) - enddo - endif ! end if_ioznflg_block - ! --- ... co2 data section co2_glb = co2vmr_def @@ -541,20 +417,18 @@ end subroutine gas_init !!\param imon month of the year !!\param iday day of the month !!\param ihour hour of the day -!!\param loz1st clim ozone 1st time update control flag !!\param ldoco2 co2 update control flag !!\param me print message control flag !!\param co2dat_file co2 2d monthly obsv data table !!\param co2gbl_file co2 global annual mean data table !!\param ictmflg data ic time/date control flag !!\param ico2flg co2 data source control flag -!!\param ioznflg ozone data control flag !!\param errflg error flag !!\param errmsg error message !>\section gen_gas_update gas_update General Algorithm !----------------------------------- - subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & - & me, co2dat_file, co2gbl_file, ictmflg, ico2flg, ioznflg, & + subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & + & me, co2dat_file, co2gbl_file, ictmflg, ico2flg, & & errflg, errmsg ) ! =================================================================== ! @@ -567,7 +441,6 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & ! imon - month of the year 1 ! ! iday - day of the month 1 ! ! ihour - hour of the day 1 ! -! loz1st - clim ozone 1st time update control flag 1 ! ! ldoco2 - co2 update control flag 1 ! ! me - print message control flag 1 ! ! ico2flg - co2 data source control flag ! @@ -587,9 +460,6 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & ! further data extrapolation. ! ! =yyyy1: use yyyy data for the fcst. if needed, do ! ! extrapolation to match the fcst time. ! -! ioznflg - ozone data control flag ! -! =0: use climatological ozone profile ! -! >0: use interactive ozone profile ! ! ivflip - vertical profile indexing flag ! ! co2dat_file - external co2 2d monthly obsv data table ! ! co2gbl_file - external co2 global annual mean data table ! @@ -603,8 +473,6 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & ! co2cyc_sav - monthly cycle co2 vol mixing ratio IMXCO2*JMXCO2*12 ! ! co2_glb - global annual mean co2 mixing ratio ! ! gco2cyc - global monthly mean co2 variation 12 ! -! k1oz,k2oz,facoz ! -! - climatology ozone parameters 1 ! ! ! ! usage: call gas_update ! ! ! @@ -616,9 +484,8 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & ! --- inputs: integer, intent(in) :: iyear,imon,iday,ihour,me,ictmflg,ico2flg - integer, intent(in) :: ioznflg character(len=26),intent(in) :: co2dat_file, co2gbl_file - logical, intent(in) :: loz1st, ldoco2 + logical, intent(in) :: ldoco2 ! --- output: character(len=*), intent(out) :: errmsg @@ -643,35 +510,6 @@ subroutine gas_update(iyear, imon, iday, ihour, loz1st, ldoco2, & errmsg = '' errflg = 0 -!> - Ozone data section - - if ( ioznflg == 0 ) then - midmon = mdays(imon)/2 + 1 - change = loz1st .or. ( (iday==midmon) .and. (ihour==0) ) -! - if ( change ) then - if ( iday < midmon ) then - k1oz = mod(imon+10, 12) + 1 - midm = mdays(k1oz)/2 + 1 - k2oz = imon - midp = mdays(k1oz) + midmon - else - k1oz = imon - midm = midmon - k2oz = mod(imon, 12) + 1 - midp = mdays(k2oz)/2 + 1 + mdays(k1oz) - endif - endif -! - if (iday < midmon) then - id = iday + mdays(k1oz) - else - id = iday - endif - - facoz = float(id - midm) / float(midp - midm) - endif - !> - co2 data section if ( ico2flg == 0 ) return ! use prescribed global mean co2 data @@ -1103,121 +941,6 @@ subroutine getgases( plvl, xlon, xlat, IMAX, LMAX, ico2flg, & end subroutine getgases !----------------------------------- -!> This subroutine sets up climatological ozone profile for radiation -!! calculation. This code is originally written by Shrinivas Moorthi. -!!\param prslk (IMAX,LM), exner function = \f$(p/p0)^{rocp}\f$ -!!\param xlat (IMAX), latitude in radians, default to pi/2 -> -!! -pi/2 range, otherwise see in-line comment -!!\param IMAX, LM (1), horizontal and vertical dimensions -!!\param top_at_1 (1), vertical profile indexing flag -!!\param o3mmr (IMAX,LM), output ozone profile in mass mixing -!! ratio (g/g) -!>\section getozn_gen getozn General Algorithm -!----------------------------------- - subroutine getozn( prslk,xlat, IMAX, LM, top_at_1, JMR, LOZ, blte,& - & dlte, o3mmr) - -! =================================================================== ! -! ! -! getozn sets up climatological ozone profile for radiation calculation! -! ! -! this code is originally written By Shrinivas Moorthi ! -! ! -! inputs: ! -! prslk (IMAX,LM) - exner function = (p/p0)**rocp ! -! xlat (IMAX) - latitude in radians, default to pi/2 -> -pi/2 ! -! range, otherwise see in-line comment ! -! IMAX, LM - horizontal and vertical dimensions ! -! top_at_1 - vertical profile indexing flag ! -! ! -! outputs: ! -! o3mmr (IMAX,LM) - output ozone profile in mass mixing ratio (g/g)! -! ! -! module variables: ! -! k1oz, k2oz - ozone data interpolation indices ! -! facoz - ozone data interpolation factor ! -! ! -! usage: call getozn ! -! ! -! =================================================================== ! -! - implicit none - -! --- inputs: - integer, intent(in) :: IMAX, LM, JMR, LOZ - real(kind=kind_phys), intent(in) :: blte, dlte - logical, intent(in) :: top_at_1 - real (kind=kind_phys), intent(in) :: prslk(:,:), xlat(:) - -! --- outputs: - real (kind=kind_phys), intent(out) :: o3mmr(:,:) - -! --- locals: - real (kind=kind_phys) :: o3i(IMAX,LOZ), wk1(IMAX), deglat, elte, & - & tem, tem1, tem2, tem3, tem4, temp - integer :: i, j, k, l, j1, j2, ll -! -!===> ... begin here -! - elte = blte + (JMR-1)*dlte - - do i = 1, IMAX - deglat = xlat(i) * raddeg ! if xlat in pi/2 -> -pi/2 range -! deglat = 90.0 - xlat(i)*raddeg ! if xlat in 0 -> pi range - - if (deglat > blte .and. deglat < elte) then - tem1 = (deglat - blte) / dlte + 1 - j1 = tem1 - j2 = j1 + 1 - tem1 = tem1 - j1 - elseif (deglat <= blte) then - j1 = 1 - j2 = 1 - tem1 = 1.0 - elseif (deglat >= elte) then - j1 = JMR - j2 = JMR - tem1 = 1.0 - endif - - tem2 = 1.0 - tem1 - do j = 1, LOZ - tem3 = tem2*o3r(j1,j,k1oz) + tem1*o3r(j2,j,k1oz) - tem4 = tem2*o3r(j1,j,k2oz) + tem1*o3r(j2,j,k2oz) - o3i(i,j) = tem4*facoz + tem3*(1.0 - facoz) - enddo - enddo - - do l = 1, LM - ll = l - if (.not. top_at_1) ll = LM -l + 1 - - do i = 1, IMAX - wk1(i) = prslk(i,ll) - enddo - - do k = 1, LOZ-1 - temp = 1.0 / (pkstr(k+1) - pkstr(k)) - - do i = 1, IMAX - if (wk1(i) > pkstr(k) .and. wk1(i) <= pkstr(k+1)) then - tem = (pkstr(k+1) - wk1(i)) * temp - o3mmr(I,ll) = tem * o3i(i,k) + (1.0 - tem) * o3i(i,k+1) - endif - enddo - enddo - - do i = 1, IMAX - if (wk1(i) > pkstr(LOZ)) o3mmr(i,ll) = o3i(i,LOZ) - if (wk1(i) < pkstr(1)) o3mmr(i,ll) = o3i(i,1) - enddo - enddo -! - return -!................................... - end subroutine getozn -!----------------------------------- - ! !........................................! end module module_radiation_gases ! diff --git a/physics/rrtmgp_lw_main.F90 b/physics/rrtmgp_lw_main.F90 index 67f7f749a..01b25c925 100644 --- a/physics/rrtmgp_lw_main.F90 +++ b/physics/rrtmgp_lw_main.F90 @@ -19,7 +19,6 @@ module rrtmgp_lw_main use rrtmgp_lw_gas_optics, only: lw_gas_props,rrtmgp_lw_gas_optics_init use rrtmgp_lw_cloud_optics, only: lw_cloud_props, rrtmgp_lw_cloud_optics_init, abssnow0, & abssnow1, absrain - use module_radiation_gases, only: NF_VGAS, getgases, getozn use GFS_rrtmgp_pre, only: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, & iStr_o2, iStr_ccl4, iStr_cfc11, iStr_cfc12, iStr_cfc22, & eps, oneminus, ftiny From 2886df96f645f9366d7d0496ac654fc178264e7d Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 27 Sep 2023 14:23:36 -0600 Subject: [PATCH 031/132] Small cosmetic changes --- physics/GFS_phys_time_vary.fv3.F90 | 53 ++++++++++++++---------------- 1 file changed, 24 insertions(+), 29 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index af2dd9b00..f72763c3a 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -219,14 +219,6 @@ subroutine GFS_phys_time_vary_init ( !$OMP sections -!$OMP section -!> - Setup spatial interpolation indices for ozone physics. - if (ntoz > 0) then - !$OMP CRITICAL - call ozphys%setup_forcing(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) - !$OMP END CRITICAL - endif - !$OMP section !> - Call read_h2odata() to read stratospheric water vapor data call read_h2odata (h2o_phys, me, master) @@ -294,6 +286,12 @@ subroutine GFS_phys_time_vary_init ( !$OMP sections +!$OMP section +!> - Setup spatial interpolation indices for ozone physics. + if (ntoz > 0) then + call ozphys%setup_forcing(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + endif + !$OMP section !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then @@ -803,21 +801,7 @@ subroutine GFS_phys_time_vary_timestep_init ( return end if -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP shared(kdt,nsswr,lsswr,clstp,imfdeepcnv,cal_pre,random_clds) & -!$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval) & -!$OMP shared(rann,im,isc,jsc,imap,jmap,ntoz,me,idate,jindx1_o3,jindx2_o3) & -!$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & -!$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & -!$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & -!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys) & -!$OMP private(iseed,iskip,i,j,rjday,idat,rinc,w3kindreal,w3kindint,jdat)& -!$OMP private(jdow,jdoy,jday,rinc4,n1,n2) - -!$OMP sections - -!$OMP section -!> - Compute temporal interpolation indices for updating gas concentrations. + !> - Compute temporal interpolation indices for updating gas concentrations. idat=0 idat(1)=idate(4) idat(2)=idate(2) @@ -849,12 +833,17 @@ subroutine GFS_phys_time_vary_timestep_init ( n1 = n2 - 1 if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime - !> - Update ozone concentration. - if (ntoz > 0) then - !$OMP CRITICAL - call ozphys%update_forcing(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) - !$OMP END CRITICAL - endif +!$OMP parallel num_threads(nthrds) default(none) & +!$OMP shared(kdt,nsswr,lsswr,clstp,imfdeepcnv,cal_pre,random_clds) & +!$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval) & +!$OMP shared(rann,im,isc,jsc,imap,jmap,ntoz,me,idate,jindx1_o3,jindx2_o3) & +!$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & +!$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & +!$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & +!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys) & +!$OMP private(iseed,iskip,i,j) + +!$OMP sections !$OMP section @@ -901,6 +890,12 @@ subroutine GFS_phys_time_vary_timestep_init ( endif ! imfdeepcnv, cal_re, random_clds +!$OMP section +!> - Update ozone concentration. + if (ntoz > 0) then + call ozphys%update_forcing(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) + endif + !$OMP section !> - Call h2ointerpol() to make stratospheric water vapor data interpolation if (h2o_phys) then From 17b057ce219479a3e46e9c8d7825736a0935083c Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 27 Sep 2023 14:28:52 -0600 Subject: [PATCH 032/132] Housekeeping --- physics/GFS_phys_time_vary.fv3.F90 | 2 +- physics/GFS_phys_time_vary.fv3.meta | 59 ++++++++++++++--------------- 2 files changed, 30 insertions(+), 31 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index f72763c3a..6fa188471 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -841,7 +841,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & !$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys) & -!$OMP private(iseed,iskip,i,j) +!$OMP private(iseed,iskip,i,j,k) !$OMP sections diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index bf5a3fa04..639e2db6a 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -30,6 +30,13 @@ dimensions = () type = logical intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in [iaerclm] standard_name = flag_for_aerosol_input_MG_radiation long_name = flag for using aerosols in Morrison-Gettelman MP_radiation @@ -72,36 +79,6 @@ dimensions = () type = integer intent = in - intent = in -[ntoz] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in -[jindx1_o3] - standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[jindx2_o3] - standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in -[ddy_o3] - standard_name = latitude_interpolation_weight_for_ozone_forcing - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in [nx] standard_name = number_of_points_in_x_direction_for_this_MPI_rank long_name = number of points in x direction for this MPI rank @@ -139,6 +116,28 @@ type = real kind = kind_phys intent = in +[jindx1_o3] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[jindx2_o3] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[ddy_o3] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor From 17203fe06a90612ad09a357e8084510c4a277d58 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 27 Sep 2023 14:32:20 -0600 Subject: [PATCH 033/132] Housekeeping --- physics/GFS_phys_time_vary.fv3.meta | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 639e2db6a..ad543e146 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -23,13 +23,6 @@ dimensions = () type = integer intent = in -[h2o_phys] - standard_name = flag_for_stratospheric_water_vapor_physics - long_name = flag for stratospheric water vapor physics - units = flag - dimensions = () - type = logical - intent = in [ntoz] standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array long_name = tracer index for ozone mixing ratio @@ -37,6 +30,13 @@ dimensions = () type = integer intent = in +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in [iaerclm] standard_name = flag_for_aerosol_input_MG_radiation long_name = flag for using aerosols in Morrison-Gettelman MP_radiation From 3f6168b12443a79adf7abcdf326bcfa6813c8d84 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 27 Sep 2023 15:49:35 -0600 Subject: [PATCH 034/132] More reorg. --- physics/GFS_phys_time_vary.fv3.F90 | 9 +- physics/GFS_rrtmg_pre.F90 | 2 +- physics/GFS_rrtmg_setup.F90 | 2 +- physics/GFS_rrtmgp_pre.F90 | 2 +- physics/GFS_rrtmgp_setup.F90 | 2 +- physics/GFS_suite_stateout_update.F90 | 135 +++++++++++++++---------- physics/GFS_suite_stateout_update.meta | 95 ++++++++++++++++- physics/module_ozphys.F90 | 50 ++++----- 8 files changed, 209 insertions(+), 88 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 6fa188471..70eeb81e1 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -95,6 +95,7 @@ subroutine GFS_phys_time_vary_init ( integer, intent(in) :: lkm integer, intent(inout) :: use_lake_model(:) real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) + integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(in) :: h2opl(:,:,:) @@ -289,7 +290,7 @@ subroutine GFS_phys_time_vary_init ( !$OMP section !> - Setup spatial interpolation indices for ozone physics. if (ntoz > 0) then - call ozphys%setup_forcing(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif !$OMP section @@ -729,7 +730,7 @@ subroutine GFS_phys_time_vary_timestep_init ( lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, & tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype,scolor, shdmin, shdmax, snowd, & - cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, & + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) implicit none @@ -841,7 +842,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & !$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys) & -!$OMP private(iseed,iskip,i,j,k) +!$OMP private(iseed,iskip,i,j,k,rjday,n1,n2) !$OMP sections @@ -893,7 +894,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP section !> - Update ozone concentration. if (ntoz > 0) then - call ozphys%update_forcing(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) + call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) endif !$OMP section diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 69be4f8d0..108d6f407 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -434,7 +434,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& enddo enddo else ! climatological ozone - call ozphys%oz_clim(xlat, prslk1, con_pi, olyr) + call ozphys%run_o3clim(xlat, prslk1, con_pi, olyr) endif ! end_if_ntoz !> - Call coszmn(), to compute cosine of zenith angle (only when SW is called) diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 908a364dc..e48a60ac8 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -467,7 +467,7 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& call gas_update ( kyear,kmon,kday,khour,lco2_chg, me, co2dat_file, & co2gbl_file, ictm, ico2, errflg, errmsg ) if (ntoz == 0) then - call ozphys%update_clim(kmon, kday, khour, loz1st) + call ozphys%update_o3clim(kmon, kday, khour, loz1st) endif if ( loz1st ) loz1st = .false. diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 9dcc002a0..cbf8d161b 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -353,7 +353,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl enddo ! OR Use climatological ozone data else - call ozphys%oz_clim(xlat, prslk, con_pi, o3_lay) + call ozphys%run_o3clim(xlat, prslk, con_pi, o3_lay) endif ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 3e4f57d13..9f2b2a9f9 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -243,7 +243,7 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad call gas_update (kyear, kmon, kday, khour, lco2_chg, me, co2dat_file, co2gbl_file, ictm,& ico2, errflg, errmsg ) if (ntoz == 0) then - call ozphys%update_clim(kmon, kday, khour, loz1st) + call ozphys%update_o3clim(kmon, kday, khour, loz1st) endif if ( loz1st ) loz1st = .false. diff --git a/physics/GFS_suite_stateout_update.F90 b/physics/GFS_suite_stateout_update.F90 index 2771c3e82..41f44e0de 100644 --- a/physics/GFS_suite_stateout_update.F90 +++ b/physics/GFS_suite_stateout_update.F90 @@ -1,63 +1,90 @@ +! ######################################################################################### !> \file GFS_suite_stateout_update.f90 -!! Contains code to update the state variables due to process-split physics from accumulated tendencies during that phase. +!! Update the state variables due to process-split physics from accumulated tendencies +!! during that phase. +!! Update gas concentrations, if using prognostic photolysis schemes. !! Also, set bounds on the mass-weighted rime factor when using Ferrier-Aligo microphysics. - - module GFS_suite_stateout_update - - contains - +! ######################################################################################### +module GFS_suite_stateout_update + use machine, only: kind_phys + use module_ozphys, only: ty_ozphys + implicit none +contains +! ######################################################################################### !> \section arg_table_GFS_suite_stateout_update_run Argument Table !! \htmlinclude GFS_suite_stateout_update_run.html !! - subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, & - tgrs, ugrs, vgrs, qgrs, dudt, dvdt, dtdt, dqdt, & - gt0, gu0, gv0, gq0, ntiw, nqrimef, imp_physics, & - imp_physics_fer_hires, epsq, errmsg, errflg) - - use machine, only: kind_phys - - implicit none - - ! Interface variables - integer, intent(in ) :: im - integer, intent(in ) :: levs - integer, intent(in ) :: ntrac - integer, intent(in ) :: imp_physics,imp_physics_fer_hires - integer, intent(in ) :: ntiw, nqrimef - real(kind=kind_phys), intent(in ) :: dtp, epsq - - real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs - real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt - real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0 - real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: i, k - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - gt0(:,:) = tgrs(:,:) + dtdt(:,:) * dtp - gu0(:,:) = ugrs(:,:) + dudt(:,:) * dtp - gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp - gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp - - if (imp_physics == imp_physics_fer_hires) then +! ######################################################################################### + subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs, qgrs, & + dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, oz0, ntiw, nqrimef, imp_physics, & + imp_physics_fer_hires, epsq, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, prsl, & + dp, ozpl, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) + + ! Inputs + integer, intent(in ) :: im + integer, intent(in ) :: levs + integer, intent(in ) :: ntrac + integer, intent(in ) :: imp_physics,imp_physics_fer_hires + integer, intent(in ) :: ntiw, nqrimef + real(kind=kind_phys), intent(in ) :: dtp, epsq, con_1ovg + real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs, prsl, dp + real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs, ozpl + real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt + real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt + logical, intent(in) :: oz_phys_2015 + logical, intent(in) :: oz_phys_2006 + type(ty_ozphys), intent(in) :: ozphys + + ! Outputs (optional) + real(kind=kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect + + ! Outputs + real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0, oz0 + real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Locals + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Update prognostic state varaibles using accumulated tendencies from "process-split" + ! section of GFS suite. + gt0(:,:) = tgrs(:,:) + dtdt(:,:) * dtp + gu0(:,:) = ugrs(:,:) + dudt(:,:) * dtp + gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp + gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp + + ! If using photolysis physics schemes, update (prognostic) gas concentrations using + ! updated state. + if (oz_phys_2015) then + call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & + do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + endif + if (oz_phys_2006) then + call ozphys%run_o3prog_2006() + endif + + ! If using Ferrier-Aligo microphysics, set bounds on the mass-weighted rime factor. + if (imp_physics == imp_physics_fer_hires) then do k=1,levs - do i=1,im - if(gq0(i,k,ntiw) > epsq) then - gq0(i,k,nqrimef) = max(1., gq0(i,k,nqrimef)/gq0(i,k,ntiw)) - else - gq0(i,k,nqrimef) = 1. - end if - end do + do i=1,im + if(gq0(i,k,ntiw) > epsq) then + gq0(i,k,nqrimef) = max(1., gq0(i,k,nqrimef)/gq0(i,k,ntiw)) + else + gq0(i,k,nqrimef) = 1. + end if + end do end do - end if + end if - end subroutine GFS_suite_stateout_update_run + end subroutine GFS_suite_stateout_update_run - end module GFS_suite_stateout_update \ No newline at end of file +end module GFS_suite_stateout_update diff --git a/physics/GFS_suite_stateout_update.meta b/physics/GFS_suite_stateout_update.meta index 580482b71..8cbab9139 100644 --- a/physics/GFS_suite_stateout_update.meta +++ b/physics/GFS_suite_stateout_update.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_update type = scheme - dependencies = machine.F + dependencies = machine.F,module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -37,6 +37,27 @@ type = real kind = kind_phys intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in +[oz_phys_2015] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[oz_phys_2006] + standard_name = flag_for_nrl_2006_ozone_scheme + long_name = flag for new (2006) ozone physics + units = flag + dimensions = () + type = logical + intent = in [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -133,6 +154,14 @@ type = real kind = kind_phys intent = out +[oz0] + standard_name = ozone_concentration_of_new_state + long_name = ozone concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [ntiw] standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array long_name = tracer index for ice water @@ -169,6 +198,70 @@ type = real kind = kind_phys intent = in +[con_1ovg] + standard_name = one_divided_by_the_gravitational_acceleration + long_name = inverse of gravitational acceleration + units = s2 m-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_loop_extent,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) + type = real + kind = kind_phys + intent = in +[dp] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[do3_dt_prd] + standard_name = ozone_tendency_due_to_production_and_loss_rate + long_name = ozone tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[do3_dt_ozmx] + standard_name = ozone_tendency_due_to_ozone_mixing_ratio + long_name = ozone tendency due to ozone mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[do3_dt_temp] + standard_name = ozone_tendency_due_to_temperature + long_name = ozone tendency due to temperature + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[do3_dt_ohoz] + standard_name = ozone_tendency_due_to_overhead_ozone_column + long_name = ozone tendency due to overhead ozone column + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_ozphys.F90 b/physics/module_ozphys.F90 index 966d27113..205a02b46 100644 --- a/physics/module_ozphys.F90 +++ b/physics/module_ozphys.F90 @@ -41,21 +41,22 @@ module module_ozphys integer :: k2oz !< Upper interpolation index in datac(dim=3), time dim real(kind_phys) :: facoz !< Parameter for ozone climotology contains - procedure, public :: load_forcing - procedure, public :: load_clim - procedure, public :: setup_forcing - procedure, public :: update_forcing - procedure, public :: update_clim - procedure, public :: oz_prog_2015 - procedure, public :: oz_prog_2006 - procedure, public :: oz_clim + procedure, public :: load_o3prog + procedure, public :: setup_o3prog + procedure, public :: update_o3prog + procedure, public :: run_o3prog_2015 + procedure, public :: run_o3prog_2006 + ! + procedure, public :: load_o3clim + procedure, public :: update_o3clim + procedure, public :: run_o3clim end type ty_ozphys contains ! ######################################################################################### ! Procedure (type-bound) for loading ozone forcing data. ! ######################################################################################### - function load_forcing(this, file, fileID) result (err_message) + function load_o3prog(this, file, fileID) result (err_message) class(ty_ozphys), intent(inout) :: this integer, intent(in) :: fileID character(len=*), intent(in) :: file @@ -97,12 +98,12 @@ function load_forcing(this, file, fileID) result (err_message) deallocate(tempin) close(fileID) - end function load_forcing + end function load_o3prog ! ######################################################################################### ! Procedure for setting up interpolation indices between data and model grid. ! ######################################################################################### - subroutine setup_forcing(this, lat, idx1, idx2, idxh) + subroutine setup_o3prog(this, lat, idx1, idx2, idxh) class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: lat(:) integer, intent(out) :: idx1(:), idx2(:) @@ -126,12 +127,12 @@ subroutine setup_forcing(this, lat, idx1, idx2, idxh) endif enddo - end subroutine setup_forcing + end subroutine setup_o3prog ! ######################################################################################### ! Procedure (type-bound) for updating ozone data. ! ######################################################################################### - subroutine update_forcing(this, idx1, idx2, idxh, rjday, idxt1, idxt2, ozpl) + subroutine update_o3prog(this, idx1, idx2, idxh, rjday, idxt1, idxt2, ozpl) class(ty_ozphys), intent(in) :: this integer, intent(in) :: idx1(:), idx2(:) real(kind_phys), intent(in) :: idxh(:) @@ -156,12 +157,12 @@ subroutine update_forcing(this, idx1, idx2, idxh, rjday, idxt1, idxt2, ozpl) enddo enddo - end subroutine update_forcing + end subroutine update_o3prog ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2015). ! ######################################################################################### - subroutine oz_prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, do3_dt_ozmx, & + subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, do3_dt_ozmx, & do3_dt_temp, do3_dt_ohoz) class(ty_ozphys), intent(in) :: this real(kind_phys),intent(in) :: & @@ -267,21 +268,20 @@ subroutine oz_prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, do3_ enddo return - end subroutine oz_prog_2015 + end subroutine run_o3prog_2015 ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2006). ! ######################################################################################### - subroutine oz_prog_2006(this) + subroutine run_o3prog_2006(this) class(ty_ozphys), intent(in) :: this return - end subroutine oz_prog_2006 + end subroutine run_o3prog_2006 ! ######################################################################################### ! Procedure (type-bound) for NRL updating climotological ozone. - ! Build this up from getozn. ! ######################################################################################### - subroutine oz_clim(this, lat, prslk, con_pi, oz) + subroutine run_o3clim(this, lat, prslk, con_pi, oz) class(ty_ozphys), intent(in) :: this real(kind_phys), intent(in) :: & con_pi ! Physics constant: Pi @@ -356,12 +356,12 @@ subroutine oz_clim(this, lat, prslk, con_pi, oz) enddo return - end subroutine oz_clim + end subroutine run_o3clim ! ######################################################################################### ! Procedure (type-bound) for loading ozone climo data. ! ######################################################################################### - function load_clim(this, file, fileID) result (err_message) + function load_o3clim(this, file, fileID) result (err_message) class(ty_ozphys), intent(inout) :: this integer, intent(in) :: fileID character(len=*), intent(in) :: file @@ -432,12 +432,12 @@ function load_clim(this, file, fileID) result (err_message) this%pkstr(iLev) = fpkapx(this%pstr(iLev)*100.0) enddo - end function load_clim + end function load_o3clim ! ######################################################################################### ! Procedure (type-bound) for updating ozone climotological data. ! ######################################################################################### - subroutine update_clim(this, imon, iday, ihour, loz1st) + subroutine update_o3clim(this, imon, iday, ihour, loz1st) class(ty_ozphys), intent(inout) :: this integer, intent(in) :: imon, iday, ihour logical, intent(in) :: loz1st @@ -471,6 +471,6 @@ subroutine update_clim(this, imon, iday, ihour, loz1st) this%facoz = float(id - midm) / float(midp - midm) - end subroutine update_clim + end subroutine update_o3clim end module module_ozphys From d0a4bfd63fae9f4e4a06cb5598049f1019aed945 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 27 Sep 2023 15:50:51 -0600 Subject: [PATCH 035/132] Remove ozphysics modules. Now part of ty_ozphys --- physics/ozphys_2015.F90 | 167 --------------------------------------- physics/ozphys_2015.meta | 140 -------------------------------- 2 files changed, 307 deletions(-) delete mode 100644 physics/ozphys_2015.F90 delete mode 100644 physics/ozphys_2015.meta diff --git a/physics/ozphys_2015.F90 b/physics/ozphys_2015.F90 deleted file mode 100644 index 1478d0d6e..000000000 --- a/physics/ozphys_2015.F90 +++ /dev/null @@ -1,167 +0,0 @@ -! ########################################################################################### -!> \file ozphys_2015.F90 -!! -! ########################################################################################### -module ozphys_2015 - use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec - use module_ozphys, only: ty_ozphys - implicit none - public ozphys_2015_run -contains - -! ########################################################################################### -!>\defgroup GFS_ozphys_2015 GFS Ozone Photochemistry (2015) Module -!! This module contains the CCPP-compliant Ozone 2015 photochemistry scheme. -!> @{ -!> The operational GFS currently parameterizes ozone production and destruction based on -!! monthly mean coefficients ( \c ozprdlos_2015_new_sbuvO3_tclm15_nuchem.f77) provided by -!! Naval Research Laboratory through CHEM2D chemistry model -!! (McCormack et al. (2006) \cite mccormack_et_al_2006). -!! (https://doi.org/10.5194/acp-6-4943-2006) -!! -!> \section genal_ozphys_2015 GFS ozphys_2015_run General Algorithm -!> - This code assumes that both 2D fields are ordered from bottom to top. -!> - This code is specifically for NRL parameterization and climatological T and O3 are in -! location 5 and 6 of ozpl array -!!\author June 2015 - Shrinivas Moorthi -!!\modified May 2023 - Dustin Swales -! ########################################################################################### - -! ########################################################################################### -! SUBROUTINE ozphys_2015_run -! ########################################################################################### -!! \section arg_table_ozphys_2015_run Argument Table -!! \htmlinclude ozphys_2015_run.html -!! - subroutine ozphys_2015_run (oz_phys, ozphys, nCol, nLev, dt, oz, tin, prsl, ozpl, & - delp, con_1ovg, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) - - ! Inputs - logical, intent(in) :: & - oz_phys ! Flag for ozone_physics_2015 scheme. - type(ty_ozphys),intent(in) :: & - ozphys - real(kind_phys),intent(in) :: & - con_1ovg ! Physical constant: One divided by gravitational acceleration (m-1 s2) - integer, intent(in) :: & - nCol, & ! Horizontal dimension - nLev ! Number of vertical layers - real(kind_phys), intent(in) :: & - dt ! Physics timestep (seconds) - real(kind_phys), intent(in), dimension(:,:) :: & - prsl, & ! Air-pressure (Pa) - tin, & ! Temperature of new-state (K) - delp ! Difference between mid-layer pressures (Pa) - real(kind_phys), intent(in), dimension(:,:,:) :: & - ozpl ! Ozone forcing data - - ! Outputs (optional) - real(kind=kind_phys), intent(inout), dimension(:,:), pointer, optional :: & - do3_dt_prd, & ! Physics tendency: production and loss effect - do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect - do3_dt_temp, & ! Physics tendency: temperature effect - do3_dt_ohoz ! Physics tendency: overhead ozone effect - - ! Outputs - real(kind=kind_phys), intent(inout), dimension(:,:) :: & - oz ! Ozone concentration updated by physics - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - - ! Locals - integer :: k, kmax, kmin, l, i, j - logical, dimension(nCol) :: flg - real(kind_phys) :: pmax, pmin, tem, temp - real(kind_phys), dimension(nCol) :: wk1, wk2, wk3, ozib - real(kind_phys), dimension(nCol,ozphys%ncf) :: prod - real(kind_phys), dimension(nCol,nLev) :: ozi - real(kind_phys), dimension(nCol,nLev+1) :: colo3, coloz - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Sanity checks - if (.not.oz_phys) then - write (errmsg,'(*(a))') 'Logic error: oz_phys_2015 == .false.' - errflg = 1 - return - endif - - ! Temporaries - ozi = oz - - colo3(:,nLev+1) = 0.0 - coloz(:,nLev+1) = 0.0 - - do l=nLev,1,-1 - pmin = 1.0e10 - pmax = -1.0e10 - - do i=1,nCol - wk1(i) = log(prsl(i,l)) - pmin = min(wk1(i), pmin) - pmax = max(wk1(i), pmax) - prod(i,:) = 0.0 - enddo - kmax = 1 - kmin = 1 - do k=1,ozphys%nlev-1 - if (pmin < ozphys%po3(k)) kmax = k - if (pmax < ozphys%po3(k)) kmin = k - enddo - ! - do k=kmin,kmax - temp = 1.0 / (ozphys%po3(k) - ozphys%po3(k+1)) - do i=1,nCol - flg(i) = .false. - if (wk1(i) < ozphys%po3(k) .and. wk1(i) >= ozphys%po3(k+1)) then - flg(i) = .true. - wk2(i) = (wk1(i) - ozphys%po3(k+1)) * temp - wk3(i) = 1.0 - wk2(i) - endif - enddo - do j=1,ozphys%ncf - do i=1,nCol - if (flg(i)) then - prod(i,j) = wk2(i) * ozpl(i,k,j) + wk3(i) * ozpl(i,k+1,j) - endif - enddo - enddo - enddo - - do j=1,ozphys%ncf - do i=1,nCol - if (wk1(i) < ozphys%po3(ozphys%nlev)) then - prod(i,j) = ozpl(i,ozphys%nlev,j) - endif - if (wk1(i) >= ozphys%po3(1)) then - prod(i,j) = ozpl(i,1,j) - endif - enddo - enddo - do i=1,nCol - colo3(i,l) = colo3(i,l+1) + ozi(i,l) * delp(i,l)*con_1ovg - coloz(i,l) = coloz(i,l+1) + prod(i,6) * delp(i,l)*con_1ovg - prod(i,2) = min(prod(i,2), 0.0) - enddo - do i=1,nCol - ozib(i) = ozi(i,l) ! no filling - tem = prod(i,1) - prod(i,2) * prod(i,6) + prod(i,3) * (tin(i,l) - prod(i,5)) & - + prod(i,4) * (colo3(i,l)-coloz(i,l)) - oz(i,l) = (ozib(i) + tem*dt) / (1.0 - prod(i,2)*dt) - enddo - - ! Diagnostics (optional) - if (associated(do3_dt_prd)) do3_dt_prd(:,l) = (prod(:,1)-prod(:,2)*prod(:,6))*dt - if (associated(do3_dt_ozmx)) do3_dt_ozmx(:,l) = (oz(:,l) - ozib(:)) - if (associated(do3_dt_temp)) do3_dt_temp(:,l) = prod(:,3)*(tin(:,l)-prod(:,5))*dt - if (associated(do3_dt_ohoz)) do3_dt_ohoz(:,l) = prod(:,4) * (colo3(:,l)-coloz(:,l))*dt - enddo - - return - end subroutine ozphys_2015_run -!> @} -end module ozphys_2015 diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta deleted file mode 100644 index ca2d56e4e..000000000 --- a/physics/ozphys_2015.meta +++ /dev/null @@ -1,140 +0,0 @@ -[ccpp-table-properties] - name = ozphys_2015 - type = scheme - dependencies = machine.F,module_ozphys.F90 - -######################################################################## -[ccpp-arg-table] - name = ozphys_2015_run - type = scheme -[oz_phys] - standard_name = flag_for_nrl_2015_ozone_scheme - long_name = flag for new (2015) ozone physics - units = flag - dimensions = () - type = logical - intent = in -[ozphys] - standard_name = dataset_for_ozone_physics - long_name = dataset for NRL ozone physics - units = mixed - dimensions = () - type = ty_ozphys - intent = in -[nCol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical layers - units = count - dimensions = () - type = integer - intent = in -[dt] - standard_name = timestep_for_physics - long_name = physics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[oz] - standard_name = ozone_concentration_of_new_state - long_name = ozone concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tin] - standard_name = air_temperature_of_new_state - long_name = updated air temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[prsl] - standard_name = air_pressure - long_name = mid-layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_loop_extent,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) - type = real - kind = kind_phys - intent = in -[delp] - standard_name = air_pressure_difference_between_midlayers - long_name = difference between mid-layer pressures - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[con_1ovg] - standard_name = one_divided_by_the_gravitational_acceleration - long_name = inverse of gravitational acceleration - units = s2 m-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[do3_dt_prd] - standard_name = ozone_tendency_due_to_production_and_loss_rate - long_name = ozone tendency due to production and loss rate - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[do3_dt_ozmx] - standard_name = ozone_tendency_due_to_ozone_mixing_ratio - long_name = ozone tendency due to ozone mixing ratio - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[do3_dt_temp] - standard_name = ozone_tendency_due_to_temperature - long_name = ozone tendency due to temperature - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[do3_dt_ohoz] - standard_name = ozone_tendency_due_to_overhead_ozone_column - long_name = ozone tendency due to overhead ozone column - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out From 385ef4e2802a838fd3099b17ee479ebaae1a6402 Mon Sep 17 00:00:00 2001 From: dustinswales Date: Wed, 27 Sep 2023 22:19:36 -0600 Subject: [PATCH 036/132] Some polishing. Merge 2006 ozone into module_ozphys --- physics/GFS_phys_time_vary.fv3.F90 | 69 ++++----- physics/GFS_suite_stateout_update.F90 | 3 +- physics/module_ozphys.F90 | 127 +++++++++++++++- physics/ozphys.f | 211 -------------------------- physics/ozphys.meta | 208 ------------------------- 5 files changed, 158 insertions(+), 460 deletions(-) delete mode 100644 physics/ozphys.f delete mode 100644 physics/ozphys.meta diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 70eeb81e1..cd1f8287a 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -802,38 +802,6 @@ subroutine GFS_phys_time_vary_timestep_init ( return end if - !> - Compute temporal interpolation indices for updating gas concentrations. - idat=0 - idat(1)=idate(4) - idat(2)=idate(2) - idat(3)=idate(3) - idat(5)=idate(1) - rinc=0. - rinc(2)=fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL w3movdat(rinc4,idat,jdat) - else - CALL w3movdat(rinc,idat,jdat) - endif - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jdat,jdow,jdoy,jday) - rjday = jdoy + jdat(5) / 24. - if (rjday < ozphys%time(1)) rjday = rjday + 365. - - n2 = ozphys%ntime + 1 - do j=2,ozphys%ntime - if (rjday < ozphys%time(j)) then - n2 = j - exit - endif - enddo - n1 = n2 - 1 - if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime - !$OMP parallel num_threads(nthrds) default(none) & !$OMP shared(kdt,nsswr,lsswr,clstp,imfdeepcnv,cal_pre,random_clds) & !$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval) & @@ -841,8 +809,9 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & -!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys) & -!$OMP private(iseed,iskip,i,j,k,rjday,n1,n2) +!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,rjday,n1,n2,idat,jdat,rinc,rinc4) & +!$OMP shared(w3kindreal,w3kindint,jdow,jdoy,jday) & +!$OMP private(iseed,iskip,i,j,k) !$OMP sections @@ -892,6 +861,38 @@ subroutine GFS_phys_time_vary_timestep_init ( endif ! imfdeepcnv, cal_re, random_clds !$OMP section + !> - Compute temporal interpolation indices for updating gas concentrations. + idat=0 + idat(1)=idate(4) + idat(2)=idate(2) + idat(3)=idate(3) + idat(5)=idate(1) + rinc=0. + rinc(2)=fhour + call w3kind(w3kindreal,w3kindint) + if(w3kindreal==4) then + rinc4=rinc + CALL w3movdat(rinc4,idat,jdat) + else + CALL w3movdat(rinc,idat,jdat) + endif + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + if (rjday < ozphys%time(1)) rjday = rjday + 365. + + n2 = ozphys%ntime + 1 + do j=2,ozphys%ntime + if (rjday < ozphys%time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime + !> - Update ozone concentration. if (ntoz > 0) then call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) diff --git a/physics/GFS_suite_stateout_update.F90 b/physics/GFS_suite_stateout_update.F90 index 41f44e0de..e9e477fce 100644 --- a/physics/GFS_suite_stateout_update.F90 +++ b/physics/GFS_suite_stateout_update.F90 @@ -69,7 +69,8 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) endif if (oz_phys_2006) then - call ozphys%run_o3prog_2006() + call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & + do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) endif ! If using Ferrier-Aligo microphysics, set bounds on the mass-weighted rime factor. diff --git a/physics/module_ozphys.F90 b/physics/module_ozphys.F90 index 205a02b46..d24585d4d 100644 --- a/physics/module_ozphys.F90 +++ b/physics/module_ozphys.F90 @@ -162,12 +162,12 @@ end subroutine update_o3prog ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2015). ! ######################################################################################### - subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, do3_dt_ozmx, & - do3_dt_temp, do3_dt_ohoz) + subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, & + do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) class(ty_ozphys), intent(in) :: this - real(kind_phys),intent(in) :: & + real(kind_phys), intent(in) :: & con_1ovg ! Physical constant: One divided by gravitational acceleration (m-1 s2) - real(kind_phys), intent(in) :: & + real(kind_phys), intent(in) :: & dt ! Model timestep (sec) real(kind_phys), intent(in), dimension(:,:) :: & p, & ! Model Pressure (Pa) @@ -253,7 +253,7 @@ subroutine run_o3prog_2015(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, d prod(iCol,2) = min(prod(iCol,2), 0.0) enddo do iCol=1,nCol - ozib(iCol) = ozi(iCol,iLev) ! no filling + ozib(iCol) = ozi(iCol,iLev) tem = prod(iCol,1) - prod(iCol,2) * prod(iCol,6) & + prod(iCol,3) * (t(iCol,iLev) - prod(iCol,5)) & + prod(iCol,4) * (colo3(iCol,iLev)-coloz(iCol,iLev)) @@ -273,8 +273,123 @@ end subroutine run_o3prog_2015 ! ######################################################################################### ! Procedure (type-bound) for NRL prognostic ozone (2006). ! ######################################################################################### - subroutine run_o3prog_2006(this) + subroutine run_o3prog_2006(this, con_1ovg, dt, p, t, dp, ozpl, oz, do3_dt_prd, & + do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) class(ty_ozphys), intent(in) :: this + real(kind_phys), intent(in) :: & + con_1ovg ! Physical constant: One divided by gravitational acceleration (m-1 s2) + real(kind_phys), intent(in) :: & + dt ! Model timestep (sec) + real(kind_phys), intent(in), dimension(:,:) :: & + p, & ! Model Pressure (Pa) + t, & ! Model temperature (K) + dp ! Model layer thickness (Pa) + real(kind_phys), intent(in), dimension(:,:,:) :: & + ozpl ! Ozone forcing data + real(kind_phys), intent(inout), dimension(:,:) :: & + oz ! Ozone concentration updated by physics + real(kind_phys), intent(inout), dimension(:,:), pointer, optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect + + ! Locals + integer :: k, kmax, kmin, iLev, iCol, nCol, nLev, iCf + logical, dimension(size(p,1)) :: flg + real(kind_phys) :: pmax, pmin, tem, temp + real(kind_phys), dimension(size(p,1)) :: wk1, wk2, wk3, ozib + real(kind_phys), dimension(size(p,1),this%ncf) :: prod + real(kind_phys), dimension(size(p,1),size(p,2)) :: ozi + real(kind_phys), dimension(size(p,1),size(p,2)+1) :: colo3, coloz + + ! Dimensions + nCol = size(p,1) + nLev = size(p,2) + + ! Temporaries + ozi = oz + + !> - Calculate vertical integrated column ozone values. + if (this%ncf > 2) then + colo3(:,nLev+1) = 0.0 + do iLev=nLev,1,-1 + do iCol=1,nCol + colo3(iCol,iLev) = colo3(iCol,iLev+1) + ozi(iCol,iLev) * dp(iCol,iLev) * con_1ovg + enddo + enddo + endif + + !> - Apply vertically linear interpolation to the ozone coefficients. + do iLev=1,nLev + pmin = 1.0e10 + pmax = -1.0e10 + + do iCol=1,nCol + wk1(iCol) = log(p(iCol,iLev)) + pmin = min(wk1(iCol), pmin) + pmax = max(wk1(iCol), pmax) + prod(iCol,:) = 0._kind_phys + enddo + kmax = 1 + kmin = 1 + do k=1,this%nlev-1 + if (pmin < this%po3(k)) kmax = k + if (pmax < this%po3(k)) kmin = k + enddo + + do k=kmin,kmax + temp = 1.0 / (this%po3(k) - this%po3(k+1)) + do iCol=1,nCol + flg(iCol) = .false. + if (wk1(iCol) < this%po3(k) .and. wk1(iCol) >= this%po3(k+1)) then + flg(iCol) = .true. + wk2(iCol) = (wk1(iCol) - this%po3(k+1)) * temp + wk3(iCol) = 1.0 - wk2(iCol) + endif + enddo + do iCf=1,this%ncf + do iCol=1,nCol + if (flg(iCol)) then + prod(iCol,iCf) = wk2(iCol) * ozpl(iCol,k,iCf) + wk3(iCol) * ozpl(iCol,k+1,iCf) + endif + enddo + enddo + enddo + + do iCf=1,this%ncf + do iCol=1,nCol + if (wk1(iCol) < this%po3(this%nlev)) then + prod(iCol,iCf) = ozpl(iCol,this%nlev,iCf) + endif + if (wk1(iCol) >= this%po3(1)) then + prod(iCol,iCf) = ozpl(iCol,1,iCf) + endif + enddo + enddo + + if (this%ncf == 2) then + do iCol=1,nCol + ozib(iCol) = ozi(iCol,iLev) + oz(iCol,iLev) = (ozib(iCol) + prod(iCol,1)*dt) / (1.0 + prod(iCol,2)*dt) + enddo + endif + + if (this%ncf == 4) then + do iCol=1,nCol + ozib(iCol) = ozi(iCol,iLev) + tem = prod(iCol,1) + prod(iCol,3)*t(iCol,iLev) + prod(iCol,4)*colo3(iCol,iLev+1) + oz(iCol,iLev) = (ozib(iCol) + tem*dt) / (1.0 + prod(iCol,2)*dt) + enddo + endif + ! Diagnostics (optional) + if (associated(do3_dt_prd)) do3_dt_prd(:,iLev) = prod(:,1)*dt + if (associated(do3_dt_ozmx)) do3_dt_ozmx(:,iLev) = (oz(:,iLev) - ozib(:)) + if (associated(do3_dt_temp)) do3_dt_temp(:,iLev) = prod(:,3) * t(:,iLev) * dt + if (associated(do3_dt_ohoz)) do3_dt_ohoz(:,iLev) = prod(:,4) * colo3(:,iLev) * dt + + enddo + return end subroutine run_o3prog_2006 diff --git a/physics/ozphys.f b/physics/ozphys.f deleted file mode 100644 index 18a9ae46f..000000000 --- a/physics/ozphys.f +++ /dev/null @@ -1,211 +0,0 @@ -!> \file ozphys.f -!! This file is ozone sources and sinks (previous version). - - -!> This module contains the CCPP-compliant Ozone photochemistry scheme. - module ozphys - - contains - -! \brief Brief description of the subroutine -! -!> \section arg_table_ozphys_init Argument Table -!! \htmlinclude ozphys_init.html -!! - subroutine ozphys_init(oz_phys, errmsg, errflg) - - implicit none - logical, intent(in) :: oz_phys - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not.oz_phys) then - write (errmsg,'(*(a))') 'Logic error: oz_phys == .false.' - errflg = 1 - return - endif - - end subroutine ozphys_init - -!>\defgroup GFS_ozphys GFS ozphys Main -!! \brief The operational GFS currently parameterizes ozone production and -!! destruction based on monthly mean coefficients (\c global_o3prdlos.f77) provided by Naval -!! Research Laboratory through CHEM2D chemistry model -!! (McCormack et al. (2006) \cite mccormack_et_al_2006). -!! \section arg_table_ozphys_run Argument Table -!! \htmlinclude ozphys_run.html -!! -!> \section genal_ozphys GFS ozphys_run General Algorithm -!> @{ - subroutine ozphys_run ( & - & im, levs, ko3, dt, oz, tin, po3, & - & prsl, prdout, oz_coeff, delp, ldiag3d, & - & ntoz, dtend, dtidx, index_of_process_prod_loss, & - & index_of_process_ozmix, index_of_process_temp, & - & index_of_process_overhead_ozone, con_g, me, errmsg, errflg) -! -! this code assumes that both prsl and po3 are from bottom to top -! as are all other variables -! - use machine , only : kind_phys - implicit none -! - ! Interface variables - integer, intent(in) :: im, levs, ko3, oz_coeff, me - real(kind=kind_phys), intent(inout) :: oz(:,:) - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), ntoz, & - & index_of_process_prod_loss, index_of_process_ozmix, & - & index_of_process_temp, index_of_process_overhead_ozone - real(kind=kind_phys), intent(in) :: & - & dt, po3(:), prdout(:,:,:), & - & prsl(:,:), tin(:,:), delp(:,:), & - & con_g - real :: gravi - logical, intent(in) :: ldiag3d - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg -! - ! Local variables - integer k,kmax,kmin,l,i,j, idtend(4) - logical flg(im) - real(kind=kind_phys) pmax, pmin, tem, temp - real(kind=kind_phys) wk1(im), wk2(im), wk3(im), prod(im,oz_coeff), - & ozib(im), colo3(im,levs+1), ozi(im,levs) -! - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 -! -! save input oz in ozi - ozi = oz - gravi=1.0/con_g - - - if(ldiag3d) then - idtend(1) = dtidx(100+ntoz,index_of_process_prod_loss) ! was ozp1 - idtend(2) = dtidx(100+ntoz,index_of_process_ozmix) ! was ozp2 - idtend(3) = dtidx(100+ntoz,index_of_process_temp) ! was ozp3 - idtend(4) = dtidx(100+ntoz,index_of_process_overhead_ozone) ! was ozp4 - else - idtend=0 - endif - -! -!> - Calculate vertical integrated column ozone values. - if (oz_coeff > 2) then - colo3(:,levs+1) = 0.0 - do l=levs,1,-1 - do i=1,im - colo3(i,l) = colo3(i,l+1) + ozi(i,l) * delp(i,l) * gravi - enddo - enddo - endif -! -!> - Apply vertically linear interpolation to the ozone coefficients. - do l=1,levs - pmin = 1.0e10 - pmax = -1.0e10 -! - do i=1,im - wk1(i) = log(prsl(i,l)) - pmin = min(wk1(i), pmin) - pmax = max(wk1(i), pmax) - prod(i,:) = 0.0 - enddo - kmax = 1 - kmin = 1 - do k=1,ko3-1 - if (pmin < po3(k)) kmax = k - if (pmax < po3(k)) kmin = k - enddo -! - do k=kmin,kmax - temp = 1.0 / (po3(k) - po3(k+1)) - do i=1,im - flg(i) = .false. - if (wk1(i) < po3(k) .and. wk1(i) >= po3(k+1)) then - flg(i) = .true. - wk2(i) = (wk1(i) - po3(k+1)) * temp - wk3(i) = 1.0 - wk2(i) - endif - enddo - do j=1,oz_coeff - do i=1,im - if (flg(i)) then - prod(i,j) = wk2(i) * prdout(i,k,j) - & + wk3(i) * prdout(i,k+1,j) - endif - enddo - enddo - enddo -! - do j=1,oz_coeff - do i=1,im - if (wk1(i) < po3(ko3)) then - prod(i,j) = prdout(i,ko3,j) - endif - if (wk1(i) >= po3(1)) then - prod(i,j) = prdout(i,1,j) - endif - enddo - enddo - - if (oz_coeff == 2) then - do i=1,im - ozib(i) = ozi(i,l) ! no filling - oz(i,l) = (ozib(i) + prod(i,1)*dt) / (1.0 + prod(i,2)*dt) - enddo -! - if(idtend(1)>=1) then - dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 - & prod(:,1)*dt - endif - if(idtend(2)>=1) then - dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 - & (oz(:,l) - ozib(:)) - endif - endif -!> - Calculate the 4 terms of prognostic ozone change during time \a dt: -!! - ozp1(:,:) - Ozone production from production/loss ratio -!! - ozp2(:,:) - Ozone production from ozone mixing ratio -!! - ozp3(:,:) - Ozone production from temperature term at model layers -!! - ozp4(:,:) - Ozone production from column ozone term at model layers - if (oz_coeff == 4) then - do i=1,im - ozib(i) = ozi(i,l) ! no filling - tem = prod(i,1) + prod(i,3)*tin(i,l) - & + prod(i,4)*colo3(i,l+1) -! if (me .eq. 0) print *,'ozphys tem=',tem,' prod=',prod(i,:) -! &,' ozib=',ozib(i),' l=',l,' tin=',tin(i,l),'colo3=',colo3(i,l+1) - oz(i,l) = (ozib(i) + tem*dt) / (1.0 + prod(i,2)*dt) - enddo - if(idtend(1)>=1) then - dtend(:,l,idtend(1)) = dtend(:,l,idtend(1)) + ! was ozp1 - & prod(:,1)*dt - endif - if(idtend(2)>=1) then - dtend(:,l,idtend(2)) = dtend(:,l,idtend(2)) + ! was ozp2 - & (oz(:,l)-ozib(:)) - endif - if(idtend(3)>=1) then - dtend(:,l,idtend(3)) = dtend(:,l,idtend(3)) + ! was ozp3 - & prod(:,3)*tin(:,l)*dt - endif - if(idtend(4)>=1) then - dtend(:,l,idtend(4)) = dtend(:,l,idtend(4)) + ! was ozp4 - & prod(:,4)*colo3(:,l+1)*dt - endif - endif - enddo ! vertical loop -! - return - end subroutine ozphys_run -!> @} - - end module ozphys diff --git a/physics/ozphys.meta b/physics/ozphys.meta deleted file mode 100644 index 485e2a491..000000000 --- a/physics/ozphys.meta +++ /dev/null @@ -1,208 +0,0 @@ -[ccpp-table-properties] - name = ozphys - type = scheme - dependencies = machine.F - -######################################################################## -[ccpp-arg-table] - name = ozphys_init - type = scheme -[oz_phys] - standard_name = flag_for_nrl_2006_ozone_scheme - long_name = flag for old (2006) ozone physics - units = flag - dimensions = () - type = logical - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = ozphys_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[levs] - standard_name = vertical_layer_dimension - long_name = number of vertical layers - units = count - dimensions = () - type = integer - intent = in -[ko3] - standard_name = vertical_dimension_of_ozone_forcing_data - long_name = number of vertical layers in ozone forcing data - units = count - dimensions = () - type = integer - intent = in -[dt] - standard_name = timestep_for_physics - long_name = physics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[oz] - standard_name = ozone_concentration_of_new_state - long_name = ozone concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tin] - standard_name = air_temperature_of_new_state - long_name = updated air temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[po3] - standard_name = natural_log_of_ozone_forcing_data_pressure_levels - long_name = natural log of ozone forcing data pressure levels - units = 1 - dimensions = (vertical_dimension_of_ozone_forcing_data) - type = real - kind = kind_phys - intent = in -[prsl] - standard_name = air_pressure - long_name = mid-layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[prdout] - standard_name = ozone_forcing - long_name = ozone forcing coefficients - units = mixed - dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys - intent = in -[oz_coeff] - standard_name = number_of_coefficients_in_ozone_forcing_data - long_name = number of coefficients in ozone forcing data - units = index - dimensions = () - type = integer - intent = in -[delp] - standard_name = air_pressure_difference_between_midlayers - long_name = difference between mid-layer pressures - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for calculating 3-D diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) - type = real - kind = kind_phys - active = (flag_for_diagnostics_3D) - intent = inout -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[ntoz] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in -[index_of_process_prod_loss] - standard_name = index_of_production_and_loss_process_in_cumulative_change_index - long_name = index of production and loss effect in photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_ozmix] - standard_name = index_of_ozone_mixing_ratio_process_in_cumulative_change_index - long_name = index of ozone mixing ratio effect in photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_temp] - standard_name = index_of_temperature_process_in_cumulative_change_index - long_name = index of temperature effect in photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_overhead_ozone] - standard_name = index_of_overhead_process_in_cumulative_change_index - long_name = index of overhead ozone effect in photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () - type = real - kind = kind_phys - intent = in -[me] - standard_name = mpi_rank - long_name = rank of the current MPI task - units = index - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out From 00d90608a08f13ac367f2c002b8ae18eea4e8f6b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 28 Sep 2023 17:19:33 +0000 Subject: [PATCH 037/132] Added documentation --- physics/GFS_physics_post.F90 | 12 +++- physics/module_ozphys.F90 | 119 +++++++++++++++++++++++------------ 2 files changed, 87 insertions(+), 44 deletions(-) diff --git a/physics/GFS_physics_post.F90 b/physics/GFS_physics_post.F90 index d034c1999..e6a50cc3a 100644 --- a/physics/GFS_physics_post.F90 +++ b/physics/GFS_physics_post.F90 @@ -1,6 +1,11 @@ ! ########################################################################################### !> \file GFS_physics_post.F90 !! +!! This module contains GFS specific calculations (e.g. diagnostics) and suite specific +!! code (e.g Saving fields for subsequent physics timesteps). For interoperability across a +!! wide range of hosts, CCPP compliant schemes should avoid including such calculations. This +!! module/scheme is intended for such "host-specific" computations. +!! ! ########################################################################################### module GFS_physics_post use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec @@ -30,9 +35,10 @@ end subroutine GFS_physics_post_init !! \section arg_table_GFS_physics_post_run Argument Table !! \htmlinclude GFS_physics_post_run.html !! - subroutine GFS_physics_post_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip_ozmix, & - ip_temp, ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, dtend,& - errmsg, errflg) + subroutine GFS_physics_post_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip_ozmix, ip_temp, & + ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, dtend, errmsg, & + errflg) + ! Inputs integer, intent(in) :: & nCol, & ! Horizontal dimension diff --git a/physics/module_ozphys.F90 b/physics/module_ozphys.F90 index d24585d4d..f824736b1 100644 --- a/physics/module_ozphys.F90 +++ b/physics/module_ozphys.F90 @@ -2,6 +2,39 @@ !> \section arg_table_module_ozphys Argument table !! \htmlinclude module_ozphys.html !! +! +!> The operational GFS currently parameterizes ozone production and destruction based on +!! monthly mean coefficients (\c global_o3prdlos.f77) provided by Naval Research Laboratory +!! through CHEM2D chemistry model (McCormack et al. (2006) \cite mccormack_et_al_2006). +!! +!! There are two implementations of this parameterization within this module. +!! run_o3prog_2006 - Relies on either two/four mean monthly coefficients. This is explained +!! in (https://doi.org/10.5194/acp-6-4943-2006. See Eq.(4)). +!! run_o3prog_2015 - Relies on six mean monthly coefficients, specifically for NRL +!! parameterization and climatological T and O3 are in location 5 and 6 of +!! the coefficient array. +!! +!! Both of these rely on the scheme being setup correctly by invoking the load(), setup(), +!! and update() procedures prior to calling the run() procedure. +!! +!! load_o3prog() - Read in data and load into type ty_ozphys (called once from host) +!! setup_o3prog() - Create spatial interpolation indices (called once, after model grid is known) +!! update_o3prog() - Update ozone concentration in time (call in physics loop, before run()) +!! *CAVEAT* Since the radiation is often run at a lower temporal resolution +!! than the rest of the physics, update_o3prog() needs to be +!! called before the radiation, which is called before the physics. +!! For example, within the physics loop: +!! update_o3prog() -> radiation() -> run_o3prog() -> physics.... +!! +!! Additionally, there is the functionality to not use interactive ozone, instead reverting +!! to ozone climatology. In this case, analagous to when using prognostic ozone, there are +!! update() and run() procedures that need to be called before the radiation. +!! For example, within the physics loop: +!! update_o3clim() -> run_o3clim() -> radiation() -> physics... +!! +!!\author June 2015 - Shrinivas Moorthi +!!\modified Sep 2023 - Dustin Swales +!! ! ######################################################################################### module module_ozphys use machine, only : kind_phys @@ -14,7 +47,8 @@ module module_ozphys !> \section arg_table_ty_ozphys Argument Table !! \htmlinclude ty_ozphys.html !! -!! All data field are ordered from surface-to-toa (j=1=isfc) +!> Derived type containing data and procedures needed by ozone photochemistry parameterization +!! *Note* All data field are ordered from surface-to-toa. !! ! ######################################################################################### type ty_ozphys @@ -54,7 +88,7 @@ module module_ozphys contains ! ######################################################################################### - ! Procedure (type-bound) for loading ozone forcing data. + ! Procedure (type-bound) for loading data for prognostic ozone. ! ######################################################################################### function load_o3prog(this, file, fileID) result (err_message) class(ty_ozphys), intent(inout) :: this @@ -101,7 +135,9 @@ function load_o3prog(this, file, fileID) result (err_message) end function load_o3prog ! ######################################################################################### - ! Procedure for setting up interpolation indices between data and model grid. + ! Procedure (type-bound) for setting up interpolation indices between data-grid and + ! model-grid. + ! Called once during initialization ! ######################################################################################### subroutine setup_o3prog(this, lat, idx1, idx2, idxh) class(ty_ozphys), intent(in) :: this @@ -130,7 +166,7 @@ subroutine setup_o3prog(this, lat, idx1, idx2, idxh) end subroutine setup_o3prog ! ######################################################################################### - ! Procedure (type-bound) for updating ozone data. + ! Procedure (type-bound) for updating data used in prognostic ozone scheme. ! ######################################################################################### subroutine update_o3prog(this, idx1, idx2, idxh, rjday, idxt1, idxt2, ozpl) class(ty_ozphys), intent(in) :: this @@ -474,7 +510,7 @@ subroutine run_o3clim(this, lat, prslk, con_pi, oz) end subroutine run_o3clim ! ######################################################################################### - ! Procedure (type-bound) for loading ozone climo data. + ! Procedure (type-bound) for loading data for climotological ozone. ! ######################################################################################### function load_o3clim(this, file, fileID) result (err_message) class(ty_ozphys), intent(inout) :: this @@ -546,46 +582,47 @@ function load_o3clim(this, file, fileID) result (err_message) this%pstr(iLev) = pstr4(iLev) this%pkstr(iLev) = fpkapx(this%pstr(iLev)*100.0) enddo - + end function load_o3clim - ! ######################################################################################### - ! Procedure (type-bound) for updating ozone climotological data. - ! ######################################################################################### - subroutine update_o3clim(this, imon, iday, ihour, loz1st) - class(ty_ozphys), intent(inout) :: this - integer, intent(in) :: imon, iday, ihour - logical, intent(in) :: loz1st - - integer :: midmon=15, midm=15, midp=45, id - integer, parameter, dimension(13) :: mdays = (/31,28,31,30,31,30,31,31,30,31,30,31,30/) - logical :: change - - midmon = mdays(imon)/2 + 1 - change = loz1st .or. ( (iday==midmon) .and. (ihour==0) ) + ! ######################################################################################### + ! Procedure (type-bound) for updating temporal interpolation index when using climotological + ! ozone + ! ######################################################################################### + subroutine update_o3clim(this, imon, iday, ihour, loz1st) + class(ty_ozphys), intent(inout) :: this + integer, intent(in) :: imon, iday, ihour + logical, intent(in) :: loz1st + + integer :: midmon=15, midm=15, midp=45, id + integer, parameter, dimension(13) :: mdays = (/31,28,31,30,31,30,31,31,30,31,30,31,30/) + logical :: change + + midmon = mdays(imon)/2 + 1 + change = loz1st .or. ( (iday==midmon) .and. (ihour==0) ) - if ( change ) then - if ( iday < midmon ) then - this%k1oz = mod(imon+10, 12) + 1 - midm = mdays(this%k1oz)/2 + 1 - this%k2oz = imon - midp = mdays(this%k1oz) + midmon - else - this%k1oz = imon - midm = midmon - this%k2oz = mod(imon, 12) + 1 - midp = mdays(this%k2oz)/2 + 1 + mdays(this%k1oz) - endif - endif + if ( change ) then + if ( iday < midmon ) then + this%k1oz = mod(imon+10, 12) + 1 + midm = mdays(this%k1oz)/2 + 1 + this%k2oz = imon + midp = mdays(this%k1oz) + midmon + else + this%k1oz = imon + midm = midmon + this%k2oz = mod(imon, 12) + 1 + midp = mdays(this%k2oz)/2 + 1 + mdays(this%k1oz) + endif + endif - if (iday < midmon) then - id = iday + mdays(this%k1oz) - else - id = iday - endif + if (iday < midmon) then + id = iday + mdays(this%k1oz) + else + id = iday + endif - this%facoz = float(id - midm) / float(midp - midm) + this%facoz = float(id - midm) / float(midp - midm) - end subroutine update_o3clim + end subroutine update_o3clim -end module module_ozphys + end module module_ozphys From e08ecd648a3f984a79e1dfd042f66edfbfb54d62 Mon Sep 17 00:00:00 2001 From: Helin Wei Date: Fri, 6 Oct 2023 15:07:48 -0400 Subject: [PATCH 038/132] land surface updates for hr3 --- physics/module_sf_noahmplsm.F90 | 15 +++++++++------ physics/noahmpdrv.F90 | 2 +- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/physics/module_sf_noahmplsm.F90 b/physics/module_sf_noahmplsm.F90 index 86853dabe..8ced8930f 100644 --- a/physics/module_sf_noahmplsm.F90 +++ b/physics/module_sf_noahmplsm.F90 @@ -2116,7 +2116,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ! thermal properties of soil, snow, lake, and frozen soil call thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in - dt ,snowh ,snice ,snliq , & !in + dt ,snowh ,snice ,snliq , shdfac, & !in smc ,sh2o ,tg ,stc ,ur , & !in lat ,z0m ,zlvl ,vegtyp , & !in df ,hcpct ,snicev ,snliqv ,epore , & !out @@ -2463,7 +2463,7 @@ end subroutine energy !>\ingroup NoahMP_LSM subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , & !in - dt ,snowh ,snice ,snliq , & !in + dt ,snowh ,snice ,snliq , shdfac, & !in smc ,sh2o ,tg ,stc ,ur , & !in lat ,z0m ,zlvl ,vegtyp , & !in df ,hcpct ,snicev ,snliqv ,epore , & !out @@ -2480,6 +2480,7 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , real (kind=kind_phys) , intent(in) :: dt !< time step [s] real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !< snow ice mass (kg/m2) real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !< snow liq mass (kg/m2) + real (kind=kind_phys) , intent(in) :: shdfac !< green vegetation fraction [0.0-1.0] real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !< thickness of snow/soil layers [m] real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !< soil moisture (ice + liq.) [m3/m3] real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sh2o !< liquid soil moisture [m3/m3] @@ -2539,6 +2540,7 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , ! not in use because of the separation of the canopy layer from the ground. ! but this may represent the effects of leaf litter (niu comments) ! df1 = df1 * exp (sbeta * shdfac) + df(1) = df(1) * exp (sbeta * shdfac) ! compute lake thermal properties ! (no consideration of turbulent mixing for this version) @@ -4888,7 +4890,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & end if endif ! 4 -! use sfc_diag to calculate t2mv and q2v for opt_sfc=1&3 +! use sfc_diag to calculate t2mb and q2b for opt_sfc=1&3 if(opt_diag ==3) then if(opt_sfc == 1 .or. opt_sfc == 3) then @@ -5823,7 +5825,8 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, elseif (opt_trs == chen09) then - z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) +! z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) +! z0m_out = fveg * z0m + (1.0 - fveg) * z0mg czil = 10.0 ** (- 0.4 * parameters%hvt) reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c @@ -5873,7 +5876,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out - elseif (opt_trs == tessel) then + elseif (opt_trs == chen09 .or. opt_trs == tessel) then if (vegtyp <= 5) then z0h_out = z0m_out @@ -5881,7 +5884,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out * 0.01 endif - elseif (opt_trs == blumel99 .or. opt_trs == chen09) then + elseif (opt_trs == blumel99) then reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c if (reyn > 2.0) then diff --git a/physics/noahmpdrv.F90 b/physics/noahmpdrv.F90 index 4500d51a8..c2c03d0de 100644 --- a/physics/noahmpdrv.F90 +++ b/physics/noahmpdrv.F90 @@ -450,7 +450,7 @@ subroutine noahmpdrv_run & integer :: iopt_pedo = 1 ! option for pedotransfer function integer :: iopt_crop = 0 ! option for crop model integer :: iopt_gla = 2 ! option for glacier treatment - integer :: iopt_z0m = 2 ! option for z0m treatment + integer :: iopt_z0m = 1 ! option for z0m treatment ! ! --- local inputs to noah-mp and glacier subroutines; listed in order in noah-mp call From 4f8004ab57b85d76884858849a5f4211f28d3084 Mon Sep 17 00:00:00 2001 From: Helin Wei Date: Fri, 6 Oct 2023 18:05:17 -0400 Subject: [PATCH 039/132] remove one printout from sfcsub.f and uncomment z0m composition in module_sf_noahmplsm.F90 --- physics/module_sf_noahmplsm.F90 | 2 +- physics/sfcsub.F | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/physics/module_sf_noahmplsm.F90 b/physics/module_sf_noahmplsm.F90 index 8ced8930f..6abd59f69 100644 --- a/physics/module_sf_noahmplsm.F90 +++ b/physics/module_sf_noahmplsm.F90 @@ -5826,7 +5826,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, elseif (opt_trs == chen09) then ! z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) -! z0m_out = fveg * z0m + (1.0 - fveg) * z0mg + z0m_out = fveg * z0m + (1.0 - fveg) * z0mg czil = 10.0 ** (- 0.4 * parameters%hvt) reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 7be07b39c..494b8f7dc 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -7491,9 +7491,6 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & endif call abort endif -! -! soil type - print *,'in FIXREAD fnsotc =',fnsotc ! if(fnsotc(1:8).ne.' ') then if ( index(fnsotc, "tileX.nc") == 0) then ! grib file From 5bd6da748d22564212a448ba0e143fb8ada23722 Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Wed, 11 Oct 2023 14:21:32 -0500 Subject: [PATCH 040/132] Set initial values for some constants (just in case) --- physics/module_mp_nssl_2mom.F90 | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/module_mp_nssl_2mom.F90 index a40a62f02..a88ffe053 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/module_mp_nssl_2mom.F90 @@ -951,19 +951,20 @@ MODULE module_mp_nssl_2mom real, parameter :: cawbolton = 17.67 real, parameter :: tfrh = 233.15 +! -------------------------- + ! For CCPP, the following variables should be set by the host model, but initial values are set just in case real :: tfr = 273.15 - real :: cp = 1004.0, rd = 287.04 real :: rw = 461.5 ! gas const. for water vapor - REAL, PRIVATE :: cpl = 4190.0 - REAL, PRIVATE :: cpigb = 2106.0 - real :: cpi - real :: cap - real :: tfrcbw - real :: tfrcbi - real :: rovcp - real, public :: rdorv = 0.622 - + real :: cpl = 4190.0 + real :: cpigb = 2106.0 + real :: cpi = 1.0/1004.0 + real :: cap = 287.04/1004.0 + real :: tfrcbw = 273.15 - cbw + real :: tfrcbi = 273.15 - cbi + real :: rovcp = 287.04/1004.0 + real :: rdorv = 0.622 +! -------------------------- real, parameter :: poo = 1.0e+05 real, parameter :: advisc0 = 1.832e-05 ! reference dynamic viscosity (SMT; see Beard & Pruppacher 71) real, parameter :: advisc1 = 1.718e-05 ! dynamic viscosity constant used in thermal conductivity calc @@ -4113,7 +4114,7 @@ subroutine hailmaxd(dtp,nx,ny,nz,an,na,nor,norz,alpha2d,dn, & g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami tmp = dn(ix,jy,kz)*an(ix,jy,kz,lh)/(hwdn*an(ix,jy,kz,lnh)) - diam = (6.0*tmp/(3.14159))**(1./3.) + diam = (6.0*tmp/pi)**(1./3.) IF ( lzh > 1 ) THEN ! 3moment cwchtmp = ((3. + alpha2d(ix,1,kz,2))*(2. + alpha2d(ix,1,kz,2))*(1.0 + alpha2d(ix,1,kz,2)))**(-1./3.) ENDIF @@ -4184,7 +4185,7 @@ subroutine hailmaxd(dtp,nx,ny,nz,an,na,nor,norz,alpha2d,dn, & g1palp = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami tmp = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/(hwdn*an(ix,jy,kz,lnhl)) - diam = (6.0*tmp/(3.14159))**(1./3.) + diam = (6.0*tmp/pi)**(1./3.) IF ( lzhl > 1 ) THEN ! 3moment cwchltmp = ((3. + alpha2d(ix,1,kz,3))*(2. + alpha2d(ix,1,kz,3))*(1.0 + alpha2d(ix,1,kz,3)))**(-1./3.) ENDIF From 1b2239714a949341409261ebbfb8a0bdf6a4f5da Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 12 Oct 2023 03:40:06 +0000 Subject: [PATCH 041/132] Some more cleanup --- physics/GFS_physics_post.F90 | 99 ++++++++++++++++++++++++++++++----- physics/GFS_physics_post.meta | 49 +++++++++++++++++ physics/phys_tend.F90 | 96 --------------------------------- physics/phys_tend.meta | 95 --------------------------------- 4 files changed, 134 insertions(+), 205 deletions(-) delete mode 100644 physics/phys_tend.F90 delete mode 100644 physics/phys_tend.meta diff --git a/physics/GFS_physics_post.F90 b/physics/GFS_physics_post.F90 index e6a50cc3a..def38cd1a 100644 --- a/physics/GFS_physics_post.F90 +++ b/physics/GFS_physics_post.F90 @@ -35,47 +35,62 @@ end subroutine GFS_physics_post_init !! \section arg_table_GFS_physics_post_run Argument Table !! \htmlinclude GFS_physics_post_run.html !! - subroutine GFS_physics_post_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip_ozmix, ip_temp, & - ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, dtend, errmsg, & - errflg) + subroutine GFS_physics_post_run(nCol, nLev, ntoz, ntracp100, nprocess, nprocess_summed, & + dtidx, is_photochem, ldiag3d, ip_physics, ip_photochem, & + ip_prod_loss, ip_ozmix, ip_temp, ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, & + do3_dt_temp, do3_dt_ohoz, dtend, errmsg, errflg) ! Inputs integer, intent(in) :: & nCol, & ! Horizontal dimension nLev, & ! Number of vertical layers ntoz, & ! Index for ozone mixing ratio + ntracp100, & ! Number of tracers plus 100 + nprocess, & ! Number of processes that cause changes in state variables + nprocess_summed,& ! Number of causes in dtidx per tracer summed for total physics tendency + ip_physics, & ! Index for process in diagnostic tendency output + ip_photochem, & ! ip_prod_loss, & ! Index for process in diagnostic tendency output ip_ozmix, & ! Index for process in diagnostic tendency output ip_temp, & ! Index for process in diagnostic tendency output ip_overhead_ozone ! Index for process in diagnostic tendency output integer, intent(in), dimension(:,:) :: & dtidx ! Bookkeeping indices for GFS diagnostic tendencies + logical, intent(in) :: & + ldiag3d ! Flag for 3d diagnostic fields + logical, intent(in), dimension(:) :: & + is_photochem ! Flags for photochemistry processes to sum ! Inputs (optional) real(kind=kind_phys), intent(in), dimension(:,:), pointer, optional :: & - do3_dt_prd, & ! Physics tendency: production and loss effect - do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect - do3_dt_temp, & ! Physics tendency: temperature effect - do3_dt_ohoz ! Physics tendency: overhead ozone effect + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz ! Physics tendency: overhead ozone effect ! Outputs real(kind=kind_phys), intent(inout), dimension(:,:,:) :: & - dtend ! Diagnostic tendencies for state variables + dtend ! Diagnostic tendencies for state variables character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag + errflg ! CCPP error flag ! Locals - integer :: idtend - + integer :: idtend, ichem, iphys, itrac + logical :: all_true(nprocess) + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + if(.not.ldiag3d) then + return + endif + ! ####################################################################################### ! - ! Ozone physics diagnostic + ! Ozone physics diagnostics ! ! ####################################################################################### idtend = dtidx(100+ntoz,ip_prod_loss) @@ -98,6 +113,62 @@ subroutine GFS_physics_post_run(nCol, nLev, ntoz, dtidx, ip_prod_loss, ip_ozmix, dtend(:,:,idtend) = dtend(:,:,idtend) + do3_dt_ohoz endif - end subroutine GFS_physics_post_run + ! ####################################################################################### + ! + ! Total (photochemical) tendencies. + ! + ! ####################################################################################### + itrac = ntoz+100 + ichem = dtidx(itrac, ip_photochem) + if(ichem >= 1) then + call sum_it(ichem, itrac, is_photochem) + endif + ! ####################################################################################### + ! + ! Total (physics) tendencies + ! + ! ####################################################################################### + all_true = .true. + do itrac = 2,ntracp100 + iphys = dtidx(itrac,ip_physics) + if(iphys >= 1) then + call sum_it(iphys, itrac, all_true) + endif + enddo + + contains + + subroutine sum_it(isum,itrac,sum_me) + integer, intent(in) :: isum ! third index of dtend of summary process + integer, intent(in) :: itrac ! tracer or state variable being summed + logical, intent(in) :: sum_me(nprocess) ! false = skip this process + logical :: first + integer :: idtend, iprocess + + first=.true. + do iprocess=1,nprocess + if(iprocess>nprocess_summed) then + exit ! Don't sum up the sums. + else if(.not.sum_me(iprocess)) then + cycle ! We were asked to skip this one. + endif + idtend = dtidx(itrac,iprocess) + if(idtend>=1) then + ! This tendency was calculated for this tracer, so + ! accumulate it into the total tendency. + if(first) then + dtend(:,:,isum) = dtend(:,:,idtend) + first=.false. + else + dtend(:,:,isum) = dtend(:,:,isum) + dtend(:,:,idtend) + endif + endif + enddo + if(first) then + ! No tendencies were calculated, so sum is 0: + dtend(:,:,isum) = 0 + endif + end subroutine sum_it + end subroutine GFS_physics_post_run end module GFS_physics_post diff --git a/physics/GFS_physics_post.meta b/physics/GFS_physics_post.meta index 8b5120b9e..649ef6491 100644 --- a/physics/GFS_physics_post.meta +++ b/physics/GFS_physics_post.meta @@ -63,6 +63,55 @@ dimensions = () type = integer intent = in +[ntracp100] + standard_name = number_of_tracers_plus_one_hundred + long_name = number of tracers plus one hundred + units = count + dimensions = () + type = integer + intent = in +[nprocess] + standard_name = number_of_cumulative_change_processes + long_name = number of processes that cause changes in state variables + units = count + dimensions = () + type = integer + intent = in +[nprocess_summed] + standard_name = number_of_physics_causes_of_tracer_changes + long_name = number of causes in dtidx per tracer summed for total physics tendency + units = count + dimensions = () + type = integer + intent = in +[ip_physics] + standard_name = index_of_all_physics_process_in_cumulative_change_index + long_name = index of all physics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ip_photochem] + standard_name = index_of_photochemistry_process_in_cumulative_change_index + long_name = index of photochemistry process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[is_photochem] + standard_name = flags_for_photochemistry_processes_to_sum + long_name = flags for photochemistry processes to sum as the total photochemistry process cumulative change + units = flag + dimensions = (number_of_cumulative_change_processes) + type = logical + intent = in +[ldiag3d] + standard_name = flag_for_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in [ip_prod_loss] standard_name = index_of_production_and_loss_process_in_cumulative_change_index long_name = index of production and loss effect in photochemistry process in second dimension of array cumulative change index diff --git a/physics/phys_tend.F90 b/physics/phys_tend.F90 deleted file mode 100644 index e63f44be5..000000000 --- a/physics/phys_tend.F90 +++ /dev/null @@ -1,96 +0,0 @@ -!>\file phys_tend.F90 -!! -module phys_tend - - use machine, only: kind_phys - - implicit none - - private - - public phys_tend_run - -contains - -!> \section arg_table_phys_tend_run Argument Table -!! \htmlinclude phys_tend_run.html -!! - subroutine phys_tend_run(ldiag3d, dtend, dtidx, ntracp100, & - index_of_process_physics, index_of_process_photochem, & - nprocess, nprocess_summed, is_photochem, ntoz, errmsg, errflg) - - ! Interface variables - logical, intent(in) :: ldiag3d, is_photochem(:) - real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_process_physics, ntoz, & - ntracp100, nprocess, nprocess_summed, index_of_process_photochem - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: ichem, iphys, itrac - logical :: all_true(nprocess) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if(.not.ldiag3d) then - return - endif - - all_true = .true. - - ! Total photochemical tendencies - itrac=ntoz+100 - ichem = dtidx(itrac,index_of_process_photochem) - if(ichem>=1) then - call sum_it(ichem,itrac,is_photochem) - endif - - - do itrac=2,ntracp100 - ! Total physics tendencies - iphys = dtidx(itrac,index_of_process_physics) - if(iphys>=1) then - call sum_it(iphys,itrac,all_true) - endif - enddo - - contains - - subroutine sum_it(isum,itrac,sum_me) - implicit none - integer, intent(in) :: isum ! third index of dtend of summary process - integer, intent(in) :: itrac ! tracer or state variable being summed - logical, intent(in) :: sum_me(nprocess) ! false = skip this process - logical :: first - integer :: idtend, iprocess - - first=.true. - do iprocess=1,nprocess - if(iprocess>nprocess_summed) then - exit ! Don't sum up the sums. - else if(.not.sum_me(iprocess)) then - cycle ! We were asked to skip this one. - endif - idtend = dtidx(itrac,iprocess) - if(idtend>=1) then - ! This tendency was calculated for this tracer, so - ! accumulate it into the total tendency. - if(first) then - dtend(:,:,isum) = dtend(:,:,idtend) - first=.false. - else - dtend(:,:,isum) = dtend(:,:,isum) + dtend(:,:,idtend) - endif - endif - enddo - if(first) then - ! No tendencies were calculated, so sum is 0: - dtend(:,:,isum) = 0 - endif - end subroutine sum_it - - end subroutine phys_tend_run - -end module phys_tend diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta deleted file mode 100644 index 0f78af20b..000000000 --- a/physics/phys_tend.meta +++ /dev/null @@ -1,95 +0,0 @@ -[ccpp-table-properties] - name = phys_tend - type = scheme - dependencies = machine.F - -######################################################################## -[ccpp-arg-table] - name = phys_tend_run - type = scheme -[ldiag3d] - standard_name = flag_for_diagnostics_3D - long_name = flag for 3d diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) - type = real - kind = kind_phys - intent = inout -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[ntracp100] - standard_name = number_of_tracers_plus_one_hundred - long_name = number of tracers plus one hundred - units = count - dimensions = () - type = integer - intent = in -[index_of_process_physics] - standard_name = index_of_all_physics_process_in_cumulative_change_index - long_name = index of all physics transport process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_photochem] - standard_name = index_of_photochemistry_process_in_cumulative_change_index - long_name = index of photochemistry process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[nprocess] - standard_name = number_of_cumulative_change_processes - long_name = number of processes that cause changes in state variables - units = count - dimensions = () - type = integer - intent = in -[nprocess_summed] - standard_name = number_of_physics_causes_of_tracer_changes - long_name = number of causes in dtidx per tracer summed for total physics tendency - units = count - dimensions = () - type = integer - intent = in -[is_photochem] - standard_name = flags_for_photochemistry_processes_to_sum - long_name = flags for photochemistry processes to sum as the total photochemistry process cumulative change - units = flag - dimensions = (number_of_cumulative_change_processes) - type = logical - intent = in -[ntoz] - standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out From 06bb2bcc9ea2fa5dd52d8f0aa8be2f41b65ab8c0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 12 Oct 2023 15:17:00 +0000 Subject: [PATCH 042/132] Final cleanup --- physics/GFS_phys_time_vary.scm.F90 | 83 +++++++++++++++++++++++------ physics/GFS_phys_time_vary.scm.meta | 75 +++++++++++++++++++++++++- physics/GFS_physics_post.F90 | 24 ++------- physics/GFS_physics_post.meta | 20 ------- 4 files changed, 144 insertions(+), 58 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 97460ac98..075bfc039 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -2,15 +2,17 @@ !! Contains code related to GFS physics suite setup (physics part of time_vary_step) !>\defgroup mod_GFS_phys_time_vary GFS Physics Time Update -!! This module contains GFS physics time vary subroutines including, stratospheric water vapor, +!! This module contains GFS physics time vary subroutines including stratospheric water vapor, !! aerosol, IN&CCN and surface properties updates. !> @{ module GFS_phys_time_vary - use machine, only : kind_phys + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec use mersenne_twister, only: random_setseed, random_number + use module_ozphys, only: ty_ozphys + use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol @@ -58,8 +60,8 @@ module GFS_phys_time_vary !>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm !! @{ subroutine GFS_phys_time_vary_init ( & - me, master, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & - jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + me, master, ntoz, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & + jindx1_o3, jindx2_o3, ddy_o3, ozphys, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -76,14 +78,14 @@ subroutine GFS_phys_time_vary_init ( implicit none ! Interface variables - integer, intent(in) :: me, master, iccn, iflip, im, nx, ny + integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) - integer, intent(inout) :: jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(inout) :: ddy_h(:) + integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(in) :: h2opl(:,:,:) integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) @@ -101,6 +103,7 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: min_seaice, fice(:) real(kind_phys), intent(in) :: landfrac(:) real(kind_phys), intent(inout) :: weasd(:) + type(ty_ozphys), intent(in) :: ozphys ! NoahMP - only allocated when NoahMP is used integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound @@ -244,6 +247,11 @@ subroutine GFS_phys_time_vary_init ( !> - Initialize soil vegetation (needed for sncovr calculation further down) call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) +!> - Setup spatial interpolation indices for ozone physics. + if (ntoz > 0) then + call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + endif + !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) @@ -625,8 +633,8 @@ end subroutine GFS_phys_time_vary_init !! @{ subroutine GFS_phys_time_vary_timestep_init ( & me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, h2o_phys, iaerclm, iccn, clstp, & - jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & + imfdeepcnv, cal_pre, random_clds, ozphys, ntoz, h2o_phys, iaerclm, iccn, clstp, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & imap, jmap, prsl, seed0, rann, do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau,& @@ -636,14 +644,14 @@ subroutine GFS_phys_time_vary_timestep_init ( ! Interface variables integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & - nsswr, imfdeepcnv, iccn, iflip + nsswr, imfdeepcnv, iccn, ntoz, iflip integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm real(kind_phys), intent(out) :: clstp - integer, intent(in) :: jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in) :: ddy_h(:) - real(kind_phys), intent(inout) :: h2opl(:,:,:) + integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) @@ -659,15 +667,19 @@ subroutine GFS_phys_time_vary_timestep_init ( integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) + type(ty_ozphys), intent(in) :: ozphys integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: i, j, k, iseed, iskip, ix - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(cny) - real(kind=kind_phys) :: rndval(cnx*cny*nrcm) + integer :: i, j, k, iseed, iskip, ix, idat(8), jdat(8), iday, j1, j2, nc, n1, n2, jdow, & + jdoy, jday, w3kindreal, w3kindint + real(kind_phys) :: wrk(1), tem, tx1, tx2, rjday + real(kind_phys) :: rannie(cny) + real(kind_phys) :: rndval(cnx*cny*nrcm) + real(kind_dbl_prec) :: rinc(5) + real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' @@ -721,6 +733,43 @@ subroutine GFS_phys_time_vary_timestep_init ( endif ! imfdeepcnv, cal_re, random_clds + !> - Compute temporal interpolation indices for updating gas concentrations. + idat=0 + idat(1)=idate(4) + idat(2)=idate(2) + idat(3)=idate(3) + idat(5)=idate(1) + rinc=0. + rinc(2)=fhour + call w3kind(w3kindreal,w3kindint) + if(w3kindreal==4) then + rinc4=rinc + CALL w3movdat(rinc4,idat,jdat) + else + CALL w3movdat(rinc,idat,jdat) + endif + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + if (rjday < ozphys%time(1)) rjday = rjday + 365. + + n2 = ozphys%ntime + 1 + do j=2,ozphys%ntime + if (rjday < ozphys%time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime + +!> - Update ozone concentration. + if (ntoz > 0) then + call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) + endif + !> - Call h2ointerpol() to make stratospheric water vapor data interpolation if (h2o_phys) then call h2ointerpol (me, im, idate, fhour, & diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 21d1f2736..cf5ad15ca 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -2,7 +2,7 @@ name = GFS_phys_time_vary type = scheme dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,cires_tauamf_data.F90,noahmp_tables.f90 + dependencies = namelist_soilveg.f,set_soilveg.f,module_ozphys.F90,cires_tauamf_data.F90,noahmp_tables.f90 ######################################################################## [ccpp-arg-table] @@ -23,6 +23,13 @@ dimensions = () type = integer intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in [h2o_phys] standard_name = flag_for_stratospheric_water_vapor_physics long_name = flag for stratospheric water vapor physics @@ -95,6 +102,28 @@ type = real kind = kind_phys intent = in +[jindx1_o3] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[jindx2_o3] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[ddy_o3] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -1019,6 +1048,13 @@ dimensions = () type = logical intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in [h2o_phys] standard_name = flag_for_stratospheric_water_vapor_physics long_name = flag for stratospheric water vapor physics @@ -1048,6 +1084,36 @@ type = real kind = kind_phys intent = out +[jindx1_o3] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[jindx2_o3] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[ddy_o3] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_dimension,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) + type = real + kind = kind_phys + intent = inout [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -1279,6 +1345,13 @@ type = real kind = kind_phys intent = inout +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in [nthrds] standard_name = number_of_openmp_threads long_name = number of OpenMP threads available for physics schemes diff --git a/physics/GFS_physics_post.F90 b/physics/GFS_physics_post.F90 index def38cd1a..f89b257a8 100644 --- a/physics/GFS_physics_post.F90 +++ b/physics/GFS_physics_post.F90 @@ -13,22 +13,6 @@ module GFS_physics_post public GFS_physics_post_init, GFS_physics_post_run contains -! ########################################################################################### -! SUBROUTINE GFS_physics_post_init -! ########################################################################################### -!! \section arg_table_GFS_physics_post_init Argument Table -!! \htmlinclude GFS_physics_post_init.html -!! - subroutine GFS_physics_post_init(errmsg, errflg) - - ! Outputs - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error flag - - end subroutine GFS_physics_post_init - ! ########################################################################################### ! SUBROUTINE GFS_physics_post_run ! ########################################################################################### @@ -36,9 +20,9 @@ end subroutine GFS_physics_post_init !! \htmlinclude GFS_physics_post_run.html !! subroutine GFS_physics_post_run(nCol, nLev, ntoz, ntracp100, nprocess, nprocess_summed, & - dtidx, is_photochem, ldiag3d, ip_physics, ip_photochem, & - ip_prod_loss, ip_ozmix, ip_temp, ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, & - do3_dt_temp, do3_dt_ohoz, dtend, errmsg, errflg) + dtidx, is_photochem, ldiag3d, ip_physics, ip_photochem, ip_prod_loss, ip_ozmix, & + ip_temp, ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, & + dtend, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -49,7 +33,7 @@ subroutine GFS_physics_post_run(nCol, nLev, ntoz, ntracp100, nprocess, nprocess_ nprocess, & ! Number of processes that cause changes in state variables nprocess_summed,& ! Number of causes in dtidx per tracer summed for total physics tendency ip_physics, & ! Index for process in diagnostic tendency output - ip_photochem, & ! + ip_photochem, & ! Index for process in diagnostic tendency output ip_prod_loss, & ! Index for process in diagnostic tendency output ip_ozmix, & ! Index for process in diagnostic tendency output ip_temp, & ! Index for process in diagnostic tendency output diff --git a/physics/GFS_physics_post.meta b/physics/GFS_physics_post.meta index 649ef6491..5701909fd 100644 --- a/physics/GFS_physics_post.meta +++ b/physics/GFS_physics_post.meta @@ -3,26 +3,6 @@ type = scheme dependencies = machine.F -######################################################################## -[ccpp-arg-table] - name = GFS_physics_post_init - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - ######################################################################## [ccpp-arg-table] name = GFS_physics_post_run From 89af3d8946ab25737628a016fe89356a261155ac Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 12 Oct 2023 15:45:58 +0000 Subject: [PATCH 043/132] Omission from previous commit --- physics/GFS_physics_post.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_physics_post.F90 b/physics/GFS_physics_post.F90 index f89b257a8..fe5409353 100644 --- a/physics/GFS_physics_post.F90 +++ b/physics/GFS_physics_post.F90 @@ -10,7 +10,7 @@ module GFS_physics_post use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec implicit none - public GFS_physics_post_init, GFS_physics_post_run + public GFS_physics_post_run contains ! ########################################################################################### From f0117dfcf75a5fd0ea74383ae2b0f36c3df9d48e Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 12 Oct 2023 16:27:32 +0000 Subject: [PATCH 044/132] Changes in RUC LSM: 1. adding a heat source from fires. It is icontrolled by a flag and not turned on yet. Needs more testing. 2. Adding output of surface paramteres: leaf area index (LAI), wilting point and soil field capacity. --- physics/lsm_ruc.F90 | 105 ++++++++++++++++++++++++----------- physics/lsm_ruc.meta | 17 +++++- physics/module_sf_ruclsm.F90 | 29 +++++++++- 3 files changed, 115 insertions(+), 36 deletions(-) diff --git a/physics/lsm_ruc.F90 b/physics/lsm_ruc.F90 index 665fe6d14..d3754b68c 100644 --- a/physics/lsm_ruc.F90 +++ b/physics/lsm_ruc.F90 @@ -359,6 +359,7 @@ subroutine lsm_ruc_run & ! inputs & qsurf_ice, gflux_ice, evap_ice, ep1d_ice, hflx_ice, & & cm_ice, ch_ice, snowfallac_ice, acsnow_ice, snowmt_ice, & & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + & add_fire_heat_flux, fire_heat_flux_out, & ! --- out & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & @@ -381,7 +382,7 @@ subroutine lsm_ruc_run & ! inputs real (kind_phys), dimension(:), intent(in) :: oro, sigma real (kind_phys), dimension(:), intent(in) :: & - & t1, sigmaf, laixy, dlwflx, dswsfc, tg3, & + & t1, sigmaf, dlwflx, dswsfc, tg3, & & coszen, prsl1, wind, shdmin, shdmax, & & sfalb_lnd_bck, snoalb, zf, qc, q1, & ! for land @@ -417,7 +418,7 @@ subroutine lsm_ruc_run & ! inputs real (kind_phys), dimension(:), intent(in) :: zs real (kind_phys), dimension(:), intent(in) :: srflag real (kind_phys), dimension(:), intent(inout) :: & - & canopy, trans, smcwlt2, smcref2, & + & canopy, trans, smcwlt2, smcref2, laixy, & ! for land & weasd_lnd, snwdph_lnd, tskin_lnd, & & tsurf_lnd, z0rl_lnd, tsnow_lnd, & @@ -430,6 +431,8 @@ subroutine lsm_ruc_run & ! inputs ! --- in real (kind_phys), dimension(:), intent(in) :: & & rainnc, rainc, ice, snow, graupel, rhonewsn1 + real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out + logical, intent(in) :: add_fire_heat_flux ! --- in/out: ! --- on RUC levels real (kind_phys), dimension(:,:), intent(inout) :: & @@ -505,12 +508,13 @@ subroutine lsm_ruc_run & ! inputs & solnet_lnd, sfcexc, & & runoff1, runoff2, acrunoff, semis_bck, & & sfcems_lnd, hfx_lnd, shdfac, shdmin1d, shdmax1d, & + & fire_heat_flux1d, & & sneqv_lnd, snoalb1d_lnd, snowh_lnd, snoh_lnd, tsnav_lnd, & & snomlt_lnd, sncovr_lnd, soilw, soilm, ssoil_lnd, & & soilt_lnd, tbot, & & xlai, swdn, z0_lnd, znt_lnd, rhosnfr, infiltr, & - & precipfr, snfallac_lnd, acsn_lnd, & - & qsfc_lnd, qsg_lnd, qvg_lnd, qcg_lnd, soilt1_lnd, chklowq + & precipfr, snfallac_lnd, acsn_lnd, soilt1_lnd, chklowq, & + & qsfc_lnd, qsg_lnd, qvg_lnd, qcg_lnd, smcwlt, smcref ! ice real (kind_phys),dimension (im,1) :: & & albbck_ice, alb_ice, chs_ice, flhc_ice, flqc_ice, & @@ -540,7 +544,7 @@ subroutine lsm_ruc_run & ! inputs integer :: l, k, i, j, fractional_seaice, ilst real (kind_phys) :: dm, cimin(im) logical :: flag(im), flag_ice(im), flag_ice_uncoupled(im) - logical :: rdlai2d, myj, frpcpn + logical :: myj, frpcpn logical :: debug_print !-- diagnostic point @@ -645,15 +649,38 @@ subroutine lsm_ruc_run & ! inputs nsoil = lsoil_ruc do i = 1, im ! i - horizontal loop - ! reassign smcref2 and smcwlt2 to RUC values - if(.not. land(i)) then - !water and sea ice - smcref2 (i) = one - smcwlt2 (i) = zero + ! reassign smcref2 and smcwlt2 to RUC values at kdt=1 + if(kdt == 1) then + if(.not. land(i)) then + !water and sea ice + smcref (i,1) = one + smcwlt (i,1) = zero + xlai (i,1) = zero + else + !land + smcref (i,1) = REFSMC(stype(i)) + smcwlt (i,1) = WLTSMC(stype(i)) + + !-- rdlai is .true. when the LAI data is available in the INPUT/sfc_data.nc on cold-start + if(rdlai) then + xlai(i,1) = laixy(i) + else + xlai(i,1) = LAITBL(vtype(i)) + endif + endif else - !land - smcref2 (i) = REFSMC(stype(i)) - smcwlt2 (i) = WLTSMC(stype(i)) + !-- if kdt > 1, parameters with sub-grid heterogeneity + if(.not. land(i)) then + !water and sea ice + smcref (i,1) = one + smcwlt (i,1) = zero + xlai (i,1) = zero + else + !land + smcref (i,1) = smcref2 (i) + smcwlt (i,1) = smcwlt2 (i) + xlai (i,1) = laixy (i) + endif endif enddo @@ -813,10 +840,6 @@ subroutine lsm_ruc_run & ! inputs ffrozp(i,j) = real(nint(srflag(i)),kind_phys) endif - !-- rdlai is .false. when the LAI data is not available in the - ! - INPUT/sfc_data.nc - - rdlai2d = rdlai conflx2(i,1,j) = zf(i) * 2._kind_phys ! factor 2. is needed to get the height of ! atm. forcing inside RUC LSM (inherited @@ -843,14 +866,15 @@ subroutine lsm_ruc_run & ! inputs !!\n \a graupelncv - time-step graupel (\f$kg m^{-2} \f$) !!\n \a snowncv - time-step snow (\f$kg m^{-2} \f$) !!\n \a precipfr - time-step precipitation in solid form (\f$kg m^{-2} \f$) -!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-1.0) -!!\n \a shdmin - minimum areal fractional coverage of green vegetation -> !shdmin1d -!!\n \a shdmax - maximum areal fractional coverage of green vegetation -> !shdmax1d +!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-100.%) +!!\n \a shdmin - minimum areal fractional coverage of green vegetation in % -> !shdmin1d +!!\n \a shdmax - maximum areal fractional coverage of green vegetation in % -> !shdmax1d !!\n \a tbot - bottom soil temperature (local yearly-mean sfc air temp) lwdn(i,j) = dlwflx(i) !..downward lw flux at sfc in w/m2 swdn(i,j) = dswsfc(i) !..downward sw flux at sfc in w/m2 + ! all precip input to RUC LSM is in [mm] !prcp(i,j) = rhoh2o * tprcp(i) ! tprcp in [m] - convective plus explicit !raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip @@ -918,17 +942,12 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'MODIS landuse is not available' endif - if(rdlai2d) then - xlai(i,j) = laixy(i) - else - xlai(i,j) = zero - endif - semis_bck(i,j) = semisbase(i) ! --- units % shdfac(i,j) = sigmaf(i)*100._kind_phys shdmin1d(i,j) = shdmin(i)*100._kind_phys shdmax1d(i,j) = shdmax(i)*100._kind_phys + fire_heat_flux1d(i,j) = fire_heat_flux_out(i) ! JLS if (land(i)) then ! at least some land in the grid cell @@ -976,6 +995,12 @@ subroutine lsm_ruc_run & ! inputs snoalb1d_lnd(i,j) = snoalb(i) albbck_lnd(i,j) = min(0.9_kind_phys,albbcksol(i)) !sfalb_lnd_bck(i) + IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then ! JLS + ! limit albedo and greenness in the areas affected by the fire + albbck_lnd(i,j) = min(0.1_kind_phys,albbck_lnd(i,j)) + shdfac(i,j) = min(50._kind_phys,shdfac(i,j)) ! % + ENDIF + !-- spp_lsm if (spp_lsm == 1) then @@ -1163,7 +1188,7 @@ subroutine lsm_ruc_run & ! inputs & wet(i,j), cmc(i,j), shdfac(i,j), alb_lnd(i,j), znt_lnd(i,j), & & z0_lnd(i,j), snoalb1d_lnd(i,j), albbck_lnd(i,j), & & xlai(i,j), landusef(i,:,j), nlcat, & - & soilctop(i,:,j), nscat, & + & soilctop(i,:,j), nscat, smcwlt(i,j), smcref(i,j), & & qsfc_lnd(i,j), qsg_lnd(i,j), qvg_lnd(i,j), qcg_lnd(i,j), & & dew_lnd(i,j), soilt1_lnd(i,j), & & tsnav_lnd(i,j), tbot(i,j), vtype_lnd(i,j), stype_lnd(i,j), & @@ -1178,8 +1203,9 @@ subroutine lsm_ruc_run & ! inputs & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & & sfcexc(i,j), acceta(i,j), ssoil_lnd(i,j), & & snfallac_lnd(i,j), acsn_lnd(i,j), snomlt_lnd(i,j), & - & smfrsoil(i,:,j),keepfrsoil(i,:,j), .false., & - & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & + & smfrsoil(i,:,j),keepfrsoil(i,:,j), & + & add_fire_heat_flux,fire_heat_flux1d(i,j), .false., & + & shdmin1d(i,j), shdmax1d(i,j), rdlai, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte, errmsg, errflg ) if(debug_print) then @@ -1218,7 +1244,7 @@ subroutine lsm_ruc_run & ! inputs 'ssoil(i,j) =',ssoil_lnd(i,j), & 'snfallac(i,j) =',snfallac_lnd(i,j), & 'acsn_lnd(i,j) =',acsn_lnd(i,j), & - 'snomlt(i,j) =',snomlt_lnd(i,j) + 'snomlt(i,j) =',snomlt_lnd(i,j),'xlai(i,j) =',xlai(i,j) endif endif @@ -1289,6 +1315,10 @@ subroutine lsm_ruc_run & ! inputs ! --- ... unit conversion (from m to mm) snwdph_lnd(i) = snowh_lnd(i,j) * rhoh2o + laixy(i) = xlai(i,j) + smcwlt2(i) = smcwlt(i,j) + smcref2(i) = smcref(i,j) + canopy(i) = cmc(i,j) ! mm weasd_lnd(i) = sneqv_lnd(i,j) ! mm sncovr1_lnd(i) = sncovr_lnd(i,j) @@ -1318,6 +1348,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'LAND -i,j,stype_lnd,vtype_lnd',i,j,stype_lnd(i,j),vtype_lnd(i,j) write (0,*)'i,j,tsurf_lnd(i)',i,j,tsurf_lnd(i) write (0,*)'kdt,iter,stsoil(i,:,j)',kdt,iter,stsoil(i,:,j) + write (0,*)'laixy(i)',laixy(i) endif endif ! end of land @@ -1449,7 +1480,7 @@ subroutine lsm_ruc_run & ! inputs & wet_ice(i,j), cmc(i,j), shdfac(i,j), alb_ice(i,j), & & znt_ice(i,j), z0_ice(i,j), snoalb1d_ice(i,j), & & albbck_ice(i,j), xlai(i,j),landusef(i,:,j), nlcat, & - & soilctop(i,:,j), nscat, & + & soilctop(i,:,j), nscat, smcwlt(i,j), smcref(i,j), & & qsfc_ice(i,j), qsg_ice(i,j), qvg_ice(i,j), qcg_ice(i,j), & & dew_ice(i,j), soilt1_ice(i,j), & & tsnav_ice(i,j), tbot(i,j), vtype_ice(i,j), stype_ice(i,j), & @@ -1464,8 +1495,9 @@ subroutine lsm_ruc_run & ! inputs & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & & sfcexc(i,j), acceta(i,j), ssoil_ice(i,j), & & snfallac_ice(i,j), acsn_ice(i,j), snomlt_ice(i,j), & - & smfrice(i,:,j),keepfrice(i,:,j), .false., & - & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & + & smfrice(i,:,j),keepfrice(i,:,j), & + & add_fire_heat_flux,fire_heat_flux1d(i,j), .false., & + & shdmin1d(i,j), shdmax1d(i,j), rdlai, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte, & & errmsg, errflg) @@ -1502,6 +1534,10 @@ subroutine lsm_ruc_run & ! inputs albivis_ice(i) = sfalb_ice(i) albinir_ice(i) = sfalb_ice(i) + laixy(i) = zero + smcwlt2(i) = zero + smcref2(i) = one + stm(i) = 3.e3_kind_phys ! kg m-2 do k = 1, lsoil_ruc tsice(i,k) = stsice(i,k,j) @@ -1517,6 +1553,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'ICE - i,j,stype_ice,vtype_ice)',i,j,stype_ice(i,j),vtype_ice(i,j) write (0,*)'i,j,tsurf_ice(i)',i,j,tsurf_ice(i) write (0,*)'kdt,iter,stsice(i,:,j)',kdt,iter,stsice(i,:,j) + write (0,*)'laixy(i)',laixy(i) endif endif ! ice @@ -1762,6 +1799,8 @@ subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in tbot(i,j) = tg3(i) ivgtyp(i,j) = vtype(i) isltyp(i,j) = stype(i) + if(isltyp(i,j)==0) isltyp(i,j)=14 + if(ivgtyp(i,j)==0) ivgtyp(i,j)=17 if (landfrac(i) > zero .or. fice(i) > zero) then !-- land or ice tsk(i,j) = tskin_lnd(i) diff --git a/physics/lsm_ruc.meta b/physics/lsm_ruc.meta index 34a5b8a8b..4cc6a9419 100644 --- a/physics/lsm_ruc.meta +++ b/physics/lsm_ruc.meta @@ -813,7 +813,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout [dlwflx] standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time @@ -1747,6 +1747,21 @@ dimensions = () type = logical intent = in +[add_fire_heat_flux] + standard_name = flag_for_fire_heat_flux + long_name = flag to add fire heat flux to LSM + units = flag + dimensions = () + type = logical + intent = in +[fire_heat_flux_out] + standard_name = surface_fire_heat_flux + long_name = heat flux of fire at the surface + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 160127e43..2bb29d440 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -97,6 +97,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & MAVAIL,CANWAT,VEGFRA, & ALB,ZNT,Z0,SNOALB,ALBBCK,LAI, & landusef, nlcat, soilctop, nscat, & + smcwlt, smcref, & QSFC,QSG,QVG,QCG,DEW,SOILT1,TSNAV, & TBOT,IVGTYP,ISLTYP,XLAND, & ISWATER,ISICE,XICE,XICE_THRESHOLD, & @@ -107,6 +108,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & RUNOFF1,RUNOFF2,ACRUNOFF,SFCEXC, & SFCEVP,GRDFLX,SNOWFALLAC,ACSNOW,SNOM, & SMFR3D,KEEPFR3DFLAG, & + add_fire_heat_flux,fire_heat_flux, & myj,shdmin,shdmax,rdlai2d, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & @@ -239,6 +241,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMIN real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: hgt real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: stdev + LOGICAL, intent(in) :: add_fire_heat_flux + real (kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: fire_heat_flux LOGICAL, intent(in) :: rdlai2d real (kind_phys), DIMENSION( 1:nsl), INTENT(IN ) :: ZS @@ -252,6 +256,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & SNOALB, & ALB, & LAI, & + SMCWLT, & + SMCREF, & EMISS, & EMISBCK, & MAVAIL, & @@ -757,6 +763,8 @@ SUBROUTINE LSMRUC(xlat,xlon, & !-- update background emissivity for land points, can have vegetation mosaic effect EMISBCK(I,J) = EMISSL(I,J) + smcwlt(i,j) = wilt + smcref(i,j) = ref IF (debug_print ) THEN if(init)then @@ -961,6 +969,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & snoalb(i,j),albbck(i,j),lai(i,j), & hgt(i,j),stdev(i,j), & !new myj,seaice(i,j),isice, & + add_fire_heat_flux,fire_heat_flux(i,j), & !--- soil fixed fields QWRTZ, & rhocs,dqm,qmin,ref, & @@ -1212,6 +1221,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia QKMS,TKMS,PC,MAVAIL,CST,VEGFRA,ALB,ZNT, & ALB_SNOW,ALB_SNOW_FREE,lai,hgt,stdev, & MYJ,SEAICE,ISICE, & + add_fire_heat_flux,fire_heat_flux, & QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat, & !--- soil fixed fields sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq, & cp,rovcp,g0,lv,stbolt,cw,c1sn,c2sn, & !--- constants @@ -1256,7 +1266,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia SEAICE, & RHO, & QKMS, & - TKMS + TKMS, & + fire_heat_flux + LOGICAL, INTENT(IN ) :: add_fire_heat_flux INTEGER, INTENT(IN ) :: IVGTYP, ISLTYP !--- 2-D variables @@ -1813,6 +1825,10 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia UPFLUX = T3 *SOILT XINET = EMISS_snowfree*(GLW-UPFLUX) RNET = GSWnew + XINET + IF ( add_fire_heat_flux ) then ! JLS + RNET = RNET + fire_heat_flux + ENDIF + IF (debug_print ) THEN print *,'Fractional snow - snowfrac=',snowfrac print *,'Snowfrac<1 GSWin,GSWnew -',GSWin,GSWnew,'SOILT, RNET',soilt,rnet @@ -1933,6 +1949,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if (SEAICE .LT. 0.5_kind_phys) then ! LAND + IF ( add_fire_heat_flux ) then ! JLS + RNET = RNET + fire_heat_flux + ENDIF if(snow_mosaic==one)then snfr=one else @@ -2049,6 +2068,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac + !IF ( add_fire_heat_flux ) then ! JLS + ! hfx = hfx + fire_heat_flux + !ENDIF s = ss*(one-snowfrac) + s*snowfrac evapl = evapls*(one-snowfrac) sublim = sublim*snowfrac @@ -2094,6 +2116,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac + !IF ( add_fire_heat_flux ) then ! JLS + ! hfx = hfx + fire_heat_flux + !ENDIF s = ss*(one-snowfrac) + s*snowfrac prcpl = prcpls*(one-snowfrac) + prcpl*snowfrac fltot = fltots*(one-snowfrac) + fltot*snowfrac @@ -6611,7 +6636,7 @@ SUBROUTINE TRANSF( debug_print, & /(REF-WILT)*DID ENDIF !-- uncomment next line for non-linear root distribution -! TRANF(k)=part(k) + TRANF(k)=part(k) END DO ! For LAI> 3 => transpiration at potential rate (F.Tardieu, 2013) From 876a1ac17df62f40a936418da7f22b15923bc10c Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 12 Oct 2023 19:34:14 +0000 Subject: [PATCH 045/132] Fire heat flux computation is added to the smoke-dust code. --- physics/smoke_dust/module_plumerise1.F90 | 4 ++++ physics/smoke_dust/module_smoke_plumerise.F90 | 12 ++++++++++-- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 13 ++++++++++--- physics/smoke_dust/rrfs_smoke_wrapper.meta | 8 ++++++++ 4 files changed, 32 insertions(+), 5 deletions(-) diff --git a/physics/smoke_dust/module_plumerise1.F90 b/physics/smoke_dust/module_plumerise1.F90 index 3c23faa6a..189bf981a 100755 --- a/physics/smoke_dust/module_plumerise1.F90 +++ b/physics/smoke_dust/module_plumerise1.F90 @@ -38,6 +38,7 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & t_phy,q_vap, & ! RAR: moist is replaced with q_vap rho_phy,vvel,u_phy,v_phy,p_phy, & z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags + fire_heat_flux,dxy, & plume_frp, k_min, k_max, & ! RAR: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -66,6 +67,8 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebb_smoke real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: fire_heat_flux + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: dxy ! real(kind=kind_phys), DIMENSION( ims:ime, 1, jms:jme ), & ! INTENT(IN ) :: ebu_in @@ -184,6 +187,7 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & !num_ebu, eburn_in, eburn_out, & u_in, v_in, w_in, theta_in ,pi_in, & rho_phyin, qv_in, zmid, z_lev, & + fire_heat_flux(i,j),dxy(i,j), & plume_frp(i,j,1), k_min(i,j), & k_max(i,j), dbg_opt, g, con_cp, & con_rd, cpor, errmsg, errflg ) diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index 61be06181..9c0dfa49d 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -28,6 +28,7 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! firesize,mean_fct, & ! nspecies,eburn_in,eburn_out, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & + fire_heat_flux, dxy, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & cpor, errmsg, errflg ) @@ -43,6 +44,9 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & integer :: ng,m1,m2,m3,ia,iz,ja,jz,ibcon,mynum,i,j,k,imm,ixx,ispc !,nspecies + real(kind=kind_phys), intent(in) :: dxy + real(kind=kind_phys), intent(out) :: fire_heat_flux ! JLS + INTEGER, INTENT (OUT) :: k1,k2 character(*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -106,6 +110,7 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & IF (frp_inst Date: Thu, 12 Oct 2023 21:31:36 +0000 Subject: [PATCH 046/132] Fix the segmentation fault error in computing fire heat flux. --- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index f9b15a494..e6a398363 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -353,10 +353,10 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, errmsg, errflg ) if(errflg/=0) return - end if - do i = its,ite + do i = its,ite fire_heat_flux_out(i) = min(max(0.,fire_heat_flux(i,1)),50000.) ! JLS - W m-2 [0 - 10,000] - enddo + enddo + end if ! -- add biomass burning emissions at every timestep if (addsmoke_flag == 1) then call add_emis_burn(dt,dz8w,rho_phy,rel_hum,chem, & From 4e45989d1f6f78bb05aa789289d4cebebe9217b7 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 09:46:45 -0400 Subject: [PATCH 047/132] Code update for HR4_roughness --- physics/sfc_diff.f | 43 +++++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 6e834537a..561a087c4 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -348,12 +348,26 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tvs = half * (tsurf_wat(i)+tskin_wat(i))/prsik1(i) & * virtfac endif - - z0 = 0.01_kp * z0rl_wat(i) - z0max = max(zmin, min(z0,z1(i))) -! ustar_wat(i) = sqrt(grav * z0 / charnock) +! wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) +! + if (sfc_z0_type == -1) then ! using wave model derived momentum roughness + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + 0.01_kp * z0rl_wav(i) + if (redrag) then + z0max = max(min(z0, z0s_max),1.0e-7_kp) + else + z0max = max(min(z0,0.1_kp), 1.0e-7_kp) + endif + z0rl_wat(i) = 100.0_kp * z0max ! cm + else + z0 = 0.01_kp * z0rl_wat(i) + z0max = max(zmin, min(z0,z1(i))) + endif +! +! ustar_wat(i) = sqrt(grav * z0 / charnock) +! !** test xubin's new z0 ! ztmax = z0max @@ -423,17 +437,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif - elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & - & z0rl_wav(i) > 1.0_kp) then -! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) - tem1 = 0.11 * vis / ustar_wat(i) - z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) +! elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & +! & z0rl_wav(i) > 1.0_kp) then +!! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) +! tem1 = 0.11 * vis / ustar_wat(i) +! z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + +! if (redrag) then +! z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) +! else +! z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) +! endif - if (redrag) then - z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) - else - z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) - endif endif endif ! end of if(open ocean) From 3debf89fdc94111624f0b99da71e605418824183 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 10:45:21 -0400 Subject: [PATCH 048/132] Code update for HR4_roughness --- physics/sfc_diff.f | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 561a087c4..d56308b79 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -437,18 +437,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif -! elseif (z0rl_wav(i) <= 1.0e-7_kp .or. & -! & z0rl_wav(i) > 1.0_kp) then -!! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) -! tem1 = 0.11 * vis / ustar_wat(i) -! z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) - -! if (redrag) then -! z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) -! else -! z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) -! endif - endif endif ! end of if(open ocean) From c2b130113acf235e7c5e65bfd5f97ca2e8e3a3d7 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Mon, 16 Oct 2023 10:55:07 -0400 Subject: [PATCH 049/132] Code update for HR4_roughness --- physics/sfc_diff.f | 2 -- 1 file changed, 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index d56308b79..b28daef3b 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -366,8 +366,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = max(zmin, min(z0,z1(i))) endif ! -! ustar_wat(i) = sqrt(grav * z0 / charnock) -! !** test xubin's new z0 ! ztmax = z0max From 16e640eca60eeadb77078c2cf251f99fd7a8f469 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 16 Oct 2023 19:25:15 +0000 Subject: [PATCH 050/132] updates from HFIP dev branch --- physics/GFS_debug.F90 | 4 +- physics/module_bl_mynn.F90 | 1579 ++++++++++++++++---------------- physics/module_mp_thompson.F90 | 19 +- physics/module_sf_mynn.F90 | 6 +- physics/mynnedmf_wrapper.F90 | 13 +- physics/mynnedmf_wrapper.meta | 21 +- 6 files changed, 845 insertions(+), 797 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index fe63c1cea..ed26b795f 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -747,9 +747,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_thl ', Diag%det_thl) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_sqv ', Diag%det_sqv) end if - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%nupdraft ', Diag%nupdraft) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%maxwidth ', Diag%maxwidth) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%maxMF ', Diag%maxMF) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ktop_plume ', Diag%ktop_plume) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ztop_plume ', Diag%ztop_plume) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_h ', Diag%exch_h) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_m ', Diag%exch_m) end if diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index ec6b5700d..943a5c81d 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -1,5 +1,5 @@ !>\file module_bl_mynn.F90 -!! This file contains the entity of MYNN-EDMF PBL scheme. +! This file contains the entity of MYNN-EDMF PBL scheme. ! ********************************************************************** ! * An improved Mellor-Yamada turbulence closure model * ! * * @@ -256,11 +256,11 @@ MODULE module_bl_mynn !=================================================================== ! From here on, these are MYNN-specific parameters: ! The parameters below depend on stability functions of module_sf_mynn. - real(kind_phys), PARAMETER :: cphm_st=5.0, cphm_unst=16.0, & + real(kind_phys), parameter :: cphm_st=5.0, cphm_unst=16.0, & cphh_st=5.0, cphh_unst=16.0 ! Closure constants - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &pr = 0.74, & &g1 = 0.235, & ! NN2009 = 0.235 &b1 = 24.0, & @@ -275,7 +275,7 @@ MODULE module_bl_mynn &a2 = a1*( g1-c1 )/( g1*pr ), & &g2 = b2/b1*( 1.0-c3 ) +2.0*a1/b1*( 3.0-2.0*c2 ) - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &cc2 = 1.0-c2, & &cc3 = 1.0-c3, & &e1c = 3.0*a2*b2*cc3, & @@ -286,15 +286,15 @@ MODULE module_bl_mynn ! Constants for min tke in elt integration (qmin), max z/L in els (zmax), ! and factor for eddy viscosity for TKE (Kq = Sqfac*Km): - real(kind_phys), PARAMETER :: qmin=0.0, zmax=1.0, Sqfac=3.0 + real(kind_phys), parameter :: qmin=0.0, zmax=1.0, Sqfac=3.0 ! Note that the following mixing-length constants are now specified in mym_length ! &cns=3.5, alp1=0.23, alp2=0.3, alp3=3.0, alp4=10.0, alp5=0.2 - real(kind_phys), PARAMETER :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 - real(kind_phys), PARAMETER :: tliq = 269. !all hydrometeors are liquid when T > tliq + real(kind_phys), parameter :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 + real(kind_phys), parameter :: tliq = 269. !all hydrometeors are liquid when T > tliq ! Constants for cloud PDF (mym_condensation) - real(kind_phys), PARAMETER :: rr2=0.7071068, rrp=0.3989423 + real(kind_phys), parameter :: rr2=0.7071068, rrp=0.3989423 !>Use Canuto/Kitamura mod (remove Ric and negative TKE) (1:yes, 0:no) !!For more info, see Canuto et al. (2008 JAS) and Kitamura (Journal of the @@ -304,35 +304,35 @@ MODULE module_bl_mynn !!(above) back to NN2009 values (see commented out lines next to the !!parameters above). This only removes the negative TKE problem !!but does not necessarily improve performance - neutral impact. - real(kind_phys), PARAMETER :: CKmod=1. + real(kind_phys), parameter :: CKmod=1. !>Use Ito et al. (2015, BLM) scale-aware (0: no, 1: yes). Note that this also has impacts !!on the cloud PDF and mass-flux scheme, using Honnert et al. (2011) similarity function !!for TKE in the upper PBL/cloud layer. - real(kind_phys), PARAMETER :: scaleaware=1. + real(kind_phys), parameter :: scaleaware=1. !>Of the following the options, use one OR the other, not both. !>Adding top-down diffusion driven by cloud-top radiative cooling - INTEGER, PARAMETER :: bl_mynn_topdown = 0 + integer, parameter :: bl_mynn_topdown = 0 !>Option to activate downdrafts, from Elynn Wu (0: deactive, 1: active) - INTEGER, PARAMETER :: bl_mynn_edmf_dd = 0 + integer, parameter :: bl_mynn_edmf_dd = 0 !>Option to activate heating due to dissipation of TKE (to activate, set to 1.0) - INTEGER, PARAMETER :: dheat_opt = 1 + integer, parameter :: dheat_opt = 1 !Option to activate environmental subsidence in mass-flux scheme - LOGICAL, PARAMETER :: env_subs = .false. + logical, parameter :: env_subs = .false. !Option to switch flux-profile relationship for surface (from Puhales et al. 2020) !0: use original Dyer-Hicks, 1: use Cheng-Brustaert and Blended COARE - INTEGER, PARAMETER :: bl_mynn_stfunc = 1 + integer, parameter :: bl_mynn_stfunc = 1 !option to print out more stuff for debugging purposes - LOGICAL, PARAMETER :: debug_code = .false. - INTEGER, PARAMETER :: idbg = 23 !specific i-point to write out + logical, parameter :: debug_code = .false. + integer, parameter :: idbg = 23 !specific i-point to write out ! Used in WRF-ARW module_physics_init.F - INTEGER :: mynn_level + integer :: mynn_level CONTAINS @@ -388,7 +388,8 @@ SUBROUTINE mynn_bl_driver( & &edmf_thl,edmf_ent,edmf_qc, & &sub_thl3D,sub_sqv3D, & &det_thl3D,det_sqv3D, & - &nupdraft,maxMF,ktop_plume, & + &maxwidth,maxMF,ztop_plume, & + &ktop_plume, & &spp_pbl,pattern_spp_pbl, & &rthraten, & &FLAG_QC,FLAG_QI,FLAG_QNC, & @@ -401,30 +402,30 @@ SUBROUTINE mynn_bl_driver( & !------------------------------------------------------------------- - INTEGER, INTENT(in) :: initflag + integer, intent(in) :: initflag !INPUT NAMELIST OPTIONS: - LOGICAL, INTENT(in) :: restart,cycling - INTEGER, INTENT(in) :: tke_budget - INTEGER, INTENT(in) :: bl_mynn_cloudpdf - INTEGER, INTENT(in) :: bl_mynn_mixlength - INTEGER, INTENT(in) :: bl_mynn_edmf - LOGICAL, INTENT(in) :: bl_mynn_tkeadvect - INTEGER, INTENT(in) :: bl_mynn_edmf_mom - INTEGER, INTENT(in) :: bl_mynn_edmf_tke - INTEGER, INTENT(in) :: bl_mynn_mixscalars - INTEGER, INTENT(in) :: bl_mynn_output - INTEGER, INTENT(in) :: bl_mynn_cloudmix - INTEGER, INTENT(in) :: bl_mynn_mixqt - INTEGER, INTENT(in) :: icloud_bl - real(kind_phys), INTENT(in) :: closure - - LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& + logical, intent(in) :: restart,cycling + integer, intent(in) :: tke_budget + integer, intent(in) :: bl_mynn_cloudpdf + integer, intent(in) :: bl_mynn_mixlength + integer, intent(in) :: bl_mynn_edmf + logical, intent(in) :: bl_mynn_tkeadvect + integer, intent(in) :: bl_mynn_edmf_mom + integer, intent(in) :: bl_mynn_edmf_tke + integer, intent(in) :: bl_mynn_mixscalars + integer, intent(in) :: bl_mynn_output + integer, intent(in) :: bl_mynn_cloudmix + integer, intent(in) :: bl_mynn_mixqt + integer, intent(in) :: icloud_bl + real(kind_phys), intent(in) :: closure + + logical, intent(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & FLAG_OZONE,FLAG_QS - LOGICAL, INTENT(IN) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg + logical, intent(in) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg - INTEGER, INTENT(in) :: & + integer, intent(in) :: & & IDS,IDE,JDS,JDE,KDS,KDE & &,IMS,IME,JMS,JME,KMS,KME & &,ITS,ITE,JTS,JTE,KTS,KTE @@ -444,81 +445,82 @@ SUBROUTINE mynn_bl_driver( & ! to prevent a crash on Cheyenne. Do not change it back without testing if the code runs ! on Cheyenne with the GNU compiler. - real(kind_phys), INTENT(in) :: delt - real(kind_phys), DIMENSION(:), INTENT(in) :: dx - real(kind_phys), DIMENSION(:,:), INTENT(in) :: dz, & + real(kind_phys), intent(in) :: delt + real(kind_phys), dimension(:), intent(in) :: dx + real(kind_phys), dimension(:,:), intent(in) :: dz, & &u,v,w,th,sqv3D,p,exner,rho,T3D - real(kind_phys), DIMENSION(:,:), INTENT(in) :: & + real(kind_phys), dimension(:,:), intent(in) :: & &sqc3D,sqi3D,sqs3D,qni,qnc,qnwfa,qnifa,qnbca - real(kind_phys), DIMENSION(:,:), INTENT(in):: ozone - real(kind_phys), DIMENSION(:), INTENT(in):: ust, & + real(kind_phys), dimension(:,:), intent(in):: ozone + real(kind_phys), dimension(:), intent(in):: ust, & &ch,qsfc,ps,wspd - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &Qke,Tsq,Qsq,Cov,qke_adv - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &rublten,rvblten,rthblten,rqvblten,rqcblten, & &rqiblten,rqsblten,rqniblten,rqncblten, & &rqnwfablten,rqnifablten,rqnbcablten - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: dozone - real(kind_phys), DIMENSION(:,:), INTENT(in) :: rthraten + real(kind_phys), dimension(:,:), intent(inout) :: dozone + real(kind_phys), dimension(:,:), intent(in) :: rthraten - real(kind_phys), DIMENSION(:,:), INTENT(out) :: exch_h,exch_m - real(kind_phys), DIMENSION(:), INTENT(in) :: xland, & + real(kind_phys), dimension(:,:), intent(out) :: exch_h,exch_m + real(kind_phys), dimension(:), intent(in) :: xland, & &ts,znt,hfx,qfx,uoce,voce !These 10 arrays are only allocated when bl_mynn_output > 0 - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D -! real, DIMENSION(IMS:IME,KMS:KME) :: & +! real, dimension(ims:ime,kms:kme) :: & ! & edmf_a_dd,edmf_w_dd,edmf_qt_dd,edmf_thl_dd,edmf_ent_dd,edmf_qc_dd - real(kind_phys), DIMENSION(:), INTENT(inout) :: Pblh - real(kind_phys), DIMENSION(:), INTENT(inout) :: rmol + real(kind_phys), dimension(:), intent(inout) :: Pblh + real(kind_phys), dimension(:), intent(inout) :: rmol - real(kind_phys), DIMENSION(IMS:IME) :: psig_bl,psig_shcu + real(kind_phys), dimension(ims:ime) :: psig_bl,psig_shcu - INTEGER,DIMENSION(:),INTENT(INOUT) :: & - &KPBL,nupdraft,ktop_plume + integer,dimension(:),intent(INOUT) :: & + &KPBL,ktop_plume - real(kind_phys), DIMENSION(:), INTENT(out) :: maxmf + real(kind_phys), dimension(:), intent(out) :: & + &maxmf,maxwidth,ztop_plume - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: el_pbl + real(kind_phys), dimension(:,:), intent(inout) :: el_pbl - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &qWT,qSHEAR,qBUOY,qDISS,dqke ! 3D budget arrays are not allocated when tke_budget == 0 ! 1D (local) budget arrays are used for passing between subroutines. - real(kind_phys), DIMENSION(kts:kte) :: & + real(kind_phys), dimension(kts:kte) :: & &qwt1,qshear1,qbuoy1,qdiss1,dqke1,diss_heat - real(kind_phys), DIMENSION(:,:), intent(out) :: Sh3D,Sm3D + real(kind_phys), dimension(:,:), intent(out) :: Sh3D,Sm3D - real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &qc_bl,qi_bl,cldfra_bl - real(kind_phys), DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D, & + real(kind_phys), dimension(kts:kte) :: qc_bl1D,qi_bl1D, & &cldfra_bl1D,qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old ! smoke/chemical arrays - INTEGER, INTENT(IN ) :: nchem, kdvel, ndvel - real(kind_phys), DIMENSION(:,:,:), INTENT(INOUT) :: chem3d - real(kind_phys), DIMENSION(:,:), INTENT(IN) :: vdep - real(kind_phys), DIMENSION(:), INTENT(IN) :: frp,EMIS_ANT_NO + integer, intent(IN ) :: nchem, kdvel, ndvel + real(kind_phys), dimension(:,:,:), intent(INOUT) :: chem3d + real(kind_phys), dimension(:,:), intent(IN) :: vdep + real(kind_phys), dimension(:), intent(IN) :: frp,EMIS_ANT_NO !local - real(kind_phys), DIMENSION(kts:kte ,nchem) :: chem1 - real(kind_phys), DIMENSION(kts:kte+1,nchem) :: s_awchem1 - real(kind_phys), DIMENSION(ndvel) :: vd1 - INTEGER :: ic + real(kind_phys), dimension(kts:kte ,nchem) :: chem1 + real(kind_phys), dimension(kts:kte+1,nchem) :: s_awchem1 + real(kind_phys), dimension(ndvel) :: vd1 + integer :: ic !local vars - INTEGER :: ITF,JTF,KTF, IMD,JMD - INTEGER :: i,j,k,kproblem - real(kind_phys), DIMENSION(KTS:KTE) :: & + integer :: ITF,JTF,KTF, IMD,JMD + integer :: i,j,k,kproblem + real(kind_phys), dimension(kts:kte) :: & &thl,tl,qv1,qc1,qi1,qs1,sqw, & &el, dfm, dfh, dfq, tcd, qcd, pdk, pdt, pdq, pdc, & &vt, vq, sgm - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &thetav,sh,sm,u1,v1,w1,p1, & &ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, & &sqv,sqi,sqc,sqs, & @@ -527,45 +529,45 @@ SUBROUTINE mynn_bl_driver( & &qnbca1,dqnwfa1,dqnifa1,dqnbca1,dozone1 !mass-flux variables - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &edmf_a1,edmf_w1,edmf_qt1,edmf_thl1, & &edmf_ent1,edmf_qc1 - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1,edmf_thl_dd1, & &edmf_ent_dd1,edmf_qc_dd1 - real(kind_phys), DIMENSION(KTS:KTE) :: & + real(kind_phys), dimension(kts:kte) :: & &sub_thl,sub_sqv,sub_u,sub_v, & &det_thl,det_sqv,det_sqc,det_u,det_v - real(kind_phys), DIMENSION(KTS:KTE+1) :: & + real(kind_phys), dimension(kts:kte+1) :: & &s_aw1,s_awthl1,s_awqt1, & &s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1, & &s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1, & &s_awqnbca1 - real(kind_phys), DIMENSION(KTS:KTE+1) :: & + real(kind_phys), dimension(kts:kte+1) :: & &sd_aw1,sd_awthl1,sd_awqt1, & &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 - real(kind_phys), DIMENSION(KTS:KTE+1) :: zw + real(kind_phys), dimension(kts:kte+1) :: zw real(kind_phys) :: cpm,sqcg,flt,fltv,flq,flqv,flqc, & &pmz,phh,exnerg,zet,phi_m, & &afk,abk,ts_decay, qc_bl2, qi_bl2, & - &th_sfc,ztop_plume,wsp + &th_sfc,wsp !top-down diffusion - real(kind_phys), DIMENSION(ITS:ITE) :: maxKHtopdown - real(kind_phys), DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD + real(kind_phys), dimension(ITS:ITE) :: maxKHtopdown + real(kind_phys), dimension(kts:kte) :: KHtopdown,TKEprodTD - LOGICAL :: INITIALIZE_QKE,problem + logical :: INITIALIZE_QKE,problem ! Stochastic fields - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(:,:), INTENT(IN) :: pattern_spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(IN) :: spp_pbl + real(kind_phys), dimension(:,:), intent(IN) :: pattern_spp_pbl + real(kind_phys), dimension(KTS:KTE) :: rstoch_col ! Substepping TKE - INTEGER :: nsub + integer :: nsub real(kind_phys) :: delt2 @@ -629,7 +631,8 @@ SUBROUTINE mynn_bl_driver( & !edmf_qc_dd(its:ite,kts:kte)=0. ENDIF ktop_plume(its:ite)=0 !int - nupdraft(its:ite)=0 !int + ztop_plume(its:ite)=0. + maxwidth(its:ite)=0. maxmf(its:ite)=0. maxKHtopdown(its:ite)=0. @@ -1021,7 +1024,7 @@ SUBROUTINE mynn_bl_driver( & endif s_awchem1 = 0.0 -!> - Call get_pblh() to calculate the hybrid \f$\theta_{vli}-TKE\f$ +!> - Call get_pblh() to calculate the hybrid \f$\theta_{v}-TKE\f$ !! PBL height diagnostic. CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& & Qke1,zw,dz1,xland(i),KPBL(i)) @@ -1147,8 +1150,8 @@ SUBROUTINE mynn_bl_driver( & &FLAG_QNC,FLAG_QNI, & &FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & &Psig_shcu(i), & - &nupdraft(i),ktop_plume(i), & - &maxmf(i),ztop_plume, & + &maxwidth(i),ktop_plume(i), & + &maxmf(i),ztop_plume(i), & &spp_pbl,rstoch_col ) endif @@ -1295,27 +1298,27 @@ SUBROUTINE mynn_bl_driver( & &dfm, dfh, dz1, K_m1, K_h1 ) !UPDATE 3D ARRAYS - exch_m(i,:) =k_m1(:) - exch_h(i,:) =k_h1(:) - rublten(i,:) =du1(:) - rvblten(i,:) =dv1(:) - rthblten(i,:)=dth1(:) - rqvblten(i,:)=dqv1(:) + exch_m(i,kts:kte) =k_m1(kts:kte) + exch_h(i,kts:kte) =k_h1(kts:kte) + rublten(i,kts:kte) =du1(kts:kte) + rvblten(i,kts:kte) =dv1(kts:kte) + rthblten(i,kts:kte)=dth1(kts:kte) + rqvblten(i,kts:kte)=dqv1(kts:kte) if (bl_mynn_cloudmix > 0) then - if (flag_qc) rqcblten(i,:)=dqc1(:) - if (flag_qi) rqiblten(i,:)=dqi1(:) - if (flag_qs) rqsblten(i,:)=dqs1(:) + if (flag_qc) rqcblten(i,kts:kte)=dqc1(kts:kte) + if (flag_qi) rqiblten(i,kts:kte)=dqi1(kts:kte) + if (flag_qs) rqsblten(i,kts:kte)=dqs1(kts:kte) else if (flag_qc) rqcblten(i,:)=0. if (flag_qi) rqiblten(i,:)=0. if (flag_qs) rqsblten(i,:)=0. endif if (bl_mynn_cloudmix > 0 .and. bl_mynn_mixscalars > 0) then - if (flag_qnc) rqncblten(i,:) =dqnc1(:) - if (flag_qni) rqniblten(i,:) =dqni1(:) - if (flag_qnwfa) rqnwfablten(i,:)=dqnwfa1(:) - if (flag_qnifa) rqnifablten(i,:)=dqnifa1(:) - if (flag_qnbca) rqnbcablten(i,:)=dqnbca1(:) + if (flag_qnc) rqncblten(i,kts:kte) =dqnc1(kts:kte) + if (flag_qni) rqniblten(i,kts:kte) =dqni1(kts:kte) + if (flag_qnwfa) rqnwfablten(i,kts:kte)=dqnwfa1(kts:kte) + if (flag_qnifa) rqnifablten(i,kts:kte)=dqnifa1(kts:kte) + if (flag_qnbca) rqnbcablten(i,kts:kte)=dqnbca1(kts:kte) else if (flag_qnc) rqncblten(i,:) =0. if (flag_qni) rqniblten(i,:) =0. @@ -1323,19 +1326,19 @@ SUBROUTINE mynn_bl_driver( & if (flag_qnifa) rqnifablten(i,:)=0. if (flag_qnbca) rqnbcablten(i,:)=0. endif - dozone(i,:)=dozone1(:) + dozone(i,kts:kte)=dozone1(kts:kte) if (icloud_bl > 0) then - qc_bl(i,:) =qc_bl1D(:) - qi_bl(i,:) =qi_bl1D(:) - cldfra_bl(i,:)=cldfra_bl1D(:) + qc_bl(i,kts:kte) =qc_bl1D(kts:kte) + qi_bl(i,kts:kte) =qi_bl1D(kts:kte) + cldfra_bl(i,kts:kte)=cldfra_bl1D(kts:kte) endif - el_pbl(i,:)=el(:) - qke(i,:) =qke1(:) - tsq(i,:) =tsq1(:) - qsq(i,:) =qsq1(:) - cov(i,:) =cov1(:) - sh3d(i,:) =sh(:) - sm3d(i,:) =sm(:) + el_pbl(i,kts:kte)=el(kts:kte) + qke(i,kts:kte) =qke1(kts:kte) + tsq(i,kts:kte) =tsq1(kts:kte) + qsq(i,kts:kte) =qsq1(kts:kte) + cov(i,kts:kte) =cov1(kts:kte) + sh3d(i,kts:kte) =sh(kts:kte) + sm3d(i,kts:kte) =sm(kts:kte) if (tke_budget .eq. 1) then !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) @@ -1363,24 +1366,24 @@ SUBROUTINE mynn_bl_driver( & !update updraft/downdraft properties if (bl_mynn_output > 0) then !research mode == 1 if (bl_mynn_edmf > 0) then - edmf_a(i,:) =edmf_a1(:) - edmf_w(i,:) =edmf_w1(:) - edmf_qt(i,:) =edmf_qt1(:) - edmf_thl(i,:) =edmf_thl1(:) - edmf_ent(i,:) =edmf_ent1(:) - edmf_qc(i,:) =edmf_qc1(:) - sub_thl3D(i,:)=sub_thl(:) - sub_sqv3D(i,:)=sub_sqv(:) - det_thl3D(i,:)=det_thl(:) - det_sqv3D(i,:)=det_sqv(:) + edmf_a(i,kts:kte) =edmf_a1(kts:kte) + edmf_w(i,kts:kte) =edmf_w1(kts:kte) + edmf_qt(i,kts:kte) =edmf_qt1(kts:kte) + edmf_thl(i,kts:kte) =edmf_thl1(kts:kte) + edmf_ent(i,kts:kte) =edmf_ent1(kts:kte) + edmf_qc(i,kts:kte) =edmf_qc1(kts:kte) + sub_thl3D(i,kts:kte)=sub_thl(kts:kte) + sub_sqv3D(i,kts:kte)=sub_sqv(kts:kte) + det_thl3D(i,kts:kte)=det_thl(kts:kte) + det_sqv3D(i,kts:kte)=det_sqv(kts:kte) endif !if (bl_mynn_edmf_dd > 0) THEN - ! edmf_a_dd(i,:) =edmf_a_dd1(:) - ! edmf_w_dd(i,:) =edmf_w_dd1(:) - ! edmf_qt_dd(i,:) =edmf_qt_dd1(:) - ! edmf_thl_dd(i,:)=edmf_thl_dd1(:) - ! edmf_ent_dd(i,:)=edmf_ent_dd1(:) - ! edmf_qc_dd(i,:) =edmf_qc_dd1(:) + ! edmf_a_dd(i,kts:kte) =edmf_a_dd1(kts:kte) + ! edmf_w_dd(i,kts:kte) =edmf_w_dd1(kts:kte) + ! edmf_qt_dd(i,kts:kte) =edmf_qt_dd1(kts:kte) + ! edmf_thl_dd(i,kts:kte)=edmf_thl_dd1(kts:kte) + ! edmf_ent_dd(i,kts:kte)=edmf_ent_dd1(kts:kte) + ! edmf_qc_dd(i,kts:kte) =edmf_qc_dd1(kts:kte) !endif endif @@ -1509,27 +1512,27 @@ SUBROUTINE mym_initialize ( & ! !------------------------------------------------------------------- - integer, INTENT(IN) :: kts,kte - integer, INTENT(IN) :: bl_mynn_mixlength - logical, INTENT(IN) :: INITIALIZE_QKE -! real(kind_phys), INTENT(IN) :: ust, rmo, pmz, phh, flt, flq - real(kind_phys), INTENT(IN) :: rmo, Psig_bl, xland - real(kind_phys), INTENT(IN) :: dx, ust, zi - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,thl,& + integer, intent(in) :: kts,kte + integer, intent(in) :: bl_mynn_mixlength + logical, intent(in) :: INITIALIZE_QKE +! real(kind_phys), intent(in) :: ust, rmo, pmz, phh, flt, flq + real(kind_phys), intent(in) :: rmo, Psig_bl, xland + real(kind_phys), intent(in) :: dx, ust, zi + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,thl,& &qw,cldfra_bl1D,edmf_w1,edmf_a1 - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: tsq,qsq,cov - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: el,qke - real(kind_phys), DIMENSION(kts:kte) :: & + real(kind_phys), dimension(kts:kte), intent(out) :: tsq,qsq,cov + real(kind_phys), dimension(kts:kte), intent(inout) :: el,qke + real(kind_phys), dimension(kts:kte) :: & &ql,pdk,pdt,pdq,pdc,dtl,dqw,dtv, & &gm,gh,sm,sh,qkw,vt,vq - INTEGER :: k,l,lmax + integer :: k,l,lmax real(kind_phys):: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1., & &flt=0.,fltv=0.,flq=0.,tmpq - real(kind_phys), DIMENSION(kts:kte) :: theta,thetav - real(kind_phys), DIMENSION(kts:kte) :: rstoch_col - INTEGER ::spp_pbl + real(kind_phys), dimension(kts:kte) :: theta,thetav + real(kind_phys), dimension(kts:kte) :: rstoch_col + integer ::spp_pbl !> - At first ql, vt and vq are set to zero. DO k = kts,kte @@ -1706,17 +1709,17 @@ SUBROUTINE mym_level2 (kts,kte, & ! !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v, & + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte), intent(in) :: u,v, & &thl,qw,ql,vt,vq,thetav - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: & + real(kind_phys), dimension(kts:kte), intent(out) :: & &dtl,dqw,dtv,gm,gh,sm,sh integer :: k @@ -1844,25 +1847,25 @@ SUBROUTINE mym_length ( & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), INTENT(in) :: rmo,flt,fltv,flq,Psig_bl,xland - real(kind_phys), INTENT(IN) :: dx,zi - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: u1,v1, & + integer, intent(in) :: bl_mynn_mixlength + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: rmo,flt,fltv,flq,Psig_bl,xland + real(kind_phys), intent(in) :: dx,zi + real(kind_phys), dimension(kts:kte), intent(in) :: u1,v1, & &qke,vt,vq,cldfra_bl1D,edmf_w1,edmf_a1 - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: qkw, el - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dtv + real(kind_phys), dimension(kts:kte), intent(out) :: qkw, el + real(kind_phys), dimension(kts:kte), intent(in) :: dtv real(kind_phys):: elt,vsc - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: theta - real(kind_phys), DIMENSION(kts:kte) :: qtke,elBLmin,elBLavg,thetaw + real(kind_phys), dimension(kts:kte), intent(in) :: theta + real(kind_phys), dimension(kts:kte) :: qtke,elBLmin,elBLavg,thetaw real(kind_phys):: wt,wt2,zi2,h1,h2,hs,elBLmin0,elBLavg0,cldavg ! THE FOLLOWING CONSTANTS ARE IMPORTANT FOR REGULATING THE @@ -1879,22 +1882,22 @@ SUBROUTINE mym_length ( & !THEY ONLY IMPOSE LIMITS ON THE CALCULATION OF THE MIXING LENGTH !SCALES SO THAT THE BOULAC MIXING LENGTH (IN FREE ATMOS) DOES !NOT ENCROACH UPON THE BOUNDARY LAYER MIXING LENGTH (els, elb & elt). - real(kind_phys), PARAMETER :: minzi = 300. !< min mixed-layer height - real(kind_phys), PARAMETER :: maxdz = 750. !< max (half) transition layer depth + real(kind_phys), parameter :: minzi = 300. !< min mixed-layer height + real(kind_phys), parameter :: maxdz = 750. !< max (half) transition layer depth !! =0.3*2500 m PBLH, so the transition !! layer stops growing for PBLHs > 2.5 km. - real(kind_phys), PARAMETER :: mindz = 300. !< 300 !min (half) transition layer depth + real(kind_phys), parameter :: mindz = 300. !< 300 !min (half) transition layer depth !SURFACE LAYER LENGTH SCALE MODS TO REDUCE IMPACT IN UPPER BOUNDARY LAYER - real(kind_phys), PARAMETER :: ZSLH = 100. !< Max height correlated to surface conditions (m) - real(kind_phys), PARAMETER :: CSL = 2. !< CSL = constant of proportionality to L O(1) + real(kind_phys), parameter :: ZSLH = 100. !< Max height correlated to surface conditions (m) + real(kind_phys), parameter :: CSL = 2. !< CSL = constant of proportionality to L O(1) - INTEGER :: i,j,k + integer :: i,j,k real(kind_phys):: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud, & & wstar,elb,els,elf,el_stab,el_mf,el_stab_mf,elb_mf, & & PBLH_PLUS_ENT,Uonset,Ugrid,wt_u,el_les - real(kind_phys), PARAMETER :: ctau = 1000. !constant for tau_cloud + real(kind_phys), parameter :: ctau = 1000. !constant for tau_cloud ! tv0 = 0.61*tref ! gtr = 9.81/tref @@ -2254,13 +2257,13 @@ SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2) ! lb2 = the average of the length up and length down !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: k,kts,kte - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - real(kind_phys), INTENT(OUT) :: lb1,lb2 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw + integer, intent(in) :: k,kts,kte + real(kind_phys), dimension(kts:kte), intent(in) :: qtke,dz,theta + real(kind_phys), intent(out) :: lb1,lb2 + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw !LOCAL VARS - INTEGER :: izz, found + integer :: izz, found real(kind_phys):: dlu,dld real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz @@ -2404,15 +2407,15 @@ SUBROUTINE boulac_length(kts,kte,zw,dz,qtke,theta,lb1,lb2) ! lb2 = the average of the length up and length down !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT):: lb1,lb2 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw + integer, intent(in) :: kts,kte + real(kind_phys), dimension(kts:kte), intent(in) :: qtke,dz,theta + real(kind_phys), dimension(kts:kte), intent(out):: lb1,lb2 + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw !LOCAL VARS - INTEGER :: iz, izz, found - real(kind_phys), DIMENSION(kts:kte) :: dlu,dld - real(kind_phys), PARAMETER :: Lmax=2000. !soft limit + integer :: iz, izz, found + real(kind_phys), dimension(kts:kte) :: dlu,dld + real(kind_phys), parameter :: Lmax=2000. !soft limit real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz !print*,"IN MYNN-BouLac",kts, kte @@ -2618,40 +2621,40 @@ SUBROUTINE mym_turbulence ( & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength,tke_budget - real(kind_phys), INTENT(IN) :: closure - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw - real(kind_phys), INTENT(in) :: rmo,flt,fltv,flq, & + integer, intent(in) :: bl_mynn_mixlength,tke_budget + real(kind_phys), intent(in) :: closure + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: rmo,flt,fltv,flq, & &Psig_bl,Psig_shcu,xland,dx,zi - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,thl,thetav,qw, & + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,thl,thetav,qw, & &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1, & &TKEprodTD - real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: dfm,dfh,dfq, & + real(kind_phys), dimension(kts:kte), intent(out) :: dfm,dfh,dfq, & &pdk,pdt,pdq,pdc,tcd,qcd,el - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: & + real(kind_phys), dimension(kts:kte), intent(inout) :: & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D real(kind_phys):: q3sq_old,dlsq1,qWTP_old,qWTP_new real(kind_phys):: dudz,dvdz,dTdz,upwp,vpwp,Tpwp - real(kind_phys), DIMENSION(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh + real(kind_phys), dimension(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh - INTEGER :: k + integer :: k ! real(kind_phys):: cc2,cc3,e1c,e2c,e3c,e4c,e5c real(kind_phys):: e6c,dzk,afk,abk,vtt,vqq, & &cw25,clow,cupp,gamt,gamq,smd,gamv,elq,elh real(kind_phys):: cldavg - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: theta + real(kind_phys), dimension(kts:kte), intent(in) :: theta real(kind_phys):: a2fac, duz, ri !JOE-Canuto/Kitamura mod @@ -2664,10 +2667,10 @@ SUBROUTINE mym_turbulence ( & DOUBLE PRECISION e1, e2, e3, e4, enum, eden, wden ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col real(kind_phys):: Prnum, shb - real(kind_phys), PARAMETER :: Prlimit = 5.0 + real(kind_phys), parameter :: Prlimit = 5.0 ! ! tv0 = 0.61*tref @@ -3042,7 +3045,8 @@ SUBROUTINE mym_turbulence ( & ! q-variance (pdq), and covariance (pdc) pdk(k) = elq*( sm(k)*gm(k) & & +sh(k)*gh(k)+gamv ) + & - & TKEprodTD(k) +!fix? & TKEprodTD(k) + & 0.5*TKEprodTD(k) ! xmchen pdt(k) = elh*( sh(k)*dtl(k)+gamt )*dtl(k) pdq(k) = elh*( sh(k)*dqw(k)+gamq )*dqw(k) pdc(k) = elh*( sh(k)*dtl(k)+gamt ) & @@ -3086,9 +3090,10 @@ SUBROUTINE mym_turbulence ( & !qBUOY1D(k) = elq*(sh(k)*(-dTdz*grav/thl(k)) + gamv) !! ORIGINAL CODE !! Buoyncy term takes the TKEprodTD(k) production now - qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered +!fix? qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered + qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+0.5*TKEprodTD(k) ! xmchen - !!!Dissipation Term (now it evaluated on mym_predict) + !!!Dissipation Term (now it evaluated in mym_predict) !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE !! >> EOB @@ -3113,8 +3118,6 @@ SUBROUTINE mym_turbulence ( & qcd(k) = ( qcd(k+1)-qcd(k) )/( dzk ) END DO ! - - if (spp_pbl==1) then DO k = kts,kte dfm(k)= dfm(k) + dfm(k)* rstoch_col(k) * 1.5 * MAX(exp(-MAX(zw(k)-8000.,0.0)/2000.),0.001) @@ -3181,43 +3184,43 @@ SUBROUTINE mym_predict (kts,kte, & & delt, & & dz, & & ust, flt, flq, pmz, phh, & - & el, dfq, rho, & + & el, dfq, rho, & & pdk, pdt, pdq, pdc, & & qke, tsq, qsq, cov, & & s_aw,s_awqke,bl_mynn_edmf_tke, & & qWT1D, qDISS1D,tke_budget) !! TKE budget (Puhales, 2020) !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte + integer, intent(in) :: kts,kte #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(IN) :: closure - INTEGER, INTENT(IN) :: bl_mynn_edmf_tke,tke_budget - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dz, dfq, el, rho - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: pdk, pdt, pdq, pdc - real(kind_phys), INTENT(IN) :: flt, flq, pmz, phh - real(kind_phys), INTENT(IN) :: ust, delt - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: qke,tsq, qsq, cov + real(kind_phys), intent(in) :: closure + integer, intent(in) :: bl_mynn_edmf_tke,tke_budget + real(kind_phys), dimension(kts:kte), intent(in) :: dz, dfq, el, rho + real(kind_phys), dimension(kts:kte), intent(inout) :: pdk, pdt, pdq, pdc + real(kind_phys), intent(in) :: flt, flq, pmz, phh + real(kind_phys), intent(in) :: ust, delt + real(kind_phys), dimension(kts:kte), intent(inout) :: qke,tsq, qsq, cov ! WA 8/3/15 - real(kind_phys), DIMENSION(kts:kte+1), INTENT(INOUT) :: s_awqke,s_aw + real(kind_phys), dimension(kts:kte+1), intent(inout) :: s_awqke,s_aw !! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT) :: qWT1D, qDISS1D - real(kind_phys), DIMENSION(kts:kte) :: tke_up,dzinv + real(kind_phys), dimension(kts:kte), intent(out) :: qWT1D, qDISS1D + real(kind_phys), dimension(kts:kte) :: tke_up,dzinv !! >> EOB - INTEGER :: k - real(kind_phys), DIMENSION(kts:kte) :: qkw, bp, rp, df3q + integer :: k + real(kind_phys), dimension(kts:kte) :: qkw, bp, rp, df3q real(kind_phys):: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff - real(kind_phys), DIMENSION(kts:kte) :: dtz - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte) :: dtz + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x - real(kind_phys), DIMENSION(kts:kte) :: rhoinv - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz,kqdz,kmdz + real(kind_phys), dimension(kts:kte) :: rhoinv + real(kind_phys), dimension(kts:kte+1) :: rhoz,kqdz,kmdz ! REGULATE THE MOMENTUM MIXING FROM THE MASS-FLUX SCHEME (on or off) IF (bl_mynn_edmf_tke == 0) THEN @@ -3263,7 +3266,7 @@ SUBROUTINE mym_predict (kts,kte, & kmdz(k) = MAX(kmdz(k), 0.5* s_aw(k)) kmdz(k) = MAX(kmdz(k), -0.5*(s_aw(k)-s_aw(k+1))) ENDDO -!JOE-end conservation mods + !end conservation mods pdk1 = 2.0*ust**3*pmz/( vkz ) phm = 2.0/ust *phh/( vkz ) @@ -3271,8 +3274,8 @@ SUBROUTINE mym_predict (kts,kte, & pdq1 = phm*flq**2 pdc1 = phm*flt*flq ! -! ** pdk(i,j,1)+pdk(i,j,2) corresponds to pdk1. ** - pdk(kts) = pdk1 -pdk(kts+1) +! ** pdk(1)+pdk(2) corresponds to pdk1. ** + pdk(kts) = pdk1 - pdk(kts+1) !! pdt(kts) = pdt1 -pdt(kts+1) !! pdq(kts) = pdq1 -pdq(kts+1) @@ -3367,7 +3370,7 @@ SUBROUTINE mym_predict (kts,kte, & ENDDO k=kte qWT1D(k)=dzinv(k)*(-kqdz(k)*(tke_up(k)-tke_up(k-1)) & - & + 0.5*rhoinv(k)*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggared + & + 0.5*rhoinv(k)*(-s_aw(k)*tke_up(k)-s_aw(k)*tke_up(k-1)+s_awqke(k))*onoff) !unstaggered !! >> EOBvt qDISS1D=bp*tke_up !! TKE dissipation rate !unstaggered END IF @@ -3596,39 +3599,42 @@ SUBROUTINE mym_condensation (kts,kte, & !------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte, bl_mynn_cloudpdf + integer, intent(in) :: kts,kte, bl_mynn_cloudpdf #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(IN) :: HFX1,rmo,xland - real(kind_phys), INTENT(IN) :: dx,pblh1 - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dz - real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw, & + real(kind_phys), intent(in) :: HFX1,rmo,xland + real(kind_phys), intent(in) :: dx,pblh1 + real(kind_phys), dimension(kts:kte), intent(in) :: dz + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), dimension(kts:kte), intent(in) :: p,exner,thl,qw, & &qv,qc,qi,qs,tsq,qsq,cov,th - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm + real(kind_phys), dimension(kts:kte), intent(inout) :: vt,vq,sgm - real(kind_phys), DIMENSION(kts:kte) :: alp,a,bet,b,ql,q1,RH - real(kind_phys), DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & + real(kind_phys), dimension(kts:kte) :: alp,a,bet,b,ql,q1,RH + real(kind_phys), dimension(kts:kte), intent(out) :: qc_bl1D,qi_bl1D, & &cldfra_bl1D DOUBLE PRECISION :: t3sq, r3sq, c3sq real(kind_phys):: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll, & &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb, & - &ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & - &qmq,qsat_tk,q1_rh,rh_hack - real(kind_phys), PARAMETER :: rhcrit=0.83 !for hom pdf min sigma - INTEGER :: i,j,k + &ls,wt,qpct,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & + &qmq,qsat_tk,q1_rh,rh_hack,dzm1,zsl,maxqc + real(kind_phys), parameter :: qpct_sfc=0.025 + real(kind_phys), parameter :: qpct_pbl=0.030 + real(kind_phys), parameter :: qpct_trp=0.040 + real(kind_phys), parameter :: rhcrit =0.83 !for hom pdf min sigma + integer :: i,j,k real(kind_phys):: erf !VARIABLES FOR ALTERNATIVE SIGMA real:: dth,dtl,dqw,dzk,els - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: Sh,el + real(kind_phys), dimension(kts:kte), intent(in) :: Sh,el !variables for SGS BL clouds real(kind_phys) :: zagl,damp,PBLH2 @@ -3636,11 +3642,11 @@ SUBROUTINE mym_condensation (kts,kte, & !JAYMES: variables for tropopause-height estimation real(kind_phys) :: theta1, theta2, ht1, ht2 - INTEGER :: k_tropo + integer :: k_tropo ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col real(kind_phys) :: qw_pert ! First, obtain an estimate for the tropopause height (k), using the method employed in the @@ -3794,29 +3800,31 @@ SUBROUTINE mym_condensation (kts,kte, & !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS !but with use of higher-order moments to estimate sigma - PBLH2=MAX(10.,PBLH1) + pblh2=MAX(10.,pblh1) zagl = 0. + dzm1 = 0. DO k = kts,kte-1 - zagl = zagl + dz(k) - t = th(k)*exner(k) + zagl = zagl + 0.5*(dz(k) + dzm1) + dzm1 = dz(k) - xl = xl_blend(t) ! obtain latent heat - qsat_tk = qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k)=MAX(MIN(1.00,qw(k)/MAX(1.E-10,qsat_tk)),0.001) + t = th(k)*exner(k) + xl = xl_blend(t) ! obtain latent heat + qsat_tk= qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p + rh(k) = MAX(MIN(1.00,qw(k)/MAX(1.E-10,qsat_tk)),0.001) !dqw/dT: Clausius-Clapeyron - dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) + dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) alp(k) = 1.0/( 1.0+dqsl*xlvcp ) bet(k) = dqsl*exner(k) - rsl = xl*qsat_tk / (r_v*t**2) ! slope of C-C curve at t (=abs temperature) + rsl = xl*qsat_tk / (r_v*t**2) ! slope of C-C curve at t (=abs temperature) ! CB02, Eqn. 4 - cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 - a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - b(k) = a(k)*rsl ! CB02 variable "b" + cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 + a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" + b(k) = a(k)*rsl ! CB02 variable "b" !SPP - qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) + qw_pert= qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) !This form of qmq (the numerator of Q1) no longer uses the a(k) factor qmq = qw_pert - qsat_tk ! saturation deficit/excess; @@ -3826,14 +3834,24 @@ SUBROUTINE mym_condensation (kts,kte, & r3sq = max( qsq(k), 0.0 ) !Calculate sigma using higher-order moments: sgm(k) = SQRT( r3sq ) - !Set limits on sigma relative to saturation water vapor + !Set constraints on sigma relative to saturation water vapor sgm(k) = min( sgm(k), qsat_tk*0.666 ) - sgm(k) = max( sgm(k), qsat_tk*0.035 ) + !sgm(k) = max( sgm(k), qsat_tk*0.035 ) + + !introduce vertical grid spacing dependence on min sgm + wt = max(500. - max(dz(k)-100.,0.0), 0.0)/500. !=1 for dz < 100 m, =0 for dz > 600 m + sgm(k) = sgm(k) + sgm(k)*0.2*(1.0-wt) !inflate sgm for coarse dz + + !allow min sgm to vary with dz and z. + qpct = qpct_pbl*wt + qpct_trp*(1.0-wt) + qpct = min(qpct, max(qpct_sfc, qpct_pbl*zagl/500.) ) + sgm(k) = max( sgm(k), qsat_tk*qpct ) + q1(k) = qmq / sgm(k) ! Q1, the normalized saturation !Add condition for falling/settling into low-RH layers, so at least !some cloud fraction is applied for all qc and qi. - rh_hack = rh(k) + rh_hack= rh(k) !ensure adequate RH & q1 when qi is at least 1e-9 if (qi(k)>1.e-9) then rh_hack =min(1.0, rhcrit + 0.06*(9.0 + log10(qi(k)))) @@ -3864,20 +3882,17 @@ SUBROUTINE mym_condensation (kts,kte, & ! Specify hydrometeors ! JAYMES- this option added 8 May 2015 ! The cloud water formulations are taken from CB02, Eq. 8. - IF (q1k < 0.) THEN !unsaturated -#ifdef SINGLE_PREC - ql_water = sgm(k)*EXP(1.2*q1k-1.) -#else - ql_water = sgm(k)*EXP(1.2*q1k-1.) -#endif - ql_ice = sgm(k)*EXP(1.2*q1k-1.) - ELSE IF (q1k > 2.) THEN !supersaturated - ql_water = sgm(k)*q1k - ql_ice = sgm(k)*q1k - ELSE !slightly saturated (0 > q1 < 2) - ql_water = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ql_ice = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ENDIF + maxqc = max(qw(k) - qsat_tk, 0.0) + if (q1k < 0.) then !unsaturated + ql_water = sgm(k)*exp(1.2*q1k-1.) + ql_ice = sgm(k)*exp(1.2*q1k-1.) + elseif (q1k > 2.) then !supersaturated + ql_water = min(sgm(k)*q1k, maxqc) + ql_ice = sgm(k)*q1k + else !slightly saturated (0 > q1 < 2) + ql_water = min(sgm(k)*(exp(-1.) + 0.66*q1k + 0.086*q1k**2), maxqc) + ql_ice = sgm(k)*(exp(-1.) + 0.66*q1k + 0.086*q1k**2) + endif !In saturated grid cells, use average of SGS and resolved values !if ( qc(k) > 1.e-6 ) ql_water = 0.5 * ( ql_water + qc(k) ) @@ -3922,17 +3937,22 @@ SUBROUTINE mym_condensation (kts,kte, & ! Fng = 1.-1.5*q1k !ENDIF ! Use the form of "Fng" from Bechtold and Siebesma (1998, JAS) - IF (q1k .GE. 1.0) THEN + if (q1k .ge. 1.0) then Fng = 1.0 - ELSEIF (q1k .GE. -1.7 .AND. q1k .LT. 1.0) THEN - Fng = EXP(-0.4*(q1k-1.0)) - ELSEIF (q1k .GE. -2.5 .AND. q1k .LT. -1.7) THEN - Fng = 3.0 + EXP(-3.8*(q1k+1.7)) - ELSE - Fng = MIN(23.9 + EXP(-1.6*(q1k+2.5)), 60.) - ENDIF + elseif (q1k .ge. -1.7 .and. q1k .lt. 1.0) then + Fng = exp(-0.4*(q1k-1.0)) + elseif (q1k .ge. -2.5 .and. q1k .lt. -1.7) then + Fng = 3.0 + exp(-3.8*(q1k+1.7)) + else + Fng = min(23.9 + exp(-1.6*(q1k+2.5)), 60.) + endif + + cfmax = min(cldfra_bl1D(k), 0.6) + !Further limit the cf going into vt & vq near the surface + zsl = min(max(25., 0.1*pblh2), 100.) + wt = min(zagl/zsl, 1.0) !=0 at z=0 m, =1 above ekman layer + cfmax = cfmax*wt - cfmax= min(cldfra_bl1D(k), 0.6) bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from ! "b" in CB02 (i.e., b(k) above) by a factor ! of T/theta. Strictly, b(k) above is formulated in @@ -4023,17 +4043,17 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & &bl_mynn_mixscalars ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i + integer, intent(in) :: kts,kte,i #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(in) :: bl_mynn_cloudmix,bl_mynn_mixqt, & + integer, intent(in) :: bl_mynn_cloudmix,bl_mynn_mixqt, & bl_mynn_edmf,bl_mynn_edmf_mom, & bl_mynn_mixscalars - LOGICAL, INTENT(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QS, & + logical, intent(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QS, & &FLAG_QNC,FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA ! thl - liquid water potential temperature @@ -4043,47 +4063,47 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! flq - surface flux of qw ! mass-flux plumes - real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: s_aw, & + real(kind_phys), dimension(kts:kte+1), intent(in) :: s_aw, & &s_awthl,s_awqt,s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & &s_awqnwfa,s_awqnifa,s_awqnbca, & &sd_aw,sd_awthl,sd_awqt,sd_awqv,sd_awqc,sd_awu,sd_awv ! tendencies from mass-flux environmental subsidence and detrainment - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & + real(kind_phys), dimension(kts:kte), intent(in) :: sub_thl,sub_sqv, & &sub_u,sub_v,det_thl,det_sqv,det_sqc,det_u,det_v - real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,& + real(kind_phys), dimension(kts:kte), intent(in) :: u,v,th,tk,qv,qc,qi,& &qs,qni,qnc,rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd, & &cldfra_bl1d,diss_heat - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,& + real(kind_phys), dimension(kts:kte), intent(inout) :: thl,sqw,sqv,sqc,& &sqi,sqs,qnwfa,qnifa,qnbca,ozone,dfm,dfh - real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv, & + real(kind_phys), dimension(kts:kte), intent(inout) :: du,dv,dth,dqv, & &dqc,dqi,dqs,dqni,dqnc,dqnwfa,dqnifa,dqnbca,dozone - real(kind_phys), INTENT(IN) :: flt,flq,flqv,flqc,uoce,voce - real(kind_phys), INTENT(IN) :: ust,delt,psfc,wspd + real(kind_phys), intent(in) :: flt,flq,flqv,flqc,uoce,voce + real(kind_phys), intent(in) :: ust,delt,psfc,wspd !debugging real(kind_phys):: wsp,wsp2,tk2,th2 - LOGICAL :: problem + logical :: problem integer :: kproblem -! real(kind_phys), INTENT(IN) :: gradu_top,gradv_top,gradth_top,gradqv_top +! real(kind_phys), intent(in) :: gradu_top,gradv_top,gradth_top,gradqv_top !local vars - real(kind_phys), DIMENSION(kts:kte) :: dtz,dfhc,dfmc,delp - real(kind_phys), DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqs2,sqw2, & + real(kind_phys), dimension(kts:kte) :: dtz,dfhc,dfmc,delp + real(kind_phys), dimension(kts:kte) :: sqv2,sqc2,sqi2,sqs2,sqw2, & &qni2,qnc2,qnwfa2,qnifa2,qnbca2,ozone2 - real(kind_phys), DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface + real(kind_phys), dimension(kts:kte) :: zfac,plumeKh,rhoinv + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte+1) :: rhoz, & !rho on model interface &khdz,kmdz real(kind_phys):: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw real(kind_phys):: t,esat,qsl,onoff,kh,km,dzk,rhosfc real(kind_phys):: ustdrag,ustdiff,qvflux real(kind_phys):: th_new,portion_qc,portion_qi,condensate,qsat - INTEGER :: k,kk + integer :: k,kk !Activate nonlocal mixing from the mass-flux scheme for !number concentrations and aerosols (0.0 = no; 1.0 = yes) - real(kind_phys), PARAMETER :: nonloc = 1.0 + real(kind_phys), parameter :: nonloc = 1.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -4813,8 +4833,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & d(kte)=qnbca(kte) ! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) + CALL tridiag2(kte,a,b,c,d,x) +! CALL tridiag3(kte,a,b,c,d,x) DO k=kts,kte !qnbca2(k)=d(k-kts+1) @@ -5207,36 +5227,36 @@ SUBROUTINE mynn_mix_chem(kts,kte,i, & enh_mix, smoke_dbg ) !------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i - real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dfh,dz,tcd,qcd - real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: rho - real(kind_phys), INTENT(IN) :: flt - real(kind_phys), INTENT(IN) :: delt,pblh - INTEGER, INTENT(IN) :: nchem, kdvel, ndvel - real(kind_phys), DIMENSION( kts:kte+1), INTENT(IN) :: s_aw - real(kind_phys), DIMENSION( kts:kte, nchem ), INTENT(INOUT) :: chem1 - real(kind_phys), DIMENSION( kts:kte+1,nchem), INTENT(IN) :: s_awchem - real(kind_phys), DIMENSION( ndvel ), INTENT(IN) :: vd1 - real(kind_phys), INTENT(IN) :: emis_ant_no,frp - LOGICAL, INTENT(IN) :: rrfs_sd,enh_mix,smoke_dbg + integer, intent(in) :: kts,kte,i + real(kind_phys), dimension(kts:kte), intent(in) :: dfh,dz,tcd,qcd + real(kind_phys), dimension(kts:kte), intent(inout) :: rho + real(kind_phys), intent(in) :: flt + real(kind_phys), intent(in) :: delt,pblh + integer, intent(in) :: nchem, kdvel, ndvel + real(kind_phys), dimension( kts:kte+1), intent(in) :: s_aw + real(kind_phys), dimension( kts:kte, nchem ), intent(inout) :: chem1 + real(kind_phys), dimension( kts:kte+1,nchem), intent(in) :: s_awchem + real(kind_phys), dimension( ndvel ), intent(in) :: vd1 + real(kind_phys), intent(in) :: emis_ant_no,frp + logical, intent(in) :: rrfs_sd,enh_mix,smoke_dbg !local vars - real(kind_phys), DIMENSION(kts:kte) :: dtz - real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys), dimension(kts:kte) :: dtz + real(kind_phys), dimension(kts:kte) :: a,b,c,d,x real(kind_phys):: rhs,dztop real(kind_phys):: t,dzk real(kind_phys):: hght real(kind_phys):: khdz_old, khdz_back - INTEGER :: k,kk,kmaxfire ! JLS 12/21/21 - INTEGER :: ic ! Chemical array loop index + integer :: k,kk,kmaxfire ! JLS 12/21/21 + integer :: ic ! Chemical array loop index - INTEGER, SAVE :: icall + integer, SAVE :: icall - real(kind_phys), DIMENSION(kts:kte) :: rhoinv - real(kind_phys), DIMENSION(kts:kte+1) :: rhoz,khdz - real(kind_phys), PARAMETER :: NO_threshold = 10.0 ! For anthropogenic sources - real(kind_phys), PARAMETER :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires - real(kind_phys), PARAMETER :: pblh_threshold = 100.0 + real(kind_phys), dimension(kts:kte) :: rhoinv + real(kind_phys), dimension(kts:kte+1) :: rhoz,khdz + real(kind_phys), parameter :: NO_threshold = 10.0 ! For anthropogenic sources + real(kind_phys), parameter :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires + real(kind_phys), parameter :: pblh_threshold = 100.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -5335,14 +5355,14 @@ SUBROUTINE retrieve_exchange_coeffs(kts,kte,& !------------------------------------------------------------------- - INTEGER , INTENT(in) :: kts,kte + integer , intent(in) :: kts,kte - real(kind_phys), DIMENSION(KtS:KtE), INTENT(in) :: dz,dfm,dfh + real(kind_phys), dimension(KtS:KtE), intent(in) :: dz,dfm,dfh - real(kind_phys), DIMENSION(KtS:KtE), INTENT(out) :: K_m, K_h + real(kind_phys), dimension(KtS:KtE), intent(out) :: K_m, K_h - INTEGER :: k + integer :: k real(kind_phys):: dzk K_m(kts)=0. @@ -5368,13 +5388,13 @@ SUBROUTINE tridiag(n,a,b,c,d) !------------------------------------------------------------------- - INTEGER, INTENT(in):: n - real(kind_phys), DIMENSION(n), INTENT(in) :: a,b - real(kind_phys), DIMENSION(n), INTENT(inout) :: c,d + integer, intent(in):: n + real(kind_phys), dimension(n), intent(in) :: a,b + real(kind_phys), dimension(n), intent(inout) :: c,d - INTEGER :: i + integer :: i real(kind_phys):: p - real(kind_phys), DIMENSION(n) :: q + real(kind_phys), dimension(n) :: q c(n)=0. q(1)=-c(1)/b(1) @@ -5508,23 +5528,23 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) !value could be found to work best in all conditions. !--------------------------------------------------------------- - INTEGER,INTENT(IN) :: KTS,KTE + integer,intent(in) :: KTS,KTE #ifdef HARDCODE_VERTICAL # define kts 1 # define kte HARDCODE_VERTICAL #endif - real(kind_phys), INTENT(OUT) :: zi - real(kind_phys), INTENT(IN) :: landsea - real(kind_phys), DIMENSION(KTS:KTE), INTENT(IN) :: thetav1D, qke1D, dz1D - real(kind_phys), DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D + real(kind_phys), intent(out) :: zi + real(kind_phys), intent(in) :: landsea + real(kind_phys), dimension(kts:kte), intent(in) :: thetav1D, qke1D, dz1D + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw1D !LOCAL VARS real(kind_phys):: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv real(kind_phys):: delt_thv !delta theta-v; dependent on land/sea point - real(kind_phys), PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). - real(kind_phys), PARAMETER :: sbl_damp = 400. !transition length for blending (m). - INTEGER :: I,J,K,kthv,ktke,kzi + real(kind_phys), parameter :: sbl_lim = 200. !upper limit of stable BL height (m). + real(kind_phys), parameter :: sbl_damp = 400. !transition length for blending (m). + integer :: I,J,K,kthv,ktke,kzi !Initialize KPBL (kzi) kzi = 2 @@ -5689,12 +5709,12 @@ SUBROUTINE DMP_mf( & & F_QNWFA,F_QNIFA,F_QNBCA, & & Psig_shcu, & ! output info - & nup2,ktop,maxmf,ztop, & + & maxwidth,ktop,maxmf,ztop, & ! inputs for stochastic perturbations & spp_pbl,rstoch_col ) ! inputs: - INTEGER, INTENT(IN) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt + integer, intent(in) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt #ifdef HARDCODE_VERTICAL # define kts 1 @@ -5702,133 +5722,137 @@ SUBROUTINE DMP_mf( & #endif ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + integer, intent(in) :: spp_pbl + real(kind_phys), dimension(kts:kte) :: rstoch_col - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: & + real(kind_phys),dimension(kts:kte), intent(in) :: & &U,V,W,TH,THL,TK,QT,QV,QC, & &exner,dz,THV,P,rho,qke,qnc,qni,qnwfa,qnifa,qnbca - real(kind_phys),DIMENSION(KTS:KTE+1), INTENT(IN) :: zw !height at full-sigma - real(kind_phys), INTENT(IN) :: flt,fltv,flq,flqv,Psig_shcu, & + real(kind_phys),dimension(kts:kte+1), intent(in) :: zw !height at full-sigma + real(kind_phys), intent(in) :: flt,fltv,flq,flqv,Psig_shcu, & &landsea,ts,dx,dt,ust,pblh - LOGICAL, OPTIONAL :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA,F_QNBCA + logical, optional :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA,F_QNBCA ! outputs - updraft properties - real(kind_phys),DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a,edmf_w, & + real(kind_phys),dimension(kts:kte), intent(out) :: edmf_a,edmf_w, & & edmf_qt,edmf_thl,edmf_ent,edmf_qc !add one local edmf variable: - real(kind_phys),DIMENSION(KTS:KTE) :: edmf_th + real(kind_phys),dimension(kts:kte) :: edmf_th ! output - INTEGER, INTENT(OUT) :: nup2,ktop - real(kind_phys), INTENT(OUT) :: maxmf - real(kind_phys), INTENT(OUT) :: ztop + integer, intent(out) :: ktop + real(kind_phys), intent(out) :: maxmf,ztop,maxwidth ! outputs - variables needed for solver - real(kind_phys),DIMENSION(KTS:KTE+1) :: s_aw, & !sum ai*rho*wis_awphi + real(kind_phys),dimension(kts:kte+1) :: s_aw, & !sum ai*rho*wis_awphi &s_awthl,s_awqt,s_awqv,s_awqc,s_awqnc,s_awqni, & &s_awqnwfa,s_awqnifa,s_awqnbca,s_awu,s_awv, & &s_awqke,s_aw2 - real(kind_phys),DIMENSION(KTS:KTE), INTENT(INOUT) :: & + real(kind_phys),dimension(kts:kte), intent(inout) :: & &qc_bl1d,cldfra_bl1d,qc_bl1d_old,cldfra_bl1d_old - INTEGER, PARAMETER :: nup=10, debug_mf=0 + integer, parameter :: nup=8, debug_mf=0 + real(kind_phys) :: nup2 !------------- local variables ------------------- ! updraft properties defined on interfaces (k=1 is the top of the ! first model layer - real(kind_phys),DIMENSION(KTS:KTE+1,1:NUP) :: & + real(kind_phys),dimension(kts:kte+1,1:NUP) :: & &UPW,UPTHL,UPQT,UPQC,UPQV, & &UPA,UPU,UPV,UPTHV,UPQKE,UPQNC, & &UPQNI,UPQNWFA,UPQNIFA,UPQNBCA ! entrainment variables - real(kind_phys),DIMENSION(KTS:KTE,1:NUP) :: ENT,ENTf - INTEGER,DIMENSION(KTS:KTE,1:NUP) :: ENTi + real(kind_phys),dimension(kts:kte,1:NUP) :: ENT,ENTf + integer,dimension(kts:kte,1:NUP) :: ENTi ! internal variables - INTEGER :: K,I,k50 + integer :: K,I,k50 real(kind_phys):: fltv2,wstar,qstar,thstar,sigmaW,sigmaQT, & &sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn, & - QNWFAn,QNIFAn,QNBCAn, & - Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int + & QNWFAn,QNIFAn,QNBCAn, & + & Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int ! w parameters - real(kind_phys), PARAMETER :: & + real(kind_phys), parameter :: & &Wa=2./3., & &Wb=0.002, & &Wc=1.5 ! Lateral entrainment parameters ( L0=100 and ENT0=0.1) were taken from ! Suselj et al (2013, jas). Note that Suselj et al (2014,waf) use L0=200 and ENT0=0.2. - real(kind_phys),PARAMETER :: & - & L0=100., & - & ENT0=0.1 - - ! Implement ideas from Neggers (2016, JAMES): - real(kind_phys), PARAMETER :: Atot = 0.10 ! Maximum total fractional area of all updrafts - real(kind_phys), PARAMETER :: lmax = 1000.! diameter of largest plume - real(kind_phys), PARAMETER :: dl = 100. ! diff size of each plume - the differential multiplied by the integrand - real(kind_phys), PARAMETER :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) - real(kind_phys):: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). + real(kind_phys),parameter :: & + & L0=100., & + & ENT0=0.1 + + ! Parameters/variables for regulating plumes: + real(kind_phys), parameter :: Atot = 0.10 ! Maximum total fractional area of all updrafts + real(kind_phys), parameter :: lmax = 1000.! diameter of largest plume (absolute maximum, can be smaller) + real(kind_phys), parameter :: lmin = 300. ! diameter of smallest plume (absolute minimum, can be larger) + real(kind_phys), parameter :: dlmin = 0. ! delta increase in the diameter of smallest plume (large fltv) + real(kind_phys) :: minwidth ! actual width of smallest plume + real(kind_phys) :: dl ! variable increment of plume size + real(kind_phys), parameter :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) + real(kind_phys):: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). ! Note that changing d to -2.0 makes each size plume equally contribute to the total coverage of all plumes. ! Note that changing d to -1.7 doubles the area coverage of the largest plumes relative to the smallest plumes. - real(kind_phys):: cn,c,l,n,an2,hux,maxwidth,wspd_pbl,cloud_base,width_flx + real(kind_phys):: cn,c,l,n,an2,hux,wspd_pbl,cloud_base,width_flx ! chem/smoke - INTEGER, INTENT(IN) :: nchem - real(kind_phys),DIMENSION(:, :) :: chem1 - real(kind_phys),DIMENSION(kts:kte+1, nchem) :: s_awchem - real(kind_phys),DIMENSION(nchem) :: chemn - real(kind_phys),DIMENSION(KTS:KTE+1,1:NUP, nchem) :: UPCHEM - INTEGER :: ic - real(kind_phys),DIMENSION(KTS:KTE+1, nchem) :: edmf_chem - LOGICAL, INTENT(IN) :: mix_chem + integer, intent(in) :: nchem + real(kind_phys),dimension(:, :) :: chem1 + real(kind_phys),dimension(kts:kte+1, nchem) :: s_awchem + real(kind_phys),dimension(nchem) :: chemn + real(kind_phys),dimension(kts:kte+1,1:NUP, nchem) :: UPCHEM + integer :: ic + real(kind_phys),dimension(kts:kte+1, nchem) :: edmf_chem + logical, intent(in) :: mix_chem !JOE: add declaration of ERF real(kind_phys):: ERF - LOGICAL :: superadiabatic + logical :: superadiabatic ! VARIABLES FOR CHABOUREAU-BECHTOLD CLOUD FRACTION - real(kind_phys),DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm + real(kind_phys),dimension(kts:kte), intent(inout) :: vt, vq, sgm real(kind_phys):: sigq,xl,rsl,cpm,a,qmq,mf_cf,Aup,Q1,diffqt,qsat_tk,& Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & Ac_mf,Ac_strat,qc_mf - real(kind_phys), PARAMETER :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value + real(kind_phys), parameter :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value ! Variables for plume interpolation/saturation check - real(kind_phys),DIMENSION(KTS:KTE) :: exneri,dzi + real(kind_phys),dimension(kts:kte) :: exneri,dzi,rhoz real(kind_phys):: THp, QTp, QCp, QCs, esat, qsl - real(kind_phys):: csigma,acfac,ac_wsp,ac_cld + real(kind_phys):: csigma,acfac,ac_wsp !plume overshoot - INTEGER :: overshoot + integer :: overshoot real(kind_phys):: bvf, Frz, dzp !Flux limiter: not let mass-flux of heat between k=1&2 exceed (fluxportion)*(surface heat flux). !This limiter makes adjustments to the entire column. real(kind_phys):: adjustment, flx1 - real(kind_phys), PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact + real(kind_phys), parameter :: fluxportion=0.75 ! set liberally, so has minimal impact. Note that + ! 0.5 starts to have a noticeable impact ! over land (decrease maxMF by 10-20%), but no impact over water. !Subsidence - real(kind_phys),DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence + real(kind_phys),dimension(kts:kte) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & envm_u,envm_v !environmental variables defined at middle of layer - real(kind_phys),DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface + real(kind_phys),dimension(kts:kte+1) :: envi_a,envi_w !environmental variables defined at model interface real(kind_phys):: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs, & qc_plume,exc_heat,exc_moist,tk_int - real(kind_phys), PARAMETER :: Cdet = 1./45. - real(kind_phys), PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers + real(kind_phys), parameter :: Cdet = 1./45. + real(kind_phys), parameter :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme !is compensated by "gentle" environmental subsidence. - real(kind_phys), PARAMETER :: Csub=0.25 + real(kind_phys), parameter :: Csub=0.25 !Factor for the pressure gradient effects on momentum transport - real(kind_phys), PARAMETER :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere + real(kind_phys), parameter :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere real(kind_phys):: Uk,Ukm1,Vk,Vkm1,dxsa ! check the inputs @@ -5859,9 +5883,9 @@ SUBROUTINE DMP_mf( & UPQNWFA=0. UPQNIFA=0. UPQNBCA=0. - IF ( mix_chem ) THEN - UPCHEM(KTS:KTE+1,1:NUP,1:nchem)=0.0 - ENDIF + if ( mix_chem ) then + UPCHEM(kts:kte+1,1:NUP,1:nchem)=0.0 + endif ENT=0.001 ! Initialize mean updraft properties @@ -5871,9 +5895,9 @@ SUBROUTINE DMP_mf( & edmf_thl=0. edmf_ent=0. edmf_qc =0. - IF ( mix_chem ) THEN + if ( mix_chem ) then edmf_chem(kts:kte+1,1:nchem) = 0.0 - ENDIF + endif ! Initialize the variables needed for implicit solver s_aw=0. @@ -5889,153 +5913,161 @@ SUBROUTINE DMP_mf( & s_awqnwfa=0. s_awqnifa=0. s_awqnbca=0. - IF ( mix_chem ) THEN + if ( mix_chem ) then s_awchem(kts:kte+1,1:nchem) = 0.0 - ENDIF + endif ! Initialize explicit tendencies for subsidence & detrainment sub_thl = 0. sub_sqv = 0. - sub_u = 0. - sub_v = 0. + sub_u = 0. + sub_v = 0. det_thl = 0. det_sqv = 0. det_sqc = 0. - det_u = 0. - det_v = 0. + det_u = 0. + det_v = 0. + nup2 = nup !start with nup, but set to zero if activation criteria fails ! Taper off MF scheme when significant resolved-scale motions ! are present This function needs to be asymetric... - k = 1 - maxw = 0.0 + maxw = 0.0 cloud_base = 9000.0 -! DO WHILE (ZW(k) < pblh + 500.) - DO k=1,kte-1 - IF(zw(k) > pblh + 500.) exit + do k=1,kte-1 + if (zw(k) > pblh + 500.) exit wpbl = w(k) - IF(w(k) < 0.)wpbl = 2.*w(k) - maxw = MAX(maxw,ABS(wpbl)) + if (w(k) < 0.)wpbl = 2.*w(k) + maxw = max(maxw,abs(wpbl)) !Find highest k-level below 50m AGL - IF(ZW(k)<=50.)k50=k + if (ZW(k)<=50.)k50=k !Search for cloud base - qc_sgs = MAX(qc(k), qc_bl1d(k)*cldfra_bl1d(k)) - IF(qc_sgs> 1E-5 .AND. cloud_base == 9000.0)THEN + qc_sgs = max(qc(k), qc_bl1d(k)) + if (qc_sgs> 1E-5 .and. (cldfra_bl1d(k) .ge. 0.5) .and. cloud_base == 9000.0) then cloud_base = 0.5*(ZW(k)+ZW(k+1)) - ENDIF + endif + enddo - !k = k + 1 - ENDDO - !print*," maxw before manipulation=", maxw - maxw = MAX(0.,maxw - 1.0) ! do nothing for small w (< 1 m/s), but - Psig_w = MAX(0.0, 1.0 - maxw) ! linearly taper off for w > 1.0 m/s - Psig_w = MIN(Psig_w, Psig_shcu) - !print*," maxw=", maxw," Psig_w=",Psig_w," Psig_shcu=",Psig_shcu + !do nothing for small w (< 1 m/s), but linearly taper off for w > 1.0 m/s + maxw = max(0.,maxw - 1.0) + Psig_w = max(0.0, 1.0 - maxw) + Psig_w = min(Psig_w, Psig_shcu) !Completely shut off MF scheme for strong resolved-scale vertical velocities. fltv2 = fltv - IF(Psig_w == 0.0 .and. fltv > 0.0) fltv2 = -1.*fltv + if(Psig_w == 0.0 .and. fltv > 0.0) fltv2 = -1.*fltv ! If surface buoyancy is positive we do integration, otherwise no. ! Also, ensure that it is at least slightly superadiabatic up through 50 m superadiabatic = .false. - IF((landsea-1.5).GE.0)THEN + if ((landsea-1.5).ge.0) then hux = -0.001 ! WATER ! dT/dz must be < - 0.1 K per 100 m. - ELSE + else hux = -0.005 ! LAND ! dT/dz must be < - 0.5 K per 100 m. - ENDIF - DO k=1,MAX(1,k50-1) !use "-1" because k50 used interface heights (zw). - IF (k == 1) then - IF ((th(k)-ts)/(0.5*dz(k)) < hux) THEN + endif + do k=1,max(1,k50-1) !use "-1" because k50 used interface heights (zw). + if (k == 1) then + if ((th(k)-ts)/(0.5*dz(k)) < hux) then superadiabatic = .true. - ELSE + else superadiabatic = .false. exit - ENDIF - ELSE - IF ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) THEN + endif + else + if ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) then superadiabatic = .true. - ELSE + else superadiabatic = .false. exit - ENDIF - ENDIF - ENDDO + endif + endif + enddo ! Determine the numer of updrafts/plumes in the grid column: ! Some of these criteria may be a little redundant but useful for bullet-proofing. - ! (1) largest plume = 1.0 * dx. - ! (2) Apply a scale-break, assuming no plumes with diameter larger than PBLH can exist. + ! (1) largest plume = 1.2 * dx. + ! (2) Apply a scale-break, assuming no plumes with diameter larger than 1.1*PBLH can exist. ! (3) max plume size beneath clouds deck approx = 0.5 * cloud_base. ! (4) add wspd-dependent limit, when plume model breaks down. (hurricanes) ! (5) limit to reduce max plume sizes in weakly forced conditions. This is only ! meant to "soften" the activation of the mass-flux scheme. ! Criteria (1) - NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) + maxwidth = min(dx*dcut, lmax) !Criteria (2) - maxwidth = 1.1*PBLH + maxwidth = min(maxwidth, 1.1*PBLH) ! Criteria (3) - maxwidth = MIN(maxwidth,0.5*cloud_base) + if ((landsea-1.5) .lt. 0) then !land + maxwidth = MIN(maxwidth, 0.5*cloud_base) + else !water + maxwidth = MIN(maxwidth, 0.9*cloud_base) + endif ! Criteria (4) wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) !Note: area fraction (acfac) is modified below ! Criteria (5) - only a function of flt (not fltv) if ((landsea-1.5).LT.0) then !land !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) + !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.040)/0.04) + .5),1000.), 0.) else !water - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.003)/0.01) + .5),1000.), 0.) + !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.003)/0.01) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.007)/0.02) + .5),1000.), 0.) + endif + maxwidth = MIN(maxwidth, width_flx) + minwidth = lmin + !allow min plume size to increase in large flux conditions (eddy diffusivity should be + !large enough to handle the representation of small plumes). + if (maxwidth .ge. (lmax - 1.0) .and. fltv .gt. 0.2)minwidth = lmin + dlmin*min((fltv-0.2)/0.3, 1.) + + if (maxwidth .le. minwidth) then ! deactivate MF component + nup2 = 0 + maxwidth = 0.0 endif - maxwidth = MIN(maxwidth,width_flx) - ! Convert maxwidth to number of plumes - NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) - !Initialize values for 2d output fields: - ktop = 0 - ztop = 0.0 - maxmf= 0.0 + ! Initialize values for 2d output fields: + ktop = 0 + ztop = 0.0 + maxmf= 0.0 - IF ( fltv2 > 0.002 .AND. NUP2 .GE. 1 .AND. superadiabatic) then - !PRINT*," Conditions met to run mass-flux scheme",fltv2,pblh +!Begin plume processing if passes criteria +if ( fltv2 > 0.002 .AND. (maxwidth > minwidth) .AND. superadiabatic) then ! Find coef C for number size density N cn = 0. - d=-1.9 !set d to value suggested by Neggers 2015 (JAMES). - !d=-1.9 + .2*tanh((fltv2 - 0.05)/0.15) - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume + d =-1.9 !set d to value suggested by Neggers 2015 (JAMES). + dl = (maxwidth - minwidth)/real(nup-1) + do i=1,NUP + ! diameter of plume + l = minwidth + dl*real(i-1) cn = cn + l**d * (l*l)/(dx*dx) * dl ! sum fractional area of each plume enddo C = Atot/cn !Normalize C according to the defined total fraction (Atot) ! Make updraft area (UPA) a function of the buoyancy flux if ((landsea-1.5).LT.0) then !land - !acfac = .5*tanh((fltv2 - 0.03)/0.09) + .5 - !acfac = .5*tanh((fltv2 - 0.02)/0.09) + .5 acfac = .5*tanh((fltv2 - 0.02)/0.05) + .5 else !water acfac = .5*tanh((fltv2 - 0.01)/0.03) + .5 endif !add a windspeed-dependent adjustment to acfac that tapers off - !the mass-flux scheme linearly above sfc wind speeds of 20 m/s: - ac_wsp = 1.0 - min(max(wspd_pbl - 20.0, 0.0), 10.0)/10.0 - !reduce area fraction beneath cloud bases < 1200 m AGL - ac_cld = min(cloud_base/1200., 1.0) - acfac = acfac * min(ac_wsp, ac_cld) + !the mass-flux scheme linearly above sfc wind speeds of 15 m/s. + !Note: this effect may be better represented by an increase in + !entrainment rate for high wind consitions (more ambient turbulence). + ac_wsp = 1.0 - min(max(wspd_pbl - 15.0, 0.0), 10.0)/10.0 + acfac = acfac * ac_wsp ! Find the portion of the total fraction (Atot) of each plume size: An2 = 0. - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume + do i=1,NUP + ! diameter of plume + l = minwidth + dl*real(i-1) N = C*l**d ! number density of plume n - UPA(1,I) = N*l*l/(dx*dx) * dl ! fractional area of plume n + UPA(1,i) = N*l*l/(dx*dx) * dl ! fractional area of plume n - UPA(1,I) = UPA(1,I)*acfac - An2 = An2 + UPA(1,I) ! total fractional area of all plumes + UPA(1,i) = UPA(1,i)*acfac + An2 = An2 + UPA(1,i) ! total fractional area of all plumes !print*," plume size=",l,"; area=",UPA(1,I),"; total=",An2 end do @@ -6048,11 +6080,11 @@ SUBROUTINE DMP_mf( & qstar=max(flq,1.0E-5)/wstar thstar=flt/wstar - IF((landsea-1.5).GE.0)THEN + if ((landsea-1.5) .ge. 0) then csigma = 1.34 ! WATER - ELSE + else csigma = 1.34 ! LAND - ENDIF + endif if (env_subs) then exc_fac = 0.0 @@ -6065,6 +6097,8 @@ SUBROUTINE DMP_mf( & exc_fac = 0.58 endif endif + !decrease excess for large wind speeds + exc_fac = exc_fac * ac_wsp !Note: sigmaW is typically about 0.5*wstar sigmaW =csigma*wstar*(z0/pblh)**(onethird)*(1 - 0.8*z0/pblh) @@ -6077,14 +6111,11 @@ SUBROUTINE DMP_mf( & wmax=MIN(sigmaW*pwmax,0.5) !SPECIFY SURFACE UPDRAFT PROPERTIES AT MODEL INTERFACE BETWEEN K = 1 & 2 - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + do i=1,NUP wlv=wmin+(wmax-wmin)/NUP2*(i-1) !SURFACE UPDRAFT VERTICAL VELOCITY UPW(1,I)=wmin + real(i)/real(NUP)*(wmax-wmin) - !IF (UPW(1,I) > 0.5*ZW(2)/dt) UPW(1,I) = 0.5*ZW(2)/dt - UPU(1,I)=(U(KTS)*DZ(KTS+1)+U(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPV(1,I)=(V(KTS)*DZ(KTS+1)+V(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQC(1,I)=0.0 @@ -6093,21 +6124,11 @@ SUBROUTINE DMP_mf( & exc_heat = exc_fac*UPW(1,I)*sigmaTH/sigmaW UPTHV(1,I)=(THV(KTS)*DZ(KTS+1)+THV(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & & + exc_heat -!was UPTHL(1,I)= UPTHV(1,I)/(1.+svp1*UPQT(1,I)) !assume no saturated parcel at surface UPTHL(1,I)=(THL(KTS)*DZ(KTS+1)+THL(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & & + exc_heat !calculate exc_moist by use of surface fluxes exc_moist=exc_fac*UPW(1,I)*sigmaQT/sigmaW - !calculate exc_moist by conserving rh: -! tk_int =(tk(kts)*dz(kts+1)+tk(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) -! pk =(p(kts)*dz(kts+1)+p(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) -! qtk =(qt(kts)*dz(kts+1)+qt(kts+1)*dz(kts))/(dz(kts)+dz(kts+1)) -! qsat_tk = qsat_blend(tk_int, pk) ! saturation water vapor mixing ratio at tk and p -! rhgrid =MAX(MIN(1.0,qtk/MAX(1.E-8,qsat_tk)),0.001) -! tk_int = tk_int + exc_heat -! qsat_tk = qsat_blend(tk_int, pk) -! exc_moist= max(rhgrid*qsat_tk - qtk, 0.0) UPQT(1,I)=(QT(KTS)*DZ(KTS+1)+QT(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1))& & +exc_moist @@ -6117,36 +6138,36 @@ SUBROUTINE DMP_mf( & UPQNWFA(1,I)=(QNWFA(KTS)*DZ(KTS+1)+QNWFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNIFA(1,I)=(QNIFA(KTS)*DZ(KTS+1)+QNIFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNBCA(1,I)=(QNBCA(KTS)*DZ(KTS+1)+QNBCA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - ENDDO + enddo - IF ( mix_chem ) THEN - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + if ( mix_chem ) then + do i=1,NUP do ic = 1,nchem - UPCHEM(1,I,ic)=(chem1(KTS,ic)*DZ(KTS+1)+chem1(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + UPCHEM(1,i,ic)=(chem1(KTS,ic)*DZ(KTS+1)+chem1(KTS+1,ic)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) enddo - ENDDO - ENDIF + enddo + endif !Initialize environmental variables which can be modified by detrainment - DO k=kts,kte - envm_thl(k)=THL(k) - envm_sqv(k)=QV(k) - envm_sqc(k)=QC(k) - envm_u(k)=U(k) - envm_v(k)=V(k) - ENDDO + envm_thl(kts:kte)=THL(kts:kte) + envm_sqv(kts:kte)=QV(kts:kte) + envm_sqc(kts:kte)=QC(kts:kte) + envm_u(kts:kte)=U(kts:kte) + envm_v(kts:kte)=V(kts:kte) + do k=kts,kte-1 + rhoz(k) = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) + enddo + rhoz(kte) = rho(kte) !dxsa is scale-adaptive factor governing the pressure-gradient term of the momentum transport dxsa = 1. - MIN(MAX((12000.0-dx)/(12000.0-3000.0), 0.), 1.) ! do integration updraft - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + do i=1,NUP QCn = 0. overshoot = 0 - l = dl*I ! diameter of plume - DO k=KTS+1,KTE-1 + l = minwidth + dl*real(i-1) ! diameter of plume + do k=kts+1,kte-1 !Entrainment from Tian and Kuang (2016) !ENT(k,i) = 0.35/(MIN(MAX(UPW(K-1,I),0.75),1.9)*l) wmin = 0.3 + l*0.0005 !* MAX(pblh-ZW(k+1), 0.0)/pblh @@ -6161,7 +6182,7 @@ SUBROUTINE DMP_mf( & ENT(k,i) = max(ENT(k,i),0.0003) !ENT(k,i) = max(ENT(k,i),0.05/ZW(k)) !not needed for Tian and Kuang - !JOE - increase entrainment for plumes extending very high. + !increase entrainment for plumes extending very high. IF(ZW(k) >= MIN(pblh+1500., 4000.))THEN ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,4000.))*5.0E-6 ENDIF @@ -6339,6 +6360,7 @@ SUBROUTINE DMP_mf( & exit !exit k-loop END IF ENDDO + IF (debug_mf == 1) THEN IF (MAXVAL(UPW(:,I)) > 10.0 .OR. MINVAL(UPA(:,I)) < 0.0 .OR. & MAXVAL(UPA(:,I)) > Atot .OR. NUP2 > 10) THEN @@ -6358,30 +6380,26 @@ SUBROUTINE DMP_mf( & ENDIF ENDIF ENDDO - ELSE +ELSE !At least one of the conditions was not met for activating the MF scheme. NUP2=0. - END IF !end criteria for mass-flux scheme +END IF !end criteria check for mass-flux scheme - ktop=MIN(ktop,KTE-1) ! Just to be safe... - IF (ktop == 0) THEN - ztop = 0.0 - ELSE - ztop=zw(ktop) - ENDIF - - IF(nup2 > 0) THEN +ktop=MIN(ktop,KTE-1) +IF (ktop == 0) THEN + ztop = 0.0 +ELSE + ztop=zw(ktop) +ENDIF - !Calculate the fluxes for each variable - !All s_aw* variable are == 0 at k=1 - DO i=1,NUP !NUP2 - IF(I > NUP2) exit +IF (nup2 > 0) THEN + !Calculate the fluxes for each variable + !All s_aw* variable are == 0 at k=1 + DO i=1,NUP DO k=KTS,KTE-1 - IF(k > ktop) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - s_aw(k+1) = s_aw(k+1) + rho_int*UPA(K,i)*UPW(K,i)*Psig_w - s_awthl(k+1)= s_awthl(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w - s_awqt(k+1) = s_awqt(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w + s_aw(k+1) = s_aw(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*Psig_w + s_awthl(k+1)= s_awthl(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w + s_awqt(k+1) = s_awqt(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w !to conform to grid mean properties, move qc to qv in grid mean !saturated layers, so total water fluxes are preserved but !negative qc fluxes in unsaturated layers is reduced. @@ -6390,72 +6408,76 @@ SUBROUTINE DMP_mf( & ! else ! qc_plume = 0.0 ! endif - s_awqc(k+1) = s_awqc(k+1) + rho_int*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w - IF (momentum_opt > 0) THEN - s_awu(k+1) = s_awu(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w - s_awv(k+1) = s_awv(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPV(K,i)*Psig_w - ENDIF - IF (tke_opt > 0) THEN - s_awqke(k+1)= s_awqke(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w - ENDIF + s_awqc(k+1) = s_awqc(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) ENDDO - ENDDO - - IF ( mix_chem ) THEN - DO k=KTS,KTE - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO i=1,NUP !NUP2 - IF(I > NUP2) exit - do ic = 1,nchem - s_awchem(k+1,ic) = s_awchem(k+1,ic) + rho_int*UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w - enddo - ENDDO - ENDDO - ENDIF - - IF (scalar_opt > 0) THEN - DO k=KTS,KTE - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NUP !NUP2 - IF (I > NUP2) exit - s_awqnc(k+1)= s_awqnc(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNC(K,i)*Psig_w - s_awqni(k+1)= s_awqni(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w - s_awqnwfa(k+1)= s_awqnwfa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w - s_awqnifa(k+1)= s_awqnifa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w - s_awqnbca(k+1)= s_awqnbca(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w - ENDDO - ENDDO - ENDIF + ENDDO + !momentum + if (momentum_opt > 0) then + do i=1,nup + do k=kts,kte-1 + s_awu(k+1) = s_awu(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w + s_awv(k+1) = s_awv(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPV(K,i)*Psig_w + enddo + enddo + endif + !tke + if (tke_opt > 0) then + do i=1,nup + do k=kts,kte-1 + s_awqke(k+1)= s_awqke(k+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w + enddo + enddo + endif + !chem + if ( mix_chem ) then + do k=kts,kte + do i=1,nup + do ic = 1,nchem + s_awchem(k+1,ic) = s_awchem(k+1,ic) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPCHEM(K,i,ic)*Psig_w + enddo + enddo + enddo + endif + + if (scalar_opt > 0) then + do k=kts,kte + do I=1,nup + s_awqnc(k+1) = s_awqnc(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNC(K,i)*Psig_w + s_awqni(k+1) = s_awqni(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w + s_awqnwfa(k+1)= s_awqnwfa(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w + s_awqnifa(k+1)= s_awqnifa(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w + s_awqnbca(k+1)= s_awqnbca(K+1) + rhoz(k)*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w + enddo + enddo + endif - !Flux limiter: Check ratio of heat flux at top of first model layer - !and at the surface. Make sure estimated flux out of the top of the - !layer is < fluxportion*surface_heat_flux - IF (s_aw(kts+1) /= 0.) THEN + !Flux limiter: Check ratio of heat flux at top of first model layer + !and at the surface. Make sure estimated flux out of the top of the + !layer is < fluxportion*surface_heat_flux + IF (s_aw(kts+1) /= 0.) THEN dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) !dz centered at model interface flx1 = MAX(s_aw(kts+1)*(TH(kts)-TH(kts+1))/dzi(kts),1.0e-5) - ELSE + ELSE flx1 = 0.0 !print*,"ERROR: s_aw(kts+1) == 0, NUP=",NUP," NUP2=",NUP2,& ! " superadiabatic=",superadiabatic," KTOP=",KTOP - ENDIF - adjustment=1.0 - !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 - !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) - IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN + ENDIF + adjustment=1.0 + !Print*,"Flux limiter in MYNN-EDMF, adjustment=",fluxportion*flt/dz(kts)/flx1 + !Print*,"flt/dz=",flt/dz(kts)," flx1=",flx1," s_aw(kts+1)=",s_aw(kts+1) + IF (flx1 > fluxportion*flt/dz(kts) .AND. flx1>0.0) THEN adjustment= fluxportion*flt/dz(kts)/flx1 - s_aw = s_aw*adjustment - s_awthl= s_awthl*adjustment - s_awqt = s_awqt*adjustment - s_awqc = s_awqc*adjustment - s_awqv = s_awqv*adjustment - s_awqnc= s_awqnc*adjustment - s_awqni= s_awqni*adjustment - s_awqnwfa= s_awqnwfa*adjustment - s_awqnifa= s_awqnifa*adjustment - s_awqnbca= s_awqnbca*adjustment + s_aw = s_aw*adjustment + s_awthl = s_awthl*adjustment + s_awqt = s_awqt*adjustment + s_awqc = s_awqc*adjustment + s_awqv = s_awqv*adjustment + s_awqnc = s_awqnc*adjustment + s_awqni = s_awqni*adjustment + s_awqnwfa = s_awqnwfa*adjustment + s_awqnifa = s_awqnifa*adjustment + s_awqnbca = s_awqnbca*adjustment IF (momentum_opt > 0) THEN s_awu = s_awu*adjustment s_awv = s_awv*adjustment @@ -6467,62 +6489,57 @@ SUBROUTINE DMP_mf( & s_awchem = s_awchem*adjustment ENDIF UPA = UPA*adjustment - ENDIF - !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt - - !Calculate mean updraft properties for output: - !all edmf_* variables at k=1 correspond to the interface at top of first model layer - DO k=KTS,KTE-1 - IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NUP !NUP2 - IF(I > NUP2) exit - edmf_a(K) =edmf_a(K) +UPA(K,i) - edmf_w(K) =edmf_w(K) +rho_int*UPA(K,i)*UPW(K,i) - edmf_qt(K) =edmf_qt(K) +rho_int*UPA(K,i)*UPQT(K,i) - edmf_thl(K)=edmf_thl(K)+rho_int*UPA(K,i)*UPTHL(K,i) - edmf_ent(K)=edmf_ent(K)+rho_int*UPA(K,i)*ENT(K,i) - edmf_qc(K) =edmf_qc(K) +rho_int*UPA(K,i)*UPQC(K,i) - ENDDO - + ENDIF + !Print*,"adjustment=",adjustment," fluxportion=",fluxportion," flt=",flt + + !Calculate mean updraft properties for output: + !all edmf_* variables at k=1 correspond to the interface at top of first model layer + do k=kts,kte-1 + do I=1,nup + edmf_a(K) =edmf_a(K) +UPA(K,i) + edmf_w(K) =edmf_w(K) +rhoz(k)*UPA(K,i)*UPW(K,i) + edmf_qt(K) =edmf_qt(K) +rhoz(k)*UPA(K,i)*UPQT(K,i) + edmf_thl(K)=edmf_thl(K)+rhoz(k)*UPA(K,i)*UPTHL(K,i) + edmf_ent(K)=edmf_ent(K)+rhoz(k)*UPA(K,i)*ENT(K,i) + edmf_qc(K) =edmf_qc(K) +rhoz(k)*UPA(K,i)*UPQC(K,i) + enddo + enddo + do k=kts,kte-1 !Note that only edmf_a is multiplied by Psig_w. This takes care of the !scale-awareness of the subsidence below: - IF (edmf_a(k)>0.) THEN - edmf_w(k)=edmf_w(k)/edmf_a(k) - edmf_qt(k)=edmf_qt(k)/edmf_a(k) - edmf_thl(k)=edmf_thl(k)/edmf_a(k) - edmf_ent(k)=edmf_ent(k)/edmf_a(k) - edmf_qc(k)=edmf_qc(k)/edmf_a(k) - edmf_a(k)=edmf_a(k)*Psig_w - - !FIND MAXIMUM MASS-FLUX IN THE COLUMN: - IF(edmf_a(k)*edmf_w(k) > maxmf) maxmf = edmf_a(k)*edmf_w(k) - ENDIF - ENDDO ! end k - - !smoke/chem - IF ( mix_chem ) THEN - DO k=kts,kte-1 - IF(k > KTOP) exit - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) - DO I=1,NUP !NUP2 - IF(I > NUP2) exit + if (edmf_a(k)>0.) then + edmf_w(k)=edmf_w(k)/edmf_a(k) + edmf_qt(k)=edmf_qt(k)/edmf_a(k) + edmf_thl(k)=edmf_thl(k)/edmf_a(k) + edmf_ent(k)=edmf_ent(k)/edmf_a(k) + edmf_qc(k)=edmf_qc(k)/edmf_a(k) + edmf_a(k)=edmf_a(k)*Psig_w + !FIND MAXIMUM MASS-FLUX IN THE COLUMN: + if(edmf_a(k)*edmf_w(k) > maxmf) maxmf = edmf_a(k)*edmf_w(k) + endif + enddo ! end k + + !smoke/chem + if ( mix_chem ) then + do k=kts,kte-1 + do I=1,nup do ic = 1,nchem - edmf_chem(k,ic) = edmf_chem(k,ic) + rho_int*UPA(K,I)*UPCHEM(k,i,ic) + edmf_chem(k,ic) = edmf_chem(k,ic) + rhoz(k)*UPA(K,I)*UPCHEM(k,i,ic) enddo - ENDDO - - IF (edmf_a(k)>0.) THEN + enddo + enddo + do k=kts,kte-1 + if (edmf_a(k)>0.) then do ic = 1,nchem edmf_chem(k,ic) = edmf_chem(k,ic)/edmf_a(k) enddo - ENDIF - ENDDO ! end k - ENDIF + endif + enddo ! end k + endif - !Calculate the effects environmental subsidence. - !All envi_*variables are valid at the interfaces, like the edmf_* variables - IF (env_subs) THEN + !Calculate the effects environmental subsidence. + !All envi_*variables are valid at the interfaces, like the edmf_* variables + IF (env_subs) THEN DO k=kts+1,kte-1 !First, smooth the profiles of w & a, since sharp vertical gradients !in plume variables are not likely extended to env variables @@ -6557,18 +6574,16 @@ SUBROUTINE DMP_mf( & !calculate tendencies from subsidence and detrainment valid at the middle of !each model layer. The lowest model layer uses an assumes w=0 at the surface. dzi(kts) = 0.5*(dz(kts)+dz(kts+1)) - rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) sub_thl(kts)= 0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rho_int + (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rhoz(k) sub_sqv(kts)= 0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rho_int + (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rhoz(k) DO k=kts+1,kte-1 dzi(k) = 0.5*(dz(k)+dz(k+1)) - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_thl(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rho_int + (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rhoz(k) sub_sqv(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rho_int + (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rhoz(k) ENDDO DO k=KTS,KTE-1 @@ -6578,17 +6593,15 @@ SUBROUTINE DMP_mf( & ENDDO IF (momentum_opt > 0) THEN - rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rho_int + (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rhoz(k) sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)* & - (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rho_int + (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rhoz(k) DO k=kts+1,kte-1 - rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_u(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rho_int + (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rhoz(k) sub_v(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rho_int + (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rhoz(k) ENDDO DO k=KTS,KTE-1 @@ -6596,23 +6609,23 @@ SUBROUTINE DMP_mf( & det_v(k) = Cdet*(envm_v(k)-v(k))*envi_a(k)*Psig_w ENDDO ENDIF - ENDIF !end subsidence/env detranment + ENDIF !end subsidence/env detranment - !First, compute exner, plume theta, and dz centered at interface - !Here, k=1 is the top of the first model layer. These values do not - !need to be defined at k=kte (unused level). - DO K=KTS,KTE-1 - exneri(k) = (exner(k)*DZ(k+1)+exner(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + !First, compute exner, plume theta, and dz centered at interface + !Here, k=1 is the top of the first model layer. These values do not + !need to be defined at k=kte (unused level). + DO K=KTS,KTE-1 + exneri(k) = (exner(k)*dz(k+1)+exner(k+1)*dz(k))/(dz(k+1)+dz(k)) edmf_th(k)= edmf_thl(k) + xlvcp/exneri(k)*edmf_qc(K) - dzi(k) = 0.5*(DZ(k)+DZ(k+1)) - ENDDO + dzi(k) = 0.5*(dz(k)+dz(k+1)) + ENDDO !JOE: ADD CLDFRA_bl1d, qc_bl1d. Note that they have already been defined in ! mym_condensation. Here, a shallow-cu component is added, but no cumulus ! clouds can be added at k=1 (start loop at k=2). - do k=kts+1,kte-2 - IF(k > KTOP) exit - IF(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0 .and. (cldfra_bl1d(k) < cf_thresh))THEN + do k=kts+1,kte-2 + if (k > KTOP) exit + if(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0 .and. (cldfra_bl1d(k) < cf_thresh))THEN !interpolate plume quantities to mass levels Aup = (edmf_a(k)*dzi(k-1)+edmf_a(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) THp = (edmf_th(k)*dzi(k-1)+edmf_th(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) @@ -6686,8 +6699,8 @@ SUBROUTINE DMP_mf( & !mf_cf = min(max(0.5 + 0.36 * atan(1.20*(Q1+0.4)),0.01),0.6) !Original CB mf_cf = min(max(0.5 + 0.36 * atan(1.55*Q1),0.01),0.6) - mf_cf = max(mf_cf, 1.75 * Aup) - mf_cf = min(mf_cf, 5.0 * Aup) + mf_cf = max(mf_cf, 1.8 * Aup) + mf_cf = min(mf_cf, 5.0 * Aup) endif !IF ( debug_code ) THEN @@ -6705,10 +6718,7 @@ SUBROUTINE DMP_mf( & if (QCp * Aup > 5e-5) then qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 else - qc_bl1d(k) = 1.18 * (QCp * Aup) - endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf + qc_bl1d(k) = 1.18 * (QCp * Aup) endif cldfra_bl1d(k) = mf_cf Ac_mf = mf_cf @@ -6718,9 +6728,6 @@ SUBROUTINE DMP_mf( & else qc_bl1d(k) = 1.18 * (QCp * Aup) endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf - endif cldfra_bl1d(k) = mf_cf Ac_mf = mf_cf endif @@ -6752,13 +6759,13 @@ SUBROUTINE DMP_mf( & endif !check for (qc in plume) .and. (cldfra_bl < threshold) enddo !k-loop - ENDIF !end nup2 > 0 +ENDIF !end nup2 > 0 - !modify output (negative: dry plume, positive: moist plume) - if (ktop > 0) then - maxqc = maxval(edmf_qc(1:ktop)) - if ( maxqc < 1.E-8) maxmf = -1.0*maxmf - endif +!modify output (negative: dry plume, positive: moist plume) +if (ktop > 0) then + maxqc = maxval(edmf_qc(1:ktop)) + if ( maxqc < 1.E-8) maxmf = -1.0*maxmf +endif ! ! debugging @@ -6927,62 +6934,68 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & &qc_bl1d,cldfra_bl1d, & &rthraten ) - INTEGER, INTENT(IN) :: KTS,KTE,KPBL - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: U,V,TH,THL,TK,QT,QV,QC,& - THV,P,rho,exner,dz - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: rthraten + integer, intent(in) :: KTS,KTE,KPBL + real(kind_phys), dimension(kts:kte), intent(in) :: & + U,V,TH,THL,TK,QT,QV,QC,THV,P,rho,exner,dz + real(kind_phys), dimension(kts:kte), intent(in) :: rthraten ! zw .. heights of the downdraft levels (edges of boxes) - real(kind_phys),DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW - real(kind_phys), INTENT(IN) :: WTHL,WQT - real(kind_phys), INTENT(IN) :: dt,ust,pblh + real(kind_phys), dimension(kts:kte+1), intent(in) :: ZW + real(kind_phys), intent(in) :: WTHL,WQT + real(kind_phys), intent(in) :: dt,ust,pblh ! outputs - downdraft properties - real(kind_phys),DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a_dd,edmf_w_dd, & - & edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd + real(kind_phys), dimension(kts:kte), intent(out) :: & + edmf_a_dd,edmf_w_dd, & + edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd ! outputs - variables needed for solver (sd_aw - sum ai*wi, sd_awphi - sum ai*wi*phii) - real(kind_phys),DIMENSION(KTS:KTE+1) :: sd_aw, sd_awthl, sd_awqt, sd_awu, & - sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 + real(kind_phys), dimension(kts:kte+1) :: & + sd_aw, sd_awthl, sd_awqt, sd_awu, & + sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 - real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: qc_bl1d, cldfra_bl1d + real(kind_phys), dimension(kts:kte), intent(in) :: & + qc_bl1d, cldfra_bl1d - INTEGER, PARAMETER :: NDOWN=5, debug_mf=0 !fixing number of plumes to 5 + integer, parameter:: ndown = 5 ! draw downdraft starting height randomly between cloud base and cloud top - INTEGER, DIMENSION(1:NDOWN) :: DD_initK - real(kind_phys) , DIMENSION(1:NDOWN) :: randNum + integer, dimension(1:NDOWN) :: DD_initK + real(kind_phys), dimension(1:NDOWN) :: randNum ! downdraft properties - real(kind_phys),DIMENSION(KTS:KTE+1,1:NDOWN) :: DOWNW,DOWNTHL,DOWNQT,& - DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV + real(kind_phys), dimension(kts:kte+1,1:NDOWN) :: & + DOWNW,DOWNTHL,DOWNQT,DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV ! entrainment variables - Real(Kind_phys),DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf - INTEGER,DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENTi + real(kind_phys), dimension(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf + integer, dimension(KTS+1:KTE+1,1:NDOWN) :: ENTi ! internal variables - INTEGER :: K,I,ki, kminrad, qlTop, p700_ind, qlBase - real(kind_phys):: wthv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw - real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn,THVk,Pk, & - EntEXP,EntW, Beta_dm, EntExp_M, rho_int - real(kind_phys):: jump_thetav, jump_qt, jump_thetal, & + integer :: K,I,ki, kminrad, qlTop, p700_ind, qlBase + real(kind_phys):: wthv,wstar,qstar,thstar,sigmaW,sigmaQT, & + sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw + real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn, & + THVk,Pk,EntEXP,EntW,beta_dm,EntExp_M,rho_int + real(kind_phys):: jump_thetav, jump_qt, jump_thetal, & refTHL, refTHV, refQT ! DD specific internal variables real(kind_phys):: minrad,zminrad, radflux, F0, wst_rad, wst_dd logical :: cloudflg - - real(kind_phys):: sigq,xl,rsl,cpm,a,mf_cf,diffqt,& + real(kind_phys):: sigq,xl,rsl,cpm,a,mf_cf,diffqt, & Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid ! w parameters - real(kind_phys),PARAMETER :: & - &Wa=1., & - &Wb=1.5,& - &Z00=100.,& - &BCOEFF=0.2 + real(kind_phys),parameter :: & + &Wa=1., Wb=1.5, Z00=100., BCOEFF=0.2 ! entrainment parameters - real(kind_phys),PARAMETER :: & - & L0=80,& - & ENT0=0.2 - + real(kind_phys),parameter :: & + &L0=80, ENT0=0.2 + !downdraft properties + real(kind_phys):: & + & dp, & !diameter of plume + & dl, & !diameter increment + & Adn !total area of downdrafts + !additional printouts for debugging + integer, parameter :: debug_mf=0 + + dl = (1000.-500.)/real(ndown) pwmin=-3. ! drawing from the negative tail -3sigma to -1sigma pwmax=-1. @@ -7052,6 +7065,14 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & if ( radflux < 0.0 ) F0 = abs(radflux) + F0 enddo F0 = max(F0, 1.0) + + !Allow the total fractional area of the downdrafts to be proportional + !to the radiative forcing: + !for 50 W/m2, Adn = 0.10 + !for 100 W/m2, Adn = 0.15 + !for 150 W/m2, Adn = 0.20 + Adn = min( 0.05 + F0*0.001, 0.3) + !found Sc cloud and cloud not at surface, trigger downdraft if (cloudflg) then @@ -7066,14 +7087,14 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & ! call Poisson(1,NDOWN,kts+1,kte,ENTf,ENTi) - ! entrainent: Ent=Ent0/dz*P(dz/L0) - do i=1,NDOWN - do k=kts+1,kte -! ENT(k,i)=real(ENTi(k,i))*Ent0/(ZW(k+1)-ZW(k)) - ENT(k,i) = 0.002 - ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) - enddo - enddo +! ! entrainent: Ent=Ent0/dz*P(dz/L0) +! do i=1,NDOWN +! do k=kts+1,kte +!! ENT(k,i)=real(ENTi(k,i))*Ent0/(ZW(k+1)-ZW(k)) +! ENT(k,i) = 0.002 +! ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) +! enddo +! enddo !!![EW: INVJUMP] find 700mb height then subtract trpospheric lapse rate!!! p700_ind = MINLOC(ABS(p-70000),1)!p1D is 70000 @@ -7116,8 +7137,10 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & !DOWNW(ki,I)=0.5*(wlv+wtv) DOWNW(ki,I)=wlv + !multiply downa by cloud fraction, so it's impact will diminish if + !clouds are mixed away over the course of the longer radiation time step !DOWNA(ki,I)=0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW)) - DOWNA(ki,I)=.1/real(NDOWN) + DOWNA(ki,I)=Adn/real(NDOWN) DOWNU(ki,I)=(u(ki-1)*DZ(ki) + u(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) DOWNV(ki,I)=(v(ki-1)*DZ(ki) + v(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) @@ -7144,16 +7167,21 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & enddo - !print*, " Begin integration of downdrafts:" DO I=1,NDOWN + dp = 500. + dl*real(I) ! diameter of plume (meters) !print *, "Plume # =", I,"=======================" DO k=DD_initK(I)-1,KTS+1,-1 + + !Entrainment from Tian and Kuang (2016), with constraints + wmin = 0.3 + dp*0.0005 + ENT(k,i) = 0.33/(MIN(MAX(-1.0*DOWNW(k+1,I),wmin),0.9)*dp) + !starting at the first interface level below cloud top !EntExp=exp(-ENT(K,I)*dz(k)) !EntExp_M=exp(-ENT(K,I)/3.*dz(k)) - EntExp =ENT(K,I)*dz(k) - EntExp_M=ENT(K,I)*0.333*dz(k) + EntExp =ENT(K,I)*dz(k) !for all scalars + EntExp_M=ENT(K,I)*0.333*dz(k) !test for momentum QTn =DOWNQT(k+1,I) *(1.-EntExp) + QT(k)*EntExp THLn=DOWNTHL(k+1,I)*(1.-EntExp) + THL(k)*EntExp @@ -7187,11 +7215,11 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & BCOEFF*B/mindownw)*MIN(dz(k), 250.) !Do not allow a parcel to accelerate more than 1.25 m/s over 200 m. - !Add max increase of 2.0 m/s for coarse vertical resolution. - IF (Wn < DOWNW(K+1,I) - MIN(1.25*dz(k)/200., 2.0))THEN - Wn = DOWNW(K+1,I) - MIN(1.25*dz(k)/200., 2.0) + !Add max acceleration of -2.0 m/s for coarse vertical resolution. + IF (Wn < DOWNW(K+1,I) - MIN(1.25*dz(k)/200., -2.0))THEN + Wn = DOWNW(K+1,I) - MIN(1.25*dz(k)/200., -2.0) ENDIF - !Add symmetrical max decrease in w + !Add symmetrical max decrease in velocity (less negative) IF (Wn > DOWNW(K+1,I) + MIN(1.25*dz(k)/200., 2.0))THEN Wn = DOWNW(K+1,I) + MIN(1.25*dz(k)/200., 2.0) ENDIF @@ -7237,7 +7265,6 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & ! Even though downdraft starts at different height, average all up to qlTop DO k=qlTop,KTS,-1 DO I=1,NDOWN - IF (I > NDOWN) exit edmf_a_dd(K) =edmf_a_dd(K) +DOWNA(K-1,I) edmf_w_dd(K) =edmf_w_dd(K) +DOWNA(K-1,I)*DOWNW(K-1,I) edmf_qt_dd(K) =edmf_qt_dd(K) +DOWNA(K-1,I)*DOWNQT(K-1,I) @@ -7287,8 +7314,8 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) ! Psig_bl tapers local mixing ! Psig_shcu tapers nonlocal mixing - real(kind_phys), INTENT(IN) :: dx,pbl1 - real(kind_phys), INTENT(OUT) :: Psig_bl,Psig_shcu + real(kind_phys), intent(in) :: dx,pbl1 + real(kind_phys), intent(out) :: Psig_bl,Psig_shcu real(kind_phys) :: dxdh Psig_bl=1.0 @@ -7361,28 +7388,28 @@ FUNCTION esat_blend(t) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t + real(kind_phys), intent(in):: t real(kind_phys):: esat_blend,XC,ESL,ESI,chi !liquid - real(kind_phys), PARAMETER:: J0= .611583699E03 - real(kind_phys), PARAMETER:: J1= .444606896E02 - real(kind_phys), PARAMETER:: J2= .143177157E01 - real(kind_phys), PARAMETER:: J3= .264224321E-1 - real(kind_phys), PARAMETER:: J4= .299291081E-3 - real(kind_phys), PARAMETER:: J5= .203154182E-5 - real(kind_phys), PARAMETER:: J6= .702620698E-8 - real(kind_phys), PARAMETER:: J7= .379534310E-11 - real(kind_phys), PARAMETER:: J8=-.321582393E-13 + real(kind_phys), parameter:: J0= .611583699E03 + real(kind_phys), parameter:: J1= .444606896E02 + real(kind_phys), parameter:: J2= .143177157E01 + real(kind_phys), parameter:: J3= .264224321E-1 + real(kind_phys), parameter:: J4= .299291081E-3 + real(kind_phys), parameter:: J5= .203154182E-5 + real(kind_phys), parameter:: J6= .702620698E-8 + real(kind_phys), parameter:: J7= .379534310E-11 + real(kind_phys), parameter:: J8=-.321582393E-13 !ice - real(kind_phys), PARAMETER:: K0= .609868993E03 - real(kind_phys), PARAMETER:: K1= .499320233E02 - real(kind_phys), PARAMETER:: K2= .184672631E01 - real(kind_phys), PARAMETER:: K3= .402737184E-1 - real(kind_phys), PARAMETER:: K4= .565392987E-3 - real(kind_phys), PARAMETER:: K5= .521693933E-5 - real(kind_phys), PARAMETER:: K6= .307839583E-7 - real(kind_phys), PARAMETER:: K7= .105785160E-9 - real(kind_phys), PARAMETER:: K8= .161444444E-12 + real(kind_phys), parameter:: K0= .609868993E03 + real(kind_phys), parameter:: K1= .499320233E02 + real(kind_phys), parameter:: K2= .184672631E01 + real(kind_phys), parameter:: K3= .402737184E-1 + real(kind_phys), parameter:: K4= .565392987E-3 + real(kind_phys), parameter:: K5= .521693933E-5 + real(kind_phys), parameter:: K6= .307839583E-7 + real(kind_phys), parameter:: K7= .105785160E-9 + real(kind_phys), parameter:: K8= .161444444E-12 XC=MAX(-80.,t - t0c) !note t0c = 273.15, tice is set in module mynn_common to 240 @@ -7412,28 +7439,28 @@ FUNCTION qsat_blend(t, P) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t, P + real(kind_phys), intent(in):: t, P real(kind_phys):: qsat_blend,XC,ESL,ESI,RSLF,RSIF,chi !liquid - real(kind_phys), PARAMETER:: J0= .611583699E03 - real(kind_phys), PARAMETER:: J1= .444606896E02 - real(kind_phys), PARAMETER:: J2= .143177157E01 - real(kind_phys), PARAMETER:: J3= .264224321E-1 - real(kind_phys), PARAMETER:: J4= .299291081E-3 - real(kind_phys), PARAMETER:: J5= .203154182E-5 - real(kind_phys), PARAMETER:: J6= .702620698E-8 - real(kind_phys), PARAMETER:: J7= .379534310E-11 - real(kind_phys), PARAMETER:: J8=-.321582393E-13 + real(kind_phys), parameter:: J0= .611583699E03 + real(kind_phys), parameter:: J1= .444606896E02 + real(kind_phys), parameter:: J2= .143177157E01 + real(kind_phys), parameter:: J3= .264224321E-1 + real(kind_phys), parameter:: J4= .299291081E-3 + real(kind_phys), parameter:: J5= .203154182E-5 + real(kind_phys), parameter:: J6= .702620698E-8 + real(kind_phys), parameter:: J7= .379534310E-11 + real(kind_phys), parameter:: J8=-.321582393E-13 !ice - real(kind_phys), PARAMETER:: K0= .609868993E03 - real(kind_phys), PARAMETER:: K1= .499320233E02 - real(kind_phys), PARAMETER:: K2= .184672631E01 - real(kind_phys), PARAMETER:: K3= .402737184E-1 - real(kind_phys), PARAMETER:: K4= .565392987E-3 - real(kind_phys), PARAMETER:: K5= .521693933E-5 - real(kind_phys), PARAMETER:: K6= .307839583E-7 - real(kind_phys), PARAMETER:: K7= .105785160E-9 - real(kind_phys), PARAMETER:: K8= .161444444E-12 + real(kind_phys), parameter:: K0= .609868993E03 + real(kind_phys), parameter:: K1= .499320233E02 + real(kind_phys), parameter:: K2= .184672631E01 + real(kind_phys), parameter:: K3= .402737184E-1 + real(kind_phys), parameter:: K4= .565392987E-3 + real(kind_phys), parameter:: K5= .521693933E-5 + real(kind_phys), parameter:: K6= .307839583E-7 + real(kind_phys), parameter:: K7= .105785160E-9 + real(kind_phys), parameter:: K8= .161444444E-12 XC=MAX(-80.,t - t0c) @@ -7470,7 +7497,7 @@ FUNCTION xl_blend(t) IMPLICIT NONE - real(kind_phys), INTENT(IN):: t + real(kind_phys), intent(in):: t real(kind_phys):: xl_blend,xlvt,xlst,chi !note: t0c = 273.15, tice is set in mynn_common @@ -7499,11 +7526,11 @@ FUNCTION phim(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - real(kind_phys), INTENT(IN):: zet + real(kind_phys), intent(in):: zet real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - real(kind_phys), PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - real(kind_phys), PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - real(kind_phys), PARAMETER :: am_unst=10., ah_unst=34. + real(kind_phys), parameter :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), parameter :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), parameter :: am_unst=10., ah_unst=34. real(kind_phys):: phi_m,phim if ( zet >= 0.0 ) then @@ -7551,11 +7578,11 @@ FUNCTION phih(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - real(kind_phys), INTENT(IN):: zet + real(kind_phys), intent(in):: zet real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - real(kind_phys), PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - real(kind_phys), PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - real(kind_phys), PARAMETER :: am_unst=10., ah_unst=34. + real(kind_phys), parameter :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), parameter :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), parameter :: am_unst=10., ah_unst=34. real(kind_phys):: phh,phih if ( zet >= 0.0 ) then diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index ca913c6e3..027c6f090 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1416,6 +1416,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qcten1(k) = 0. endif initialize_extended_diagnostics enddo + lsml = lsm(i,j) if (is_aerosol_aware .or. merra2_aerosol_aware) then do k = kts, kte nc1d(k) = nc(i,k,j) @@ -1423,7 +1424,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nifa1d(k) = nifa(i,k,j) enddo else - lsml = lsm(i,j) do k = kts, kte if(lsml == 1) then nc1d(k) = Nt_c_l/rho(k) @@ -5358,14 +5358,15 @@ end subroutine table_ccnAct ! TO_DO ITEM: For radiation cooling producing fog, in which case the !.. updraft velocity could easily be negative, we could use the temp !.. and its tendency to diagnose a pretend postive updraft velocity. - real function activ_ncloud(Tt, Ww, NCCN) + real function activ_ncloud(Tt, Ww, NCCN, lsm_in) implicit none REAL, INTENT(IN):: Tt, Ww, NCCN + INTEGER, INTENT(IN):: lsm_in REAL:: n_local, w_local INTEGER:: i, j, k, l, m, n REAL:: A, B, C, D, t, u, x1, x2, y1, y2, nx, wy, fraction - + REAL:: lower_lim_nuc_frac ! ta_Na = (/10.0, 31.6, 100.0, 316.0, 1000.0, 3160.0, 10000.0/) ntb_arc ! ta_Ww = (/0.01, 0.0316, 0.1, 0.316, 1.0, 3.16, 10.0, 31.6, 100.0/) ntb_arw @@ -5412,6 +5413,14 @@ real function activ_ncloud(Tt, Ww, NCCN) l = 3 m = 2 + if (lsm_in .eq. 1) then ! land + lower_lim_nuc_frac = 0. + else if (lsm_in .eq. 0) then ! water + lower_lim_nuc_frac = 0.15 + else + lower_lim_nuc_frac = 0.15 ! catch-all for anything else + endif + A = tnccn_act(i-1,j-1,k,l,m) B = tnccn_act(i,j-1,k,l,m) C = tnccn_act(i,j,k,l,m) @@ -5426,7 +5435,8 @@ real function activ_ncloud(Tt, Ww, NCCN) ! u = (w_local-ta_Ww(j-1))/(ta_Ww(j)-ta_Ww(j-1)) fraction = (1.0-t)*(1.0-u)*A + t*(1.0-u)*B + t*u*C + (1.0-t)*u*D - + fraction = MAX(fraction, lower_lim_nuc_frac) + ! if (NCCN*fraction .gt. 0.75*Nt_c_max) then ! write(*,*) ' DEBUG-GT ', n_local, w_local, Tt, i, j, k ! endif @@ -5846,6 +5856,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & endif lamc = (nc(k)*am_r*g_ratio(inu_c)/rc(k))**obmr re_qc1d(k) = SNGL(0.5D0 * DBLE(3.+inu_c)/lamc) + if (lsml .ne. 1) re_qc1d(k) = max(re_qc1d(k), 7.0E-6) enddo endif diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index eecc5493c..17f682218 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -26,7 +26,7 @@ MODULE module_sf_mynn ! ! LAND only: ! "iz0tlnd" namelist option is used to select the following momentum options: -! (default) =0: Zilitinkevich (1995); Czil now set to 0.085 +! (default) =0: Zilitinkevich (1995); Czil now set to 0.095 ! =1: Czil_new (modified according to Chen & Zhang 2008) ! =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (original form; Garratt 1992) @@ -225,7 +225,7 @@ SUBROUTINE SFCLAY_mynn( & ! (water =1: z0 from Davis et al (2008), zt & zq from COARE3.0/3.5 ! only) =2: z0 from Davis et al (2008), zt & zq from Garratt (1992) ! =3: z0 from Taylor and Yelland (2004), zt and zq from COARE 3.0/3.5 -!-- iz0tlnd =0: Zilitinkevich (1995) with Czil=0.085, +!-- iz0tlnd =0: Zilitinkevich (1995) with Czil=0.095, ! (land =1: Czil_new (modified according to Chen & Zhang 2008) ! only) =2: Modified Yang et al (2002, 2008) - generalized for all landuse ! =3: constant zt = z0/7.4 (Garratt 1992) @@ -2604,7 +2604,7 @@ SUBROUTINE zilitinkevich_1995(Z_0,Zt,Zq,restar,ustar,KARMAN,& IF ( IZ0TLND2 .EQ. 1 ) THEN CZIL = 10.0 ** ( -0.40 * ( Z_0 / 0.07 ) ) ELSE - CZIL = 0.085 !0.075 !0.10 + CZIL = 0.095 !0.075 !0.10 END IF Zt = Z_0*EXP(-KARMAN*CZIL*SQRT(restar)) diff --git a/physics/mynnedmf_wrapper.F90 b/physics/mynnedmf_wrapper.F90 index 3c7de235f..46db1c441 100644 --- a/physics/mynnedmf_wrapper.F90 +++ b/physics/mynnedmf_wrapper.F90 @@ -131,7 +131,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv,& - & nupdraft,maxMF,ktop_plume, & + & maxwidth,maxMF,ztop_plume, & + & ktop_plume, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & ! <=== ntqv, ntcw & dqdt_ice, dqdt_snow, & ! <=== ntiw, ntsw @@ -310,9 +311,9 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind_phys), dimension(:), intent(out) :: & & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, & & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag, & - & maxMF + & maxMF,maxwidth,ztop_plume integer, dimension(:), intent(inout) :: & - & kpbl,nupdraft,ktop_plume + & kpbl,ktop_plume real(kind_phys), dimension(:), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl @@ -748,7 +749,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc,& !output & sub_thl3D=sub_thl,sub_sqv3D=sub_sqv, & & det_thl3D=det_thl,det_sqv3D=det_sqv, & - & nupdraft=nupdraft,maxMF=maxMF, & !output + & maxwidth=maxwidth,maxMF=maxMF,ztop_plume=ztop_plume,& !output & ktop_plume=ktop_plume, & !output & spp_pbl=spp_pbl,pattern_spp_pbl=spp_wts_pbl, & !input & RTHRATEN=htrlw, & !input @@ -1005,8 +1006,8 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"dudt:",dudt(1,1),dudt(1,2),dudt(1,levs) print*,"dvdt:",dvdt(1,1),dvdt(1,2),dvdt(1,levs) print*,"dqdt:",dqdt_water_vapor(1,1),dqdt_water_vapor(1,2),dqdt_water_vapor(1,levs) - print*,"ktop_plume:",ktop_plume(1)," maxmf:",maxmf(1) - print*,"nup:",nupdraft(1) + print*,"ztop_plume:",ztop_plume(1)," maxmf:",maxmf(1) + print*,"maxwidth:",maxwidth(1) print* endif diff --git a/physics/mynnedmf_wrapper.meta b/physics/mynnedmf_wrapper.meta index ec4706aba..8614d3ba2 100644 --- a/physics/mynnedmf_wrapper.meta +++ b/physics/mynnedmf_wrapper.meta @@ -964,13 +964,14 @@ type = real kind = kind_phys intent = inout -[nupdraft] - standard_name = number_of_plumes - long_name = number of plumes per grid column - units = count +[maxwidth] + standard_name = maximum_width_of_plumes + long_name = maximum width of plumes per grid column + units = m dimensions = (horizontal_loop_extent) - type = integer - intent = inout + type = real + kind = kind_phys + intent = out [maxMF] standard_name = maximum_mass_flux long_name = maximum mass flux within a column @@ -979,6 +980,14 @@ type = real kind = kind_phys intent = out +[ztop_plume] + standard_name = height_of_tallest_plume_in_a_column + long_name = height of tallest plume in a column + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [ktop_plume] standard_name = k_level_of_highest_plume long_name = k-level of highest plume From 2f417bb5f8c1e814ea5f3539615395d9ed096eca Mon Sep 17 00:00:00 2001 From: Helin Wei Date: Tue, 17 Oct 2023 12:32:30 -0400 Subject: [PATCH 051/132] refine surface 2m t/q diagnostic method --- physics/sfc_diag_post.F90 | 24 ++++++++++++++++++------ physics/sfc_diag_post.meta | 7 +++++++ 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/physics/sfc_diag_post.F90 b/physics/sfc_diag_post.F90 index c1a43f170..6945e48e9 100644 --- a/physics/sfc_diag_post.F90 +++ b/physics/sfc_diag_post.F90 @@ -14,16 +14,17 @@ module sfc_diag_post !! #endif subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, con_eps, con_epsm1, pgr,& - t2mmp,q2mp, t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax, & + vegtype,t2mmp,q2mp, t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax, & wind10mmax, u10mmax, v10mmax, dpt2m, errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec implicit none - integer, intent(in) :: im, lsm, lsm_noahmp,opt_diag - logical, intent(in) :: lssav - real(kind=kind_phys), intent(in) :: dtf, con_eps, con_epsm1 + integer, intent(in) :: im, lsm, lsm_noahmp,opt_diag + integer, dimension(:), intent(in) :: vegtype ! vegetation type (integer index) + logical, intent(in) :: lssav + real(kind=kind_phys), intent(in) :: dtf, con_eps, con_epsm1 logical , dimension(:), intent(in) :: dry real(kind=kind_phys), dimension(:), intent(in) :: pgr, u10m, v10m real(kind=kind_phys), dimension(:), intent(inout) :: t2m, q2m, tmpmin, tmpmax, spfhmin, spfhmax @@ -41,12 +42,23 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, co errflg = 0 if (lsm == lsm_noahmp) then - if (opt_diag == 2 .or. opt_diag == 3)then +! over shrublands use opt_diag=2 + do i=1, im + if(dry(i)) then + if (vegtype(i) == 6 .or. vegtype(i) == 7 & + .or. vegtype(i) == 16) then + t2m(i) = t2mmp(i) + q2m(i) = q2mp(i) + endif + endif + enddo + + if (opt_diag == 2 .or. opt_diag == 3) then do i=1,im if(dry(i)) then t2m(i) = t2mmp(i) q2m(i) = q2mp(i) - endif + endif enddo endif endif diff --git a/physics/sfc_diag_post.meta b/physics/sfc_diag_post.meta index c50d3c4dc..17648753a 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/sfc_diag_post.meta @@ -81,6 +81,13 @@ type = real kind = kind_phys intent = in +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent= in [t2mmp] standard_name = temperature_at_2m_from_noahmp long_name = 2 meter temperature from noahmp From 14c58871eb4a91fab9d88632b6a1f0e404ad96fb Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Tue, 17 Oct 2023 16:36:31 +0000 Subject: [PATCH 052/132] missed a variable in the argument for activ_ncloud during the intial merge. --- physics/module_mp_thompson.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 027c6f090..d483ec0c2 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -3581,7 +3581,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ ! DROPLET NUCLEATION if (clap .gt. eps) then if (is_aerosol_aware .or. merra2_aerosol_aware) then - xnc = MAX(2., activ_ncloud(temp(k), w1d(k)+rand3, nwfa(k))) + xnc = MAX(2., activ_ncloud(temp(k), w1d(k)+rand3, nwfa(k), lsml)) else if(lsml == 1) then xnc = Nt_c_l From fe5322b0da1fa904f1cb36ff8b1a99b67c14495f Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 18 Oct 2023 18:53:03 +0000 Subject: [PATCH 053/132] Addressed the reviewer's comments. --- physics/lsm_ruc.F90 | 47 +++++++++++++++++---------------------------- 1 file changed, 18 insertions(+), 29 deletions(-) diff --git a/physics/lsm_ruc.F90 b/physics/lsm_ruc.F90 index d3754b68c..79bcbf7b1 100644 --- a/physics/lsm_ruc.F90 +++ b/physics/lsm_ruc.F90 @@ -649,38 +649,27 @@ subroutine lsm_ruc_run & ! inputs nsoil = lsoil_ruc do i = 1, im ! i - horizontal loop - ! reassign smcref2 and smcwlt2 to RUC values at kdt=1 - if(kdt == 1) then - if(.not. land(i)) then - !water and sea ice - smcref (i,1) = one - smcwlt (i,1) = zero - xlai (i,1) = zero + if(.not. land(i)) then + !water and sea ice + smcref (i,1) = one + smcwlt (i,1) = zero + xlai (i,1) = zero + elseif (kdt == 1) then + !land + ! reassign smcref2 and smcwlt2 to RUC values at kdt=1 + smcref (i,1) = REFSMC(stype(i)) + smcwlt (i,1) = WLTSMC(stype(i)) + !-- rdlai is .true. when the LAI data is available in the INPUT/sfc_data.nc on cold-start + if(rdlai) then + xlai(i,1) = laixy(i) else - !land - smcref (i,1) = REFSMC(stype(i)) - smcwlt (i,1) = WLTSMC(stype(i)) - - !-- rdlai is .true. when the LAI data is available in the INPUT/sfc_data.nc on cold-start - if(rdlai) then - xlai(i,1) = laixy(i) - else - xlai(i,1) = LAITBL(vtype(i)) - endif + xlai(i,1) = LAITBL(vtype(i)) endif else - !-- if kdt > 1, parameters with sub-grid heterogeneity - if(.not. land(i)) then - !water and sea ice - smcref (i,1) = one - smcwlt (i,1) = zero - xlai (i,1) = zero - else - !land - smcref (i,1) = smcref2 (i) - smcwlt (i,1) = smcwlt2 (i) - xlai (i,1) = laixy (i) - endif + !-- land and kdt > 1, parameters has sub-grid heterogeneity + smcref (i,1) = smcref2 (i) + smcwlt (i,1) = smcwlt2 (i) + xlai (i,1) = laixy (i) endif enddo From 056f42021aa0a12715bbc07bfe85a2222759b41b Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 18 Oct 2023 19:00:20 +0000 Subject: [PATCH 054/132] Changes in module_sf_ruclsm.F90: 1. Removed commented lines in fire feedback to RUC LSM. 2. The coordinates of a test point are passed to the RUC LSM subroutines to make debug printing more manageable. 3. Reverted change in the TRANSF subroutine to original version. The non-linear root distribution needs scientific evaluation in the retro runs. --- physics/module_sf_ruclsm.F90 | 119 +++++++++++++++++++++++------------ 1 file changed, 79 insertions(+), 40 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 2bb29d440..83d7a04d6 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1853,7 +1853,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ilands = ivgtyp - CALL SOIL(debug_print,xlat,xlon, & + CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,& !--- input variables i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,QVATM,QCATM,GLW,GSWnew,gswin, & @@ -2068,9 +2068,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac - !IF ( add_fire_heat_flux ) then ! JLS - ! hfx = hfx + fire_heat_flux - !ENDIF s = ss*(one-snowfrac) + s*snowfrac evapl = evapls*(one-snowfrac) sublim = sublim*snowfrac @@ -2116,9 +2113,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac - !IF ( add_fire_heat_flux ) then ! JLS - ! hfx = hfx + fire_heat_flux - !ENDIF s = ss*(one-snowfrac) + s*snowfrac prcpl = prcpls*(one-snowfrac) + prcpl*snowfrac fltot = fltots*(one-snowfrac) + fltot*snowfrac @@ -2248,7 +2242,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if(SEAICE .LT. 0.5_kind_phys) then ! LAND - CALL SOIL(debug_print,xlat,xlon, & + CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,& !--- input variables i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,QVATM,QCATM,GLW,GSWnew,GSWin, & @@ -2341,7 +2335,7 @@ END FUNCTION QSN !>\ingroup lsm_ruc_group !> This subroutine calculates energy and moisture budget for vegetated surfaces !! without snow, heat diffusion and Richards eqns in soil. - SUBROUTINE SOIL (debug_print,xlat,xlon, & + SUBROUTINE SOIL (debug_print,xlat,xlon,testptlat,testptlon,& i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot,& !--- input variables PRCPMS,RAINF,PATM,QVATM,QCATM, & GLW,GSW,GSWin,EMISS,RNET, & @@ -2423,7 +2417,8 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & INTEGER, INTENT(IN ) :: nroot,ktau,nzs , & nddzs !nddzs=2*(nzs-2) INTEGER, INTENT(IN ) :: i,j,iland,isoil - real (kind_phys), INTENT(IN ) :: DELT,CONFLX,xlat,xlon + real (kind_phys), INTENT(IN ) :: DELT,CONFLX + real (kind_phys), INTENT(IN ) :: xlat,xlon,testptlat,testptlon LOGICAL, INTENT(IN ) :: myj !--- 3-D Atmospheric variables real (kind_phys), & @@ -2647,6 +2642,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! hydraulic condeuctivities !****************************************************************** CALL SOILPROP( debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,fwsat,lwsat,tav,keepfr, & soilmois,soiliqw,soilice, & @@ -2682,6 +2678,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! TRANSF computes transpiration function !************************************************************** CALL TRANSF(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,nroot,soiliqw,tabs,lai,gswin, & !--- soil fixed fields @@ -2739,7 +2736,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! SOILTEMP soilves heat budget and diffusion eqn. in soil !************************************************************** - CALL SOILTEMP(debug_print,xlat,xlon, & + CALL SOILTEMP(debug_print,xlat,xlon,testptlat,testptlon,& !--- input variables i,j,iland,isoil, & delt,ktau,conflx,nzs,nddzs,nroot, & @@ -2809,6 +2806,7 @@ SUBROUTINE SOIL (debug_print,xlat,xlon, & ! and Richards eqn. !************************************************************************* CALL SOILMOIST (debug_print, & + xlat, xlon, testptlat, testptlon, & !-- input delt,nzs,nddzs,DTDZS,DTDZS2,RIW, & zsmain,zshalf,diffu,hydro, & @@ -3603,6 +3601,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & ! hydraulic condeuctivities !****************************************************************** CALL SOILPROP(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,fwsat,lwsat,tav,keepfr, & soilmois,soiliqw,soilice, & @@ -3653,6 +3652,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & ! TRANSF computes transpiration function !************************************************************** CALL TRANSF(debug_print, & + xlat, xlon, testptlat, testptlon, & !--- input variables nzs,nroot,soiliqw,tabs,lai,gswin, & !--- soil fixed fields @@ -3748,7 +3748,7 @@ SUBROUTINE SNOWSOIL ( debug_print,xlat,xlon, & !--- TQCAN FOR SOLUTION OF MOISTURE BALANCE (Smirnova et al. 1996, EQ.22,28) ! AND TSO,ETA PROFILES !************************************************************************* - CALL SOILMOIST (debug_print, & + CALL SOILMOIST (debug_print,xlat,xlon,testptlat,testptlon,& !-- input delt,nzs,nddzs,DTDZS,DTDZS2,RIW, & zsmain,zshalf,diffu,hydro, & @@ -4704,7 +4704,7 @@ END SUBROUTINE SNOWSEAICE !>\ingroup lsm_ruc_group !> This subroutine solves energy budget equation and heat diffusion !! equation. - SUBROUTINE SOILTEMP( debug_print,xlat,xlon, & + SUBROUTINE SOILTEMP( debug_print,xlat,xlon,testptlat,testptlon,& i,j,iland,isoil, & !--- input variables delt,ktau,conflx,nzs,nddzs,nroot, & PRCPMS,RAINF,PATM,TABS,QVATM,QCATM, & @@ -4774,7 +4774,8 @@ SUBROUTINE SOILTEMP( debug_print,xlat,xlon, & INTEGER, INTENT(IN ) :: nroot,ktau,nzs , & nddzs !nddzs=2*(nzs-2) INTEGER, INTENT(IN ) :: i,j,iland,isoil - real (kind_phys), INTENT(IN ) :: DELT,CONFLX,PRCPMS, RAINF,xlat,xlon + real (kind_phys), INTENT(IN ) :: DELT,CONFLX,PRCPMS, RAINF + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon real (kind_phys), INTENT(INOUT) :: DRYCAN,WETCAN,TRANSUM !--- 3-D Atmospheric variables real (kind_phys), & @@ -5984,6 +5985,7 @@ END SUBROUTINE SNOWTEMP !! This subroutine solves moisture budget and computes soil moisture !! and surface and sub-surface runoffs. SUBROUTINE SOILMOIST ( debug_print, & + xlat, xlon, testptlat, testptlon, & DELT,NZS,NDDZS,DTDZS,DTDZS2,RIW, & !--- input parameters ZSMAIN,ZSHALF,DIFFU,HYDRO, & QSG,QVG,QCG,QCATM,QVATM,PRCP, & @@ -6037,6 +6039,7 @@ SUBROUTINE SOILMOIST ( debug_print, & !--- input variables LOGICAL, INTENT(IN ) :: debug_print real (kind_phys), INTENT(IN ) :: DELT + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon INTEGER, INTENT(IN ) :: NZS,NDDZS ! input variables @@ -6124,8 +6127,12 @@ SUBROUTINE SOILMOIST ( debug_print, & DENOM=one+X2+X4-Q2*COSMC(K) COSMC(K+1)=Q4/DENOM IF (debug_print ) THEN - print *,'q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k' & - ,q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k' & + ,q2,soilmois(kn),DIFFU(KN),x2,HYDRO(KN+1),DTDZS2(KN-1),kn,k + endif ENDIF RHSMC(K+1)=(SOILMOIS(KN)+Q2*RHSMC(K) & +TRANSP(KN) & @@ -6156,8 +6163,12 @@ SUBROUTINE SOILMOIST ( debug_print, & TOTLIQ=PRCP-DRIP/DELT-(one-VEGFRAC)*DEW*RAS-SMELT IF (debug_print ) THEN -print *,'UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT', & - UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT', & + UMVEG*PRCP,DRIP/DELT,UMVEG*DEW*RAS,SMELT + endif ENDIF FLX=TOTLIQ @@ -6200,7 +6211,7 @@ SUBROUTINE SOILMOIST ( debug_print, & INFMAX1 = zero ENDIF IF (debug_print ) THEN - print *,'INFMAX1 before frozen part',INFMAX1 + print *,'INFMAX1 before frozen part',INFMAX1 ENDIF ! ----------- FROZEN GROUND VERSION -------------------------- @@ -6234,8 +6245,8 @@ SUBROUTINE SOILMOIST ( debug_print, & INFMAX = MAX(INFMAX1,HYDRO(1)*SOILMOIS(1)) INFMAX = MIN(INFMAX, -TOTLIQ) IF (debug_print ) THEN -print *,'INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ', & - INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ + print *,'INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ', & + INFMAX,INFMAX1,HYDRO(1)*SOILIQW(1),-TOTLIQ ENDIF !---- IF (-TOTLIQ.GT.INFMAX)THEN @@ -6285,8 +6296,12 @@ SUBROUTINE SOILMOIST ( debug_print, & END IF IF (debug_print ) THEN - print *,'SOILMOIS,SOILIQW, soilice',SOILMOIS,SOILIQW,soilice*riw - print *,'COSMC,RHSMC',COSMC,RHSMC + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'SOILMOIS,SOILIQW, soilice',SOILMOIS,SOILIQW,soilice*riw + print *,'COSMC,RHSMC',COSMC,RHSMC + endif ENDIF !--- FINAL SOLUTION FOR SOILMOIS ! DO K=2,NZS1 @@ -6312,7 +6327,11 @@ SUBROUTINE SOILMOIST ( debug_print, & END IF END DO IF (debug_print ) THEN - print *,'END soilmois,soiliqw,soilice',soilmois,SOILIQW,soilice*riw + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'END soilmois,soiliqw,soilice',soilmois,SOILIQW,soilice*riw + endif ENDIF MAVAIL=max(.00001_kind_phys,min(one,(SOILMOIS(1)/(REF-QMIN)*(one-snowfrac)+one*snowfrac))) @@ -6324,6 +6343,7 @@ END SUBROUTINE SOILMOIST !! This subroutine computes thermal diffusivity, and diffusional and !! hydraulic condeuctivities in soil. SUBROUTINE SOILPROP( debug_print, & + xlat, xlon, testptlat, testptlon, & nzs,fwsat,lwsat,tav,keepfr, & !--- input variables soilmois,soiliqw,soilice, & soilmoism,soiliqwm,soilicem, & @@ -6357,6 +6377,8 @@ SUBROUTINE SOILPROP( debug_print, & !--- soil properties LOGICAL, INTENT(IN ) :: debug_print INTEGER, INTENT(IN ) :: NZS + real (kind_phys), INTENT(IN ) :: xlat, xlon, testptlat, testptlon + real (kind_phys) , & INTENT(IN ) :: RHOCS, & BCLH, & @@ -6533,6 +6555,7 @@ END SUBROUTINE SOILPROP !> This subroutine solves the transpiration function (EQs. 18,19 in !! Smirnova et al.(1997) \cite Smirnova_1997) SUBROUTINE TRANSF( debug_print, & + xlat,xlon,testptlat,testptlon, & nzs,nroot,soiliqw,tabs,lai,gswin, & !--- input variables dqm,qmin,ref,wilt,zshalf,pc,iland, & !--- soil fixed fields tranf,transum) !--- output variables @@ -6553,6 +6576,7 @@ SUBROUTINE TRANSF( debug_print, & LOGICAL, INTENT(IN ) :: debug_print INTEGER, INTENT(IN ) :: nroot,nzs,iland + real (kind_phys), INTENT(IN ) :: xlat,xlon,testptlat,testptlon real (kind_phys) , & INTENT(IN ) :: GSWin, TABS, lai @@ -6599,7 +6623,7 @@ SUBROUTINE TRANSF( debug_print, & ap4=59.656_kind_phys gx=ap0+ap1*sm1+ap2*sm2+ap3*sm3+ap4*sm4 if(totliq.ge.ref) gx=one - if(totliq.le.zero) gx=zero + if(totliq.le.wilt) gx=zero if(gx.gt.one) gx=one if(gx.lt.zero) gx=zero DID=zshalf(2) @@ -6612,7 +6636,7 @@ SUBROUTINE TRANSF( debug_print, & TRANF(1)=(TOTLIQ-WILT)/(REF-WILT)*DID ENDIF !-- uncomment next line for non-linear root distribution - TRANF(1)=part(1) + !TRANF(1)=part(1) DO K=2,NROOT totliq=soiliqw(k)+qmin @@ -6622,7 +6646,7 @@ SUBROUTINE TRANSF( debug_print, & sm4=sm3*sm1 gx=ap0+ap1*sm1+ap2*sm2+ap3*sm3+ap4*sm4 if(totliq.ge.ref) gx=one - if(totliq.le.zero) gx=zero + if(totliq.le.wilt) gx=zero if(gx.gt.one) gx=one if(gx.lt.zero) gx=zero DID=zshalf(K+1)-zshalf(K) @@ -6636,8 +6660,16 @@ SUBROUTINE TRANSF( debug_print, & /(REF-WILT)*DID ENDIF !-- uncomment next line for non-linear root distribution - TRANF(k)=part(k) + !TRANF(k)=part(k) END DO + IF (debug_print ) THEN + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'soiliqw =',soiliqw,'wilt=',wilt,'qmin= ',qmin + print *,'tranf = ',tranf + endif + ENDIF ! For LAI> 3 => transpiration at potential rate (F.Tardieu, 2013) if(lai > 4._kind_phys) then @@ -6649,7 +6681,11 @@ SUBROUTINE TRANSF( debug_print, & ! pctot=min(0.8,max(pc,pc*lai)) endif IF ( debug_print ) THEN - print *,'pctot,lai,pc',pctot,lai,pc + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'pctot,lai,pc',pctot,lai,pc + endif ENDIF !--- !--- air temperature function @@ -6659,9 +6695,6 @@ SUBROUTINE TRANSF( debug_print, & ELSE FTEM = one / (one + EXP(0.5_kind_phys * (TABS - 314.0_kind_phys))) ENDIF - IF ( debug_print ) THEN - print *,'tabs,ftem',tabs,ftem - ENDIF !--- incoming solar function cmin = one/rsmax_data cmax = one/rstbl(iland) @@ -6684,27 +6717,33 @@ SUBROUTINE TRANSF( debug_print, & else fsol = one endif - IF ( debug_print ) THEN - print *,'GSWin,lai,f1,fsol',gswin,lai,f1,fsol - ENDIF !--- total conductance totcnd =(cmin + (cmax - cmin)*pctot*ftem*fsol)/cmax IF ( debug_print ) THEN - print *,'iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd' & - ,iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'GSWin,Tabs,lai,f1,cmax,cmin,pc,pctot,ftem,fsol',GSWin,Tabs,lai,f1,cmax,cmin,pc,pctot,ftem,fsol + print *,'iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd' & + ,iland,RGLTBL(iland),RSTBL(iland),RSMAX_DATA,totcnd + endif ENDIF !-- TRANSUM - total for the rooting zone transum=zero DO K=1,NROOT ! linear root distribution - TRANF(k)=max(cmin,TRANF(k)*totcnd) + TRANF(k)=max(zero,TRANF(k)*totcnd) transum=transum+tranf(k) END DO IF ( debug_print ) THEN - print *,'transum,TRANF',transum,tranf - endif + if (abs(xlat-testptlat).lt.0.05 .and. & + abs(xlon-testptlon).lt.0.05)then + print *,'xlat,xlon=',xlat,xlon + print *,'transum,TRANF',transum,tranf + endif + ENDIF !----------------------------------------------------------------- END SUBROUTINE TRANSF From ffb091280816bb1aac4ea92b421314c0c695cb3c Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Thu, 19 Oct 2023 17:19:27 +0000 Subject: [PATCH 055/132] Adding back a missing exclamation point in module_bl_mynn.F90 and adding a limit to protect against the ridiculously large z0s when using thin first model levels in module_sf_mynn.F90 --- physics/module_bl_mynn.F90 | 2 +- physics/module_sf_mynn.F90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 943a5c81d..18a385ba7 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -1,5 +1,5 @@ !>\file module_bl_mynn.F90 -! This file contains the entity of MYNN-EDMF PBL scheme. +!! This file contains the entity of MYNN-EDMF PBL scheme. ! ********************************************************************** ! * An improved Mellor-Yamada turbulence closure model * ! * * diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 17f682218..c2845f290 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -1380,6 +1380,8 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & else ZNTstoch_lnd(I) = ZNT_lnd(I) endif + !add limit to prevent ridiculous values of z0 (more than dz/15) + ZNTstoch_lnd(I) = min(ZNTstoch_lnd(I), dz8w1d(i)*0.0666) !-------------------------------------- ! LAND From 5592fc4fe88ac2c704eccf6fa01b8ff875135726 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 19 Oct 2023 17:42:47 +0000 Subject: [PATCH 056/132] Metafile cleanup --- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta | 8 ++++---- .../UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta | 3 ++- .../UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta | 4 ++-- .../UFS_SCM_NEPTUNE/GFS_radiation_surface.meta | 2 +- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta | 2 +- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta | 6 +++--- .../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta | 6 +++--- .../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta | 2 +- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta | 2 +- .../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta | 2 +- .../Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta | 2 +- .../Morrison_Gettelman}/aerinterp.F90 | 0 physics/h2o_photo/h2o_def.meta | 2 +- physics/o3_photo/ozne_def.meta | 2 +- 14 files changed, 22 insertions(+), 21 deletions(-) rename physics/{Interstitials/UFS_SCM_NEPTUNE => MP/Morrison_Gettelman}/aerinterp.F90 (100%) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta index de3f49a6f..10eb43671 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta @@ -200,7 +200,7 @@ [ccpp-table-properties] name = GFS_interstitialtoscreen type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -399,7 +399,7 @@ [ccpp-table-properties] name = GFS_abort type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -439,7 +439,7 @@ [ccpp-table-properties] name = GFS_checkland type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -698,7 +698,7 @@ [ccpp-table-properties] name = GFS_checktracers type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 2aec034fd..7df4cf715 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -3,7 +3,8 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F - dependencies = Interstitials/GFS/gcycle.F90,Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/gcycle.F90,Interstitials/UFS_SCM_NEPTUNE/iccn_def.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90,Interstitials/UFS_SCM_NEPTUNE/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index d033c889b..e1de4d699 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -3,8 +3,8 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F - dependencies = Interstitials/GFS/iccn_def.F,Interstitials/GFS/iccninterp.F90,Interstitials/GFS/sfcsub.F - dependencies = Radiation/mersenne_twister.f + dependencies = Interstitials/UFS_SCM_NEPTUNE/iccn_def.F,Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 + dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta index 79837d0bf..686bd3c6c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta @@ -2,7 +2,7 @@ name = GFS_radiation_surface type = scheme relative_path = ../../ - dependencies = Radiation/iounitdef.f,Radiation/radiation_surface.f + dependencies = Radiation/radiation_surface.f dependencies = SFC_Models/Land/RUC/set_soilveg_ruc.F90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 dependencies = hooks/machine.F diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta index c84b9da31..b387c3e33 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta @@ -3,7 +3,7 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F - dependencies = Radiation/iounitdef.f,Radiation/radiation_aerosols.f,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f + dependencies = Radiation/radiation_aerosols.f,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index af95daf52..72495eac5 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -3,10 +3,10 @@ type = scheme relative_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F - dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompsonmodule_mp_thompson_make_number_concentrations.F90 - dependencies = Radiation/iounitdef.f,Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f + dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompson/module_mp_thompson_make_number_concentrations.F90 + dependencies = Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f - dependencies = Radiation/radlw_param.f,Radiation/radsw_param.f,Radiation/radiation_cloud_overlap.F90 + dependencies = Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f,Radiation/radiation_cloud_overlap.F90 dependencies = SFC_Models/Land/Noah/surface_perturbation.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta index 0c199deaa..a9fbf91d9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta @@ -3,9 +3,9 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F - dependencies = Radiaiton/iounitdef.f,Radiaiton/RRTMG/radcons.f90,Radiaiton/radiation_aerosols.f - dependencies = Radiaiton/radiation_astronomy.f,Radiaiton/radiation_clouds.f,Radiaiton/radiation_gases.f - dependencies = Radiaiton/radlw_main.F90,Radiaiton/radlw_param.f,Radiaiton/radsw_main.F90,Radiaiton/radsw_param.f + dependencies = Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f + dependencies = Radiation/RRTMG/radlw_main.F90,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_main.F90,Radiation/RRTMG/radsw_param.f dependencies = MP/Thompson/module_mp_thompson.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta index c21c2ef7c..5b355849a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_post type = scheme relative_path = ../../ - dependencies = Radiation/iounitdef.f,hooks/machine.F,Radiation/radiation_aerosols.f + dependencies = hooks/machine.F,Radiation/radiation_aerosols.f dependencies = Radiation/RRTMG/radlw_param.f,Radiation/radiation_tools.F90,Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta index ae67ef51b..ddc95c55c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_pre type = scheme relative_path = ../../ - dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/iounitdef.f,Radiation/radiation_aerosols.f + dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_gases.f,Radiation/radiation_tools.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta index 5d21e1910..14c1f91cd 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta @@ -3,7 +3,7 @@ type = scheme relative_path = ../../ dependencies = hooks/machine.F,MP/Thompson/module_mp_thompson.F90 - dependencies = Radiation/iounitdef.f,Radiation/radiation_aerosols.f + dependencies = Radiation/radiation_aerosols.f dependencies = Radiation/radiation_gases.f,Radiation/radiation_astronomy.f ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta index c9fd5950c..9829e3538 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta @@ -2,7 +2,7 @@ name = sgscloud_radpre type = scheme relative_path = ../../ - dependencies = tools/funcphys.f90,Radiation/iounitdef.f,hooks/machine.F,hooks/physcons.F90 + dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 dependencies = Radiation/radiation_clouds.f,MP/Thompson/module_mp_thompson.F90 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 similarity index 100% rename from physics/Interstitials/UFS_SCM_NEPTUNE/aerinterp.F90 rename to physics/MP/Morrison_Gettelman/aerinterp.F90 diff --git a/physics/h2o_photo/h2o_def.meta b/physics/h2o_photo/h2o_def.meta index 3bb9bf94d..92e1d61bd 100644 --- a/physics/h2o_photo/h2o_def.meta +++ b/physics/h2o_photo/h2o_def.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = h2o_def type = module - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F [ccpp-arg-table] name = h2o_def diff --git a/physics/o3_photo/ozne_def.meta b/physics/o3_photo/ozne_def.meta index 3123892bb..bdb51ce8d 100644 --- a/physics/o3_photo/ozne_def.meta +++ b/physics/o3_photo/ozne_def.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozne_def type = module - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F [ccpp-arg-table] name = ozne_def From e627b189236c8ddc7d6a41683e1526b458413336 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 19 Oct 2023 17:51:25 +0000 Subject: [PATCH 057/132] Move rte-rrtmgp submodule --- .gitmodules | 3 +++ physics/Radiation/RRTMGP/rte-rrtmgp | 1 + 2 files changed, 4 insertions(+) create mode 160000 physics/Radiation/RRTMGP/rte-rrtmgp diff --git a/.gitmodules b/.gitmodules index c82541c5b..24b9cf118 100644 --- a/.gitmodules +++ b/.gitmodules @@ -2,3 +2,6 @@ path = physics/Radiation/RRTMGP/rte-rrtmgp url = https://github.com/earth-system-radiation/rte-rrtmgp branch = main +[submodule "physics/Radiation/RRTMGP/rte-rrtmgp"] + path = physics/Radiation/RRTMGP/rte-rrtmgp + url = https://github.com/earth-system-radiation/rte-rrtmgp diff --git a/physics/Radiation/RRTMGP/rte-rrtmgp b/physics/Radiation/RRTMGP/rte-rrtmgp new file mode 160000 index 000000000..74a0e098b --- /dev/null +++ b/physics/Radiation/RRTMGP/rte-rrtmgp @@ -0,0 +1 @@ +Subproject commit 74a0e098b2163425e4b5466c2dfcf8ae26d560a5 From 91415d42d51059697e8d0c03f8b7f00e3fb7aea3 Mon Sep 17 00:00:00 2001 From: "Xiaqiong.Zhou" Date: Fri, 20 Oct 2023 14:45:01 +0000 Subject: [PATCH 058/132] Add a switch to turn off samfdeepcnv when the MYNN shallow convection is active --- physics/samfdeepcnv.f | 6 ++++-- physics/samfdeepcnv.meta | 15 +++++++++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 8a36fe34c..94a4cd148 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -83,7 +83,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,& & clam,c0s,c1,betal,betas,evef,pgcon,asolfac, & & do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep, & - & rainevap,sigmain, sigmaout, errmsg,errflg) + & rainevap,sigmain, sigmaout, maxMF, do_mynnedmf, errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -99,11 +99,12 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:) real(kind=kind_phys), dimension(:), intent(in) :: fscav logical, intent(in) :: first_time_step,restart,hwrf_samfdeep, & - & progsigma + & progsigma,do_mynnedmf real(kind=kind_phys), intent(in) :: nthresh real(kind=kind_phys), intent(in) :: ca_deep(:) real(kind=kind_phys), intent(in) :: sigmain(:,:),qmicro(:,:), & & tmf(:,:,:),q(:,:), prevsq(:,:) + real(kind=kind_phys), dimension (:), intent(in) :: maxMF real(kind=kind_phys), intent(out) :: rainevap(:) real(kind=kind_phys), intent(out) :: sigmaout(:,:) logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger @@ -347,6 +348,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! do i=1,im cnvflg(i) = .true. + if(do_mynnedmf.and.(maxMF(i).gt.0.))cnvflg(i)=.false. sfcpbl(i) = sfclfac * hpbl(i) rn(i)=0. mbdt(i)=10. diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index bed4d655d..86c713a06 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -450,6 +450,21 @@ type = real kind = kind_phys intent = out +[maxMF] + standard_name = maximum_mass_flux + long_name = maximum mass flux within a column + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[do_mynnedmf] + standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water From a515ec34081d5b55894191b15655e5f83c96de3b Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Mon, 23 Oct 2023 18:19:59 +0000 Subject: [PATCH 059/132] Based on 1-D testing in ESM-SnowMIP a change to computation of snow thermal conductivity is made in module_sf_ruclsm.F90. --- physics/module_sf_ruclsm.F90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 83d7a04d6..fe02ccdc8 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -4071,7 +4071,7 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOnewCSN=sheatsn * RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -4088,13 +4088,13 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys + !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys + !fact = 2._kind_phys endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -4535,7 +4535,7 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -4552,13 +4552,13 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & if(rhosn < 156._kind_phys .or. (newsn > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys + !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys + !fact = 2._kind_phys endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -5219,7 +5219,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN RHOnewCSN=sheatsn* RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -5236,10 +5236,10 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys + !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys + !fact = 2._kind_phys if(debug_print) then print *,'SnowTemp xlat,xlon,rhosn,keff', xlat,xlon,rhosn,keff,keff/rhocsn*fact print *,'SNOWTEMP - 0.265/rhocsn',0.265_kind_phys/rhocsn @@ -5249,7 +5249,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & print *,'SNOWTEMP - xlat,xlon,newsnow,rhonewsn,rhosn,fact,keff',xlat,xlon,newsnow, rhonewsn,rhosn,fact,keff endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -5802,7 +5802,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. @@ -5819,10 +5819,10 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys !-- fact is added by tgs based on 4 Jan 2017 testing - fact = 5._kind_phys + !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - fact = 2._kind_phys + !fact = 2._kind_phys if(debug_print) then print *,'End SNOWTEMP - xlat,xlon,rhosn,keff',xlat,xlon,rhosn,keff print *,'End SNOWTEMP - 0.265/rhocsn',0.265/rhocsn @@ -5833,7 +5833,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & xlat,xlon,newsnow, rhonewsn,rhosn,fact,keff,keff/rhocsn*fact endif - if(newsnow <= zero .and. snhei > 3.0_kind_phys*SNHEI_crit .and. rhosn > 250._kind_phys) then + if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. From b314eabab45297076deaad068e5d30f1fa6eab68 Mon Sep 17 00:00:00 2001 From: Xiaqiong Zhou Date: Tue, 24 Oct 2023 13:30:32 +0000 Subject: [PATCH 060/132] Fix the undefined dimension issue for maxmf in tests with GNU debug --- physics/samfdeepcnv.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 94a4cd148..7bf9cd2f5 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -348,7 +348,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! do i=1,im cnvflg(i) = .true. - if(do_mynnedmf.and.(maxMF(i).gt.0.))cnvflg(i)=.false. + if(do_mynnedmf) then + if(maxMF(i).gt.0.)cnvflg(i)=.false. + endif sfcpbl(i) = sfclfac * hpbl(i) rn(i)=0. mbdt(i)=10. From ce11da759b562845cee1722ec36e8f46aebd0c67 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 24 Oct 2023 17:28:40 +0000 Subject: [PATCH 061/132] In module_sf_ruclsm.F90: clean-up comments, changed the constant for hard snow slab thermal conductivity. --- physics/module_sf_ruclsm.F90 | 76 ++++++++++++------------------------ 1 file changed, 24 insertions(+), 52 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index fe02ccdc8..74d2719d4 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -4071,23 +4071,15 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOnewCSN=sheatsn * RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing + !-- fact is tuning parameter added by tgs based on 4 Jan 2017 testing !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys @@ -4097,9 +4089,10 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -4535,23 +4528,15 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsn > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing + !-- fact is a tuning parameter !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys @@ -4561,9 +4546,10 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -5219,23 +5205,15 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN RHOnewCSN=sheatsn* RHOnewSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing + !-- fact is a tuning parameter !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys @@ -5252,9 +5230,10 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif @@ -5802,23 +5781,15 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & RHOCSN=sheatsn* RHOSN if(isncond_opt == 1) then - if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then - !-- some areas with large snow depth have unrealistically - !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. - !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys - else - !-- old version thdifsn = 0.265/RHOCSN - THDIFSN = 0.265_kind_phys/RHOCSN - endif + !-- old version thdifsn = 0.265/RHOCSN + THDIFSN = 0.265_kind_phys/RHOCSN else !-- 07Jun19 - thermal conductivity (K_eff) from Sturm et al.(1997) !-- keff = 10. ** (2.650 * RHOSN*1.e-3 - 1.652) fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is added by tgs based on 4 Jan 2017 testing + !-- fact is a tuning parameter !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys @@ -5836,9 +5807,10 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then !-- some areas with large snow depth have unrealistically !-- low snow density (in the Rockie's with snow depth > 1 m). - !-- Based on Sturm et al. the 2.5e-6 is typical for hard snow slabs. + !-- Based on Sturm et al. keff=0.452 typical for hard snow slabs + !-- with rhosn=488 kg/m^3. Thdifsn = 0.452/(2090*488)=4.431718e-7 !-- In future a better compaction scheme is needed for these areas. - thdifsn = 2.5e-6_kind_phys + thdifsn = 4.431718e-7_kind_phys else thdifsn = keff/rhocsn * fact endif From 2fc4a64040e36f150af41890270112b1abc3200d Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Tue, 24 Oct 2023 22:11:54 +0000 Subject: [PATCH 062/132] Updates to bring out tuning parameters in C3 and SAS convection schemes --- physics/cu_c3_deep.F90 | 26 ++++++++++++++++++-------- physics/cu_c3_driver.F90 | 16 ++++++++++++---- physics/cu_c3_driver.meta | 23 +++++++++++++++++++++++ physics/cu_c3_sh.F90 | 23 ++++++++++++++--------- physics/progsigma_calc.f90 | 31 ++++++++++++++++++++----------- physics/samfdeepcnv.f | 19 +++++++++++-------- physics/samfdeepcnv.meta | 23 +++++++++++++++++++++++ physics/samfshalcnv.f | 19 +++++++++++-------- physics/samfshalcnv.meta | 23 +++++++++++++++++++++++ 9 files changed, 155 insertions(+), 48 deletions(-) diff --git a/physics/cu_c3_deep.F90 b/physics/cu_c3_deep.F90 index 7092840c3..7e907aaba 100644 --- a/physics/cu_c3_deep.F90 +++ b/physics/cu_c3_deep.F90 @@ -97,6 +97,9 @@ subroutine cu_c3_deep_run( & ,tmf & ! instantanious tendency from turbulence ,qmicro & ! instantanious tendency from microphysics ,forceqv_spechum & !instantanious tendency from dynamics + ,betascu & ! Tuning parameter for shallow clouds + ,betamcu & ! Tuning parameter for mid-level clouds + ,betadcu & ! Tuning parameter for deep clouds ,sigmain & ! input area fraction after advection ,sigmaout & ! updated prognostic area fraction ,z1 & ! terrain @@ -233,8 +236,8 @@ subroutine cu_c3_deep_run( & real(kind=kind_phys) & - ,intent (in ) :: & - dtime,ccnclean,fv,r_d + ,intent (in ) :: & + dtime,ccnclean,fv,r_d,betascu,betamcu,betadcu ! @@ -386,13 +389,16 @@ subroutine cu_c3_deep_run( & real(kind=kind_phys), dimension (its:ite) :: pefc real(kind=kind_phys) entdo,dp,subin,detdo,entup, & detup,subdown,entdoj,entupk,detupk,totmas + real(kind=kind_phys) :: & + sigmind,sigminm,sigmins + parameter(sigmind=0.005,sigmins=0.03,sigminm=0.01) real(kind=kind_phys), dimension (its:ite) :: lambau,flux_tun,zws,ztexec,zqexec !$acc declare create(lambau,flux_tun,zws,ztexec,zqexec) integer :: jprnt,jmini,start_k22 logical :: keep_going,flg(its:ite),cnvflg(its:ite) - logical :: flag_shallow + logical :: flag_shallow,flag_mid !$acc declare create(flg) @@ -1988,7 +1994,11 @@ subroutine cu_c3_deep_run( & ! equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget if(progsigma)then + flag_mid = .false. flag_shallow = .false. + if(imid.eq.1)then + flag_mid = .true. + endif do k=kts,ktf do i=its,itf del(i,k) = delp(i,k)*0.001 @@ -2003,9 +2013,9 @@ subroutine cu_c3_deep_run( & endif enddo call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, & - del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, & - forceqv_spechum,kbcon,ktop,cnvflg, & - sigmain,sigmaout,sigmab) + flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, & + forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !$acc end kernels @@ -3147,7 +3157,7 @@ subroutine cup_forcing_ens_3d(closure_n,xland,aa0,aa1,xaa0,mbdt,dtime,ierr,ierr2 ! pcrit,acrit,acritt integer, dimension (its:ite) :: kloc real(kind=kind_phys) :: & - a1,a_ave,xff0,xomg,gravinv!,aclim1,aclim2,aclim3,aclim4 + a1,a_ave,xff0,xomg,gravinv real(kind=kind_phys), dimension (its:ite) :: ens_adj !$acc declare create(kloc,ens_adj) @@ -5748,7 +5758,7 @@ subroutine calculate_updraft_velocity(its,itf,ktf,ite,kts,kte,ierr,progsigma, do k = 2, ktf-1 do i = 1, itf if (ierr(i)==0) then - if(k >= kbcon(i) .and. k < ktcon(i))then + if(k >= kbcon(i) .and. k < ktcon(i) .and. dbyo(i,k)>0.)then gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) if(k >= kbcon(i) .and. clw_all(i,k)>0.)then buo(i,k) = buo(i,k) - g * qlk(i,k) diff --git a/physics/cu_c3_driver.F90 b/physics/cu_c3_driver.F90 index 8592e08f9..0ecb81750 100644 --- a/physics/cu_c3_driver.F90 +++ b/physics/cu_c3_driver.F90 @@ -60,7 +60,8 @@ end subroutine cu_c3_driver_init subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, & - qv_spechum,t,cld1d,us,vs,t2di,w,qv2di_spechum,p2di,psuri, & + betascu,betamcu,betadcu,qv_spechum,t,cld1d,us,vs,t2di,w, & + qv2di_spechum,p2di,psuri, & hbot,htop,kcnv,xland,hfx2,qfx2,aod_gf,cliw,clcw,ca_deep,rainevap,& pbl,ud_mf,dd_mf,dt_mf,cnvw_moist,cnvc,imfshalcnv, & flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & @@ -97,7 +98,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & do_ca,progsigma - real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v + real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu logical, intent(in ) :: ldiag3d real(kind=kind_phys), intent(inout) :: dtend(:,:,:) @@ -587,7 +588,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& hfx(i)=hfx2(i)*cp*rhoi(i,1) qfx(i)=qfx2(i)*xlv*rhoi(i,1) dx(i) = sqrt(garea(i)) - enddo + enddo do i=its,itf do k=kts,kpbli(i) @@ -669,7 +670,8 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& zus,xmbs,kbcons,ktops,k22s,ierrs,ierrcs, & ! Prog closure flag_init, flag_restart,fv,r_d,delp,tmfq,qmicro, & - forceqv_spechum,sigmain,sigmaout,progsigma,dx, & + forceqv_spechum,betascu,betamcu,betadcu,sigmain, & + sigmaout,progsigma,dx, & ! output tendencies outts,outqs,outqcs,outus,outvs,cnvwt,prets,cupclws, & ! dimesnional variables @@ -714,6 +716,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,tmfq & ,qmicro & ,forceqv_spechum & + ,betascu & + ,betamcu & + ,betadcu & ,sigmain & ,sigmaout & ,ter11 & @@ -805,6 +810,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,tmfq & ,qmicro & ,forceqv_spechum & + ,betascu & + ,betamcu & + ,betadcu & ,sigmain & ,sigmaout & ,ter11 & diff --git a/physics/cu_c3_driver.meta b/physics/cu_c3_driver.meta index 999b5c2bc..e02116243 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/cu_c3_driver.meta @@ -244,6 +244,29 @@ type = real kind = kind_phys intent = out +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in [phil] standard_name = geopotential long_name = layer geopotential diff --git a/physics/cu_c3_sh.F90 b/physics/cu_c3_sh.F90 index a79e1dfcf..704f2a0fc 100644 --- a/physics/cu_c3_sh.F90 +++ b/physics/cu_c3_sh.F90 @@ -68,7 +68,8 @@ subroutine cu_c3_sh_run ( & hfx,qfx,xland,ichoice,tcrit,dtime, & zuo,xmb_out,kbcon,ktop,k22,ierr,ierrc, & flag_init, flag_restart,fv,r_d,delp,tmf,qmicro, & - forceqv_spechum,sigmain,sigmaout,progsigma,dx, & + forceqv_spechum,betascu,betamcu,betadcu,sigmain,& + sigmaout,progsigma,dx, & outt,outq,outqc,outu,outv,cnvwt,pre,cupclw, & ! output tendencies itf,ktf,its,ite, kts,kte,ipr,tropics) ! dimesnional variables ! @@ -131,7 +132,7 @@ subroutine cu_c3_sh_run ( & real(kind=kind_phys) & ,intent (in ) :: & - dtime,tcrit,fv,r_d + dtime,tcrit,fv,r_d,betascu,betamcu,betadcu !$acc declare sigmaout real(kind=kind_phys), dimension (its:,kts:) & ,intent (out) :: & @@ -234,15 +235,18 @@ subroutine cu_c3_sh_run ( & !$acc cap_max_increment,lambau, & !$acc kstabi,xland1,kbmax,ktopx) - logical :: flag_shallow + logical :: flag_shallow,flag_mid logical, dimension(its:ite) :: cnvflg integer :: & kstart,i,k,ki - real(kind=kind_phys) :: & + real(kind=kind_phys) :: & dz,mbdt,zkbmax, & cap_maxs,trash,trash2,frh,el2orc,gravinv - real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas + real(kind=kind_phys) buo_flux,pgeoh,dp,entup,detup,totmas + real(kind=kind_phys) :: & + sigmind,sigminm,sigmins + parameter(sigmind=0.005,sigmins=0.03,sigminm=0.01) real(kind=kind_phys) xff_shal(3),blqe,xkshal character*50 :: ierrc(its:) @@ -672,13 +676,13 @@ subroutine cu_c3_sh_run ( & dz=z_cup(i,k)-z_cup(i,k-1) ! cloud liquid water c1d(i,k)=c1_shal! 0. !.02*up_massdetr(i,k-1) + clw_all(i,k)=max(0.,qco(i,k)-trash) qrco(i,k)= (qco(i,k)-trash)/(1.+(c0_shal+c1d(i,k))*dz) if(qrco(i,k).lt.0.)then ! hli new test 02/12/19 qrco(i,k)=0. !c1d(i,k)=0. endif pwo(i,k)=c0_shal*dz*qrco(i,k)*zuo(i,k) - clw_all(i,k)=qco(i,k)-trash !LB total cloud before rain and detrain ! cloud water vapor qco (i,k)= trash+qrco(i,k) @@ -960,6 +964,7 @@ subroutine cu_c3_sh_run ( & ! equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget if(progsigma)then flag_shallow = .true. + flag_mid = .false. do k=kts,ktf do i=its,itf del(i,k) = delp(i,k)*0.001 @@ -974,9 +979,9 @@ subroutine cu_c3_sh_run ( & endif enddo call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, & - del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, & - forceqv_spechum,kbcon,ktop,cnvflg, & - sigmain,sigmaout,sigmab) + flag_mid,del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, & + forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif diff --git a/physics/progsigma_calc.f90 b/physics/progsigma_calc.f90 index c87308602..469df49f6 100644 --- a/physics/progsigma_calc.f90 +++ b/physics/progsigma_calc.f90 @@ -19,10 +19,10 @@ module progsigma !! This subroutine computes a prognostic updraft area fracftion !! used in the closure computations in the samfshalcnv. scheme !!\section gen_progsigma progsigma_calc General Algorithm - subroutine progsigma_calc (im,km,flag_init,flag_restart, & - flag_shallow,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, & - delt,qadv,kbcon1,ktcon,cnvflg,sigmain,sigmaout, & - sigmab) + subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& + flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, & + delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) ! ! use machine, only : kind_phys @@ -32,11 +32,12 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & ! intent in integer, intent(in) :: im,km,kbcon1(im),ktcon(im) - real(kind=kind_phys), intent(in) :: hvap,delt + real(kind=kind_phys), intent(in) :: hvap,delt,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins real(kind=kind_phys), intent(in) :: qadv(im,km),del(im,km), & qmicro(im,km),tmf(im,km),dbyo1(im,km),zdqca(im,km), & omega_u(im,km),zeta(im,km) - logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow + logical, intent(in) :: flag_init,flag_restart,cnvflg(im),flag_shallow,flag_mid real(kind=kind_phys), intent(in) :: sigmain(im,km) ! intent out @@ -53,15 +54,13 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & real(kind=kind_phys) :: gcvalmx,epsilon,ZZ,cvg,mcon,buy2, & fdqb,dtdyn,dxlim,rmulacvg,tem, & - DEN,betascu,betadcu,dp1,invdelt + DEN,dp1,invdelt !Parameters gcvalmx = 0.1 rmulacvg=10. epsilon=1.E-11 km1=km-1 - betadcu = 2.0 - betascu = 8.0 invdelt = 1./delt !Initialization 2D @@ -206,17 +205,27 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart, & do i= 1, im if(cnvflg(i)) then sigmab(i)=sigmab(i)/betascu - sigmab(i)=MAX(0.03,sigmab(i)) + sigmab(i)=MAX(sigmins,sigmab(i)) + endif + enddo + elseif(flag_mid)then + do i= 1, im + if(cnvflg(i)) then + sigmab(i)=sigmab(i)/betamcu + sigmab(i)=MAX(sigminm,sigmab(i)) endif enddo else do i= 1, im if(cnvflg(i)) then sigmab(i)=sigmab(i)/betadcu - sigmab(i)=MAX(0.01,sigmab(i)) + sigmab(i)=MAX(sigmind,sigmab(i)) endif enddo endif + do i= 1, im + sigmab(i) = MIN(0.95,sigmab(i)) + enddo end subroutine progsigma_calc diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 8a36fe34c..e8faecf14 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -83,7 +83,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,& & clam,c0s,c1,betal,betas,evef,pgcon,asolfac, & & do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep, & - & rainevap,sigmain, sigmaout, errmsg,errflg) + & rainevap,sigmain,sigmaout,betadcu,betamcu,betascu, & + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -100,14 +101,14 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & real(kind=kind_phys), dimension(:), intent(in) :: fscav logical, intent(in) :: first_time_step,restart,hwrf_samfdeep, & & progsigma - real(kind=kind_phys), intent(in) :: nthresh + real(kind=kind_phys), intent(in) :: nthresh,betadcu,betamcu, & + & betascu real(kind=kind_phys), intent(in) :: ca_deep(:) real(kind=kind_phys), intent(in) :: sigmain(:,:),qmicro(:,:), & & tmf(:,:,:),q(:,:), prevsq(:,:) real(kind=kind_phys), intent(out) :: rainevap(:) real(kind=kind_phys), intent(out) :: sigmaout(:,:) logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger - integer, intent(inout) :: kcnv(:) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH real(kind=kind_phys), intent(inout) :: qtr(:,:,:), & @@ -213,8 +214,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! parameters for prognostic sigma closure real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), & omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im),qadv(im,km) - real(kind=kind_phys) gravinv,invdelt - logical flag_shallow + real(kind=kind_phys) gravinv,invdelt,sigmind,sigminm,sigmins + parameter(sigmind=0.01,sigmins=0.03,sigminm=0.01) + logical flag_shallow, flag_mid c physical parameters ! parameter(grav=grav,asolfac=0.958) ! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) @@ -2930,10 +2932,11 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & enddo flag_shallow = .false. + flag_mid = .false. call progsigma_calc(im,km,first_time_step,restart,flag_shallow, - & del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap,delt, - & qadv,kbcon1,ktcon,cnvflg, - & sigmain,sigmaout,sigmab) + & flag_mid,del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, + & delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, + & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !> - From Han et al.'s (2017) \cite han_et_al_2017 equation 6, calculate cloud base mass flux as a function of the mean updraft velcoity for the grid sizes where the quasi-equilibrium assumption of Arakawa-Schubert is not valid any longer. diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index bed4d655d..d0d39d830 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -450,6 +450,29 @@ type = real kind = kind_phys intent = out +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in [qlcn] standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index a7682342f..3869ea6ea 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -57,7 +57,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & rn,kbot,ktop,kcnv,islimsk,garea, & & dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & & clam,c0s,c1,evef,pgcon,asolfac,hwrf_samfshal, & - & sigmain,sigmaout,errmsg,errflg) + & sigmain,sigmaout,betadcu,betamcu,betascu,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -67,7 +67,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & integer, intent(in) :: im, km, itc, ntc, ntk, ntr, ncloud integer, intent(in) :: islimsk(:) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, & - & eps, epsm1, fv, grav, hvap, rd, rv, t0c + & eps, epsm1, fv, grav, hvap, rd, rv, t0c, betascu, betadcu, & + & betamcu real(kind=kind_phys), intent(in) :: delt real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:), & @@ -159,8 +160,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), & omegac(im),zeta(im,km),dbyo1(im,km), & sigmab(im),qadv(im,km) - real(kind=kind_phys) gravinv,dxcrtas,invdelt - logical flag_shallow + real(kind=kind_phys) gravinv,dxcrtas,invdelt,sigmind,sigmins, + & sigminm + logical flag_shallow,flag_mid c physical parameters ! parameter(g=grav,asolfac=0.89) ! parameter(g=grav) @@ -194,7 +196,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & parameter(betaw=.03,dxcrtc0=9.e3) parameter(h1=0.33333333) ! progsigma - parameter(dxcrtas=30.e3) + parameter(dxcrtas=30.e3,sigmind=0.01,sigmins=0.03,sigminm=0.01) c local variables and arrays real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), & uo(im,km), vo(im,km), qeso(im,km), @@ -1974,10 +1976,11 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo flag_shallow = .true. + flag_mid = .false. call progsigma_calc(im,km,first_time_step,restart,flag_shallow, - & del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap,delt, - & qadv,kbcon1,ktcon,cnvflg, - & sigmain,sigmaout,sigmab) + & flag_mid,del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, + & delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, + & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !> - From Han et al.'s (2017) \cite han_et_al_2017 equation 6, calculate cloud base mass flux as a function of the mean updraft velcoity. diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index c1fffef58..200e33707 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -482,6 +482,29 @@ type = real kind = kind_phys intent = out +[betascu] + standard_name = tuning_param_for_shallow_cu + long_name = tuning param for shallow cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betamcu] + standard_name = tuning_param_for_midlevel_cu + long_name = tuning param for midlevel cu in case prognostic closure is used + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[betadcu] + standard_name = tuning_param_for_deep_cu + long_name = tuning param for deep cu in case prognostic closure is used + units = none + dimensions = () + type = real + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 12b400a210854d33e64fd6d211482d9f8ab7add5 Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Wed, 25 Oct 2023 21:30:26 +0000 Subject: [PATCH 063/132] Ensure prognostic closure is not used at coarse resolution --- physics/cu_c3_deep.F90 | 2 +- physics/cu_c3_driver.F90 | 16 ++++++++++++---- physics/cu_c3_driver.meta | 7 +++++++ 3 files changed, 20 insertions(+), 5 deletions(-) diff --git a/physics/cu_c3_deep.F90 b/physics/cu_c3_deep.F90 index 7e907aaba..b7cd5f62d 100644 --- a/physics/cu_c3_deep.F90 +++ b/physics/cu_c3_deep.F90 @@ -5758,7 +5758,7 @@ subroutine calculate_updraft_velocity(its,itf,ktf,ite,kts,kte,ierr,progsigma, do k = 2, ktf-1 do i = 1, itf if (ierr(i)==0) then - if(k >= kbcon(i) .and. k < ktcon(i) .and. dbyo(i,k)>0.)then + if(k >= kbcon(i) .and. k < ktcon(i))then gamma = el2orc * qeso(i,k+1) / (to(i,k+1)**2) if(k >= kbcon(i) .and. clw_all(i,k)>0.)then buo(i,k) = buo(i,k) - g * qlk(i,k) diff --git a/physics/cu_c3_driver.F90 b/physics/cu_c3_driver.F90 index 0ecb81750..5b6be1d6c 100644 --- a/physics/cu_c3_driver.F90 +++ b/physics/cu_c3_driver.F90 @@ -58,7 +58,7 @@ end subroutine cu_c3_driver_init !! !>\section gen_c3_driver Grell-Freitas Cumulus Scheme Driver General Algorithm subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& - do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & + do_ca,progsigma,cnx,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, & betascu,betamcu,betadcu,qv_spechum,t,cld1d,us,vs,t2di,w, & qv2di_spechum,p2di,psuri, & @@ -93,14 +93,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,km,ntracer + integer, intent(in ) :: im,km,ntracer,cnx integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & - do_ca,progsigma + do_ca real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu logical, intent(in ) :: ldiag3d - + logical, intent(inout) :: progsigma real(kind=kind_phys), intent(inout) :: dtend(:,:,:) !$acc declare copy(dtend) integer, intent(in) :: dtidx(:,:), & @@ -280,6 +280,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !$acc end kernels endif + + if(progsigma)then + if(cnx < 384)then + progsigma=.false. + write(*,*)'Forcing prognostic closure to .false. due to coarse resolution' + endif + endif + if(ldiag3d) then if(flag_for_dcnv_generic_tend) then cliw_deep_idx=0 diff --git a/physics/cu_c3_driver.meta b/physics/cu_c3_driver.meta index e02116243..71a785318 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/cu_c3_driver.meta @@ -133,6 +133,13 @@ units = flag dimensions = () type = logical + intent = inout +[cnx] + standard_name = number_of_x_points_for_current_cubed_sphere_tile + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer intent = in [cactiv] standard_name = counter_for_grell_freitas_convection From 454189320fb2b2105284836077b3b66a3dfc5f2e Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Wed, 25 Oct 2023 22:28:07 +0000 Subject: [PATCH 064/132] Further tweaks to improve the MYNN, will update the attached pdf. --- physics/module_bl_mynn.F90 | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 18a385ba7..f520ae171 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3868,6 +3868,14 @@ SUBROUTINE mym_condensation (kts,kte, & q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif + !ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH) + if (qs(k)>1.e-7 .and. zagl .gt. pblh2) then + rh_hack =min(1.0, rhcrit + 0.08*(7.0 + log10(qs(k)))) + rh(k) =max(rh(k), rh_hack) + !add rh-based q1 + q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1(k) =max(q1_rh, q1(k) ) + endif q1k = q1(k) ! backup Q1 for later modification @@ -5842,7 +5850,7 @@ SUBROUTINE DMP_mf( & real(kind_phys),dimension(kts:kte+1) :: envi_a,envi_w !environmental variables defined at model interface real(kind_phys):: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs, & - qc_plume,exc_heat,exc_moist,tk_int + qc_plume,exc_heat,exc_moist,tk_int,tvs real(kind_phys), parameter :: Cdet = 1./45. real(kind_phys), parameter :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to @@ -5967,16 +5975,17 @@ SUBROUTINE DMP_mf( & else hux = -0.005 ! LAND ! dT/dz must be < - 0.5 K per 100 m. endif + tvs = ts*(1.0+p608*qv(kts)) do k=1,max(1,k50-1) !use "-1" because k50 used interface heights (zw). if (k == 1) then - if ((th(k)-ts)/(0.5*dz(k)) < hux) then + if ((thv(k)-tvs)/(0.5*dz(k)) < hux) then superadiabatic = .true. else superadiabatic = .false. exit endif else - if ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) then + if ((thv(k)-thv(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) then superadiabatic = .true. else superadiabatic = .false. @@ -6052,10 +6061,14 @@ SUBROUTINE DMP_mf( & acfac = .5*tanh((fltv2 - 0.01)/0.03) + .5 endif !add a windspeed-dependent adjustment to acfac that tapers off - !the mass-flux scheme linearly above sfc wind speeds of 15 m/s. + !the mass-flux scheme linearly above sfc wind speeds of 10 m/s. !Note: this effect may be better represented by an increase in !entrainment rate for high wind consitions (more ambient turbulence). - ac_wsp = 1.0 - min(max(wspd_pbl - 15.0, 0.0), 10.0)/10.0 + if (wspd_pbl .le. 10.) then + ac_wsp = 1.0 + else + ac_wsp = 1.0 - min((wspd_pbl - 10.0)/15., 1.0) + endif acfac = acfac * ac_wsp ! Find the portion of the total fraction (Atot) of each plume size: @@ -6091,7 +6104,7 @@ SUBROUTINE DMP_mf( & else if ((landsea-1.5).GE.0) then !water: increase factor to compensate for decreased pwmin/pwmax - exc_fac = 0.58*4.0*min(cloud_base/1000., 1.0) + exc_fac = 0.58*4.0 else !land: no need to increase factor - already sufficiently large superadiabatic layers exc_fac = 0.58 From 6d079b8380e0948186e7019644fb38374d31c2fc Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Wed, 25 Oct 2023 20:53:05 -0600 Subject: [PATCH 065/132] Hail diagnostic --- physics/module_mp_thompson.F90 | 102 ++++++++++++------ ...mp_thompson_make_number_concentrations.F90 | 7 +- physics/mp_thompson.F90 | 4 + physics/mp_thompson.meta | 8 ++ 4 files changed, 86 insertions(+), 35 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 271db11d0..d2199bdc6 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -2464,17 +2464,17 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo - + ! do k = kte, kts, -1 + ! ygra1 = alog10(max(1.E-9, rg(k))) + ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + ! N0_exp = 10.**(zans1) + ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) + ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ! ilamg(k) = 1./lamg + ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + ! enddo + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -3541,17 +3541,17 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo - + ! do k = kte, kts, -1 + ! ygra1 = alog10(max(1.E-9, rg(k))) + ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + ! N0_exp = 10.**(zans1) + ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) + ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ! ilamg(k) = 1./lamg + ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + ! enddo + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -6085,16 +6085,17 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ if (ANY(L_qg .eqv. .true.)) then - do k = kte, kts, -1 - ygra1 = alog10(max(1.E-9, rg(k))) - zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - N0_exp = 10.**(zans1) - N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ilamg(k) = 1./lamg - N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - enddo + ! do k = kte, kts, -1 + ! ygra1 = alog10(max(1.E-9, rg(k))) + ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + ! N0_exp = 10.**(zans1) + ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) + ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ! ilamg(k) = 1./lamg + ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + ! enddo + call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif !+---+-----------------------------------------------------------------+ @@ -6471,6 +6472,43 @@ SUBROUTINE semi_lagrange_sedim(km,dzl,wwl,rql,precip,pfsan,dt,R1) END SUBROUTINE semi_lagrange_sedim +!>\ingroup aathompson +!! @brief Calculates graupel size distribution parameters +!! +!! Calculates graupel intercept and slope parameters for +!! for a vertical column +!! +!! @param[in] kts integer start index for vertical column +!! @param[in] kte integer end index for vertical column +!! @param[in] rand1 real random number for stochastic physics +!! @param[in] rg real array, size(kts:kte) for graupel mass concentration [kg m^3] +!! @param[out] ilamg double array, size(kts:kte) for inverse graupel slope parameter [m] +!! @param[out] N0_g double array, size(kts:kte) for graupel intercept paramter [m-4] +subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) + + implicit none + + integer, intent(in) :: kts, kte + real, intent(in) :: rand1 + real, intent(in) :: rg(:) + double precision, intent(out) :: ilamg(:), N0_g(:) + + integer :: k + real :: ygra1, zans1, N0_exp, lam_exp, lamg + + do k = kte, kts, -1 + ygra1 = alog10(max(1.e-9, rg(k))) + zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 + N0_exp = 10.**(zans1) + N0_exp = max1(dble(gonv_min), min(N0_exp, dble(gonv_max))) + lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 + lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg + ilamg(k) = 1./lamg + N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) + enddo + +end subroutine graupel_psd_parameters + !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ END MODULE module_mp_thompson diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/module_mp_thompson_make_number_concentrations.F90 index 72a1055dd..496942f21 100644 --- a/physics/module_mp_thompson_make_number_concentrations.F90 +++ b/physics/module_mp_thompson_make_number_concentrations.F90 @@ -4,6 +4,7 @@ !>\ingroup aathompson module module_mp_thompson_make_number_concentrations + use machine, only : kind_phys use physcons, only: PI => con_pi implicit none @@ -35,7 +36,7 @@ elemental real function make_IceNumber (Q_ice, temp) !IMPLICIT NONE REAL, PARAMETER:: Ice_density = 890.0 !REAL, PARAMETER:: PI = 3.1415926536 - real, intent(in):: Q_ice, temp + real(kind_phys), intent(in):: Q_ice, temp integer idx_rei real corr, reice, deice double precision lambda @@ -134,7 +135,7 @@ elemental real function make_DropletNumber (Q_cloud, qnwfa) !IMPLICIT NONE - real, intent(in):: Q_cloud, qnwfa + real(kind_phys), intent(in):: Q_cloud, qnwfa !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. @@ -173,7 +174,7 @@ elemental real function make_RainNumber (Q_rain, temp) IMPLICIT NONE - real, intent(in):: Q_rain, temp + real(kind_phys), intent(in):: Q_rain, temp double precision:: lambda, N0, qnr !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index c456e87cd..7b5b83b37 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -329,6 +329,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & first_time_step, istep, nsteps, & prcp, rain, graupel, ice, snow, sr, & refl_10cm, fullradar_diag, & + max_hail_diam_sfc, & do_radar_ref, aerfld, & mpicomm, mpirank, mpiroot, blkno, & ext_diag, diag3d, reset_diag3d, & @@ -387,6 +388,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent( out) :: sr(:) ! Radar reflectivity real(kind_phys), intent(inout) :: refl_10cm(:,:) + real(kind_phys), intent(inout) :: max_hail_diam_sfc(:) logical, intent(in ) :: do_radar_ref logical, intent(in) :: sedi_semi integer, intent(in) :: decfl @@ -698,6 +700,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & refl_10cm=refl_10cm, & diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, & kme_stoch=kme_stoch, & @@ -738,6 +741,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & refl_10cm=refl_10cm, & diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & rand_perturb_on=spp_mp_opt, kme_stoch=kme_stoch, & rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 5918e4dd9..293dd7625 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -610,6 +610,14 @@ type = real kind = kind_phys intent = out +[max_hail_diam_sfc] + standard_name = max_hail_diameter_sfc + long_name = instantaneous maximum hail diameter at lowest model level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [fullradar_diag] standard_name = do_full_radar_reflectivity long_name = flag for computing full radar reflectivity From ed82327f21b75f0c57562f45c6bce8d3fc25d5f0 Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Thu, 26 Oct 2023 10:01:51 -0600 Subject: [PATCH 066/132] Max hail diameter --- physics/module_mp_thompson.F90 | 46 +++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index d2199bdc6..61c07ba29 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -993,6 +993,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & rainprod, evapprod, & #endif refl_10cm, diagflag, do_radar_ref, & + max_hail_diam_sfc, & vt_dbz_wt, first_time_step, & re_cloud, re_ice, re_snow, & has_reqc, has_reqi, has_reqs, & @@ -1062,6 +1063,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & GRAUPELNC, GRAUPELNCV REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & refl_10cm + REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: & + max_hail_diam_sfc REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & vt_dbz_wt LOGICAL, INTENT(IN) :: first_time_step @@ -1679,6 +1682,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & (nsteps>1 .and. istep==nsteps) .or. & (nsteps==1 .and. ndt==1)) THEN + max_hail_diam_sfc(i,j) = hail_mass_99th_percentile(kts, kte, qg1d, t1d, p1d) + !> - Call calc_refl10cm() diagflag_present: IF ( PRESENT (diagflag) ) THEN @@ -6496,7 +6501,7 @@ subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) integer :: k real :: ygra1, zans1, N0_exp, lam_exp, lamg - do k = kte, kts, -1 + do k = kte, kts, -1 ygra1 = alog10(max(1.e-9, rg(k))) zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) @@ -6509,6 +6514,45 @@ subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) end subroutine graupel_psd_parameters +!>\ingroup aathompson +!! @brief Calculates graupel/hail maximum diameter +!! +!! Calculates graupel/hail maximum diameter (currently the 99th percentile of mass distribtuion) +!! for a vertical column +!! +!! @param[in] kts integer start index for vertical column +!! @param[in] kte integer end index for vertical column +!! @param[in] qg real array, size(kts:kte) for graupel mass mixing ratio [kg kg^-1] +!! @param[in] temperature double array, size(kts:kte) temperature [K] +!! @param[in] pressure double array, size(kts:kte) pressure [Pa] +!! @param[out] max_hail_diam real maximum hail diameter [m] +function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) result(max_hail_diam) + + implicit none + + integer, intent(in) :: kts, kte + real, intent(in) :: qg(:), temperature(:), pressure(:), qv(:) + real, intent(out) :: max_hail_diam + + real :: rho(:), rg(:), max_hail_column + real, parameter :: random_number = 0. + + max_hail_column = 0. + rg = 0. + do k = kts, kte + rho(k) = 0.622*pressure(k)/(R*temperature(k)*(max(1.e-10, qv(k))+0.622)) + if (qg(k) .gt. R1) then + rg(k) = qg(k)*rho(k) + endif + enddo + + call graupel_psd_parameters(kts, kte, random_number, rg, ilamg, N0_g) + + where(rg .gt. 1.e-9) max_hail_column = 10.05 * ilamg + max_hail_diam = max_hail_column(kts) + +end function hail_mass_99th_percentile + !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ END MODULE module_mp_thompson From f7edbc1db5595cf58370713a50abdd1ba3bd5eda Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 26 Oct 2023 16:49:24 +0000 Subject: [PATCH 067/132] More cleanup --- physics/CONV/C3/cu_c3_driver.meta | 3 +- physics/CONV/Grell_Freitas/cu_gf_driver.meta | 3 +- .../GFS_phys_time_vary.fv3.meta | 4 +- .../GFS_phys_time_vary.scm.meta | 4 +- .../GFS_surface_composites_post.meta | 2 +- .../GFS_surface_generic_pre.meta | 2 +- .../UFS_SCM_NEPTUNE/sgscloud_radpre.meta | 2 +- physics/MP/Morrison_Gettelman/m_micro.meta | 4 +- physics/NOTUSED/gfs_phy_tracer_config.F | 228 ------------------ physics/NOTUSED/gocart_tracer_config_stub.f | 17 -- physics/NOTUSED/rrtmg_lw_pre.F90 | 26 -- physics/NOTUSED/rrtmg_lw_pre.meta | 24 -- .../RRTMGP/rrtmgp_aerosol_optics.meta | 2 +- physics/Radiation/RRTMGP/rrtmgp_lw_main.meta | 2 +- physics/Radiation/RRTMGP/rrtmgp_sw_main.meta | 2 +- physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta | 5 +- .../GFDL/module_sf_exchcoef.f90 | 0 physics/SFC_Layer/MYJ/myjsfc_wrapper.meta | 2 +- physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta | 2 +- physics/SFC_Layer/UFS/sfc_diag.meta | 2 +- physics/SFC_Models/Lake/CLM/clm_lake.meta | 2 +- .../SFC_Models/Lake/Flake/flake_driver.meta | 2 +- physics/SFC_Models/Land/Noah/lsm_noah.meta | 2 +- physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 3 +- physics/SFC_Models/Land/RUC/lsm_ruc.meta | 3 +- physics/SFC_Models/Ocean/UFS/sfc_ocean.meta | 2 +- physics/SFC_Models/SeaIce/CICE/sfc_cice.meta | 2 +- physics/SFC_Models/SeaIce/CICE/sfc_sice.meta | 2 +- physics/{h2o_photo => photochem}/h2o_def.f | 0 physics/{h2o_photo => photochem}/h2o_def.meta | 0 .../{h2o_photo => photochem}/h2ointerp.f90 | 0 physics/{h2o_photo => photochem}/h2ophys.f | 0 physics/{h2o_photo => photochem}/h2ophys.meta | 2 +- physics/{o3_photo => photochem}/ozinterp.f90 | 0 physics/{o3_photo => photochem}/ozne_def.f | 0 physics/{o3_photo => photochem}/ozne_def.meta | 0 physics/{o3_photo => photochem}/ozphys.f | 0 physics/{o3_photo => photochem}/ozphys.meta | 2 +- physics/{o3_photo => photochem}/ozphys_2015.f | 0 .../{o3_photo => photochem}/ozphys_2015.meta | 2 +- physics/smoke_dust/rrfs_smoke_postpbl.meta | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.meta | 2 +- 42 files changed, 38 insertions(+), 326 deletions(-) delete mode 100644 physics/NOTUSED/gfs_phy_tracer_config.F delete mode 100644 physics/NOTUSED/gocart_tracer_config_stub.f delete mode 100644 physics/NOTUSED/rrtmg_lw_pre.F90 delete mode 100644 physics/NOTUSED/rrtmg_lw_pre.meta rename physics/{MP => SFC_Layer}/GFDL/module_sf_exchcoef.f90 (100%) rename physics/{h2o_photo => photochem}/h2o_def.f (100%) rename physics/{h2o_photo => photochem}/h2o_def.meta (100%) rename physics/{h2o_photo => photochem}/h2ointerp.f90 (100%) rename physics/{h2o_photo => photochem}/h2ophys.f (100%) rename physics/{h2o_photo => photochem}/h2ophys.meta (98%) rename physics/{o3_photo => photochem}/ozinterp.f90 (100%) rename physics/{o3_photo => photochem}/ozne_def.f (100%) rename physics/{o3_photo => photochem}/ozne_def.meta (100%) rename physics/{o3_photo => photochem}/ozphys.f (100%) rename physics/{o3_photo => photochem}/ozphys.meta (99%) rename physics/{o3_photo => photochem}/ozphys_2015.f (100%) rename physics/{o3_photo => photochem}/ozphys_2015.meta (99%) diff --git a/physics/CONV/C3/cu_c3_driver.meta b/physics/CONV/C3/cu_c3_driver.meta index bb2784642..da3ccc6dd 100644 --- a/physics/CONV/C3/cu_c3_driver.meta +++ b/physics/CONV/C3/cu_c3_driver.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = cu_c3_driver type = scheme - dependencies = cu_c3_deep.F90,cu_c3_sh.F90,../../hooks/machine.F,../../hooks/physcons.F90,../progsigma_calc.f90 + dependencies = ../../hooks/machine.F + dependencies = cu_c3_deep.F90,cu_c3_sh.F90,../progsigma_calc.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta index db2973c0f..87add2809 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = cu_gf_driver type = scheme - dependencies = cu_gf_deep.F90,cu_gf_sh.F90,../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = ../../hooks/machine.F + dependencies = cu_gf_deep.F90,cu_gf_sh.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 7df4cf715..8a35d469c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -8,8 +8,8 @@ dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 - dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f - dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 + dependencies = photochem/ozinterp.f90,photochem/ozne_def.f + dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index e1de4d699..86c052b0e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -7,8 +7,8 @@ dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 - dependencies = o3_photo/ozinterp.f90,o3_photo/ozne_def.f - dependencies = h2o_photo/h2o_def.f,h2o_photo/h2ointerp.f90 + dependencies = photochem/ozinterp.f90,photochem/ozne_def.f + dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta index 35b54544a..7224d7221 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta @@ -3,7 +3,7 @@ name = GFS_surface_composites_post type = scheme relative_path = ../../ - dependencies = hooks/machine.F,SFC_Layer/GFS_sfc/sfc_diff.f + dependencies = hooks/machine.F,SFC_Layer/UFS/sfc_diff.f ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta index 63fb9b96c..bbf7dd5c3 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta @@ -2,7 +2,7 @@ name = GFS_surface_generic_pre type = scheme relative_path = ../../ - dependencies = hooks/machine.F,Land/Noah/surface_perturbation.F90 + dependencies = hooks/machine.F,SFC_Models/Land/Noah/surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta index 9829e3538..a9635efa5 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta @@ -2,7 +2,7 @@ name = sgscloud_radpre type = scheme relative_path = ../../ - dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 + dependencies = tools/funcphys.f90,hooks/machine.F dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 dependencies = Radiation/radiation_clouds.f,MP/Thompson/module_mp_thompson.F90 diff --git a/physics/MP/Morrison_Gettelman/m_micro.meta b/physics/MP/Morrison_Gettelman/m_micro.meta index 4b6df18c7..16efc5cc4 100644 --- a/physics/MP/Morrison_Gettelman/m_micro.meta +++ b/physics/MP/Morrison_Gettelman/m_micro.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = m_micro type = scheme - dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,wv_saturation.F + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F + dependencies = micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,wv_saturation.F ######################################################################## [ccpp-arg-table] diff --git a/physics/NOTUSED/gfs_phy_tracer_config.F b/physics/NOTUSED/gfs_phy_tracer_config.F deleted file mode 100644 index 647919a23..000000000 --- a/physics/NOTUSED/gfs_phy_tracer_config.F +++ /dev/null @@ -1,228 +0,0 @@ - -! -!! ! Module: gfs_phy_tracer_config -! -! ! Description: gfs physics tracer configuration module -! -! ! Revision history: -! Oct 16 2009 Sarah Lu, adopted from dyn fc -! Nov 21 2009 Sarah Lu, chem tracer specified from ChemRegistry -! Dec 10 2009 Sarah Lu, add doing_GOCART -! Jan 12 2010 Sarah Lu, add trcindx -! Feb 08 2009 Sarah Lu, ri/cpi added to gfs_phy_tracer_type -! Aug 17 2010 Sarah Lu, remove debug print -! Oct 16 2010 Sarah Lu, add fscav -! Aug 08 2011 Jun Wang, remove gocart dependency when not running GOCART -! Sep 17 2011 Sarah Lu, revise chem tracer initialization -! Nov 11 2011 Sarah Lu, allocate but not assign value for cpi/ri array -! Apr 06 2012 Henry Juang, relax hardwire num_tracer, add tracer 4 and 5 -! Apr 23 2012 Jun Wang, remove save attibute for gfs_phy_tracer (already defined) -! --- -- 2016 Anning Cheng add ntiw,ntlnc,ntinc -! May 03 2016 S Moorthi add nto, nto2 -! ------------------------------------------------------------------------- -! - module gfs_phy_tracer_config - use machine , only : kind_phys - - implicit none - SAVE -! -! tracer specification: add fscav -! - type gfs_phy_tracer_type - character*20 , pointer :: chem_name(:) ! chem_tracer name - character*20 , pointer :: vname(:) ! variable name - real(kind=kind_phys), pointer :: ri(:) - real(kind=kind_phys), pointer :: cpi(:) - real(kind=kind_phys), pointer :: fscav(:) - integer :: ntrac, ntrac_met, ntrac_chem - logical :: doing_DU, doing_SU, doing_SS - &, doing_OC, doing_BC, doing_GOCART - endtype gfs_phy_tracer_type - - type (gfs_phy_tracer_type) :: gfs_phy_tracer -! -! misc tracer options -! - logical :: glbsum = .true. -! - -! --- public interface - public tracer_config_init, trcindx - - contains - -! ------------------------------------------------------------------- -! ------------------------------------------------------------------- -! subroutine tracer_config_init (gfs_phy_tracer,ntrac, - subroutine tracer_config_init (ntrac,ntoz,ntcw,ncld, - & ntiw,ntlnc,ntinc, - & fprcp,ntrw,ntsw,ntrnc,ntsnc, - & ntke,nto,nto2,me) - -c -c This subprogram sets up gfs_phy_tracer -c - implicit none -! input - integer, intent(in) :: me, ntoz,ntcw,ntke, - & ntiw,ntlnc,ntinc,nto,nto2, - & fprcp,ntrw,ntsw,ntrnc,ntsnc -! output -! type (gfs_phy_tracer_type), intent(out) :: gfs_phy_tracer -! input/output - integer, intent(inout) :: ntrac -! local - integer :: i, j, status, ierr - character*20 :: rgname - -! initialize ntrac_chem (the default is no chemistry) - gfs_phy_tracer%ntrac_chem = 0 - gfs_phy_tracer%doing_GOCART = .false. - -! initialize chem tracers - call gocart_tracer_config(me) - -! input ntrac is meteorological tracers - gfs_phy_tracer%ntrac_met = ntrac - -! update ntrac = total number of tracers - gfs_phy_tracer%ntrac = gfs_phy_tracer%ntrac_met + - & gfs_phy_tracer%ntrac_chem - ntrac = gfs_phy_tracer%ntrac - - if(me==0) then - print *, 'LU_TRCp: ntrac_met =',gfs_phy_tracer%ntrac_met - print *, 'LU_TRCp: ntrac_chem=',gfs_phy_tracer%ntrac_chem - print *, 'LU_TRCp: ntrac =',gfs_phy_tracer%ntrac - endif - -! Set up tracer name, cpi, and ri - if ( gfs_phy_tracer%ntrac > 0 ) then - allocate(gfs_phy_tracer%vname(ntrac), stat=status) - if( status /= 0 ) then - print *,'LU_TRC: alloc error - gfs_dyn_tracer :',status,me - return - endif - allocate(gfs_phy_tracer%ri(0:ntrac), stat=status) - if( status /= 0 ) then - print *,'LU_TRC: alloc error - gfs_dyn_tracer :',status,me - return - endif - allocate(gfs_phy_tracer%cpi(0:ntrac), stat=status) - if( status /= 0 ) then - print *,'LU_TRC: alloc error - gfs_dyn_tracer :',status,me - return - endif - allocate(gfs_phy_tracer%fscav(ntrac), stat=status) - if( status /= 0 ) then - print *,'LU_TRC: alloc error - gfs_dyn_tracer :',status,me - return - endif - -!--- fill in met tracers - gfs_phy_tracer%vname(1) = 'spfh' - if(ntcw > 0) gfs_phy_tracer%vname(ntcw) = 'clwmr' - if(ntiw > 0) gfs_phy_tracer%vname(ntiw) = 'climr' - if(ntlnc > 0) gfs_phy_tracer%vname(ntlnc) = 'lnc' - if(ntinc > 0) gfs_phy_tracer%vname(ntinc) = 'inc' - if(ntrw > 0) gfs_phy_tracer%vname(ntrw) = 'rnmr' - if(ntsw > 0) gfs_phy_tracer%vname(ntsw) = 'snwmr' - if(ntrnc > 0) gfs_phy_tracer%vname(ntrnc) = 'rnc' - if(ntsnc > 0) gfs_phy_tracer%vname(ntsnc) = 'snc' - if(ntke > 0) gfs_phy_tracer%vname(ntke) = 'tke' -#ifdef MULTI_GASES - print *,' ++++ ntoz nto nto2 ',ntoz,nto,nto2 - if(ntoz > 0) gfs_phy_tracer%vname(ntoz) = 'spo3' - if(nto > 0) gfs_phy_tracer%vname(nto) = 'spo' - if(nto2 > 0) gfs_phy_tracer%vname(nto2) = 'spo2' -#else - if(ntoz > 0) gfs_phy_tracer%vname(ntoz) = 'o3mr' - if(nto > 0) gfs_phy_tracer%vname(nto) = 'o' - if(nto2 > 0) gfs_phy_tracer%vname(nto2) = 'o2' -#endif - - - gfs_phy_tracer%fscav(1:gfs_phy_tracer%ntrac_met) = 0. - -!--- fill in chem tracers - if ( gfs_phy_tracer%ntrac_chem > 0 ) then - do i = 1,gfs_phy_tracer%ntrac_chem - j = i + gfs_phy_tracer%ntrac_met - rgname = trim(gfs_phy_tracer%chem_name(i)) - if(me==0)print *, 'LU_TRC_phy: vname=',j,rgname - gfs_phy_tracer%vname(j) = rgname - enddo - endif - - endif !! - - return - - end subroutine tracer_config_init -! ------------------------------------------------------------------- -! ------------------------------------------------------------------- - function trcindx( specname, tracer ) - implicit none - - character*(*), intent(in) :: specname - type (gfs_phy_tracer_type), intent(in) :: tracer - - character*10 :: name1, name2 - integer :: i, trcindx - -! -- set default value - trcindx = -999 - -! -- convert specname to upper case - call fixchar(specname, name1, 1) - do i = 1, tracer%ntrac - call fixchar(tracer%vname(i), name2, 1) - if( name1 == name2 ) then - trcindx = i - exit - endif - enddo - - return - end function trcindx - -! ------------------------------------------------------------------- - subroutine fixchar(name_in, name_out, option) - implicit none - - character*(*), intent(in) :: name_in - character*(*), intent(out) :: name_out - integer, intent(in) :: option - - character*10 :: temp - integer :: i, ic - - name_out= ' ' - temp = trim(adjustl(name_in)) - do i = 1, len_trim(temp) - ic = IACHAR(temp(i:i)) - if(option == 1 ) then !<--- convert to upper case - if(ic .ge. 97 .and. ic .le. 122) then - name_out(i:i) = CHAR( IC-32 ) - else - name_out(i:i) = temp(i:i) - endif - endif - if(option == 2 ) then !<--- convert to lower case - if(ic .ge. 65 .and. ic .le. 90) then - name_out(i:i) = CHAR( IC+32 ) - else - name_out(i:i) = temp(i:i) - endif - endif - - enddo - name_out = trim(name_out) - return - - end subroutine fixchar - -! ========================================================================= - - end module gfs_phy_tracer_config diff --git a/physics/NOTUSED/gocart_tracer_config_stub.f b/physics/NOTUSED/gocart_tracer_config_stub.f deleted file mode 100644 index d6df297c7..000000000 --- a/physics/NOTUSED/gocart_tracer_config_stub.f +++ /dev/null @@ -1,17 +0,0 @@ -! -!! ! Subroutine : gocart_tracer_config -! -! ! Description: stub for resetting gfs phys when gocart is running -! -! ! Revision history: -! Aug 09 2011 Jun Wang, initial code -! ------------------------------------------------------------------------- -! - subroutine gocart_tracer_config() -! - -! print *,'TRAC_CONFIG: gocart is not running.' - - return - - end subroutine gocart_tracer_config diff --git a/physics/NOTUSED/rrtmg_lw_pre.F90 b/physics/NOTUSED/rrtmg_lw_pre.F90 deleted file mode 100644 index 2b63d98c5..000000000 --- a/physics/NOTUSED/rrtmg_lw_pre.F90 +++ /dev/null @@ -1,26 +0,0 @@ -!>\file rrtmg_lw_pre.F90 -!! - module rrtmg_lw_pre - contains - -!>\defgroup rrtmg_lw_pre GFS RRTMG-LW scheme pre -!! This module contains RRTMG-LW pre module. -!> @{ -!> \section arg_table_rrtmg_lw_pre_run Argument Table -!! \htmlinclude rrtmg_lw_pre_run.html -!! - subroutine rrtmg_lw_pre_run (errmsg, errflg) - - implicit none - - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - end subroutine rrtmg_lw_pre_run - -!> @} - end module rrtmg_lw_pre diff --git a/physics/NOTUSED/rrtmg_lw_pre.meta b/physics/NOTUSED/rrtmg_lw_pre.meta deleted file mode 100644 index 9f6ec07c8..000000000 --- a/physics/NOTUSED/rrtmg_lw_pre.meta +++ /dev/null @@ -1,24 +0,0 @@ -[ccpp-table-properties] - name = rrtmg_lw_pre - type = scheme - dependencies = - -######################################################################## -[ccpp-arg-table] - name = rrtmg_lw_pre_run - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta index 0847877d6..37ec2e9a0 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_aerosol_optics type = scheme - dependencies = ../iounitdef.f,../../hooks/machine.F,../radiation_aerosols.f,../radiation_tools.F90 + dependencies = ../../hooks/machine.F,../radiation_aerosols.f,../radiation_tools.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index 011376985..779389581 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -7,7 +7,7 @@ dependencies = rte-rrtmgp/rte/mo_source_functions.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90,rrtmgp_sampling.F90 - dependencies = ../../GFS/GFS_rrtmgp_pre.F90 + dependencies = ../../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index 932e2195e..711d01bc1 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -7,7 +7,7 @@ dependencies = rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90 dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90,rrtmgp_sampling.F90 - dependencies = ../../GFS/GFS_rrtmgp_pre.F90 + dependencies = ../../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta index b0d613eed..ac98437e9 100644 --- a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta +++ b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.meta @@ -1,8 +1,9 @@ [ccpp-table-properties] name = gfdl_sfc_layer type = scheme - relative_path = ../../ - dependencies = hooks/machine.F,SFC_Layer/module_sf_exchcoef.f90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90,Land/Noahmp/noahmp_tables.f90 + dependencies = ../../hooks/machine.F,module_sf_exchcoef.f90 + dependencies = ../../SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 + dependencies = ../../SFC_Models/Land/Noahmp/noahmp_tables.f90 ######################################################################## [ccpp-arg-table] diff --git a/physics/MP/GFDL/module_sf_exchcoef.f90 b/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 similarity index 100% rename from physics/MP/GFDL/module_sf_exchcoef.f90 rename to physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 diff --git a/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta index 9805db619..0ae09985e 100644 --- a/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = myjsfc_wrapper type = scheme - dependencies = ../../hooks/machine.f,module_SF_JSFC.F90 + dependencies = ../../hooks/machine.F,module_SF_JSFC.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta index a76df3790..0e1c96c02 100644 --- a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = mynnsfc_wrapper type = scheme - dependencies = ../../hooks/machine.F,module_sf_mynn.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,module_sf_mynn.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index 6a82c2c61..f4f83ab04 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -2,7 +2,7 @@ name = sfc_diag type = scheme relative_path = ../../ - dependencies = tools/funcphys.f90,hooks/machine.F + dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.meta b/physics/SFC_Models/Lake/CLM/clm_lake.meta index 3a519244a..a02aee9c6 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.meta +++ b/physics/SFC_Models/Lake/CLM/clm_lake.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = clm_lake type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Lake/Flake/flake_driver.meta b/physics/SFC_Models/Lake/Flake/flake_driver.meta index 8b295bc27..22ab62d1e 100644 --- a/physics/SFC_Models/Lake/Flake/flake_driver.meta +++ b/physics/SFC_Models/Lake/Flake/flake_driver.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = flake_driver type = scheme - dependencies = ../../hooks/machine.F,flake.F90 + dependencies = ../../../hooks/machine.F,flake.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index 2dc612d5b..07f4045a2 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = lsm_noah type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F dependencies = ../set_soilveg.f,sflx.f,surface_perturbation.F90 ######################################################################## diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 55a787cd7..e7a73ef99 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = noahmpdrv type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,../set_soilveg.f + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F + dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,../set_soilveg.f ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Land/RUC/lsm_ruc.meta b/physics/SFC_Models/Land/RUC/lsm_ruc.meta index f02d6de67..c05eb30e8 100644 --- a/physics/SFC_Models/Land/RUC/lsm_ruc.meta +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = lsm_ruc type = scheme - dependencies = ../../hooks/machine.F,module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 + dependencies = ../../../hooks/machine.F,../../../hooks/physcons.F90 + dependencies = module_sf_ruclsm.F90,module_soil_pre.F90,namelist_soilveg_ruc.F90,set_soilveg_ruc.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index ea575a071..848c2e3ed 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_ocean type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F + dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta index 52fa28a3d..c44f9d6b5 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_cice type = scheme - relative_path = ../../ + relative_path = ../../../ dependencies = hooks/machine.F ######################################################################## diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta index 7277c0511..828a83939 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_sice type = scheme - relative_path = ../../ + relative_path = ../../../ dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## diff --git a/physics/h2o_photo/h2o_def.f b/physics/photochem/h2o_def.f similarity index 100% rename from physics/h2o_photo/h2o_def.f rename to physics/photochem/h2o_def.f diff --git a/physics/h2o_photo/h2o_def.meta b/physics/photochem/h2o_def.meta similarity index 100% rename from physics/h2o_photo/h2o_def.meta rename to physics/photochem/h2o_def.meta diff --git a/physics/h2o_photo/h2ointerp.f90 b/physics/photochem/h2ointerp.f90 similarity index 100% rename from physics/h2o_photo/h2ointerp.f90 rename to physics/photochem/h2ointerp.f90 diff --git a/physics/h2o_photo/h2ophys.f b/physics/photochem/h2ophys.f similarity index 100% rename from physics/h2o_photo/h2ophys.f rename to physics/photochem/h2ophys.f diff --git a/physics/h2o_photo/h2ophys.meta b/physics/photochem/h2ophys.meta similarity index 98% rename from physics/h2o_photo/h2ophys.meta rename to physics/photochem/h2ophys.meta index d8a9eabab..9e9b03647 100644 --- a/physics/h2o_photo/h2ophys.meta +++ b/physics/photochem/h2ophys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = h2ophys type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/o3_photo/ozinterp.f90 b/physics/photochem/ozinterp.f90 similarity index 100% rename from physics/o3_photo/ozinterp.f90 rename to physics/photochem/ozinterp.f90 diff --git a/physics/o3_photo/ozne_def.f b/physics/photochem/ozne_def.f similarity index 100% rename from physics/o3_photo/ozne_def.f rename to physics/photochem/ozne_def.f diff --git a/physics/o3_photo/ozne_def.meta b/physics/photochem/ozne_def.meta similarity index 100% rename from physics/o3_photo/ozne_def.meta rename to physics/photochem/ozne_def.meta diff --git a/physics/o3_photo/ozphys.f b/physics/photochem/ozphys.f similarity index 100% rename from physics/o3_photo/ozphys.f rename to physics/photochem/ozphys.f diff --git a/physics/o3_photo/ozphys.meta b/physics/photochem/ozphys.meta similarity index 99% rename from physics/o3_photo/ozphys.meta rename to physics/photochem/ozphys.meta index 631dcb332..a1f7e4eb2 100644 --- a/physics/o3_photo/ozphys.meta +++ b/physics/photochem/ozphys.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozphys type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/o3_photo/ozphys_2015.f b/physics/photochem/ozphys_2015.f similarity index 100% rename from physics/o3_photo/ozphys_2015.f rename to physics/photochem/ozphys_2015.f diff --git a/physics/o3_photo/ozphys_2015.meta b/physics/photochem/ozphys_2015.meta similarity index 99% rename from physics/o3_photo/ozphys_2015.meta rename to physics/photochem/ozphys_2015.meta index 7da8cdf27..632dbc340 100644 --- a/physics/o3_photo/ozphys_2015.meta +++ b/physics/photochem/ozphys_2015.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ozphys_2015 type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 339f6ca03..e65d182d3 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = machine.F + dependencies = ../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index b084cdd66..b079b12c9 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = machine.F,dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 + dependencies = ../hooks/machine.F,dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 ######################################################################## [ccpp-arg-table] From 81563de9686260bc5f1c85fe350d48e56fdf7afc Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 26 Oct 2023 19:17:33 +0000 Subject: [PATCH 068/132] move setting of flag from run to init phase --- physics/cu_c3_driver.F90 | 26 ++++++++++++++------------ physics/cu_c3_driver.meta | 21 ++++++++++++++------- 2 files changed, 28 insertions(+), 19 deletions(-) diff --git a/physics/cu_c3_driver.F90 b/physics/cu_c3_driver.F90 index 5b6be1d6c..c911ff5e4 100644 --- a/physics/cu_c3_driver.F90 +++ b/physics/cu_c3_driver.F90 @@ -30,7 +30,8 @@ module cu_c3_driver !! \htmlinclude cu_c3_driver_init.html !! subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & - imfdeepcnv_c3,mpirank, mpiroot, errmsg, errflg) + imfdeepcnv_c3,progsigma, cnx, mpirank, mpiroot, & + errmsg, errflg) implicit none @@ -38,6 +39,8 @@ subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & integer, intent(in) :: imfdeepcnv, imfdeepcnv_c3 integer, intent(in) :: mpirank integer, intent(in) :: mpiroot + integer, intent(in) :: cnx + logical, intent(inout) :: progsigma character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -45,6 +48,13 @@ subroutine cu_c3_driver_init(imfshalcnv, imfshalcnv_c3, imfdeepcnv, & errmsg = '' errflg = 0 + if(progsigma)then + if(cnx < 384)then + progsigma=.false. + write(*,*)'Forcing prognostic closure to .false. due to coarse resolution' + endif + endif + end subroutine cu_c3_driver_init ! @@ -58,7 +68,7 @@ end subroutine cu_c3_driver_init !! !>\section gen_c3_driver Grell-Freitas Cumulus Scheme Driver General Algorithm subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& - do_ca,progsigma,cnx,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & + do_ca,progsigma,cactiv,cactiv_m,g,cp,fv,r_d,xlv,r_v,forcet, & forceqv_spechum,phil,delp,raincv,tmf,qmicro,sigmain, & betascu,betamcu,betadcu,qv_spechum,t,cld1d,us,vs,t2di,w, & qv2di_spechum,p2di,psuri, & @@ -93,14 +103,14 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,km,ntracer,cnx + integer, intent(in ) :: im,km,ntracer integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend, & do_ca real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu logical, intent(in ) :: ldiag3d - logical, intent(inout) :: progsigma + logical, intent(in ) :: progsigma real(kind=kind_phys), intent(inout) :: dtend(:,:,:) !$acc declare copy(dtend) integer, intent(in) :: dtidx(:,:), & @@ -280,14 +290,6 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& !$acc end kernels endif - - if(progsigma)then - if(cnx < 384)then - progsigma=.false. - write(*,*)'Forcing prognostic closure to .false. due to coarse resolution' - endif - endif - if(ldiag3d) then if(flag_for_dcnv_generic_tend) then cliw_deep_idx=0 diff --git a/physics/cu_c3_driver.meta b/physics/cu_c3_driver.meta index 71a785318..801b1e9d7 100644 --- a/physics/cu_c3_driver.meta +++ b/physics/cu_c3_driver.meta @@ -49,6 +49,20 @@ dimensions = () type = integer intent = in +[progsigma] + standard_name = do_prognostic_updraft_area_fraction + long_name = flag for prognostic sigma in cumuls scheme + units = flag + dimensions = () + type = logical + intent = inout +[cnx] + standard_name = number_of_x_points_for_current_cubed_sphere_tile + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -133,13 +147,6 @@ units = flag dimensions = () type = logical - intent = inout -[cnx] - standard_name = number_of_x_points_for_current_cubed_sphere_tile - long_name = number of points in x direction for this cubed sphere face - units = count - dimensions = () - type = integer intent = in [cactiv] standard_name = counter_for_grell_freitas_convection From e861277c1ffe8fdcb1b026240f98077bb7a91473 Mon Sep 17 00:00:00 2001 From: Lisa Bengtsson Date: Thu, 26 Oct 2023 21:10:37 +0000 Subject: [PATCH 069/132] address review comments --- physics/cu_c3_sh.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/cu_c3_sh.F90 b/physics/cu_c3_sh.F90 index 704f2a0fc..736292092 100644 --- a/physics/cu_c3_sh.F90 +++ b/physics/cu_c3_sh.F90 @@ -676,7 +676,7 @@ subroutine cu_c3_sh_run ( & dz=z_cup(i,k)-z_cup(i,k-1) ! cloud liquid water c1d(i,k)=c1_shal! 0. !.02*up_massdetr(i,k-1) - clw_all(i,k)=max(0.,qco(i,k)-trash) + clw_all(i,k)=max(0._kind_phys,qco(i,k)-trash) qrco(i,k)= (qco(i,k)-trash)/(1.+(c0_shal+c1d(i,k))*dz) if(qrco(i,k).lt.0.)then ! hli new test 02/12/19 qrco(i,k)=0. From 32cf7ba5484db1387e33c7f9d25de87079e9014c Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 27 Oct 2023 17:01:01 +0000 Subject: [PATCH 070/132] Reverted standard_name change --- physics/GFS_phys_time_vary.fv3.meta | 2 +- physics/GFS_phys_time_vary.scm.meta | 2 +- physics/GFS_suite_stateout_update.meta | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index ad543e146..968f33027 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -1205,7 +1205,7 @@ standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_dimension,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index cf5ad15ca..d72e27fd5 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -1110,7 +1110,7 @@ standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_dimension,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_suite_stateout_update.meta b/physics/GFS_suite_stateout_update.meta index 8cbab9139..fae276d2f 100644 --- a/physics/GFS_suite_stateout_update.meta +++ b/physics/GFS_suite_stateout_update.meta @@ -218,7 +218,7 @@ standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_loop_extent,number_of_levels_in_ozone_data,number_of_coefficients_in_ozone_data) + dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) type = real kind = kind_phys intent = in From 1000af768a289c9a139f92a7d50c7a56bd2de5c9 Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Fri, 27 Oct 2023 18:21:27 +0000 Subject: [PATCH 071/132] Fixes after debug --- physics/module_mp_thompson.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 61c07ba29..9f81bb3f3 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1682,7 +1682,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & (nsteps>1 .and. istep==nsteps) .or. & (nsteps==1 .and. ndt==1)) THEN - max_hail_diam_sfc(i,j) = hail_mass_99th_percentile(kts, kte, qg1d, t1d, p1d) + max_hail_diam_sfc(i,j) = hail_mass_99th_percentile(kts, kte, qg1d, t1d, p1d, qv1d) !> - Call calc_refl10cm() @@ -6525,6 +6525,7 @@ end subroutine graupel_psd_parameters !! @param[in] qg real array, size(kts:kte) for graupel mass mixing ratio [kg kg^-1] !! @param[in] temperature double array, size(kts:kte) temperature [K] !! @param[in] pressure double array, size(kts:kte) pressure [Pa] +!! @param[in] qv real array, size(kts:kte) water vapor mixing ratio [kg kg^-1] !! @param[out] max_hail_diam real maximum hail diameter [m] function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) result(max_hail_diam) @@ -6532,9 +6533,11 @@ function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) resu integer, intent(in) :: kts, kte real, intent(in) :: qg(:), temperature(:), pressure(:), qv(:) - real, intent(out) :: max_hail_diam + real :: max_hail_diam - real :: rho(:), rg(:), max_hail_column + integer :: k + real :: rho(kts:kte), rg(kts:kte), max_hail_column(kts:kte) + double precision :: ilamg(kts:kte), N0_g(kts:kte) real, parameter :: random_number = 0. max_hail_column = 0. From ddf6a5ca1a740f79cd8c58f8ecf84d47f0f4905d Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Fri, 27 Oct 2023 18:29:56 +0000 Subject: [PATCH 072/132] real to double for graupel psd parameters --- physics/module_mp_thompson.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 9f81bb3f3..211a044c9 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -6499,7 +6499,8 @@ subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) double precision, intent(out) :: ilamg(:), N0_g(:) integer :: k - real :: ygra1, zans1, N0_exp, lam_exp, lamg + real :: ygra1, zans1 + double precision :: N0_exp, lam_exp, lamg do k = kte, kts, -1 ygra1 = alog10(max(1.e-9, rg(k))) From dbfd4e639334271831b1c260fdceb116a93d8bf6 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Fri, 27 Oct 2023 23:06:11 +0000 Subject: [PATCH 073/132] Updating snow cloud fractions in MYNN-EDMF and removing redundant logic in sgscloud_radpre.F90 --- physics/module_bl_mynn.F90 | 26 ++++++++++++++------------ physics/mynnedmf_wrapper.F90 | 28 +++++++++++++++------------- physics/sgscloud_radpre.F90 | 6 +++--- 3 files changed, 32 insertions(+), 28 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index f520ae171..a2ba17c65 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -519,7 +519,7 @@ SUBROUTINE mynn_bl_driver( & real(kind_phys), dimension(kts:kte) :: & &thl,tl,qv1,qc1,qi1,qs1,sqw, & &el, dfm, dfh, dfq, tcd, qcd, pdk, pdt, pdq, pdc, & - &vt, vq, sgm + &vt, vq, sgm, kzero real(kind_phys), dimension(kts:kte) :: & &thetav,sh,sm,u1,v1,w1,p1, & &ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, & @@ -635,6 +635,7 @@ SUBROUTINE mynn_bl_driver( & maxwidth(its:ite)=0. maxmf(its:ite)=0. maxKHtopdown(its:ite)=0. + kzero(kts:kte)=0. ! DH* CHECK HOW MUCH OF THIS INIT IF-BLOCK IS ACTUALLY NEEDED FOR RESTARTS !> - Within the MYNN-EDMF, there is a dependecy check for the first time step, @@ -743,7 +744,7 @@ SUBROUTINE mynn_bl_driver( & !keep snow out for now - increases ceiling bias sqw(k)=sqv(k)+sqc(k)+sqi(k)!+sqs(k) thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*(sqi(k)+sqs(k)) + & - xlscp/ex1(k)*(sqi(k))!+sqs(k)) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & @@ -990,10 +991,10 @@ SUBROUTINE mynn_bl_driver( & else zw(k)=zw(k-1)+dz(i,k-1) endif - !keep snow out for now - increases ceiling bias + !keep snow out for now - increases ceiling bias sqw(k)= sqv(k)+sqc(k)+sqi(k)!+sqs(k) thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*(sqi(k)+sqs(k)) + & - xlscp/ex1(k)*(sqi(k))!+sqs(k)) !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy. !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & @@ -1223,9 +1224,9 @@ SUBROUTINE mynn_bl_driver( & call mynn_tendencies(kts,kte,i, & &delt, dz1, rho1, & &u1, v1, th1, tk1, qv1, & - &qc1, qi1, qs1, qnc1, qni1, & + &qc1, qi1, kzero, qnc1, qni1, & !kzero replaces qs1 - not mixing snow &ps(i), p1, ex1, thl, & - &sqv, sqc, sqi, sqs, sqw, & + &sqv, sqc, sqi, kzero, sqw, & !kzero replaces sqs - not mixing snow &qnwfa1, qnifa1, qnbca1, ozone1, & &ust(i),flt,flq,flqv,flqc, & &wspd(i),uoce(i),voce(i), & @@ -3850,11 +3851,11 @@ SUBROUTINE mym_condensation (kts,kte, & q1(k) = qmq / sgm(k) ! Q1, the normalized saturation !Add condition for falling/settling into low-RH layers, so at least - !some cloud fraction is applied for all qc and qi. + !some cloud fraction is applied for all qc, qs, and qi. rh_hack= rh(k) !ensure adequate RH & q1 when qi is at least 1e-9 if (qi(k)>1.e-9) then - rh_hack =min(1.0, rhcrit + 0.06*(9.0 + log10(qi(k)))) + rh_hack =min(1.0, rhcrit + 0.07*(9.0 + log10(qi(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -3869,8 +3870,8 @@ SUBROUTINE mym_condensation (kts,kte, & q1(k) =max(q1_rh, q1(k) ) endif !ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH) - if (qs(k)>1.e-7 .and. zagl .gt. pblh2) then - rh_hack =min(1.0, rhcrit + 0.08*(7.0 + log10(qs(k)))) + if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then + rh_hack =min(1.0, rhcrit + 0.07*(8.0 + log10(qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -4614,7 +4615,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !============================================ ! MIX SNOW ( sqs ) !============================================ -IF (bl_mynn_cloudmix > 0 .AND. FLAG_QS) THEN +!hard-code to not mix snow +IF (bl_mynn_cloudmix > 0 .AND. .false.) THEN k=kts !rho-weighted: @@ -4981,7 +4983,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== ! CLOUD SNOW TENDENCY !=================== - IF (FLAG_QS) THEN + IF (.false.) THEN !disabled DO k=kts,kte Dqs(k)=(sqs2(k)/(1.-sqs2(k)) - qs(k))/delt ENDDO diff --git a/physics/mynnedmf_wrapper.F90 b/physics/mynnedmf_wrapper.F90 index 46db1c441..487753027 100644 --- a/physics/mynnedmf_wrapper.F90 +++ b/physics/mynnedmf_wrapper.F90 @@ -326,6 +326,7 @@ SUBROUTINE mynnedmf_wrapper_run( & integer :: idtend real(kind_phys), dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 real(kind_phys), allocatable :: save_qke_adv(:,:) + real(kind_phys), dimension(levs) :: kzero ! Initialize CCPP error handling variables errmsg = '' @@ -356,6 +357,7 @@ SUBROUTINE mynnedmf_wrapper_run( & !print*,"in MYNN, initflag=",initflag endif + kzero = zero !generic zero array !initialize arrays for test EMIS_ANT_NO = 0. @@ -392,7 +394,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QNI= .true. FLAG_QC = .true. FLAG_QNC= .true. - FLAG_QS = .false. !.true. + FLAG_QS = .true. FLAG_QNWFA= nssl_ccn_on ! ERM: Perhaps could use this field for CCN field? FLAG_QNIFA= .false. FLAG_QNBCA= .false. @@ -401,7 +403,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0.0 !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) ozone(i,k) = qgrs_ozone(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) @@ -419,7 +421,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. !pipe it in, but do not mix FLAG_QNC= .true. FLAG_QNWFA= .true. FLAG_QNIFA= .true. @@ -429,7 +431,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -442,7 +444,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. FLAG_QNC= .true. FLAG_QNWFA= .false. FLAG_QNIFA= .false. @@ -452,7 +454,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -465,7 +467,7 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. - FLAG_QS = .false. + FLAG_QS = .true. FLAG_QNC= .false. FLAG_QNWFA= .false. FLAG_QNIFA= .false. @@ -475,7 +477,7 @@ SUBROUTINE mynnedmf_wrapper_run( & sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = qgrs_ice(i,k) - sqs(i,k) = 0. !qgrs_snow(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = 0. qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) @@ -566,7 +568,7 @@ SUBROUTINE mynnedmf_wrapper_run( & call moisture_check2(levs, delt, & delp(i,:), exner(i,:), & sqv(i,:), sqc(i,:), & - sqi(i,:), sqs(i,:), & + sqi(i,:), kzero(:), & t3d(i,:) ) enddo @@ -835,7 +837,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) @@ -870,7 +872,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) enddo enddo if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then @@ -888,7 +890,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - dqdt_snow(i,k) = 0.0 !RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 enddo enddo @@ -918,7 +920,7 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - !dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) IF ( nssl_ccn_on ) THEN ! dqdt_cccn(i,k) = RQNWFABLTEN(i,k) ENDIF diff --git a/physics/sgscloud_radpre.F90 b/physics/sgscloud_radpre.F90 index 44ab87bcc..936393d5b 100644 --- a/physics/sgscloud_radpre.F90 +++ b/physics/sgscloud_radpre.F90 @@ -216,10 +216,10 @@ subroutine sgscloud_radpre_run( & qi(i,k) = ice_frac*qi_bl(i,k) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) + clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 8b) !iwc = qi(i,k)*1.0e6*rho(i,k) - !IF(qi(i,k)>1.E-8)clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) + !clouds5(i,k)=MAX(139.7 + 1.76*Tc + 13.49*LOG(iwc), 20.) !calculate the ice water path using additional BL clouds clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) @@ -229,7 +229,7 @@ subroutine sgscloud_radpre_run( & qs(i,k) = snow_frac*qi_bl(i,k) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) - if(qs(i,k)>1.E-8)clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.) + clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.) !calculate the snow water path using additional BL clouds clouds8(i,k) = max(0.0, qs(i,k) * gfac * delp(i,k)) From 872f48820b8194275268b5d6add33cf0e7731025 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Sun, 29 Oct 2023 20:25:12 +0000 Subject: [PATCH 074/132] Addressing comments from Dustin --- physics/module_sf_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index c2845f290..048a5c696 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -1381,7 +1381,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ZNTstoch_lnd(I) = ZNT_lnd(I) endif !add limit to prevent ridiculous values of z0 (more than dz/15) - ZNTstoch_lnd(I) = min(ZNTstoch_lnd(I), dz8w1d(i)*0.0666) + ZNTstoch_lnd(I) = min(ZNTstoch_lnd(I), dz8w1d(i)*0.0666_kind_phys) !-------------------------------------- ! LAND From 277bd480032dfa3ab518f12e17cd145d8590ebce Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Sun, 29 Oct 2023 20:26:23 +0000 Subject: [PATCH 075/132] Addressing comments from Dustin --- physics/module_bl_mynn.F90 | 53 +++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index a2ba17c65..4b47b43a7 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3046,7 +3046,6 @@ SUBROUTINE mym_turbulence ( & ! q-variance (pdq), and covariance (pdc) pdk(k) = elq*( sm(k)*gm(k) & & +sh(k)*gh(k)+gamv ) + & -!fix? & TKEprodTD(k) & 0.5*TKEprodTD(k) ! xmchen pdt(k) = elh*( sh(k)*dtl(k)+gamt )*dtl(k) pdq(k) = elh*( sh(k)*dqw(k)+gamq )*dqw(k) @@ -3091,7 +3090,6 @@ SUBROUTINE mym_turbulence ( & !qBUOY1D(k) = elq*(sh(k)*(-dTdz*grav/thl(k)) + gamv) !! ORIGINAL CODE !! Buoyncy term takes the TKEprodTD(k) production now -!fix? qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+TKEprodTD(k) !staggered qBUOY1D(k) = elq*(sh(k)*gh(k)+gamv)+0.5*TKEprodTD(k) ! xmchen !!!Dissipation Term (now it evaluated in mym_predict) @@ -3801,7 +3799,7 @@ SUBROUTINE mym_condensation (kts,kte, & !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS !but with use of higher-order moments to estimate sigma - pblh2=MAX(10.,pblh1) + pblh2=MAX(10._kind_phys,pblh1) zagl = 0. dzm1 = 0. DO k = kts,kte-1 @@ -3811,7 +3809,7 @@ SUBROUTINE mym_condensation (kts,kte, & t = th(k)*exner(k) xl = xl_blend(t) ! obtain latent heat qsat_tk= qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k) = MAX(MIN(1.00,qw(k)/MAX(1.E-10,qsat_tk)),0.001) + rh(k) = MAX(MIN(1.0_kind_phys,qw(k)/MAX(1.E-10,qsat_tk)),0.001_kind_phys) !dqw/dT: Clausius-Clapeyron dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) @@ -3840,7 +3838,7 @@ SUBROUTINE mym_condensation (kts,kte, & !sgm(k) = max( sgm(k), qsat_tk*0.035 ) !introduce vertical grid spacing dependence on min sgm - wt = max(500. - max(dz(k)-100.,0.0), 0.0)/500. !=1 for dz < 100 m, =0 for dz > 600 m + wt = max(500. - max(dz(k)-100.,0.0), 0.0_kind_phys)/500. !=1 for dz < 100 m, =0 for dz > 600 m sgm(k) = sgm(k) + sgm(k)*0.2*(1.0-wt) !inflate sgm for coarse dz !allow min sgm to vary with dz and z. @@ -3855,7 +3853,7 @@ SUBROUTINE mym_condensation (kts,kte, & rh_hack= rh(k) !ensure adequate RH & q1 when qi is at least 1e-9 if (qi(k)>1.e-9) then - rh_hack =min(1.0, rhcrit + 0.07*(9.0 + log10(qi(k)))) + rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(9.0 + log10(qi(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -3863,7 +3861,7 @@ SUBROUTINE mym_condensation (kts,kte, & endif !ensure adequate RH & q1 when qc is at least 1e-6 if (qc(k)>1.e-6) then - rh_hack =min(1.0, rhcrit + 0.09*(6.0 + log10(qc(k)))) + rh_hack =min(1.0_kind_phys, rhcrit + 0.09*(6.0 + log10(qc(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -3871,7 +3869,7 @@ SUBROUTINE mym_condensation (kts,kte, & endif !ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH) if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then - rh_hack =min(1.0, rhcrit + 0.07*(8.0 + log10(qs(k)))) + rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(8.0 + log10(qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) @@ -3953,10 +3951,10 @@ SUBROUTINE mym_condensation (kts,kte, & elseif (q1k .ge. -2.5 .and. q1k .lt. -1.7) then Fng = 3.0 + exp(-3.8*(q1k+1.7)) else - Fng = min(23.9 + exp(-1.6*(q1k+2.5)), 60.) + Fng = min(23.9 + exp(-1.6*(q1k+2.5)), 60._kind_phys) endif - cfmax = min(cldfra_bl1D(k), 0.6) + cfmax = min(cldfra_bl1D(k), 0.6_kind_phys) !Further limit the cf going into vt & vq near the surface zsl = min(max(25., 0.1*pblh2), 100.) wt = min(zagl/zsl, 1.0) !=0 at z=0 m, =1 above ekman layer @@ -4921,9 +4919,6 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & sqi2(k) = 0.0 ! if sqw2 > qsat sqc2(k) = 0.0 ENDIF - !dqv(k) = (sqv2(k) - sqv(k))/delt - !dqc(k) = (sqc2(k) - sqc(k))/delt - !dqi(k) = (sqi2(k) - sqi(k))/delt ENDDO ENDIF @@ -4932,7 +4927,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! WATER VAPOR TENDENCY !===================== DO k=kts,kte - Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt + Dqv(k)=(sqv2(k) - sqv(k))/delt !if (sqv2(k) < 0.0)print*,"neg qv:",sqv2(k),k ENDDO @@ -4943,7 +4938,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !print*,"FLAG_QC:",FLAG_QC IF (FLAG_QC) THEN DO k=kts,kte - Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt + Dqc(k)=(sqc2(k) - sqc(k))/delt !if (sqc2(k) < 0.0)print*,"neg qc:",sqc2(k),k ENDDO ELSE @@ -4971,7 +4966,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== IF (FLAG_QI) THEN DO k=kts,kte - Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt + Dqi(k)=(sqi2(k) - sqi(k))/delt !if (sqi2(k) < 0.0)print*,"neg qi:",sqi2(k),k ENDDO ELSE @@ -4985,7 +4980,7 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== IF (.false.) THEN !disabled DO k=kts,kte - Dqs(k)=(sqs2(k)/(1.-sqs2(k)) - qs(k))/delt + Dqs(k)=(sqs2(k) - sqs(k))/delt ENDDO ELSE DO k=kts,kte @@ -5009,10 +5004,11 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ELSE !-MIX CLOUD SPECIES? !CLOUDS ARE NOT NIXED (when bl_mynn_cloudmix == 0) DO k=kts,kte - Dqc(k)=0. + Dqc(k) =0. Dqnc(k)=0. - Dqi(k)=0. + Dqi(k) =0. Dqni(k)=0. + Dqs(k) =0. ENDDO ENDIF @@ -6007,30 +6003,27 @@ SUBROUTINE DMP_mf( & ! Criteria (1) maxwidth = min(dx*dcut, lmax) !Criteria (2) - maxwidth = min(maxwidth, 1.1*PBLH) + maxwidth = min(maxwidth, 1.1_kind_phys*PBLH) ! Criteria (3) if ((landsea-1.5) .lt. 0) then !land - maxwidth = MIN(maxwidth, 0.5*cloud_base) + maxwidth = MIN(maxwidth, 0.5_kind_phys*cloud_base) else !water - maxwidth = MIN(maxwidth, 0.9*cloud_base) + maxwidth = MIN(maxwidth, 0.9_kind_phys*cloud_base) endif ! Criteria (4) - wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) + wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01_kind_phys)) !Note: area fraction (acfac) is modified below ! Criteria (5) - only a function of flt (not fltv) if ((landsea-1.5).LT.0) then !land - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.040)/0.03) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.040)/0.04) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.040)/0.04) + .5),1000._kind_phys), 0._kind_phys) else !water - !width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.003)/0.01) + .5),1000.), 0.) - width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.007)/0.02) + .5),1000.), 0.) + width_flx = MAX(MIN(1000.*(0.6*tanh((fltv - 0.007)/0.02) + .5),1000._kind_phys), 0._kind_phys) endif maxwidth = MIN(maxwidth, width_flx) minwidth = lmin !allow min plume size to increase in large flux conditions (eddy diffusivity should be !large enough to handle the representation of small plumes). - if (maxwidth .ge. (lmax - 1.0) .and. fltv .gt. 0.2)minwidth = lmin + dlmin*min((fltv-0.2)/0.3, 1.) + if (maxwidth .ge. (lmax - 1.0) .and. fltv .gt. 0.2)minwidth = lmin + dlmin*min((fltv-0.2)/0.3, 1._kind_phys) if (maxwidth .le. minwidth) then ! deactivate MF component nup2 = 0 @@ -6048,7 +6041,7 @@ SUBROUTINE DMP_mf( & ! Find coef C for number size density N cn = 0. d =-1.9 !set d to value suggested by Neggers 2015 (JAMES). - dl = (maxwidth - minwidth)/real(nup-1) + dl = (maxwidth - minwidth)/real(nup-1,kind=kind_phys) do i=1,NUP ! diameter of plume l = minwidth + dl*real(i-1) From 1abaff07fabc582e2ddaaf4977e337c85e5e9dfa Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Sun, 29 Oct 2023 15:42:36 -0500 Subject: [PATCH 076/132] module_mp_nssl_2mom.F90: fix bug when nz > 128 where sedimentation did not work for k > 128 --- physics/module_mp_nssl_2mom.F90 | 152 ++++++++++++++++++++++++-------- 1 file changed, 115 insertions(+), 37 deletions(-) diff --git a/physics/module_mp_nssl_2mom.F90 b/physics/module_mp_nssl_2mom.F90 index a88ffe053..ad90ec81f 100644 --- a/physics/module_mp_nssl_2mom.F90 +++ b/physics/module_mp_nssl_2mom.F90 @@ -4274,7 +4274,7 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! real gz(-nor+ng1:nz+nor),z1d(-nor+ng1:nz+nor,4) real dtp real xfall(nx,ny,na) ! array for stuff landing on the ground - real xfall0(nx,ny) ! dummy array +! real xfall0(nx,ny) ! dummy array integer infdo integer jslab ! which line of xfall to use @@ -4282,47 +4282,81 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & real tmp, vtmax, dtptmp, dtfrac real, parameter :: dz = 200. - real :: xvt(nz+1,nx,3,lc:lhab) ! (nx,nz,2,lc:lhab) ! 1=mass-weighted, 2=number-weighted - real :: tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) - real :: tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) - real :: z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab) - real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) +! real :: xvt(nz+1,nx,3,lc:lhab) ! (nx,nz,2,lc:lhab) ! 1=mass-weighted, 2=number-weighted +! real :: tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) +! real :: tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) +! real :: z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab) +! real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) - real :: rhovtzx(nz,nx) +! real :: rhovtzx(nz,nx) + + real, allocatable :: db1(:,:), dtz1(:,:,:),dz2dinv(:,:),db1inv(:,:) ! db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) + real, allocatable :: rhovtzx(:,:) + real, allocatable :: xfall0(:,:), xvt(:,:,:,:),tmpn(:,:,:),tmpn2(:,:,:),z(:,:,:) double precision :: timesed1,timesed2,timesed3, zmaxsed,timesetvt,dummy double precision :: dt1,dt2,dt3,dt4 - integer,parameter :: ngs = 128 + integer :: ngs ! = 512 integer :: ngscnt,mgs,ipconc0 - real :: qx(ngs,lv:lhab) - real :: qxw(ngs,ls:lhab) - real :: cx(ngs,lc:lhab) - real :: xv(ngs,lc:lhab) - real :: vtxbar(ngs,lc:lhab,3) - real :: xmas(ngs,lc:lhab) - real :: xdn(ngs,lc:lhab) - real :: xdia(ngs,lc:lhab,3) - real :: vx(ngs,li:lhab) - real :: alpha(ngs,lc:lhab) - real :: zx(ngs,lr:lhab) - logical :: hasmass(nx,lc+1:lhab) - - integer igs(ngs),kgs(ngs) - - real rho0(ngs),temcg(ngs) - - real temg(ngs) - - real rhovt(ngs) - - real cwnc(ngs),cinc(ngs) - real fadvisc(ngs),cwdia(ngs),cipmas(ngs) - - real cimasn,cimasx,cnina(ngs),cimas(ngs) - - real cnostmp(ngs) +! real :: qx(ngs,lv:lhab) +! real :: qxw(ngs,ls:lhab) +! real :: cx(ngs,lc:lhab) +! real :: xv(ngs,lc:lhab) +! real :: vtxbar(ngs,lc:lhab,3) +! real :: xmas(ngs,lc:lhab) +! real :: xdn(ngs,lc:lhab) +! real :: xdia(ngs,lc:lhab,3) +! real :: vx(ngs,li:lhab) +! real :: alpha(ngs,lc:lhab) +! real :: zx(ngs,lr:lhab) +! logical :: hasmass(nx,lc+1:lhab) +! +! integer igs(ngs),kgs(ngs) +! +! real rho0(ngs),temcg(ngs) +! +! real temg(ngs) +! +! real rhovt(ngs) +! +! real cwnc(ngs),cinc(ngs) +! real fadvisc(ngs),cwdia(ngs),cipmas(ngs) +! +! real cimasn,cimasx,cnina(ngs),cimas(ngs) +! +! real cnostmp(ngs) + + real, allocatable :: qx(:,:) + real, allocatable :: qxw(:,:) + real, allocatable :: cx(:,:) + real, allocatable :: xv(:,:) + real, allocatable :: vtxbar(:,:,:) + real, allocatable :: xmas(:,:) + real, allocatable :: xdn(:,:) + real, allocatable :: xdia(:,:,:) + real, allocatable :: vx(:,:) + real, allocatable :: alpha(:,:) + real, allocatable :: zx(:,:) + logical, allocatable :: hasmass(:,:) + + integer, allocatable :: igs(:),kgs(:) + + real, allocatable :: rho0(:),temcg(:) + + real, allocatable :: temg(:) + + real, allocatable :: rhovt(:) + + real, allocatable :: cwnc(:),cinc(:) + real, allocatable :: fadvisc(:),cwdia(:),cipmas(:) + + real, allocatable :: cnina(:),cimas(:) + + real, allocatable :: cnostmp(:) + + real :: cimasn,cimasx !----------------------------------------------------------------------------- @@ -4336,7 +4370,30 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! ################################################################### - + allocate( db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1),rhovtzx(nz,nx) ) + allocate( xfall0(nx,ny), xvt(nz+1,nx,3,lc:lhab), tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) ) + allocate( tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz), z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab)) + + ngs = nz+3 + + allocate( qx(ngs,lv:lhab), & + qxw(ngs,ls:lhab), & + cx(ngs,lc:lhab), & + xv(ngs,lc:lhab), & + vtxbar(ngs,lc:lhab,3), & + xmas(ngs,lc:lhab), & + xdn(ngs,lc:lhab), & + xdia(ngs,lc:lhab,3), & + vx(ngs,li:lhab), & + alpha(ngs,lc:lhab), & + zx(ngs,lr:lhab), & + hasmass(nx,lc+1:lhab), & + igs(ngs),kgs(ngs), & + rho0(ngs),temcg(ngs),temg(ngs), rhovt(ngs), & + cwnc(ngs),cinc(ngs), & + fadvisc(ngs),cwdia(ngs),cipmas(ngs), & + cnina(ngs),cimas(ngs), & + cnostmp(ngs) ) kzb = 1 kze = nz @@ -4656,8 +4713,29 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDDO ! ix + deallocate( db1,dtz1,dz2dinv,db1inv,rhovtzx ) + deallocate( xfall0, xvt, tmpn ) + deallocate( tmpn2, z) + + deallocate( qx, & + qxw, & + cx, & + xv, & + vtxbar, & + xmas, & + xdn, & + xdia, & + vx, & + alpha, & + zx, & + hasmass, & + igs,kgs, & + rho0,temcg,temg, rhovt, & + cwnc,cinc, & + fadvisc,cwdia,cipmas, & + cnina,cimas, & + cnostmp ) - RETURN END SUBROUTINE SEDIMENT1D From b2dc0bf4eb3de74c43cf447ecac18578a4587167 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Sun, 29 Oct 2023 20:51:30 +0000 Subject: [PATCH 077/132] Adding some comments to describe overall changes. --- physics/module_bl_mynn.F90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index 4b47b43a7..a636a4fe8 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -232,6 +232,18 @@ ! bl_mynn_cloudpdf = 2 (Chab-Becht). ! Removed WRF_CHEM dependencies. ! Many miscellaneous tweaks. +! v4.5.2 / CCPP +! Some code optimization. Removed many conditions from loops. Redesigned the mass- +! flux scheme to use 8 plumes instead of a variable n plumes. This results in +! the removal of the output variable "nudprafts" and adds maxwidth and ztop_plume. +! Revision option bl_mynn_cloudpdf = 2, which now ensures cloud fractions for all +! optically relevant mixing ratios (tip from Greg Thompson). Also, added flexibility +! for tuning near-surface cloud fractions to remove excess fog/low ceilings. +! Now outputs all SGS cloud mixing ratios as grid-mean values, not in-cloud. This +! results in a change in the pre-radiation code to no longer multiply mixing ratios +! by cloud fractions. +! Lots of code cleanup: removal of test code, comments, changing text case, etc. +! Many misc tuning/tweaks. ! ! Many of these changes are now documented in references listed above. !==================================================================== From 5658192be2595309ba44e258c86d831275149991 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Mon, 30 Oct 2023 19:12:02 +0000 Subject: [PATCH 078/132] fix typo --- physics/module_bl_mynn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index a636a4fe8..e522b65eb 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3879,7 +3879,7 @@ SUBROUTINE mym_condensation (kts,kte, & q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif - !ensure adequate RH & q1 when qs is at least 1e-7 (above the PBLH) + !ensure adequate RH & q1 when qs is at least 1e-8 (above the PBLH) if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(8.0 + log10(qs(k)))) rh(k) =max(rh(k), rh_hack) From d4835d1bfe04f1dd3753f08b9d7f1baa37942a1f Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 30 Oct 2023 19:31:09 +0000 Subject: [PATCH 079/132] Address reviewers comments. --- CMakeLists.txt | 54 +++++++++---------- physics/SFC_Models/Land/Noah/lsm_noah.meta | 2 +- .../Land/{ => Noah}/namelist_soilveg.f | 0 .../SFC_Models/Land/{ => Noah}/set_soilveg.f | 0 physics/SFC_Models/Land/Noahmp/noahmpdrv.meta | 3 +- 5 files changed, 30 insertions(+), 29 deletions(-) rename physics/SFC_Models/Land/{ => Noah}/namelist_soilveg.f (100%) rename physics/SFC_Models/Land/{ => Noah}/set_soilveg.f (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 97591a2ee..bac0637a4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -79,37 +79,37 @@ get_filename_component(LOCAL_CURRENT_SOURCE_DIR ${FULL_PATH_TO_CMAKELISTS} DIREC #------------------------------------------------------------------------------ # List of files that need to be compiled without OpenMP -set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_byband.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_heating_rates.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_fluxes_bygpoint.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/mo_compute_bc.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_config.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_source_functions.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_sw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_fluxes.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_lw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_util_array.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_rte_kind.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/rte-rrtmgp/rte/mo_optical_props.F90) +set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_fluxes_byband.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_fluxes_bygpoint.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_compute_bc.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_config.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_source_functions.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_sw.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_fluxes.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_lw.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_util_array.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_kind.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_optical_props.F90) # List of files that need to be compiled with different precision set(SCHEMES_DYNAMICS) -if(${LOCAL_CURRENT_SOURCE_DIR}/physics/fv_sat_adj.F90 IN_LIST SCHEMES) - list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/fv_sat_adj.F90) +if(${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90fv_sat_adj.F90 IN_LIST SCHEMES) + list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90/fv_sat_adj.F90) endif() # Remove files that need to be compiled with different precision diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index 07f4045a2..44cb6aa5b 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -2,7 +2,7 @@ name = lsm_noah type = scheme dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F - dependencies = ../set_soilveg.f,sflx.f,surface_perturbation.F90 + dependencies = set_soilveg.f,sflx.f,surface_perturbation.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Land/namelist_soilveg.f b/physics/SFC_Models/Land/Noah/namelist_soilveg.f similarity index 100% rename from physics/SFC_Models/Land/namelist_soilveg.f rename to physics/SFC_Models/Land/Noah/namelist_soilveg.f diff --git a/physics/SFC_Models/Land/set_soilveg.f b/physics/SFC_Models/Land/Noah/set_soilveg.f similarity index 100% rename from physics/SFC_Models/Land/set_soilveg.f rename to physics/SFC_Models/Land/Noah/set_soilveg.f diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index e7a73ef99..64372bdb8 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -2,7 +2,8 @@ name = noahmpdrv type = scheme dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F - dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90,../set_soilveg.f + dependencies = module_sf_noahmp_glacier.F90,module_sf_noahmplsm.F90,noahmp_tables.f90 + dependencies = ../Noah/set_soilveg.f ######################################################################## [ccpp-arg-table] From 1d3118299e53cf4a6d25367f27caefbe586d2909 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 31 Oct 2023 02:42:41 +0000 Subject: [PATCH 080/132] More metatdata changes --- .../Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta | 2 +- .../Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index 8a35d469c..f35510ed2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -7,7 +7,7 @@ dependencies = Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90,Interstitials/UFS_SCM_NEPTUNE/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 - dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 + dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = photochem/ozinterp.f90,photochem/ozne_def.f dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index 86c052b0e..c885e7c2a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -6,7 +6,7 @@ dependencies = Interstitials/UFS_SCM_NEPTUNE/iccn_def.F,Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 - dependencies = SFC_Models/Land/namelist_soilveg.f,SFC_Models/Land/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 + dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 dependencies = photochem/ozinterp.f90,photochem/ozne_def.f dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 dependencies = GWD/cires_tauamf_data.F90 From e10030bf5a9578046d04adef261440bf9173013f Mon Sep 17 00:00:00 2001 From: Ted Mansell Date: Thu, 2 Nov 2023 13:28:39 -0500 Subject: [PATCH 081/132] mp_nssl.F90: space formatting --- physics/mp_nssl.F90 | 233 ++++++++++++++++++++++---------------------- 1 file changed, 115 insertions(+), 118 deletions(-) diff --git a/physics/mp_nssl.F90 b/physics/mp_nssl.F90 index aacf4c3dd..e79376709 100644 --- a/physics/mp_nssl.F90 +++ b/physics/mp_nssl.F90 @@ -26,12 +26,12 @@ module mp_nssl !! \htmlinclude mp_nssl_init.html !! subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & - mpirank, mpiroot, & - con_g, con_rd, con_cp, con_rv, & - con_t0c, con_cliq, con_csol, con_eps, & - imp_physics, imp_physics_nssl, & - nssl_cccn, nssl_alphah, nssl_alphahl, & - nssl_alphar, nssl_ehw0, nssl_ehlw0, & + mpirank, mpiroot, & + con_g, con_rd, con_cp, con_rv, & + con_t0c, con_cliq, con_csol, con_eps, & + imp_physics, imp_physics_nssl, & + nssl_cccn, nssl_alphah, nssl_alphahl, & + nssl_alphar, nssl_ehw0, nssl_ehlw0, & nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment ) @@ -134,7 +134,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! write(0,*) 'call nssl_2mom_init' CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=ipc,mixphase=0, & - ihvol=ihailv,nssl_ehw0=nssl_ehw0,nssl_ehlw0=nssl_ehlw0,errmsg=errmsg, & + ihvol=ihailv,nssl_ehw0=nssl_ehw0,nssl_ehlw0=nssl_ehlw0,errmsg=errmsg, & nssl_alphar=nssl_alphar, & nssl_alphah=nssl_alphah, & nssl_alphahl=nssl_alphahl, & @@ -165,19 +165,18 @@ end subroutine mp_nssl_init !! \htmlinclude mp_nssl_run.html !! subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & -! spechum, cccn, qc, qr, qi, qs, qh, qhl, & - spechum, cccn, cccna, qc, qr, qi, qs, qh, qhl, & - ccw, crw, cci, csw, chw, chl, vh, vhl, & - zrw, zhw, zhl, & - tgrs, prslk, prsl, phii, omega, dtp, & - prcp, rain, graupel, ice, snow, sr, & + spechum, cccn, cccna, qc, qr, qi, qs, qh, qhl, & + ccw, crw, cci, csw, chw, chl, vh, vhl, & + zrw, zhw, zhl, & + tgrs, prslk, prsl, phii, omega, dtp, & + prcp, rain, graupel, ice, snow, sr, & refl_10cm, do_radar_ref, first_time_step, restart, & - re_cloud, re_ice, re_snow, re_rain, & - nleffr, nieffr, nseffr, nreffr, & - imp_physics, convert_dry_rho, & - imp_physics_nssl, nssl_ccn_on, & - nssl_hail_on, nssl_invertccn, nssl_3moment, & - ntccn, ntccna, & + re_cloud, re_ice, re_snow, re_rain, & + nleffr, nieffr, nseffr, nreffr, & + imp_physics, convert_dry_rho, & + imp_physics_nssl, nssl_ccn_on, & + nssl_hail_on, nssl_invertccn, nssl_3moment, & + ntccn, ntccna, & errflg, errmsg) use module_mp_nssl_2mom, only: calcnfromq, na @@ -602,116 +601,114 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & IF ( nssl_ccn_on ) THEN - - CALL nssl_2mom_driver( & - ITIMESTEP=itimestep, & - ! TH=th, & - tt=tgrs, & - QV=qv_mp, & - QC=qc_mp, & - QR=qr_mp, & - QI=qi_mp, & - QS=qs_mp, & - QH=qh_mp, & - QHL=qhl_mp, & - CCW=nc_mp, & - CRW=nr_mp, & - CCI=ni_mp, & - CSW=ns_mp, & - CHW=nh_mp, & - CHL=nhl_mp, & - VHW=vh_mp, & - VHL=vhl_mp, & - cn=cn_mp, & - ZRW=zrw_mp, & - ZHW=zhw_mp, & - ZHL=zhl_mp, & -! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use - cna=cna_mp, f_cna=.false. , & - PII=prslk, & - P=prsl, & - W=w, & - DZ=dz, & - DTP=dtptmp, & - DN=rho, & - rainnc=xrain_mp, rainncv=xdelta_rain_mp, & - snownc=xsnow_mp, snowncv=xdelta_snow_mp, & -! icenc=ice_mp, icencv=delta_ice_mp, & - GRPLNC=xgraupel_mp, GRPLNCV=xdelta_graupel_mp, sr=sr, & - dbz = refl_10cm, & -! nssl_progn=.false., & - diagflag = diagflag, & - errmsg=errmsg,errflg=errflg, & - re_cloud=re_cloud_mp, & - re_ice=re_ice_mp, & - re_snow=re_snow_mp, & - re_rain=re_rain_mp, & - has_reqc=has_reqc, & ! ala G. Thompson - has_reqi=has_reqi, & ! ala G. Thompson - has_reqs=has_reqs, & ! ala G. Thompson - has_reqr=has_reqr, & + CALL nssl_2mom_driver( & + ITIMESTEP=itimestep, & + ! TH=th, & + tt=tgrs, & + QV=qv_mp, & + QC=qc_mp, & + QR=qr_mp, & + QI=qi_mp, & + QS=qs_mp, & + QH=qh_mp, & + QHL=qhl_mp, & + CCW=nc_mp, & + CRW=nr_mp, & + CCI=ni_mp, & + CSW=ns_mp, & + CHW=nh_mp, & + CHL=nhl_mp, & + VHW=vh_mp, & + VHL=vhl_mp, & + cn=cn_mp, & + ZRW=zrw_mp, & + ZHW=zhw_mp, & + ZHL=zhl_mp, & +! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use + cna=cna_mp, f_cna=.false. , & + PII=prslk, & + P=prsl, & + W=w, & + DZ=dz, & + DTP=dtptmp, & + DN=rho, & + rainnc=xrain_mp, rainncv=xdelta_rain_mp, & + snownc=xsnow_mp, snowncv=xdelta_snow_mp, & + GRPLNC=xgraupel_mp, & + GRPLNCV=xdelta_graupel_mp, & + sr=sr, & + dbz = refl_10cm, & + diagflag = diagflag, & + errmsg=errmsg,errflg=errflg, & + re_cloud=re_cloud_mp, & + re_ice=re_ice_mp, & + re_snow=re_snow_mp, & + re_rain=re_rain_mp, & + has_reqc=has_reqc, & + has_reqi=has_reqi, & + has_reqs=has_reqs, & + has_reqr=has_reqr, & 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 & ) - ELSE - CALL nssl_2mom_driver( & - ITIMESTEP=itimestep, & - ! TH=th, & - tt=tgrs, & - QV=qv_mp, & - QC=qc_mp, & - QR=qr_mp, & - QI=qi_mp, & - QS=qs_mp, & - QH=qh_mp, & - QHL=qhl_mp, & -! CCW=qnc_mp, & - CCW=nc_mp, & - CRW=nr_mp, & - CCI=ni_mp, & - CSW=ns_mp, & - CHW=nh_mp, & - CHL=nhl_mp, & - VHW=vh_mp, & - VHL=vhl_mp, & - ZRW=zrw_mp, & - ZHW=zhw_mp, & - ZHL=zhl_mp, & - ! cn=cccn, & - PII=prslk, & - P=prsl, & - W=w, & - DZ=dz, & - DTP=dtptmp, & - DN=rho, & - rainnc=xrain_mp, rainncv=xdelta_rain_mp, & - snownc=xsnow_mp, snowncv=xdelta_snow_mp, & -! icenc=ice_mp, icencv=delta_ice_mp, & - GRPLNC=xgraupel_mp, GRPLNCV=xdelta_graupel_mp, sr=sr, & - dbz = refl_10cm, & -! nssl_progn=.false., & - diagflag = diagflag, & - errmsg=errmsg,errflg=errflg, & - re_cloud=re_cloud_mp, & - re_ice=re_ice_mp, & - re_snow=re_snow_mp, & - re_rain=re_rain_mp, & - has_reqc=has_reqc, & ! ala G. Thompson - has_reqi=has_reqi, & ! ala G. Thompson - has_reqs=has_reqs, & ! ala G. Thompson - has_reqr=has_reqr, & + CALL nssl_2mom_driver( & + ITIMESTEP=itimestep, & + ! TH=th, & + tt=tgrs, & + QV=qv_mp, & + QC=qc_mp, & + QR=qr_mp, & + QI=qi_mp, & + QS=qs_mp, & + QH=qh_mp, & + QHL=qhl_mp, & + CCW=nc_mp, & + CRW=nr_mp, & + CCI=ni_mp, & + CSW=ns_mp, & + CHW=nh_mp, & + CHL=nhl_mp, & + VHW=vh_mp, & + VHL=vhl_mp, & +! cn=cn_mp, & + ZRW=zrw_mp, & + ZHW=zhw_mp, & + ZHL=zhl_mp, & +! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use +! cna=cna_mp, f_cna=.false. , & + PII=prslk, & + P=prsl, & + W=w, & + DZ=dz, & + DTP=dtptmp, & + DN=rho, & + rainnc=xrain_mp, rainncv=xdelta_rain_mp, & + snownc=xsnow_mp, snowncv=xdelta_snow_mp, & + GRPLNC=xgraupel_mp, & + GRPLNCV=xdelta_graupel_mp, & + sr=sr, & + dbz = refl_10cm, & + diagflag = diagflag, & + errmsg=errmsg,errflg=errflg, & + re_cloud=re_cloud_mp, & + re_ice=re_ice_mp, & + re_snow=re_snow_mp, & + re_rain=re_rain_mp, & + has_reqc=has_reqc, & + has_reqi=has_reqi, & + has_reqs=has_reqs, & + has_reqr=has_reqr, & 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 & ) - + ENDIF - - + DO i = 1,ncol delta_rain_mp(i) = delta_rain_mp(i) + xdelta_rain_mp(i) ! this is liquid equivalent of all precip delta_graupel_mp(i) = delta_graupel_mp(i) + xdelta_graupel_mp(i) ! this is liquid equivalent of graupel @@ -720,7 +717,7 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ENDDO ENDDO - + ENDIF From e0991a8a2c653ffe989d2e77ea2ecc018512b294 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 2 Nov 2023 19:57:39 +0000 Subject: [PATCH 082/132] Removed requested by the reviewer commented lines. --- physics/module_sf_ruclsm.F90 | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 74d2719d4..47c03c49d 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1521,7 +1521,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ENDIF if(snhei.gt.0.0081_kind_phys*rhowater/rhosn) then -!*** Update snow density for current temperature (Koren et al. 1999) +!*** Update snow density for current temperature (Koren et al 1999,doi:10.1029/1999JD900232.) BSN=delt/3600._kind_phys*c1sn*exp(0.08_kind_phys*min(zero,tsnav)-c2sn*rhosn*1.e-3_kind_phys) if(bsn*snwe*100._kind_phys.lt.1.e-4_kind_phys) goto 777 XSN=rhosn*(exp(bsn*snwe*100._kind_phys)-one)/(bsn*snwe*100._kind_phys) @@ -4079,11 +4079,8 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is tuning parameter added by tgs based on 4 Jan 2017 testing - !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - !fact = 2._kind_phys endif if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then @@ -4536,11 +4533,8 @@ SUBROUTINE SNOWSEAICE( debug_print,xlat,xlon, & fact = one if(rhosn < 156._kind_phys .or. (newsn > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is a tuning parameter - !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - !fact = 2._kind_phys endif if(newsnow <= zero .and. snhei > one .and. rhosn > 250._kind_phys) then @@ -5213,11 +5207,8 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is a tuning parameter - !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - !fact = 2._kind_phys if(debug_print) then print *,'SnowTemp xlat,xlon,rhosn,keff', xlat,xlon,rhosn,keff,keff/rhocsn*fact print *,'SNOWTEMP - 0.265/rhocsn',0.265_kind_phys/rhocsn @@ -5789,11 +5780,8 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & fact = one if(rhosn < 156._kind_phys .or. (newsnow > zero .and. rhonewsn < 156._kind_phys)) then keff = 0.023_kind_phys + 0.234_kind_phys * rhosn * 1.e-3_kind_phys - !-- fact is a tuning parameter - !fact = 5._kind_phys else keff = 0.138_kind_phys - 1.01_kind_phys * rhosn*1.e-3_kind_phys + 3.233_kind_phys * rhosn**2 * 1.e-6_kind_phys - !fact = 2._kind_phys if(debug_print) then print *,'End SNOWTEMP - xlat,xlon,rhosn,keff',xlat,xlon,rhosn,keff print *,'End SNOWTEMP - 0.265/rhocsn',0.265/rhocsn From 0dce0a55dbced9c3dcae8da900b836b3128138d5 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Thu, 2 Nov 2023 20:03:59 +0000 Subject: [PATCH 083/132] Convective reflectivity added for NSSL,Thompson mp,SAS,GF shal/deep --- physics/GFS_MP_generic_post.F90 | 71 ++++++++++++++++++++++++++++++-- physics/GFS_MP_generic_post.meta | 58 ++++++++++++++++++++++++++ 2 files changed, 125 insertions(+), 4 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 201c0e817..4b4907aea 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -21,7 +21,8 @@ module GFS_MP_generic_post subroutine GFS_MP_generic_post_run( & im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_nssl, & imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, rhowater, rainmin, dtf, & - frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_q, & + frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice,phil,htop,refl_10cm, & + imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf,snow, graupel, save_t, save_q, & rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp,& totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, & pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & @@ -40,12 +41,14 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma, exticeden integer, intent(in) :: index_of_temperature,index_of_process_mp,use_lake_model(:) - +!aligo + integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf + integer, dimension (:), intent(in) :: htop integer :: dfi_radar_max_intervals real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour real(kind=kind_phys), intent(in) :: radar_tten_limits(:) integer :: ix_dfi_radar(:) - real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0 + real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0,refl_10cm real(kind=kind_phys), intent(in) :: dtf, frain, con_g, rainmin, rhowater real(kind=kind_phys), dimension(:), intent(in) :: rain1, xlat, xlon, tsfc @@ -53,7 +56,7 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), dimension(:), intent(in) :: rain0, ice0, snow0, graupel0 real(kind=kind_phys), dimension(:,:), intent(in) :: rann real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, save_t, del - real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii + real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii,phil real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q real(kind=kind_phys), dimension(:,:,:), intent(in) :: dfi_radar_tten @@ -112,6 +115,18 @@ subroutine GFS_MP_generic_post_run( real :: snowrat,grauprat,icerat,curat,prcpncfr,prcpcufr real :: rhonewsnow,rhoprcpice,rhonewgr,rhonewice +!aligo + real(kind_phys), parameter :: dbzmin=-20.0 + real(kind_phys) :: cuprate + real(kind_phys) :: ze, ze_conv, dbz_sum + + real(kind_phys), dimension(1:im,1:levs) :: zo + real(kind_phys), dimension(1:im) :: zfrz + real(kind_phys), dimension(1:im) :: factor + real(kind_phys) ze_mp, fctz, delz, xlatd,xlond + logical :: lfrz + + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -121,6 +136,54 @@ subroutine GFS_MP_generic_post_run( do i = 1, im rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo +! +! Combine convective reflectivity with MP reflectivity for selected +! parameterizations. + if (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl .and. imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf .or. imfshalcnv == imfshalcnv_gf) then + do i=1,im + lfrz = .true. + zfrz(i) = phil(i,1) / con_g + do k = levs, 2, -1 + zo(i,k) = phil(i,k) / con_g + if (gt0(i,k) >= 273.16 .and. lfrz) then + zfrz(i) = zo(i,k) + lfrz = .false. + endif + enddo + enddo + + do i=1,im + factor(i) = 0.0 + enddo + + do i=1,im + if(rainc (i) > 0.0 .or. htop(i) > 0) then + factor(i) = -2./max(1000., zo(i,htop(i)) - zfrz(i)) + endif + enddo + +! combine the reflectivity from both Thompson MP and samfdeep convection + + do k=1,levs + do i=1,im + if(rainc(i) > 0. .and. k <= htop(i)) then + fctz = 0.0 + delz = zo(i,k) - zfrz(i) + if(delz <0.0) then + fctz = 1. ! wrong + else + fctz = 10.**(factor(i)*delz) + endif + cuprate = rainc(i) * 3.6e6 / dtp ! cu precip rate (mm/h) + ze_conv = 300.0 * cuprate**1.4 + ze_conv = fctz * ze_conv + ze_mp = 10._kind_phys ** (0.1 * refl_10cm(i,k)) + dbz_sum = max(DBZmin, 10.*log10(ze_mp + ze_conv)) + refl_10cm(i,k) = dbz_sum + endif + enddo + enddo + endif ! compute surface snowfall, graupel/sleet, freezing rain and precip ice density if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl ) then diff --git a/physics/GFS_MP_generic_post.meta b/physics/GFS_MP_generic_post.meta index 7cd2ca4b5..9bc7dcffe 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/GFS_MP_generic_post.meta @@ -254,6 +254,64 @@ type = real kind = kind_phys intent = in +[phil] + standard_name = geopotential + long_name = layer geopotential + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[htop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = out +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[imfshalcnv] + standard_name = control_for_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfshalcnv_gf] + standard_name = identifier_for_grell_freitas_shallow_convection + long_name = flag for Grell-Freitas shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv] + standard_name = control_for_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_gf] + standard_name = identifier_for_grell_freitas_deep_convection + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_samf] + standard_name = identifer_for_scale_aware_mass_flux_deep_convection + long_name = flag for SAMF deep convection scheme + units = flag + dimensions = () + type = integer + intent = in [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature From 6d62ab84c22b60033dec92d7f90ac3643b83da8c Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Fri, 3 Nov 2023 16:57:46 +0000 Subject: [PATCH 084/132] Better range checks for output in surface layer, tweaked cloud fractions. last commit before reg tests --- physics/module_bl_mynn.F90 | 21 +++++++++++---------- physics/module_sf_mynn.F90 | 6 +++--- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index e522b65eb..6840f80bf 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -3638,7 +3638,8 @@ SUBROUTINE mym_condensation (kts,kte, & real(kind_phys), parameter :: qpct_sfc=0.025 real(kind_phys), parameter :: qpct_pbl=0.030 real(kind_phys), parameter :: qpct_trp=0.040 - real(kind_phys), parameter :: rhcrit =0.83 !for hom pdf min sigma + real(kind_phys), parameter :: rhcrit =0.83 !for cloudpdf = 2 + real(kind_phys), parameter :: rhmax =1.01 !for cloudpdf = 2 integer :: i,j,k real(kind_phys):: erf @@ -3821,7 +3822,7 @@ SUBROUTINE mym_condensation (kts,kte, & t = th(k)*exner(k) xl = xl_blend(t) ! obtain latent heat qsat_tk= qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k) = MAX(MIN(1.0_kind_phys,qw(k)/MAX(1.E-10,qsat_tk)),0.001_kind_phys) + rh(k) = MAX(MIN(rhmax, qw(k)/MAX(1.E-10,qsat_tk)),0.001_kind_phys) !dqw/dT: Clausius-Clapeyron dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) @@ -3863,28 +3864,28 @@ SUBROUTINE mym_condensation (kts,kte, & !Add condition for falling/settling into low-RH layers, so at least !some cloud fraction is applied for all qc, qs, and qi. rh_hack= rh(k) - !ensure adequate RH & q1 when qi is at least 1e-9 - if (qi(k)>1.e-9) then - rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(9.0 + log10(qi(k)))) + !ensure adequate RH & q1 when qi is at least 1e-9 (above the PBLH) + if (qi(k)>1.e-9 .and. zagl .gt. pblh2) then + rh_hack =min(rhmax, rhcrit + 0.07*(9.0 + log10(qi(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 - q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif !ensure adequate RH & q1 when qc is at least 1e-6 if (qc(k)>1.e-6) then - rh_hack =min(1.0_kind_phys, rhcrit + 0.09*(6.0 + log10(qc(k)))) + rh_hack =min(rhmax, rhcrit + 0.09*(6.0 + log10(qc(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 - q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif !ensure adequate RH & q1 when qs is at least 1e-8 (above the PBLH) if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then - rh_hack =min(1.0_kind_phys, rhcrit + 0.07*(8.0 + log10(qs(k)))) + rh_hack =min(rhmax, rhcrit + 0.07*(8.0 + log10(qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 - q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index 048a5c696..3d847348d 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -947,7 +947,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_lnd(I) = TSK_lnd(I)*THCON(I) !(K) THVSK_lnd(I) = THSK_lnd(I)*(1.+EP1*qsfc_lnd(I)) - if(THVSK_lnd(I) < 170. .or. THVSK_lnd(I) > 360.) & + if(THVSK_lnd(I) < 160. .or. THVSK_lnd(I) > 390.) & print *,'THVSK_lnd(I)',itimestep,i,THVSK_lnd(I),THSK_lnd(i),tsurf_lnd(i),tskin_lnd(i),qsfc_lnd(i) endif if(icy(i)) then @@ -956,7 +956,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_ice(I) = TSK_ice(I)*THCON(I) !(K) THVSK_ice(I) = THSK_ice(I)*(1.+EP1*qsfc_ice(I)) !(K) - if(THVSK_ice(I) < 170. .or. THVSK_ice(I) > 360.) & + if(THVSK_ice(I) < 160. .or. THVSK_ice(I) > 390.) & print *,'THVSK_ice(I)',itimestep,i,THVSK_ice(I),THSK_ice(i),tsurf_ice(i),tskin_ice(i),qsfc_ice(i) endif if(wet(i)) then @@ -965,7 +965,7 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ! CONVERT SKIN TEMPERATURES TO POTENTIAL TEMPERATURE: THSK_wat(I) = TSK_wat(I)*THCON(I) !(K) THVSK_wat(I) = THSK_wat(I)*(1.+EP1*QVSH(I)) !(K) - if(THVSK_wat(I) < 170. .or. THVSK_wat(I) > 360.) & + if(THVSK_wat(I) < 160. .or. THVSK_wat(I) > 390.) & print *,'THVSK_wat(I)',i,THVSK_wat(I),THSK_wat(i),tsurf_wat(i),tskin_wat(i),qsfc_wat(i) endif endif ! flag_iter From ce7a3c013f24d0442ced8d9cc6a30250520504c8 Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Fri, 3 Nov 2023 13:35:30 -0600 Subject: [PATCH 085/132] Updates to Thompson MP after code review --- physics/module_mp_thompson.F90 | 32 +------------------ ...mp_thompson_make_number_concentrations.F90 | 7 ++-- 2 files changed, 4 insertions(+), 35 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index b1e5875da..fd5a6e770 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -2469,16 +2469,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - ! do k = kte, kts, -1 - ! ygra1 = alog10(max(1.E-9, rg(k))) - ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - ! N0_exp = 10.**(zans1) - ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ! ilamg(k) = 1./lamg - ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - ! enddo call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif @@ -3546,16 +3536,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - ! do k = kte, kts, -1 - ! ygra1 = alog10(max(1.E-9, rg(k))) - ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - ! N0_exp = 10.**(zans1) - ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ! ilamg(k) = 1./lamg - ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - ! enddo call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif @@ -6101,16 +6081,6 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ if (ANY(L_qg .eqv. .true.)) then - ! do k = kte, kts, -1 - ! ygra1 = alog10(max(1.E-9, rg(k))) - ! zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 - ! N0_exp = 10.**(zans1) - ! N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - ! lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 - ! lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg - ! ilamg(k) = 1./lamg - ! N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) - ! enddo call graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) endif @@ -6517,7 +6487,7 @@ subroutine graupel_psd_parameters(kts, kte, rand1, rg, ilamg, N0_g) ygra1 = alog10(max(1.e-9, rg(k))) zans1 = 3.4 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) - N0_exp = max1(dble(gonv_min), min(N0_exp, dble(gonv_max))) + N0_exp = max(dble(gonv_min), min(N0_exp, dble(gonv_max))) lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg ilamg(k) = 1./lamg diff --git a/physics/module_mp_thompson_make_number_concentrations.F90 b/physics/module_mp_thompson_make_number_concentrations.F90 index 496942f21..72a1055dd 100644 --- a/physics/module_mp_thompson_make_number_concentrations.F90 +++ b/physics/module_mp_thompson_make_number_concentrations.F90 @@ -4,7 +4,6 @@ !>\ingroup aathompson module module_mp_thompson_make_number_concentrations - use machine, only : kind_phys use physcons, only: PI => con_pi implicit none @@ -36,7 +35,7 @@ elemental real function make_IceNumber (Q_ice, temp) !IMPLICIT NONE REAL, PARAMETER:: Ice_density = 890.0 !REAL, PARAMETER:: PI = 3.1415926536 - real(kind_phys), intent(in):: Q_ice, temp + real, intent(in):: Q_ice, temp integer idx_rei real corr, reice, deice double precision lambda @@ -135,7 +134,7 @@ elemental real function make_DropletNumber (Q_cloud, qnwfa) !IMPLICIT NONE - real(kind_phys), intent(in):: Q_cloud, qnwfa + real, intent(in):: Q_cloud, qnwfa !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. @@ -174,7 +173,7 @@ elemental real function make_RainNumber (Q_rain, temp) IMPLICIT NONE - real(kind_phys), intent(in):: Q_rain, temp + real, intent(in):: Q_rain, temp double precision:: lambda, N0, qnr !real, parameter:: PI = 3.1415926536 real, parameter:: am_r = PI*1000./6. From 551e50387c12192ded6965a83818db4bdad41144 Mon Sep 17 00:00:00 2001 From: joeolson42 Date: Fri, 3 Nov 2023 19:53:45 +0000 Subject: [PATCH 086/132] removing the effective radii limit due to concerns by GFS developers --- 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 fd5a6e770..4e0e2b79e 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -5849,7 +5849,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & endif lamc = (nc(k)*am_r*g_ratio(inu_c)/rc(k))**obmr re_qc1d(k) = SNGL(0.5D0 * DBLE(3.+inu_c)/lamc) - if (lsml .ne. 1) re_qc1d(k) = max(re_qc1d(k), 7.0E-6) enddo endif From 571cb5941ad1089c207469145c78f57820773dce Mon Sep 17 00:00:00 2001 From: Anders Jensen Date: Fri, 3 Nov 2023 18:44:48 -0600 Subject: [PATCH 087/132] Bug fix for divide by zero in hail size --- physics/module_mp_thompson.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 4e0e2b79e..44e552160 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -6527,6 +6527,8 @@ function hail_mass_99th_percentile(kts, kte, qg, temperature, pressure, qv) resu rho(k) = 0.622*pressure(k)/(R*temperature(k)*(max(1.e-10, qv(k))+0.622)) if (qg(k) .gt. R1) then rg(k) = qg(k)*rho(k) + else + rg(k) = R1 endif enddo From a61a78b08528ea132f9e42a0921f012f2524dc1a Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Sun, 5 Nov 2023 16:34:39 +0000 Subject: [PATCH 088/132] Bug fix: htop set to intent in and modified if condition for convective reflectivity --- physics/GFS_MP_generic_post.F90 | 3 ++- physics/GFS_MP_generic_post.meta | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 4b4907aea..682263fc4 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -139,7 +139,8 @@ subroutine GFS_MP_generic_post_run( ! ! Combine convective reflectivity with MP reflectivity for selected ! parameterizations. - if (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl .and. imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf .or. imfshalcnv == imfshalcnv_gf) then + if ( (imp_physics==imp_physics_thompson .or. imp_physics==imp_physics_nssl) .and. & + (imfdeepcnv==imfdeepcnv_samf .or. imfdeepcnv==imfdeepcnv_gf .or. imfshalcnv==imfshalcnv_gf) ) then do i=1,im lfrz = .true. zfrz(i) = phil(i,1) / con_g diff --git a/physics/GFS_MP_generic_post.meta b/physics/GFS_MP_generic_post.meta index 9bc7dcffe..0660a533a 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/GFS_MP_generic_post.meta @@ -268,7 +268,7 @@ units = index dimensions = (horizontal_loop_extent) type = integer - intent = out + intent = in [refl_10cm] standard_name = radar_reflectivity_10cm long_name = instantaneous refl_10cm From 9d59ccac9ff77742ae9e417102291b1c08a36fa8 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 6 Nov 2023 10:49:52 -0500 Subject: [PATCH 089/132] add kind_phys where missing --- physics/module_nst_water_prop.f90 | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 6a183da52..7f0f480ae 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -42,7 +42,7 @@ module module_nst_water_prop ! ------------------------------------------------------ !>\ingroup gfs_nst_main_mod !! This subroutine computes thermal expansion coefficient (alpha) -!! and saline contraction coefficient (beta). +!! and saline contraction coefficient (beta). subroutine rhocoef(t, s, rhoref, alpha, beta) ! ------------------------------------------------------ @@ -124,7 +124,7 @@ end subroutine density !====================== ! !>\ingroup gfs_nst_main_mod -!! This subroutine computes the fraction of the solar radiation absorbed +!! This subroutine computes the fraction of the solar radiation absorbed !! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_ps_9b(z,fxp) ! @@ -138,10 +138,11 @@ elemental subroutine sw_ps_9b(z,fxp) ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! implicit none - real,intent(in):: z - real,intent(out):: fxp - real, dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp + real(kind=kind_phys), dimension(9), parameter :: & + f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & + ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>0) then fxp=1.0-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & @@ -159,7 +160,7 @@ end subroutine sw_ps_9b !====================== ! !>\ingroup gfs_nst_main_mod -!! This subroutine +!! This subroutine elemental subroutine sw_ps_9b_aw(z,aw) ! ! d(fw)/d(z) for 9-band @@ -171,10 +172,11 @@ elemental subroutine sw_ps_9b_aw(z,aw) ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! implicit none - real,intent(in):: z - real,intent(out):: aw - real, dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + real(kind=kind_phys), dimension(9), parameter :: & + f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & + ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>0) then aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & From 793ec64226a3f9bcabe6cf67c937b5b473ac7c24 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 9 Nov 2023 12:54:23 -0500 Subject: [PATCH 090/132] add extra condition in line 2655 of module_sf_noahmp_glacier.F90 to avoid FPE errors in some tests --- physics/module_sf_noahmp_glacier.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/module_sf_noahmp_glacier.F90 b/physics/module_sf_noahmp_glacier.F90 index 6e34c43af..fcbe40a70 100644 --- a/physics/module_sf_noahmp_glacier.F90 +++ b/physics/module_sf_noahmp_glacier.F90 @@ -2652,7 +2652,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in !to obtain equilibrium state of snow in glacier region - if(sneqv > mwd) then ! 100 mm -> maximum water depth + if(sneqv > mwd .and. isnow /= 0) then ! 100 mm -> maximum water depth bdsnow = snice(0) / dzsnso(0) snoflow = (sneqv - mwd) snice(0) = snice(0) - snoflow From d595541a964499d15c9664092dbbe76f21487763 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 9 Nov 2023 23:43:13 +0000 Subject: [PATCH 091/132] Computation of surface fire heat for use in LSM to rrfs_smoke_wrapper. Also, added the fraction of grid cell that is burned out. --- physics/smoke_dust/module_plumerise1.F90 | 4 ---- physics/smoke_dust/module_smoke_plumerise.F90 | 12 ++---------- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 18 +++++++++++------- physics/smoke_dust/rrfs_smoke_wrapper.meta | 8 ++++++++ 4 files changed, 21 insertions(+), 21 deletions(-) diff --git a/physics/smoke_dust/module_plumerise1.F90 b/physics/smoke_dust/module_plumerise1.F90 index 189bf981a..3c23faa6a 100755 --- a/physics/smoke_dust/module_plumerise1.F90 +++ b/physics/smoke_dust/module_plumerise1.F90 @@ -38,7 +38,6 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & t_phy,q_vap, & ! RAR: moist is replaced with q_vap rho_phy,vvel,u_phy,v_phy,p_phy, & z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags - fire_heat_flux,dxy, & plume_frp, k_min, k_max, & ! RAR: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -67,8 +66,6 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebb_smoke real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: fire_heat_flux - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: dxy ! real(kind=kind_phys), DIMENSION( ims:ime, 1, jms:jme ), & ! INTENT(IN ) :: ebu_in @@ -187,7 +184,6 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & !num_ebu, eburn_in, eburn_out, & u_in, v_in, w_in, theta_in ,pi_in, & rho_phyin, qv_in, zmid, z_lev, & - fire_heat_flux(i,j),dxy(i,j), & plume_frp(i,j,1), k_min(i,j), & k_max(i,j), dbg_opt, g, con_cp, & con_rd, cpor, errmsg, errflg ) diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index 9c0dfa49d..61be06181 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -28,7 +28,6 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! firesize,mean_fct, & ! nspecies,eburn_in,eburn_out, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & - fire_heat_flux, dxy, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & cpor, errmsg, errflg ) @@ -44,9 +43,6 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & integer :: ng,m1,m2,m3,ia,iz,ja,jz,ibcon,mynum,i,j,k,imm,ixx,ispc !,nspecies - real(kind=kind_phys), intent(in) :: dxy - real(kind=kind_phys), intent(out) :: fire_heat_flux ! JLS - INTEGER, INTENT (OUT) :: k1,k2 character(*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -110,7 +106,6 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & IF (frp_inst Date: Thu, 9 Nov 2023 23:56:17 +0000 Subject: [PATCH 092/132] Small changes to fire feedback to RUC LSM. One more variable is added: fraction of grid cell burned by the fire. This fraction is used to take into account fire's effect on surface albedo. Also, added some debug prints. These changes will change the results only when fire feedback is turned on. The default is .false. --- physics/lsm_ruc.F90 | 24 ++++++++++++++++-------- physics/lsm_ruc.meta | 8 ++++++++ physics/module_sf_ruclsm.F90 | 17 +++++++++++++++-- 3 files changed, 39 insertions(+), 10 deletions(-) diff --git a/physics/lsm_ruc.F90 b/physics/lsm_ruc.F90 index 79bcbf7b1..ba1b1b4e9 100644 --- a/physics/lsm_ruc.F90 +++ b/physics/lsm_ruc.F90 @@ -360,6 +360,7 @@ subroutine lsm_ruc_run & ! inputs & cm_ice, ch_ice, snowfallac_ice, acsnow_ice, snowmt_ice, & & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & & add_fire_heat_flux, fire_heat_flux_out, & + & frac_grid_burned_out, & ! --- out & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & @@ -431,7 +432,8 @@ subroutine lsm_ruc_run & ! inputs ! --- in real (kind_phys), dimension(:), intent(in) :: & & rainnc, rainc, ice, snow, graupel, rhonewsn1 - real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out + real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out, & + frac_grid_burned_out logical, intent(in) :: add_fire_heat_flux ! --- in/out: ! --- on RUC levels @@ -984,13 +986,6 @@ subroutine lsm_ruc_run & ! inputs snoalb1d_lnd(i,j) = snoalb(i) albbck_lnd(i,j) = min(0.9_kind_phys,albbcksol(i)) !sfalb_lnd_bck(i) - IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then ! JLS - ! limit albedo and greenness in the areas affected by the fire - albbck_lnd(i,j) = min(0.1_kind_phys,albbck_lnd(i,j)) - shdfac(i,j) = min(50._kind_phys,shdfac(i,j)) ! % - ENDIF - - !-- spp_lsm if (spp_lsm == 1) then !-- spp for LSM is dimentioned as (1:lsoil_ruc) @@ -1013,6 +1008,19 @@ subroutine lsm_ruc_run & ! inputs alb_lnd(i,j) = albbck_lnd(i,j) * (one-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i) solnet_lnd(i,j) = dswsfc(i)*(one-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 + IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then ! JLS + if (debug_print) then + print *,'alb_lnd before fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i) + print *,'fire_heat_flux_out, frac_grid_burned_out, xlat/xlon ', & + fire_heat_flux_out(i),frac_grid_burned_out(i),xlat_d(i),xlon_d(i) + endif + ! limit albedo in the areas affected by the fire + alb_lnd(i,j) = alb_lnd(i,j) * (one-frac_grid_burned_out(i)) + 0.08_kind_phys*frac_grid_burned_out(i) + if (debug_print) then + print *,'alb_lnd after fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i) + endif + ENDIF + cmc(i,j) = canopy(i) ! [mm] soilt_lnd(i,j) = tsurf_lnd(i) ! sanity check for snow temperature tsnow diff --git a/physics/lsm_ruc.meta b/physics/lsm_ruc.meta index 4cc6a9419..9bc7fa10a 100644 --- a/physics/lsm_ruc.meta +++ b/physics/lsm_ruc.meta @@ -1762,6 +1762,14 @@ type = real kind = kind_phys intent = in +[frac_grid_burned_out] + standard_name = fraction_of_grid_cell_burning + long_name = ration of the burnt area to the grid cell area + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 47c03c49d..52fbc8123 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1825,7 +1825,10 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia UPFLUX = T3 *SOILT XINET = EMISS_snowfree*(GLW-UPFLUX) RNET = GSWnew + XINET - IF ( add_fire_heat_flux ) then ! JLS + IF ( add_fire_heat_flux .and. fire_heat_flux >0 ) then ! JLS + IF (debug_print ) THEN + print *,'RNET snow-free, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + ENDIF RNET = RNET + fire_heat_flux ENDIF @@ -1949,7 +1952,10 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if (SEAICE .LT. 0.5_kind_phys) then ! LAND - IF ( add_fire_heat_flux ) then ! JLS + IF ( add_fire_heat_flux .and. fire_heat_flux>0 ) then ! JLS + IF (debug_print ) THEN + print *,'RNET snow, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + ENDIF RNET = RNET + fire_heat_flux ENDIF if(snow_mosaic==one)then @@ -2242,6 +2248,13 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if(SEAICE .LT. 0.5_kind_phys) then ! LAND + IF ( add_fire_heat_flux .and. fire_heat_flux>0) then ! JLS + IF (debug_print ) THEN + print *,'RNET no snow, fire_heat_flux, xlat/xlon',RNET, fire_heat_flux,xlat,xlon + endif + RNET = RNET + fire_heat_flux + ENDIF + CALL SOIL(debug_print,xlat, xlon, testptlat, testptlon,& !--- input variables i,j,iland,isoil,delt,ktau,conflx,nzs,nddzs,nroot, & From 6397387e0eb523039806d43e06d7ecf762fc48f5 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 10 Nov 2023 07:14:05 -0700 Subject: [PATCH 093/132] clean up type mix-matches * add one,zero and half * fix instances of reals compared to integer and integers used in real expressions --- physics/module_nst_water_prop.f90 | 119 +++++++++++++++--------------- 1 file changed, 60 insertions(+), 59 deletions(-) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 7f0f480ae..5d71ce82d 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -12,6 +12,8 @@ module module_nst_water_prop public :: rhocoef,density,sw_rad,sw_rad_aw,sw_rad_sum,sw_rad_upper,sw_rad_upper_aw,sw_rad_skin,grv,solar_time_from_julian,compjd, & sw_ps_9b,sw_ps_9b_aw,get_dtzm_point,get_dtzm_2d + integer, parameter :: kp = kind_phys + real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp, half=0.5_kp ! interface sw_ps_9b module procedure sw_ps_9b @@ -78,7 +80,7 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) + 7.6438e-5 * tc**2 - 8.2467e-7 * tc**3 & + 5.3875e-9 * tc**4 - 1.5 * 5.72466e-3 * s**.5 & + 1.5 * 1.0227e-4 * tc * s**.5 & - - 1.5 * 1.6546e-6 * tc**2 * s**.5 & + - 1.5 * 1.6546e-6 * tc**2 * s**.5 & + 2.0 * 4.8314e-4 * s beta = beta / rhoref @@ -104,7 +106,7 @@ subroutine density(t, s, rho) ! introduction to dynamical oceanography, pp310). ! compression effects are not included - rho = 0.0 + rho = zero tc = t - t0k ! effect of temperature on density (lines 1-3) @@ -144,12 +146,12 @@ elemental subroutine sw_ps_9b(z,fxp) f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! - if(z>0) then - fxp=1.0-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & + if(z>zero) then + fxp=one-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & f(4)*exp(-z/gamma(4))+f(5)*exp(-z/gamma(5))+f(6)*exp(-z/gamma(6))+ & f(7)*exp(-z/gamma(7))+f(8)*exp(-z/gamma(8))+f(9)*exp(-z/gamma(9))) else - fxp=0. + fxp=zero endif ! end subroutine sw_ps_9b @@ -178,12 +180,12 @@ elemental subroutine sw_ps_9b_aw(z,aw) f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! - if(z>0) then + if(z>zero) then aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & (f(1)/gamma(4))*exp(-z/gamma(4))+(f(2)/gamma(5))*exp(-z/gamma(5))+(f(6)/gamma(6))*exp(-z/gamma(6))+ & (f(1)/gamma(7))*exp(-z/gamma(7))+(f(2)/gamma(8))*exp(-z/gamma(8))+(f(9)/gamma(9))*exp(-z/gamma(9)) else - aw=0. + aw=zero endif ! end subroutine sw_ps_9b_aw @@ -212,12 +214,12 @@ elemental subroutine sw_fairall_6exp_v1(z,fxp) real(kind=kind_phys),dimension(9) :: zgamma real(kind=kind_phys),dimension(9) :: f_c ! - if(z>0) then + if(z>zero) then zgamma=z/gamma - f_c=f*(1.-1./zgamma*(1-exp(-zgamma))) + f_c=f*(one-one/zgamma*(one-exp(-zgamma))) fxp=sum(f_c) else - fxp=0. + fxp=zero endif ! end subroutine sw_fairall_6exp_v1 @@ -251,15 +253,15 @@ elemental subroutine sw_fairall_6exp_v1_aw(z,aw) real(kind=kind_phys),dimension(9) :: zgamma real(kind=kind_phys),dimension(9) :: f_aw ! - if(z>0) then + if(z>zero) then zgamma=z/gamma - f_aw=(f/z)*((gamma/z)*(1-exp(-zgamma))-exp(-zgamma)) + f_aw=(f/z)*((gamma/z)*(one-exp(-zgamma))-exp(-zgamma)) aw=sum(f_aw) ! write(*,'(a,f6.2,f12.6,9f10.4)') 'z,aw in sw_rad_aw : ',z,aw,f_aw else - aw=0. + aw=zero endif ! end subroutine sw_fairall_6exp_v1_aw @@ -293,9 +295,9 @@ elemental subroutine sw_fairall_6exp_v1_sum(z,sum) ! f_sum=(zgamma/z)*exp(-zgamma) ! sum=sum(f_sum) - sum=(1.0/gamma(1))*exp(-z/gamma(1))+(1.0/gamma(2))*exp(-z/gamma(2))+(1.0/gamma(3))*exp(-z/gamma(3))+ & - (1.0/gamma(4))*exp(-z/gamma(4))+(1.0/gamma(5))*exp(-z/gamma(5))+(1.0/gamma(6))*exp(-z/gamma(6))+ & - (1.0/gamma(7))*exp(-z/gamma(7))+(1.0/gamma(8))*exp(-z/gamma(8))+(1.0/gamma(9))*exp(-z/gamma(9)) + sum=(one/gamma(1))*exp(-z/gamma(1))+(one/gamma(2))*exp(-z/gamma(2))+(one/gamma(3))*exp(-z/gamma(3))+ & + (one/gamma(4))*exp(-z/gamma(4))+(one/gamma(5))*exp(-z/gamma(5))+(one/gamma(6))*exp(-z/gamma(6))+ & + (one/gamma(7))*exp(-z/gamma(7))+(one/gamma(8))*exp(-z/gamma(8))+(one/gamma(9))*exp(-z/gamma(9)) ! end subroutine sw_fairall_6exp_v1_sum ! @@ -321,10 +323,10 @@ elemental subroutine sw_fairall_simple_v1(f_sol_0,z,df_sol_z) real(kind=kind_phys),intent(in):: z,f_sol_0 real(kind=kind_phys),intent(out):: df_sol_z ! - if(z>0) then - df_sol_z=f_sol_0*(0.137+11.0*z-6.6e-6/z*(1.-exp(-z/8.e-4))) + if(z>zero) then + df_sol_z=f_sol_0*(0.137+11.0*z-6.6e-6/z*(one-exp(-z/8.e-4))) else - df_sol_z=0. + df_sol_z=zero endif ! end subroutine sw_fairall_simple_v1 @@ -352,10 +354,10 @@ elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) real(kind=kind_phys),intent(in):: z,f_sol_0 real(kind=kind_phys),intent(out):: df_sol_z ! - if(z>0) then - df_sol_z=f_sol_0*(0.065+11.0*z-6.6e-5/z*(1.-exp(-z/8.e-4))) + if(z>zero) then + df_sol_z=f_sol_0*(0.065+11.0*z-6.6e-5/z*(one-exp(-z/8.e-4))) else - df_sol_z=0. + df_sol_z=zero endif ! end subroutine sw_wick_v1 @@ -388,11 +390,11 @@ elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) real(kind=kind_phys), dimension(3), parameter :: f=(/0.45,0.27,0.28/) & ,gamma=(/12.8,0.357,0.014/) ! - if(z>0) then - f_c = f*gamma(int(1-exp(-z/gamma))) - df_sol_z = f_sol_0*(1.0-sum(f_c)/z) + if(z>zero) then + f_c = f*gamma(int(one-exp(-z/gamma))) + df_sol_z = f_sol_0*(one-sum(f_c)/z) else - df_sol_z = 0. + df_sol_z = zero endif ! end subroutine sw_soloviev_3exp_v1 @@ -416,14 +418,14 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) real(kind=kind_phys),intent(in):: z,f_sol_0 real(kind=kind_phys),intent(out):: df_sol_z ! - if(z>0) then - df_sol_z=f_sol_0*(1.0 & - -(0.28*0.014*(1.-exp(-z/0.014)) & - +0.27*0.357*(1.-exp(-z/0.357)) & - +.45*12.82*(1.-exp(-z/12.82)))/z & + if(z>zero) then + df_sol_z=f_sol_0*(one & + -(0.28*0.014*(one-exp(-z/0.014)) & + + 0.27*0.357*(one-exp(-z/0.357)) & + + 0.45*12.82*(one-exp(-z/12.82)))/z & ) else - df_sol_z=0. + df_sol_z=zero endif ! end subroutine sw_soloviev_3exp_v2 @@ -445,15 +447,15 @@ elemental subroutine sw_soloviev_3exp_v2_aw(z,aw) real(kind=kind_phys),intent(out):: aw real(kind=kind_phys):: fxp ! - if(z>0) then - fxp=(1.0 & - -(0.28*0.014*(1.-exp(-z/0.014)) & - + 0.27*0.357*(1.-exp(-z/0.357)) & - + 0.45*12.82*(1.-exp(-z/12.82)))/z & + if(z>zero) then + fxp=(one & + -(0.28*0.014*(one-exp(-z/0.014)) & + + 0.27*0.357*(one-exp(-z/0.357)) & + + 0.45*12.82*(one-exp(-z/12.82)))/z & ) - aw=1.0-fxp-(0.28*exp(-z/0.014)+0.27*exp(-z/0.357)+0.45*exp(-z/12.82)) + aw=one-fxp-(0.28*exp(-z/0.014)+0.27*exp(-z/0.357)+0.45*exp(-z/12.82)) else - aw=0. + aw=zero endif end subroutine sw_soloviev_3exp_v2_aw ! @@ -475,10 +477,10 @@ elemental subroutine sw_ohlmann_v1(z,fxp) real(kind=kind_phys),intent(in):: z real(kind=kind_phys),intent(out):: fxp ! - if(z>0) then - fxp=.065+11.*z-6.6e-5/z*(1.-exp(-z/8.0e-4)) + if(z>zero) then + fxp=.065+11.*z-6.6e-5/z*(one-exp(-z/8.0e-4)) else - fxp=0. + fxp=zero endif ! end subroutine sw_ohlmann_v1 @@ -497,7 +499,7 @@ function grv(lat) phi=lat*pi/180 x=sin(phi) - grv=gamma*(1+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) + grv=gamma*(one+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) !print *,'grav=',grv,lat end function grv @@ -511,14 +513,14 @@ subroutine solar_time_from_julian(jday,xlon,soltim) real(kind=kind_phys), intent(in) :: jday real(kind=kind_phys), intent(in) :: xlon real(kind=kind_phys), intent(out) :: soltim - real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime + real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime integer :: nn ! fjd=jday-floor(jday) fjd=jday - xhr=floor(fjd*24.0)-sign(12.0,fjd-0.5) - xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-0.5))*60 - xsec=0 + xhr=floor(fjd*24.0)-sign(12.0,fjd-half) + xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-half))*60.0 + xsec=zero intime=xhr+xmin/60.0+xsec/3600.0+24.0 soltim=mod(xlon/15.0+intime,24.0)*3600.0 end subroutine solar_time_from_julian @@ -570,7 +572,7 @@ subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) jd=iw3jdn(jyr,jmnth,jday) if(jhr.lt.12) then jd=jd-1 - fjd=0.5+jhr/24.+jmn/1440. + fjd=half+jhr/24.+jmn/1440. else fjd=(jhr-12)/24.+jmn/1440. endif @@ -618,35 +620,35 @@ subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) ! ! get the mean warming in the range of z=z1 to z=z2 ! - dtw = 0.0 - if ( xt > 0.0 ) then + dtw = zero + if ( xt > zero ) then dt_warm = (xt+xt)/xz ! Tw(0) if ( z1 < z2) then if ( z2 < xz ) then - dtw = dt_warm*(1.0-(z1+z2)/(xz+xz)) + dtw = dt_warm*(one-(z1+z2)/(xz+xz)) elseif ( z1 < xz .and. z2 >= xz ) then - dtw = 0.5*(1.0-z1/xz)*dt_warm*(xz-z1)/(z2-z1) + dtw = half*(one-z1/xz)*dt_warm*(xz-z1)/(z2-z1) endif elseif ( z1 == z2 ) then if ( z1 < xz ) then - dtw = dt_warm*(1.0-z1/xz) + dtw = dt_warm*(one-z1/xz) endif endif endif ! ! get the mean cooling in the range of z=z1 to z=z2 ! - dtc = 0.0 - if ( zc > 0.0 ) then + dtc = zero + if ( zc > zero ) then if ( z1 < z2) then if ( z2 < zc ) then - dtc = dt_cool*(1.0-(z1+z2)/(zc+zc)) + dtc = dt_cool*(one-(z1+z2)/(zc+zc)) elseif ( z1 < zc .and. z2 >= zc ) then - dtc = 0.5*(1.0-z1/zc)*dt_cool*(zc-z1)/(z2-z1) + dtc = half*(one-z1/zc)*dt_cool*(zc-z1)/(z2-z1) endif elseif ( z1 == z2 ) then if ( z1 < zc ) then - dtc = dt_cool*(1.0-z1/zc) + dtc = dt_cool*(one-z1/zc) endif endif endif @@ -706,7 +708,6 @@ subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,dtm) ! Local variables integer :: i,j real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi - real (kind=kind_phys), parameter :: zero=0.0, half=0.5, one=1.0 !$omp parallel do num_threads (nth) private(j,i,dtw,dtc,xzi) From 3714e76763a91841712bc38f1f7ef4cc2fe01730 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 13 Nov 2023 10:19:49 -0500 Subject: [PATCH 094/132] add parameter zero and clean up nst_parameters * fix type mis-match in call to int_epn using parameter zero in module_nst_model --- physics/module_nst_model.f90 | 196 ++++++++++++++++-------------- physics/module_nst_parameters.f90 | 50 ++++---- physics/physcons.F90 | 4 +- 3 files changed, 129 insertions(+), 121 deletions(-) diff --git a/physics/module_nst_model.f90 b/physics/module_nst_model.f90 index 980035fe6..d47ab838b 100644 --- a/physics/module_nst_model.f90 +++ b/physics/module_nst_model.f90 @@ -1,5 +1,5 @@ !>\file module_nst_model.f90 -!! This file contains the diurnal thermocline layer model (DTM) of +!! This file contains the diurnal thermocline layer model (DTM) of !! the GFS NSST scheme. !>\defgroup dtm_module GFS NSST Diurnal Thermocline Model @@ -12,7 +12,7 @@ module nst_module ! -! the module of diurnal thermocline layer model +! the module of diurnal thermocline layer model ! use machine , only : kind_phys use module_nst_parameters, only: z_w_max,z_w_min,z_w_ini,eps_z_w,eps_conv, & @@ -23,6 +23,14 @@ module nst_module use module_nst_water_prop, only: sw_rad_skin,sw_ps_9b,sw_ps_9b_aw implicit none + private + + integer, parameter :: kp = kind_phys + real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp + + public :: dtm_1p, dtm_1p_fca, dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, convdepth + public :: cal_w, cal_ttop, cool_skin, dtl_reset + contains !>\ingroup gfs_nst_main_mod @@ -72,12 +80,12 @@ subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! logical lprnt ! if (lprnt) print *,' first xt=',xt - if ( xt <= 0.0 ) then ! dtl doesn't exist yet + if ( xt <= zero ) then ! dtl doesn't exist yet call dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) - elseif ( xt > 0.0 ) then ! dtl already exists + elseif ( xt > zero ) then ! dtl already exists ! -! forward the system one time step +! forward the system one time step ! call eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & beta,alon,sinlat,soltim,grav,le,d_conv, & @@ -150,7 +158,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& xtts0 = xtts xzts0 = xzts speed = max(1.0e-8, xu0*xu0+xv0*xv0) - + alat = asin(sinlat)*rad2deg fc = const_rot*sinlat @@ -177,7 +185,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& ! if (lprnt) print *,' xt1=',xt1,' xz1=',xz1,' xz0=',xz0,' dzw=',dzw, & ! 'timestep=',timestep,tox,toy,xu0,xv0,rho,drho,grav,rich - if ( xt1 <= 0.0 .or. xz1 <= 0.0 .or. xz1 > z_w_max ) then + if ( xt1 <= zero .or. xz1 <= zero .or. xz1 > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) return endif @@ -189,7 +197,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& +( (tox*xu0+toy*xv0)/rho+(3.0*drho-alpha*i0*aw*xz0/(rho*cp_w)) & *grav*xz0*xz0/(4.0*rich) )*xzts0 )) xtts1 = xtts0 + timestep*(i0*aw*xzts0-q_ts)/(rho*cp_w) - + ! if ( 2.0*xt1/xz1 > 0.001 ) then ! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_01 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& ! 2.0*xt1/xz1,2.0*xs1/xz1,2.0*xu1/xz1,2.0*xv1/xz1,xz1,xtts1,xzts1,d_conv,t_fcl,te @@ -210,7 +218,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& ! if (lprnt) print *,' xt2=',xt2,' xz2=',xz2 - if ( xt2 <= 0.0 .or. xz2 <= 0.0 .or. xz2 > z_w_max ) then + if ( xt2 <= zero .or. xz2 <= zero .or. xz2 > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) return endif @@ -229,7 +237,7 @@ subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& xzts = 0.5*(xzts1 + xzts2) xtts = 0.5*(xtts1 + xtts2) - if ( xt <= 0.0 .or. xz < 0.0 .or. xz > z_w_max ) then + if ( xt <= zero .or. xz < zero .or. xz > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) endif @@ -249,7 +257,7 @@ subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca, ! free convection adjustment (fca); ! top layer adjustment (tla); ! maximum warming adjustment (mwa) -! +! integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: timestep,i0,q,rho,d_conv real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz @@ -260,16 +268,16 @@ subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca, ! real(kind=kind_phys) xz_mda - tr_mda = 0.0; tr_fca = 0.0; tr_tla = 0.0; tr_mwa = 0.0 + tr_mda = zero; tr_fca = zero; tr_tla = zero; tr_mwa = zero ! apply mda if ( z_w_min > xz ) then xz_mda = z_w_min endif ! apply fca - if ( d_conv > 0.0 ) then + if ( d_conv > zero ) then xz_fca = 2.0*xt/((2.0*xt/xz)*(1.0-d_conv/(2.0*xz))) - tr_fca = 1.0 + tr_fca = 1.0 if ( xz_fca >= z_w_max ) then call dtl_reset_cv(xt,xs,xu,xv,xz) go to 10 @@ -280,13 +288,13 @@ subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca, call sw_ps_9b(dz,fw) q_warm=fw*i0-q !total heat abs in warm layer - if ( q_warm > 0.0 ) then + if ( q_warm > zero ) then call cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop0) ! ttop = (2.0*xt/xz)*(1.0-dz/(2.0*xz)) ttop = ((xt+xt)/xz)*(1.0-dz/(xz+xz)) if ( ttop > ttop0 ) then xz_tla = (xt+sqrt(xt*(xt-delz*ttop0)))/ttop0 - tr_tla = 1.0 + tr_tla = 1.0 if ( xz_tla >= z_w_max ) then call dtl_reset_cv(xt,xs,xu,xv,xz) go to 10 @@ -306,7 +314,7 @@ subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca, xz = max(xz_mda,xz_fca,xz_tla,xz_mwa) 10 continue - + end subroutine dtm_1p_zwa !>\ingroup gfs_nst_main_mod @@ -314,7 +322,7 @@ end subroutine dtm_1p_zwa subroutine dtm_1p_fca(d_conv,xt,xtts,xz,xzts) ! apply xz adjustment: free convection adjustment (fca); -! +! real(kind=kind_phys), intent(in) :: d_conv,xt,xtts real(kind=kind_phys), intent(inout) :: xz,xzts ! local variables @@ -332,14 +340,14 @@ end subroutine dtm_1p_fca subroutine dtm_1p_tla(dz,te,xt,xtts,xz,xzts) ! apply xz adjustment: top layer adjustment (tla); -! +! real(kind=kind_phys), intent(in) :: dz,te,xt,xtts real(kind=kind_phys), intent(inout) :: xz,xzts ! local variables real(kind=kind_phys) tem ! tem = xt*(xt-dz*te) - if (tem > 0.0) then + if (tem > zero) then xz = (xt+sqrt(xt*(xt-dz*te)))/te else xz = z_w_max @@ -389,8 +397,8 @@ subroutine dtm_1p_mta(dta,xt,xtts,xz,xzts) ! local variables real(kind=kind_phys) :: ta ! - ta = max(0.0,2.0*xt/xz-dta) - if ( ta > 0.0 ) then + ta = max(zero,2.0*xt/xz-dta) + if ( ta > zero ) then xz = 2.0*xt/ta else xz = z_w_max @@ -441,39 +449,39 @@ subroutine convdepth(kdt,timestep,i0,q,sss,sep,rho,alpha,beta,xt,xs,xz,d_conv) s1 = alpha*rho*t-omg_m*beta*rho*s - if ( s1 == 0.0 ) then - d_conv = 0.0 + if ( s1 == zero ) then + d_conv = zero else fac1 = alpha*q/cp_w+omg_m*beta*rho*sep - if ( i0 <= 0.0 ) then + if ( i0 <= zero ) then d_conv2=(2.0*xz*timestep/s1)*fac1 - if ( d_conv2 > 0.0 ) then + if ( d_conv2 > zero ) then d_conv = sqrt(d_conv2) else - d_conv = 0.0 + d_conv = zero endif - elseif ( i0 > 0.0 ) then + elseif ( i0 > zero ) then - d_conv_ini = 0.0 + d_conv_ini = zero iter_conv: do n = 1, niter_conv call sw_ps_9b(d_conv_ini,fxp) call sw_ps_9b_aw(d_conv_ini,aw) s2 = alpha*(q-(fxp-aw*d_conv_ini)*i0)/cp_w+omg_m*beta*rho*sep d_conv2=(2.0*xz*timestep/s1)*s2 - if ( d_conv2 < 0.0 ) then - d_conv = 0.0 + if ( d_conv2 < zero ) then + d_conv = zero exit iter_conv endif d_conv = sqrt(d_conv2) if ( abs(d_conv-d_conv_ini) < eps_conv .and. n <= niter_conv ) exit iter_conv d_conv_ini = d_conv enddo iter_conv - d_conv = max(0.0,min(d_conv,z_w_max)) - endif ! if ( i0 <= 0.0 ) then + d_conv = max(zero,min(d_conv,z_w_max)) + endif ! if ( i0 <= zero ) then - endif ! if ( s1 == 0.0 ) then + endif ! if ( s1 == zero ) then ! if ( d_conv > 0.01 ) then ! write(*,'(a,i4,i3,10f9.3,3f10.6,f10.1,f6.2)') ' d_conv : ',kdt,n,d_conv,d_conv_ini,q,i0,rho,cp_w,timestep,xt,xs,xz,sep, & @@ -488,7 +496,7 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! ! determine xz iteratively (starting wit fw = 0.5) and then update the other 6 variables ! - + integer,intent(in) :: kdt real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& hl_ts,rho,alpha,beta,alon,sinlat,soltim,grav,le @@ -519,9 +527,9 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! output variables ! ! xt : onset t content in dtl -! xs : onset s content in dtl -! xu : onset u content in dtl -! xv : onset v content in dtl +! xs : onset s content in dtl +! xu : onset u content in dtl +! xv : onset v content in dtl ! xz : onset dtl thickness (m) ! xzts : onset d(xz)/d(ts) (m/k ) ! xtts : onset d(xt)/d(ts) (m) @@ -531,15 +539,15 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! ! initializing dtl (just before the onset) ! - xt0 = 0.0 - xs0 = 0.0 - xu0 = 0.0 - xv0 = 0.0 + xt0 = zero + xs0 = zero + xu0 = zero + xv0 = zero z_w_tmp=z_w_ini call sw_ps_9b(z_w_tmp,fw) -! fw=0.5 ! +! fw=0.5 ! q_warm=fw*i0-q !total heat abs in warm layer if ( abs(alat) > 1.0 ) then @@ -552,9 +560,9 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & coeff2=omg_m*beta*grav*rho warml = coeff1*q_warm-coeff2*sep - if ( warml > 0.0 .and. q_warm > 0.0) then + if ( warml > zero .and. q_warm > zero) then iters_z_w: do n = 1,niter_z_w - if ( warml > 0.0 .and. q_warm > 0.0 ) then + if ( warml > zero .and. q_warm > zero ) then z_w=sqrt(2.0*rich*ftime/rho)*sqrt(tox**2+toy**2)/sqrt(warml) else z_w = z_w_max @@ -578,7 +586,7 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & ! ! update xt, xs, xu, xv ! - if ( z_w < z_w_max .and. q_warm > 0.0) then + if ( z_w < z_w_max .and. q_warm > zero) then call sw_ps_9b(z_w,fw) q_warm=fw*i0-q !total heat abs in warm layer @@ -599,7 +607,7 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & xz1 = max(xz1,z_w_min) - if ( xt1 < 0.0 .or. xz1 > z_w_max ) then + if ( xt1 < zero .or. xz1 > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) return endif @@ -630,16 +638,16 @@ subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & xtts = timestep*(i0*aw*xzts-q_ts)/(rho*cp_w) endif - if ( xt < 0.0 .or. xz > z_w_max ) then + if ( xt < zero .or. xz > z_w_max ) then call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) endif - + return end subroutine dtm_onset !>\ingroup gfs_nst_main_mod -!! This subroutine computes coefficients (\a w_0 and \a w_d) to +!! This subroutine computes coefficients (\a w_0 and \a w_d) to !! calculate d(tw)/d(ts). subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) ! @@ -648,15 +656,15 @@ subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) ! input variables ! ! kdt : the number of time step -! xt : dtl heat content -! xz : dtl depth +! xt : dtl heat content +! xz : dtl depth ! xzts : d(zw)/d(ts) ! xtts : d(xt)/d(ts) ! ! output variables ! -! w_0 : coefficint 1 to calculate d(tw)/d(ts) -! w_d : coefficint 2 to calculate d(tw)/d(ts) +! w_0 : coefficint 1 to calculate d(tw)/d(ts) +! w_d : coefficint 2 to calculate d(tw)/d(ts) integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: xz,xt,xzts,xtts @@ -719,11 +727,11 @@ subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) ! alpha ! beta ! grav -! d_1p : dtl depth before sfs applied +! d_1p : dtl depth before sfs applied ! ! output variables ! -! xz : dtl depth +! xz : dtl depth integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: xt,xs,xu,xv,alpha,beta,grav,d_1p @@ -736,10 +744,10 @@ subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) cc = ri_g/(grav*c2) tem = alpha*xt - beta*xs - if (tem > 0.0) then + if (tem > zero) then d_sfs = sqrt(2.0*cc*(xu*xu+xv*xv)/tem) else - d_sfs = 0.0 + d_sfs = zero endif ! xz0 = d_1p @@ -750,10 +758,10 @@ subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) ! if ( abs(d_sfs-xz0) < eps_sfs .and. n <= niter_sfs ) exit iter_sfs ! xz0 = d_sfs ! enddo iter_sfs - + ! ze = a2*d_sfs ! not used! - l = int_epn(0.0,d_sfs,0.0,d_sfs,2) + l = int_epn(zero,d_sfs,zero,d_sfs,2) ! t_sfs = xt/l ! xz = (xt+xt) / t_sfs @@ -774,20 +782,20 @@ subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) ! kdt : the number of record ! xt : heat content in dtl ! xz : dtl depth (m) -! c_0 : coefficint 1 to calculate d(tc)/d(ts) -! c_d : coefficint 2 to calculate d(tc)/d(ts) -! w_0 : coefficint 1 to calculate d(tw)/d(ts) -! w_d : coefficint 2 to calculate d(tw)/d(ts) +! c_0 : coefficint 1 to calculate d(tc)/d(ts) +! c_d : coefficint 2 to calculate d(tc)/d(ts) +! w_0 : coefficint 1 to calculate d(tw)/d(ts) +! w_d : coefficint 2 to calculate d(tw)/d(ts) ! ! output variables ! -! tztr : d(tz)/d(tr) +! tztr : d(tz)/d(tr) integer, intent(in) :: kdt real(kind=kind_phys), intent(in) :: xt,c_0,c_d,w_0,w_d,zc,zw,z real(kind=kind_phys), intent(out) :: tztr - if ( xt > 0.0 ) then + if ( xt > zero ) then if ( z <= zc ) then ! tztr = 1.0/(1.0-w_0+c_0)+z*(w_d-c_d)/(1.0-w_0+c_0) tztr = (1.0+z*(w_d-c_d))/(1.0-w_0+c_0) @@ -797,7 +805,7 @@ subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) elseif ( z >= zw ) then tztr = 1.0 endif - elseif ( xt == 0.0 ) then + elseif ( xt == zero ) then if ( z <= zc ) then ! tztr = 1.0/(1.0+c_0)-z*c_d/(1.0+c_0) tztr = (1.0-z*c_d)/(1.0+c_0) @@ -812,7 +820,7 @@ subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) end subroutine cal_tztr !>\ingroup gfs_nst_main_mod -!> This subroutine contains the upper ocean cool-skin parameterization +!> This subroutine contains the upper ocean cool-skin parameterization !! (Fairall et al, 1996 \cite fairall_et_al_1996). subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le,deltat_c,z_c,c_0,c_d) ! @@ -831,8 +839,8 @@ subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q ! ts : oceanic surface temperature ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes ! hl_ts : d(hl)/d(ts) -! grav : gravity -! le : +! grav : gravity +! le : ! ! output: ! deltat_c: cool-skin temperature correction (degrees k) @@ -876,33 +884,33 @@ subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q if ( deltaf > 0 ) then deltat_c = deltaf * z_c / kw else - deltat_c = 0. - z_c = 0. + deltat_c = zero + z_c = zero endif ! ! calculate c_0 & c_d ! - if ( z_c > 0.0 ) then + if ( z_c > zero ) then cc1 = 6.0*visw / (tcw*ustar1_a*sqrt(rho_a/rho_w)) cc2 = bigc*alpha / max(ustar_a,ustar_a_min)**4 cc3 = beta*sss*cp_w/(alpha*le) zcsq = z_c * z_c a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) - if ( hb > 0.0 .and. zcsq > 0.0 .and. alpha > 0.0) then + if ( hb > zero .and. zcsq > zero .and. alpha > zero) then bc1 = zcsq * (q_ts+cc3*hl_ts) bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) zc_ts = bc1/bc2 ! b_c = z_c**2*(q_ts+cc3*hl_ts)/(z_c**2*f_sol_0*a_c-4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*z_c**2)) ! d(z_c)/d(ts) b_c = (q_ts+cc3*hl_ts)/(f_sol_0*a_c & - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq*zcsq)) ! d(z_c)/d(ts) - c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi - c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi + c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi + c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi else - b_c = 0.0 - zc_ts = 0.0 - c_0 = z_c*q_ts*tcwi + b_c = zero + zc_ts = zero + c_0 = z_c*q_ts*tcwi c_d = -q_ts*tcwi endif @@ -910,12 +918,12 @@ subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q ! write(*,'(a,2f12.6,10f10.6)') ' c_0, c_d = ',c_0,c_d,b_c,zc_ts,hb,bc1,bc2,z_c,cc1,cc2,cc3,z_c**2 ! endif -! c_0 = z_c*q_ts/tcw -! c_d = -q_ts/tcw +! c_0 = z_c*q_ts/tcw +! c_d = -q_ts/tcw else - c_0 = 0.0 - c_d = 0.0 + c_0 = zero + c_d = zero endif ! if ( z_c > 0.0 ) then end subroutine cool_skin @@ -935,7 +943,7 @@ real function int_epn(z1,z2,zmx,ztr,n) m = nint((z2-z1)/delz) fa = exp(-exp_const*((z1-zmx)/(ztr-zmx))**n) fb = exp(-exp_const*((z2-zmx)/(ztr-zmx))**n) - int = 0.0 + int = zero do i = 1, m-1 zi = z1 + delz*float(i) fi = exp(-exp_const*((zi-zmx)/(ztr-zmx))**n) @@ -948,10 +956,10 @@ end function int_epn !! This subroutine resets the value of xt,xs,xu,xv,xz. subroutine dtl_reset_cv(xt,xs,xu,xv,xz) real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz - xt = 0.0 - xs = 0.0 - xu = 0.0 - xv = 0.0 + xt = zero + xs = zero + xu = zero + xv = zero xz = z_w_max end subroutine dtl_reset_cv @@ -959,13 +967,13 @@ end subroutine dtl_reset_cv !! This subroutine resets the value of xt,xs,xu,xv,xz,xtts,xzts. subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts - xt = 0.0 - xs = 0.0 - xu = 0.0 - xv = 0.0 + xt = zero + xs = zero + xu = zero + xv = zero xz = z_w_max - xtts = 0.0 - xzts = 0.0 + xtts = zero + xzts = zero end subroutine dtl_reset end module nst_module diff --git a/physics/module_nst_parameters.f90 b/physics/module_nst_parameters.f90 index ee0a34914..1e1a39ca1 100644 --- a/physics/module_nst_parameters.f90 +++ b/physics/module_nst_parameters.f90 @@ -12,34 +12,34 @@ module module_nst_parameters use machine, only : kind_phys ! ! air constants and coefficients from the atmospehric model - use physcons, only: & - eps => con_eps & - ,cp_a => con_cp & !< spec heat air @p (j/kg/k) - , epsm1 => con_epsm1 & - , hvap => con_hvap & !< lat heat h2o cond (j/kg) - ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) - ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) - ,omega => con_omega & !< ang vel of earth (1/s) - ,rvrdm1 => con_fvirt & - ,rd => con_rd & - ,rocp => con_rocp & !< r/cp + use physcons, only: & + eps => con_eps & !< con_rd/con_rv (nd) + ,cp_a => con_cp & !< spec heat air @p (j/kg/k) + ,epsm1 => con_epsm1 & !< eps - 1 (nd) + ,hvap => con_hvap & !< lat heat h2o cond (j/kg) + ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) + ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) + ,omega => con_omega & !< ang vel of earth (1/s) + ,rvrdm1 => con_fvirt & !< con_rv/con_rd-1. (nd) + ,rd => con_rd & !< gas constant air (j/kg/k) + ,rocp => con_rocp & !< r/cp ,pi => con_pi ! ! note: take timestep from here later - public + public integer :: & niter_conv = 5, & niter_z_w = 5, & niter_sfs = 5 - real (kind=kind_phys), parameter :: & + real (kind=kind_phys), parameter :: & ! ! general constants sec_in_day=86400. & ,sec_in_hour=3600. & ,solar_time_6am=21600.0 & ,const_rot=0.000073 & !< constant to calculate corioli force - ,ri_c=0.65 & - ,ri_g=0.25 & + ,ri_c=0.65 & + ,ri_g=0.25 & ,eps_z_w=0.01 & !< criteria to finish iterations for z_w ,eps_conv=0.01 & !< criteria to finish iterations for d_conv ,eps_sfs=0.01 & !< criteria to finish iterations for d_sfs @@ -52,7 +52,7 @@ module module_nst_parameters ,tau_min=0.005 & !< minimum of wind stress for dtm ,exp_const=9.5 & !< coefficient in exponet profile ,delz=0.1 & !< vertical increment for integral calculation (m) - ,von=0.4 & !< von karman's "constant" + ,von=0.4 & !< von karman's "constant" ,t0k=273.16 & !< celsius to kelvin ,gray=0.97 & ,sst_max=308.16 & @@ -63,20 +63,20 @@ module module_nst_parameters ,omg_sh = 1.0 & !< trace factor to apply sensible heat due to rainfall effect ,visw=1.e-6 & !< m2/s kinematic viscosity water ,novalue=0 & - ,smallnumber=1.e-6 & + ,smallnumber=1.e-6 & ,timestep_oc=sec_in_day/8. & !< time step in the ocean model (3 hours) - ,radian=2.*pi/180. & - ,rad2deg=180./pi & + ,radian=2.*pi/180. & + ,rad2deg=180./pi & ,cp_w=4000. & !< specific heat water (j/kg/k ) ,rho0_w=1022.0 & !< density water (kg/m3 ) (or 1024.438) ,vis_w=1.e-6 & !< kinematic viscosity water (m2/s ) ,tc_w=0.6 & !< thermal conductivity water (w/m/k ) ,capa_w =3950.0 & !< heat capacity of sea water ! - ,thref =1.0e-3 !< reference value of specific volume (m**3/kg) + ,thref =1.0e-3 !< reference value of specific volume (m**3/kg) !!$!============================================ !!$ -!!$ ,lvapor=2.453e6 & ! latent heat of vaporization note: make it function of t ????? note the same as hvap +!!$ ,lvapor=2.453e6 & ! latent heat of vaporization note: make it function of t ????? note the same as hvap !!$ ,alpha=1 ! thermal expansion coefficient !!$ ,beta ! saline contraction coefficient !!$ ,cp=1 !=1 specific heat of sea water @@ -95,7 +95,7 @@ module module_nst_parameters !!$ fdg=1.00 !based on results from flux workshop august 1995 !!$ tok=273.16 ! celsius to kelvin !!$ twopi=3.14159*2. -!!$ +!!$ !!$c air constants and coefficients !!$ rgas=287.1 !j/kg/k gas const. dry air !!$ xlv=(2.501-0.00237*ts)*1e+6 !j/kg latent heat of vaporization at ts @@ -104,7 +104,7 @@ module module_nst_parameters !!$ rhoa=p*100./(rgas*(t+tok)*(1.+.61*q)) !kg/m3 moist air density ( " ) !!$ visa=1.326e-5*(1+6.542e-3*t+8.301e-6*t*t-4.84e-9*t*t*t) !m2/s !!$ !kinematic viscosity of dry air - andreas (1989) crrel rep. 89-11 -!!$c +!!$c !!$c cool skin constants !!$ al=2.1e-5*(ts+3.2)**0.79 !water thermal expansion coefft. !!$ be=0.026 !salinity expansion coefft. @@ -126,11 +126,11 @@ module module_nst_parameters !!$ real, parameter :: rhoref = 1024.438 !sea water reference density, kg/m^3 !!$ real , parameter :: hslab=50.0 !slab ocean depth !!$ real , parameter :: bad=-1.0e+10 -!!$ real , parameter :: tmin=2.68e+02 +!!$ real , parameter :: tmin=2.68e+02 !!$ real , parameter :: tmax=3.11e+02 !!$ !!$ real, parameter :: grav =9.81 !gravity, kg/m/s^2 -!!$ real, parameter :: capa =3950.0 !heat capacity of sea water +!!$ real, parameter :: capa =3950.0 !heat capacity of sea water !!$ real, parameter :: rhoref = 1024.438 !sea water reference density, kg/m^3 !!$ real, parameter :: tmin=2.68e+02 !normal minimal temp !!$ real, parameter :: tmax=3.11e+02 !normal max temp diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 19a03ef20..4d86301e2 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -33,7 +33,7 @@ !> This module contains some of the most frequently used math and physics !! constants for GCM models. - module physcons + module physcons ! use machine, only: kind_phys, kind_dyn ! @@ -44,7 +44,7 @@ module physcons !> \name Math constants ! real(kind=kind_phys),parameter:: con_pi =3.1415926535897931 !< pi real(kind=kind_phys),parameter:: con_pi =4.0d0*atan(1.0d0) !< pi - real(kind=kind_phys),parameter:: con_sqrt2 =1.414214e+0_kind_phys !< square root of 2 + real(kind=kind_phys),parameter:: con_sqrt2 =1.414214e+0_kind_phys !< square root of 2 real(kind=kind_phys),parameter:: con_sqrt3 =1.732051e+0_kind_phys !< quare root of 3 !> \name Geophysics/Astronomy constants From 86eb1bdc2ccd250575066a5a736201fd8e17e65b Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Tue, 14 Nov 2023 14:10:02 +0000 Subject: [PATCH 095/132] Bug fix for conv refl,remove conv refl computation from the cu_gf driver --- physics/GFS_MP_generic_post.F90 | 11 ++++----- physics/cu_gf_driver_post.F90 | 24 +------------------- physics/cu_gf_driver_post.meta | 40 --------------------------------- 3 files changed, 5 insertions(+), 70 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 682263fc4..f1b15e01d 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -142,9 +142,10 @@ subroutine GFS_MP_generic_post_run( if ( (imp_physics==imp_physics_thompson .or. imp_physics==imp_physics_nssl) .and. & (imfdeepcnv==imfdeepcnv_samf .or. imfdeepcnv==imfdeepcnv_gf .or. imfshalcnv==imfshalcnv_gf) ) then do i=1,im + factor(i) = 0.0 lfrz = .true. zfrz(i) = phil(i,1) / con_g - do k = levs, 2, -1 + do k = levs, 1, -1 zo(i,k) = phil(i,k) / con_g if (gt0(i,k) >= 273.16 .and. lfrz) then zfrz(i) = zo(i,k) @@ -152,13 +153,9 @@ subroutine GFS_MP_generic_post_run( endif enddo enddo - - do i=1,im - factor(i) = 0.0 - enddo - +! do i=1,im - if(rainc (i) > 0.0 .or. htop(i) > 0) then + if(rainc (i) > 0.0 .and. htop(i) > 0) then factor(i) = -2./max(1000., zo(i,htop(i)) - zfrz(i)) endif enddo diff --git a/physics/cu_gf_driver_post.F90 b/physics/cu_gf_driver_post.F90 index 5adf3ac42..111bf0863 100644 --- a/physics/cu_gf_driver_post.F90 +++ b/physics/cu_gf_driver_post.F90 @@ -15,7 +15,7 @@ module cu_gf_driver_post !> \section arg_table_cu_gf_driver_post_run Argument Table !! \htmlinclude cu_gf_driver_post_run.html !! - subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m,dt, garea, raincv, maxupmf, refl_10cm, errmsg, errflg) + subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, errmsg, errflg) use machine, only: kind_phys @@ -25,25 +25,17 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m integer, intent(in) :: im, km real(kind_phys), intent(in) :: t(:,:) real(kind_phys), intent(in) :: q(:,:) - real(kind_phys), dimension(:),intent(in) :: garea real(kind_phys), intent(out) :: prevst(:,:) real(kind_phys), intent(out) :: prevsq(:,:) integer, intent(in) :: cactiv(:) integer, intent(in) :: cactiv_m(:) real(kind_phys), intent(out) :: conv_act(:) real(kind_phys), intent(out) :: conv_act_m(:) - ! for Radar reflectivity - real(kind_phys), intent(in) :: dt - real(kind_phys), intent(in) :: raincv(:), maxupmf(:) - real(kind_phys), intent(inout) :: refl_10cm(:,:) character(len=*), intent(out) :: errmsg !$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) integer, intent(out) :: errflg ! Local variables - real(kind_phys), parameter :: dbzmin=-10.0 - real(kind_phys) :: cuprate - real(kind_phys) :: ze, ze_conv, dbz_sum integer :: i, k ! Initialize CCPP error handling variables @@ -65,20 +57,6 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m else conv_act_m(i)=0.0 endif - ! reflectivity parameterization for parameterized convection (reference:Unipost MDLFLD.f) - ze = 0.0 - ze_conv = 0.0 - dbz_sum = 0.0 - cuprate = 1.e3*raincv(i) * 3600.0 / dt ! cu precip rate (mm/h) - if(cuprate .lt. 0.05) cuprate=0. - ze_conv = 300.0 * cuprate**1.5 - if (maxupmf(i).gt.0.1 .and. cuprate.gt.0.) then - do k = 1, km - ze = 10._kind_phys ** (0.1 * refl_10cm(i,k)) - dbz_sum = max(dbzmin, 10.0 * log10(ze + ze_conv)) - refl_10cm(i,k) = dbz_sum - enddo - endif enddo !$acc end kernels diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 48e762cb4..6c6ceeb66 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -83,46 +83,6 @@ type = real kind = kind_phys intent = out -[dt] - standard_name = timestep_for_physics - long_name = physics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[garea] - standard_name = cell_area - long_name = grid cell area - units = m2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[raincv] - standard_name = lwe_thickness_of_deep_convective_precipitation_amount - long_name = deep convective rainfall amount on physics timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[maxupmf] - standard_name = maximum_convective_updraft_mass_flux - long_name = maximum convective updraft mass flux within a column - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[refl_10cm] - standard_name = radar_reflectivity_10cm - long_name = instantaneous refl_10cm - units = dBZ - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 8759f1c3897f49aaa05c04e0ffd5029683884761 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 15 Nov 2023 07:34:27 -0500 Subject: [PATCH 096/132] fix grv function for argument value --- physics/module_nst_water_prop.f90 | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 6a183da52..57f27f329 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -42,7 +42,7 @@ module module_nst_water_prop ! ------------------------------------------------------ !>\ingroup gfs_nst_main_mod !! This subroutine computes thermal expansion coefficient (alpha) -!! and saline contraction coefficient (beta). +!! and saline contraction coefficient (beta). subroutine rhocoef(t, s, rhoref, alpha, beta) ! ------------------------------------------------------ @@ -124,7 +124,7 @@ end subroutine density !====================== ! !>\ingroup gfs_nst_main_mod -!! This subroutine computes the fraction of the solar radiation absorbed +!! This subroutine computes the fraction of the solar radiation absorbed !! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_ps_9b(z,fxp) ! @@ -159,7 +159,7 @@ end subroutine sw_ps_9b !====================== ! !>\ingroup gfs_nst_main_mod -!! This subroutine +!! This subroutine elemental subroutine sw_ps_9b_aw(z,aw) ! ! d(fw)/d(z) for 9-band @@ -483,20 +483,16 @@ end subroutine sw_ohlmann_v1 ! !>\ingroup gfs_nst_main_mod -function grv(lat) - real(kind=kind_phys) :: lat - real(kind=kind_phys) :: gamma,c1,c2,c3,c4,pi,phi,x +function grv(x) + real(kind=kind_phys) :: x !< sin(lat) + real(kind=kind_phys) :: gamma,c1,c2,c3,c4 gamma=9.7803267715 c1=0.0052790414 c2=0.0000232718 c3=0.0000001262 c4=0.0000000007 - pi=3.141593 - phi=lat*pi/180 - x=sin(phi) - grv=gamma*(1+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) - !print *,'grav=',grv,lat + grv=gamma*(1.0+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) end function grv !>\ingroup gfs_nst_main_mod From 967740ffd92709ebb162921d5cad3c8428ba740e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 15 Nov 2023 12:15:55 -0500 Subject: [PATCH 097/132] fix intent in mp_thompson.meta --- physics/mp_thompson.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 293dd7625..ae1072d39 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -617,7 +617,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [fullradar_diag] standard_name = do_full_radar_reflectivity long_name = flag for computing full radar reflectivity From a85b2c8d817d23c6dc7f196f9b07afd661d10532 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Thu, 16 Nov 2023 13:46:41 +0000 Subject: [PATCH 098/132] clean up a bit, remove comments and temporary parameters --- physics/GFS_MP_generic_post.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index f1b15e01d..803f0334a 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -21,7 +21,7 @@ module GFS_MP_generic_post subroutine GFS_MP_generic_post_run( & im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_nssl, & imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, rhowater, rainmin, dtf, & - frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice,phil,htop,refl_10cm, & + frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, refl_10cm, & imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf,snow, graupel, save_t, save_q, & rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp,& totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, & @@ -41,7 +41,6 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma, exticeden integer, intent(in) :: index_of_temperature,index_of_process_mp,use_lake_model(:) -!aligo integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf integer, dimension (:), intent(in) :: htop integer :: dfi_radar_max_intervals @@ -115,7 +114,6 @@ subroutine GFS_MP_generic_post_run( real :: snowrat,grauprat,icerat,curat,prcpncfr,prcpcufr real :: rhonewsnow,rhoprcpice,rhonewgr,rhonewice -!aligo real(kind_phys), parameter :: dbzmin=-20.0 real(kind_phys) :: cuprate real(kind_phys) :: ze, ze_conv, dbz_sum @@ -123,7 +121,7 @@ subroutine GFS_MP_generic_post_run( real(kind_phys), dimension(1:im,1:levs) :: zo real(kind_phys), dimension(1:im) :: zfrz real(kind_phys), dimension(1:im) :: factor - real(kind_phys) ze_mp, fctz, delz, xlatd,xlond + real(kind_phys) ze_mp, fctz, delz logical :: lfrz From 152132604f4fc80ce7508a9b39ca5684a8ec18f5 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Thu, 16 Nov 2023 16:51:51 +0000 Subject: [PATCH 099/132] Take advantage of onebg to avoid division --- physics/GFS_MP_generic_post.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 803f0334a..3527c0613 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -142,9 +142,9 @@ subroutine GFS_MP_generic_post_run( do i=1,im factor(i) = 0.0 lfrz = .true. - zfrz(i) = phil(i,1) / con_g + zfrz(i) = phil(i,1)*onebg do k = levs, 1, -1 - zo(i,k) = phil(i,k) / con_g + zo(i,k) = phil(i,k)*onebg if (gt0(i,k) >= 273.16 .and. lfrz) then zfrz(i) = zo(i,k) lfrz = .false. From 78cab8732919882fe5b7d3bded1fe176d300ea88 Mon Sep 17 00:00:00 2001 From: Eric Aligo Date: Fri, 17 Nov 2023 16:49:51 +0000 Subject: [PATCH 100/132] Replace constant 273.16 with con_t0c, a physical constant already defined. --- physics/GFS_MP_generic_post.F90 | 6 +++--- physics/GFS_MP_generic_post.meta | 8 ++++++++ 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 3527c0613..d9d30fb90 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -22,7 +22,7 @@ subroutine GFS_MP_generic_post_run( im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_nssl, & imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, rhowater, rainmin, dtf, & frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, refl_10cm, & - imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf,snow, graupel, save_t, save_q, & + imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf, con_t0c, snow, graupel, save_t, save_q, & rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp,& totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, & pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & @@ -44,7 +44,7 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf integer, dimension (:), intent(in) :: htop integer :: dfi_radar_max_intervals - real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour + real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour, con_t0c real(kind=kind_phys), intent(in) :: radar_tten_limits(:) integer :: ix_dfi_radar(:) real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0,refl_10cm @@ -145,7 +145,7 @@ subroutine GFS_MP_generic_post_run( zfrz(i) = phil(i,1)*onebg do k = levs, 1, -1 zo(i,k) = phil(i,k)*onebg - if (gt0(i,k) >= 273.16 .and. lfrz) then + if (gt0(i,k) >= con_t0c .and. lfrz) then zfrz(i) = zo(i,k) lfrz = .false. endif diff --git a/physics/GFS_MP_generic_post.meta b/physics/GFS_MP_generic_post.meta index 0660a533a..a6137643d 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/GFS_MP_generic_post.meta @@ -312,6 +312,14 @@ dimensions = () type = integer intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature From f8e160157ff4466e606ba1b1b55156ed0c7af546 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 26 Nov 2023 13:09:56 -0500 Subject: [PATCH 101/132] rename and update files * remove continuation lines in column 6 and rename files as f90 * remove unused variables and make only needed variables, routines or procedures public * move use statements to module level, remove implicit none and use statements in SRs --- physics/module_nst_model.f90 | 1803 ++++++++++++++--------------- physics/module_nst_parameters.f90 | 123 +- physics/module_nst_water_prop.f90 | 753 ++++++------ physics/sfc_nst.f | 696 ----------- physics/sfc_nst.f90 | 664 +++++++++++ physics/sfc_nst_post.f | 93 -- physics/sfc_nst_post.f90 | 87 ++ physics/sfc_nst_pre.f | 96 -- physics/sfc_nst_pre.f90 | 89 ++ 9 files changed, 2171 insertions(+), 2233 deletions(-) delete mode 100644 physics/sfc_nst.f create mode 100644 physics/sfc_nst.f90 delete mode 100644 physics/sfc_nst_post.f create mode 100644 physics/sfc_nst_post.f90 delete mode 100644 physics/sfc_nst_pre.f create mode 100644 physics/sfc_nst_pre.f90 diff --git a/physics/module_nst_model.f90 b/physics/module_nst_model.f90 index d47ab838b..74c75924b 100644 --- a/physics/module_nst_model.f90 +++ b/physics/module_nst_model.f90 @@ -10,963 +10,960 @@ !> This module contains the diurnal thermocline layer model (DTM) of !! the GFS NSST scheme. module nst_module + ! + ! the module of diurnal thermocline layer model + ! + use machine , only : kind_phys + use module_nst_parameters , only : z_w_max, z_w_min, z_w_ini, eps_z_w, eps_conv + use module_nst_parameters , only : eps_sfs, niter_z_w, niter_conv, niter_sfs, ri_c + use module_nst_parameters , only : ri_g, omg_m, omg_sh, kw => tc_w, visw, t0k, cp_w + use module_nst_parameters , only : z_c_max, z_c_ini, ustar_a_min, delz, exp_const + use module_nst_parameters , only : rad2deg, const_rot, tw_max, sst_max + use module_nst_parameters , only : zero, one + use module_nst_water_prop , only : sw_rad_skin, sw_ps_9b, sw_ps_9b_aw + + implicit none + + private + + public :: dtm_1p, dtm_1p_fca, dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, convdepth + public :: cal_w, cal_ttop, cool_skin, dtl_reset + +contains + + !>\ingroup gfs_nst_main_mod + !! This subroutine contains the module of diurnal thermocline layer model. + subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & + alpha,beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& + hl_ts,rho,alpha,beta,alon,sinlat,soltim,& + grav,le,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + ! local variables + + ! + ! input variables + ! + ! timestep: integration time step in seconds + ! rich : critical ri (flow dependent) + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! sinlat : sine (lat) + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! d-conv : fcl thickness + ! + ! inout variables + ! + ! xt : dtl heat content (m*k) + ! xs : dtl salinity content (m*ppt) + ! xu : dtl x current content (m*m/s) + ! xv : dtl y current content (m*m/s) + ! xz : dtl thickness (m) + ! xzts : d(xz)/d(ts) (m/k ) + ! xtts : d(xt)/d(ts) (m) + ! + ! logical lprnt + + ! if (lprnt) print *,' first xt=',xt + if ( xt <= zero ) then ! dtl doesn't exist yet + call dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) + elseif ( xt > zero ) then ! dtl already exists + ! + ! forward the system one time step + ! + call eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + endif ! if ( xt == 0 ) then + + end subroutine dtm_1p + + !>\ingroup gfs_nst_main_mod + !! This subroutine integrates one time step with modified Euler method. + subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & + beta,alon,sinlat,soltim,grav,le,d_conv, & + xt,xs,xu,xv,xz,xzts,xtts) + + ! + ! subroutine eulerm: integrate one time step with modified euler method + ! + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts, & + hl_ts,rho,alpha,beta,alon,sinlat,soltim, & + grav,le,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + ! local variables + real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0,xzts0,xtts0 + real(kind=kind_phys) :: fw,aw,q_warm + real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1,xzts1,xtts1 + real(kind=kind_phys) :: xt2,xs2,xu2,xv2,xz2,xzts2,xtts2 + real(kind=kind_phys) :: dzw,drho,fc + real(kind=kind_phys) :: alat,speed + ! logical lprnt + + ! + ! input variables + ! + ! timestep: integration time step in seconds + ! rich : critial ri (flow/mass dependent) + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! alon : longitude (deg) + ! sinlat : sine (lat) + ! soltim : solar time + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! d_conv : fcl thickness (m) + ! + ! inout variables + ! + ! xt : dtl heat content (m*k) + ! xs : dtl salinity content (m*ppt) + ! xu : dtl x current content (m*m/s) + ! xv : dtl y current content (m*m/s) + ! xz : dtl thickness (m) + ! xzts : d(xz)/d(ts) (m/k ) + ! xtts : d(xt)/d(ts) (m) + + xt0 = xt + xs0 = xs + xu0 = xu + xv0 = xv + xz0 = xz + xtts0 = xtts + xzts0 = xzts + speed = max(1.0e-8, xu0*xu0+xv0*xv0) + + alat = asin(sinlat)*rad2deg + + fc = const_rot*sinlat + + call sw_ps_9b(xz0,fw) + + q_warm = fw*i0-q !total heat abs in warm layer + + call sw_ps_9b_aw(xz0,aw) + + drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep + + ! dzw = xz0*(tox*xu0+toy*xv0) / (rho*(xu0*xu0+xv0*xv0)) & + ! + xz0*xz0*xz0*drho*grav / (4.0*rich*(xu0*xu0+xv0*xv0)) + dzw = xz0 * ((tox*xu0+toy*xv0) / (rho*speed) & + + xz0*xz0*drho*grav / (4.0*rich*speed)) + + xt1 = xt0 + timestep*q_warm/(rho*cp_w) + xs1 = xs0 + timestep*sep + xu1 = xu0 + timestep*(fc*xv0+tox/rho) + xv1 = xv0 + timestep*(-fc*xu0+toy/rho) + xz1 = xz0 + timestep*dzw + + ! if (lprnt) print *,' xt1=',xt1,' xz1=',xz1,' xz0=',xz0,' dzw=',dzw, & + ! 'timestep=',timestep,tox,toy,xu0,xv0,rho,drho,grav,rich + + if ( xt1 <= zero .or. xz1 <= zero .or. xz1 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + return + endif -! -! the module of diurnal thermocline layer model -! - use machine , only : kind_phys - use module_nst_parameters, only: z_w_max,z_w_min,z_w_ini,eps_z_w,eps_conv, & - eps_sfs,niter_z_w,niter_conv,niter_sfs,ri_c, & - ri_g,omg_m,omg_sh, kw => tc_w,visw,t0k,cp_w, & - z_c_max,z_c_ini,ustar_a_min,delz,exp_const, & - rad2deg,const_rot,tw_max,sst_max - use module_nst_water_prop, only: sw_rad_skin,sw_ps_9b,sw_ps_9b_aw - implicit none - - private - - integer, parameter :: kp = kind_phys - real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp - - public :: dtm_1p, dtm_1p_fca, dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, convdepth - public :: cal_w, cal_ttop, cool_skin, dtl_reset + ! call dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt1,xs1,xu1,xv1,xz1,tr_mda,tr_fca,tr_tla,tr_mwa) - contains + xzts1 = xzts0 + timestep*((1.0/(xu0*xu0+xv0*xv0)) * & + ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz0**3/(4.0*rich*rho) & + +( (tox*xu0+toy*xv0)/rho+(3.0*drho-alpha*i0*aw*xz0/(rho*cp_w)) & + *grav*xz0*xz0/(4.0*rich) )*xzts0 )) + xtts1 = xtts0 + timestep*(i0*aw*xzts0-q_ts)/(rho*cp_w) -!>\ingroup gfs_nst_main_mod -!! This subroutine contains the module of diurnal thermocline layer model. - subroutine dtm_1p(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & - alpha,beta,alon,sinlat,soltim,grav,le,d_conv, & - xt,xs,xu,xv,xz,xzts,xtts) + ! if ( 2.0*xt1/xz1 > 0.001 ) then + ! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_01 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& + ! 2.0*xt1/xz1,2.0*xs1/xz1,2.0*xu1/xz1,2.0*xv1/xz1,xz1,xtts1,xzts1,d_conv,t_fcl,te + ! endif - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& - hl_ts,rho,alpha,beta,alon,sinlat,soltim,& - grav,le,d_conv - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts -! local variables - -! -! input variables -! -! timestep: integration time step in seconds -! rich : critical ri (flow dependent) -! tox : x wind stress (n*m^-2 or kg/m/s^2) -! toy : y wind stress (n*m^-2 or kg/m/s^2) -! i0 : solar radiation flux at the surface (wm^-2) -! q : non-solar heat flux at the surface (wm^-2) -! sss : salinity (ppt) -! sep : sr(e-p) (ppt*m/s) -! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes -! hl_ts : d(hl)/d(ts) -! rho : sea water density (kg*m^-3) -! alpha : thermal expansion coefficient (1/k) -! beta : saline contraction coefficient (1/ppt) -! sinlat : sine (lat) -! grav : gravity accelleration -! le : le=(2.501-.00237*tsea)*1e6 -! d-conv : fcl thickness -! -! inout variables -! -! xt : dtl heat content (m*k) -! xs : dtl salinity content (m*ppt) -! xu : dtl x current content (m*m/s) -! xv : dtl y current content (m*m/s) -! xz : dtl thickness (m) -! xzts : d(xz)/d(ts) (m/k ) -! xtts : d(xt)/d(ts) (m) -! -! logical lprnt - -! if (lprnt) print *,' first xt=',xt - if ( xt <= zero ) then ! dtl doesn't exist yet - call dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& - beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) - elseif ( xt > zero ) then ! dtl already exists -! -! forward the system one time step -! - call eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha, & - beta,alon,sinlat,soltim,grav,le,d_conv, & - xt,xs,xu,xv,xz,xzts,xtts) - endif ! if ( xt == 0 ) then - - end subroutine dtm_1p + call sw_ps_9b(xz1,fw) + q_warm = fw*i0-q !total heat abs in warm layer + call sw_ps_9b_aw(xz1,aw) + drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep + dzw = xz1*(tox*xu1+toy*xv1) / (rho*(xu1*xu1+xv1*xv1)) & + + xz1*xz1*xz1*drho*grav / (4.0*rich*(xu1*xu1+xv1*xv1)) + + xt2 = xt0 + timestep*q_warm/(rho*cp_w) + xs2 = xs0 + timestep*sep + xu2 = xu0 + timestep*(fc*xv1+tox/rho) + xv2 = xv0 + timestep*(-fc*xu1+toy/rho) + xz2 = xz0 + timestep*dzw + + ! if (lprnt) print *,' xt2=',xt2,' xz2=',xz2 + + if ( xt2 <= zero .or. xz2 <= zero .or. xz2 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + return + endif -!>\ingroup gfs_nst_main_mod -!! This subroutine integrates one time step with modified Euler method. - subroutine eulerm(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho,alpha,& - beta,alon,sinlat,soltim,grav,le,d_conv, & - xt,xs,xu,xv,xz,xzts,xtts) + xzts2 = xzts0 + timestep*((1.0/(xu1*xu1+xv1*xv1)) * & + ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz1**3/(4.0*rich*rho) & + +( (tox*xu1+toy*xv1)/rho+(3.0*drho-alpha*i0*aw*xz1/(rho*cp_w))* & + grav*xz1*xz1/(4.0*rich) )*xzts1 )) + xtts2 = xtts0 + timestep*(i0*aw*xzts1-q_ts)/(rho*cp_w) + + xt = 0.5*(xt1 + xt2) + xs = 0.5*(xs1 + xs2) + xu = 0.5*(xu1 + xu2) + xv = 0.5*(xv1 + xv2) + xz = 0.5*(xz1 + xz2) + xzts = 0.5*(xzts1 + xzts2) + xtts = 0.5*(xtts1 + xtts2) + + if ( xt <= zero .or. xz < zero .or. xz > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + endif -! -! subroutine eulerm: integrate one time step with modified euler method -! - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& - hl_ts,rho,alpha,beta,alon,sinlat,soltim,& - grav,le,d_conv - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts -! local variables - real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0,xzts0,xtts0 - real(kind=kind_phys) :: fw,aw,q_warm - real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1,xzts1,xtts1 - real(kind=kind_phys) :: xt2,xs2,xu2,xv2,xz2,xzts2,xtts2 - real(kind=kind_phys) :: dzw,drho,fc - real(kind=kind_phys) :: alat,speed -! logical lprnt - -! -! input variables -! -! timestep: integration time step in seconds -! rich : critial ri (flow/mass dependent) -! tox : x wind stress (n*m^-2 or kg/m/s^2) -! toy : y wind stress (n*m^-2 or kg/m/s^2) -! i0 : solar radiation flux at the surface (wm^-2) -! q : non-solar heat flux at the surface (wm^-2) -! sss : salinity (ppt) -! sep : sr(e-p) (ppt*m/s) -! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes -! hl_ts : d(hl)/d(ts) -! rho : sea water density (kg*m^-3) -! alpha : thermal expansion coefficient (1/k) -! beta : saline contraction coefficient (1/ppt) -! alon : longitude (deg) -! sinlat : sine (lat) -! soltim : solar time -! grav : gravity accelleration -! le : le=(2.501-.00237*tsea)*1e6 -! d_conv : fcl thickness (m) -! -! inout variables -! -! xt : dtl heat content (m*k) -! xs : dtl salinity content (m*ppt) -! xu : dtl x current content (m*m/s) -! xv : dtl y current content (m*m/s) -! xz : dtl thickness (m) -! xzts : d(xz)/d(ts) (m/k ) -! xtts : d(xt)/d(ts) (m) - - xt0 = xt - xs0 = xs - xu0 = xu - xv0 = xv - xz0 = xz - xtts0 = xtts - xzts0 = xzts - speed = max(1.0e-8, xu0*xu0+xv0*xv0) - - alat = asin(sinlat)*rad2deg - - fc = const_rot*sinlat - - call sw_ps_9b(xz0,fw) - - q_warm = fw*i0-q !total heat abs in warm layer - - call sw_ps_9b_aw(xz0,aw) - - drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep - -! dzw = xz0*(tox*xu0+toy*xv0) / (rho*(xu0*xu0+xv0*xv0)) & -! + xz0*xz0*xz0*drho*grav / (4.0*rich*(xu0*xu0+xv0*xv0)) - dzw = xz0 * ((tox*xu0+toy*xv0) / (rho*speed) & - + xz0*xz0*drho*grav / (4.0*rich*speed)) - - xt1 = xt0 + timestep*q_warm/(rho*cp_w) - xs1 = xs0 + timestep*sep - xu1 = xu0 + timestep*(fc*xv0+tox/rho) - xv1 = xv0 + timestep*(-fc*xu0+toy/rho) - xz1 = xz0 + timestep*dzw - -! if (lprnt) print *,' xt1=',xt1,' xz1=',xz1,' xz0=',xz0,' dzw=',dzw, & -! 'timestep=',timestep,tox,toy,xu0,xv0,rho,drho,grav,rich - - if ( xt1 <= zero .or. xz1 <= zero .or. xz1 > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) - return - endif - -! call dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt1,xs1,xu1,xv1,xz1,tr_mda,tr_fca,tr_tla,tr_mwa) - - xzts1 = xzts0 + timestep*((1.0/(xu0*xu0+xv0*xv0)) * & - ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz0**3/(4.0*rich*rho)& - +( (tox*xu0+toy*xv0)/rho+(3.0*drho-alpha*i0*aw*xz0/(rho*cp_w)) & - *grav*xz0*xz0/(4.0*rich) )*xzts0 )) - xtts1 = xtts0 + timestep*(i0*aw*xzts0-q_ts)/(rho*cp_w) - -! if ( 2.0*xt1/xz1 > 0.001 ) then -! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_01 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& -! 2.0*xt1/xz1,2.0*xs1/xz1,2.0*xu1/xz1,2.0*xv1/xz1,xz1,xtts1,xzts1,d_conv,t_fcl,te -! endif - - call sw_ps_9b(xz1,fw) - q_warm = fw*i0-q !total heat abs in warm layer - call sw_ps_9b_aw(xz1,aw) - drho = -alpha*q_warm/(rho*cp_w) + omg_m*beta*sep - dzw = xz1*(tox*xu1+toy*xv1) / (rho*(xu1*xu1+xv1*xv1)) & - + xz1*xz1*xz1*drho*grav / (4.0*rich*(xu1*xu1+xv1*xv1)) - - xt2 = xt0 + timestep*q_warm/(rho*cp_w) - xs2 = xs0 + timestep*sep - xu2 = xu0 + timestep*(fc*xv1+tox/rho) - xv2 = xv0 + timestep*(-fc*xu1+toy/rho) - xz2 = xz0 + timestep*dzw - -! if (lprnt) print *,' xt2=',xt2,' xz2=',xz2 - - if ( xt2 <= zero .or. xz2 <= zero .or. xz2 > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + ! if (lprnt) print *,' xt=',xt,' xz=',xz + ! if ( 2.0*xt/xz > 0.001 ) then + ! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_02 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& + ! 2.0*xt/xz,2.0*xs/xz,2.0*xu/xz,2.0*xv/xz,xz,xtts,xzts,d_conv,t_fcl,te + ! endif return - endif - - xzts2 = xzts0 + timestep*((1.0/(xu1*xu1+xv1*xv1)) * & - ( (alpha*q_ts/cp_w+omg_m*beta*sss*hl_ts/le)*grav*xz1**3/(4.0*rich*rho)& - +( (tox*xu1+toy*xv1)/rho+(3.0*drho-alpha*i0*aw*xz1/(rho*cp_w))* & - grav*xz1*xz1/(4.0*rich) )*xzts1 )) - xtts2 = xtts0 + timestep*(i0*aw*xzts1-q_ts)/(rho*cp_w) - - xt = 0.5*(xt1 + xt2) - xs = 0.5*(xs1 + xs2) - xu = 0.5*(xu1 + xu2) - xv = 0.5*(xv1 + xv2) - xz = 0.5*(xz1 + xz2) - xzts = 0.5*(xzts1 + xzts2) - xtts = 0.5*(xtts1 + xtts2) - - if ( xt <= zero .or. xz < zero .or. xz > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) - endif - -! if (lprnt) print *,' xt=',xt,' xz=',xz -! if ( 2.0*xt/xz > 0.001 ) then -! write(*,'(a,i5,2f8.3,4f8.2,f10.6,10f8.4)') 'eulerm_02 : ',kdt,alat,alon,soltim/3600.,i0,q,q_warm,sep,& -! 2.0*xt/xz,2.0*xs/xz,2.0*xu/xz,2.0*xv/xz,xz,xtts,xzts,d_conv,t_fcl,te -! endif - return - - end subroutine eulerm -!>\ingroup gfs_nst_main_mod -!! This subroutine applies xz adjustment. - subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca,tr_tla,tr_mwa) -! apply xz adjustment: minimum depth adjustment (mda) -! free convection adjustment (fca); -! top layer adjustment (tla); -! maximum warming adjustment (mwa) -! - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,i0,q,rho,d_conv - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz - real(kind=kind_phys), intent(out) :: tr_mda,tr_fca,tr_tla,tr_mwa -! local variables - real(kind=kind_phys) :: dz,t0,ttop0,ttop,fw,q_warm - real(kind=kind_phys) :: xz_fca,xz_tla,xz_mwa -! - real(kind=kind_phys) xz_mda - - tr_mda = zero; tr_fca = zero; tr_tla = zero; tr_mwa = zero - -! apply mda - if ( z_w_min > xz ) then - xz_mda = z_w_min - endif -! apply fca - if ( d_conv > zero ) then - xz_fca = 2.0*xt/((2.0*xt/xz)*(1.0-d_conv/(2.0*xz))) - tr_fca = 1.0 - if ( xz_fca >= z_w_max ) then - call dtl_reset_cv(xt,xs,xu,xv,xz) - go to 10 - endif - endif -! apply tla - dz = min(xz,max(d_conv,delz)) - call sw_ps_9b(dz,fw) - q_warm=fw*i0-q !total heat abs in warm layer - - if ( q_warm > zero ) then - call cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop0) -! ttop = (2.0*xt/xz)*(1.0-dz/(2.0*xz)) - ttop = ((xt+xt)/xz)*(1.0-dz/(xz+xz)) - if ( ttop > ttop0 ) then - xz_tla = (xt+sqrt(xt*(xt-delz*ttop0)))/ttop0 - tr_tla = 1.0 - if ( xz_tla >= z_w_max ) then - call dtl_reset_cv(xt,xs,xu,xv,xz) - go to 10 + end subroutine eulerm + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies xz adjustment. + subroutine dtm_1p_zwa(kdt,timestep,i0,q,rho,d_conv,xt,xs,xu,xv,xz,tr_mda,tr_fca,tr_tla,tr_mwa) + ! apply xz adjustment: minimum depth adjustment (mda) + ! free convection adjustment (fca); + ! top layer adjustment (tla); + ! maximum warming adjustment (mwa) + ! + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,i0,q,rho,d_conv + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz + real(kind=kind_phys), intent(out) :: tr_mda,tr_fca,tr_tla,tr_mwa + ! local variables + real(kind=kind_phys) :: dz,t0,ttop0,ttop,fw,q_warm + ! TODO: xz_mwa is unset but used below in max function + real(kind=kind_phys) :: xz_fca,xz_tla,xz_mwa + ! + real(kind=kind_phys) :: xz_mda + + tr_mda = zero; tr_fca = zero; tr_tla = zero; tr_mwa = zero + + ! apply mda + if ( z_w_min > xz ) then + xz_mda = z_w_min + endif + ! apply fca + if ( d_conv > zero ) then + xz_fca = 2.0*xt/((2.0*xt/xz)*(1.0-d_conv/(2.0*xz))) + tr_fca = 1.0 + if ( xz_fca >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 endif - endif - endif - -! apply mwa - t0 = 2.0*xt/xz - if ( t0 > tw_max ) then - if ( xz >= z_w_max ) then - call dtl_reset_cv(xt,xs,xu,xv,xz) - go to 10 - endif - endif - - xz = max(xz_mda,xz_fca,xz_tla,xz_mwa) - - 10 continue - - end subroutine dtm_1p_zwa + endif + ! apply tla + dz = min(xz,max(d_conv,delz)) + call sw_ps_9b(dz,fw) + q_warm=fw*i0-q !total heat abs in warm layer -!>\ingroup gfs_nst_main_mod -!! This subroutine applies free convection adjustment(fca). - subroutine dtm_1p_fca(d_conv,xt,xtts,xz,xzts) - -! apply xz adjustment: free convection adjustment (fca); -! - real(kind=kind_phys), intent(in) :: d_conv,xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables - real(kind=kind_phys) :: t_fcl,t0 -! - t0 = 2.0*xt/xz - t_fcl = t0*(1.0-d_conv/(2.0*xz)) - xz = 2.0*xt/t_fcl -! xzts = 2.0*xtts/t_fcl - - end subroutine dtm_1p_fca + if ( q_warm > zero ) then + call cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop0) + ! ttop = (2.0*xt/xz)*(1.0-dz/(2.0*xz)) + ttop = ((xt+xt)/xz)*(1.0-dz/(xz+xz)) + if ( ttop > ttop0 ) then + xz_tla = (xt+sqrt(xt*(xt-delz*ttop0)))/ttop0 + tr_tla = 1.0 + if ( xz_tla >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 + endif + endif + endif -!>\ingroup gfs_nst_main_mod -!! This subroutine applies top layer adjustment (tla). - subroutine dtm_1p_tla(dz,te,xt,xtts,xz,xzts) - -! apply xz adjustment: top layer adjustment (tla); -! - real(kind=kind_phys), intent(in) :: dz,te,xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables - real(kind=kind_phys) tem -! - tem = xt*(xt-dz*te) - if (tem > zero) then - xz = (xt+sqrt(xt*(xt-dz*te)))/te - else - xz = z_w_max - endif -! xzts = xtts*(1.0+0.5*(2.0*xt-dz*te)/sqrt(xt*(xt-dz*te)))/te - end subroutine dtm_1p_tla + ! apply mwa + t0 = 2.0*xt/xz + if ( t0 > tw_max ) then + if ( xz >= z_w_max ) then + call dtl_reset_cv(xt,xs,xu,xv,xz) + go to 10 + endif + endif -!>\ingroup gfs_nst_main_mod -!! This subroutine applies maximum warming adjustment (mwa). - subroutine dtm_1p_mwa(xt,xtts,xz,xzts) - -! apply xz adjustment: maximum warming adjustment (mwa) -! - real(kind=kind_phys), intent(in) :: xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables -! - xz = 2.0*xt/tw_max -! xzts = 2.0*xtts/tw_max - end subroutine dtm_1p_mwa + xz = max(xz_mda,xz_fca,xz_tla,xz_mwa) + +10 continue + + end subroutine dtm_1p_zwa + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies free convection adjustment(fca). + subroutine dtm_1p_fca(d_conv,xt,xtts,xz,xzts) + + ! apply xz adjustment: free convection adjustment (fca); + ! + real(kind=kind_phys), intent(in) :: d_conv,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: t_fcl,t0 + ! + t0 = 2.0*xt/xz + t_fcl = t0*(1.0-d_conv/(2.0*xz)) + xz = 2.0*xt/t_fcl + ! xzts = 2.0*xtts/t_fcl + + end subroutine dtm_1p_fca + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies top layer adjustment (tla). + subroutine dtm_1p_tla(dz,te,xt,xtts,xz,xzts) + + ! apply xz adjustment: top layer adjustment (tla); + ! + real(kind=kind_phys), intent(in) :: dz,te,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: tem + ! + tem = xt*(xt-dz*te) + if (tem > zero) then + xz = (xt+sqrt(xt*(xt-dz*te)))/te + else + xz = z_w_max + endif + ! xzts = xtts*(1.0+0.5*(2.0*xt-dz*te)/sqrt(xt*(xt-dz*te)))/te + end subroutine dtm_1p_tla + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies maximum warming adjustment (mwa). + subroutine dtm_1p_mwa(xt,xtts,xz,xzts) + + ! apply xz adjustment: maximum warming adjustment (mwa) + ! + real(kind=kind_phys), intent(in) :: xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + ! + xz = 2.0*xt/tw_max + ! xzts = 2.0*xtts/tw_max + end subroutine dtm_1p_mwa + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies minimum depth adjustment (xz adjustment). + subroutine dtm_1p_mda(xt,xtts,xz,xzts) + + ! apply xz adjustment: minimum depth adjustment (mda) + ! + real(kind=kind_phys), intent(in) :: xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: ta + ! + xz = max(z_w_min,xz) + ta = 2.0*xt/xz + ! xzts = 2.0*xtts/ta + + end subroutine dtm_1p_mda + + !>\ingroup gfs_nst_main_mod + !! This subroutine applies maximum temperature adjustment (mta). + subroutine dtm_1p_mta(dta,xt,xtts,xz,xzts) + + ! apply xz adjustment: maximum temperature adjustment (mta) + ! + real(kind=kind_phys), intent(in) :: dta,xt,xtts + real(kind=kind_phys), intent(inout) :: xz,xzts + ! local variables + real(kind=kind_phys) :: ta + ! + ta = max(zero,2.0*xt/xz-dta) + if ( ta > zero ) then + xz = 2.0*xt/ta + else + xz = z_w_max + endif + ! xzts = 2.0*xtts/ta + + end subroutine dtm_1p_mta + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates depth for convective adjustment. + subroutine convdepth(kdt,timestep,i0,q,sss,sep,rho,alpha,beta,xt,xs,xz,d_conv) + + ! + ! calculate depth for convective adjustment + ! + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,i0,q,sss,sep,rho,alpha,beta + real(kind=kind_phys), intent(in) :: xt,xs,xz + real(kind=kind_phys), intent(out) :: d_conv + real(kind=kind_phys) :: t,s,d_conv_ini,d_conv2,fxp,aw,s1,s2,fac1 + integer :: n + ! + ! input variables + ! + ! timestep: time step in seconds + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! xt : initial heat content (k*m) + ! xs : initial salinity content (ppt*m) + ! xz : initial dtl thickness (m) + ! + ! output variables + ! + ! d_conv : free convection depth (m) + + ! t : initial diurnal warming t (k) + ! s : initial diurnal warming s (ppt) + + n = 0 + t = 2.0*xt/xz + s = 2.0*xs/xz + + s1 = alpha*rho*t-omg_m*beta*rho*s + + if ( s1 == zero ) then + d_conv = zero + else -!>\ingroup gfs_nst_main_mod -!! This subroutine applies minimum depth adjustment (xz adjustment). - subroutine dtm_1p_mda(xt,xtts,xz,xzts) - -! apply xz adjustment: minimum depth adjustment (mda) -! - real(kind=kind_phys), intent(in) :: xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables - real(kind=kind_phys) :: ta -! - xz = max(z_w_min,xz) - ta = 2.0*xt/xz -! xzts = 2.0*xtts/ta - - end subroutine dtm_1p_mda + fac1 = alpha*q/cp_w+omg_m*beta*rho*sep + if ( i0 <= zero ) then + d_conv2=(2.0*xz*timestep/s1)*fac1 + if ( d_conv2 > zero ) then + d_conv = sqrt(d_conv2) + else + d_conv = zero + endif + elseif ( i0 > zero ) then + + d_conv_ini = zero + + iter_conv: do n = 1, niter_conv + call sw_ps_9b(d_conv_ini,fxp) + call sw_ps_9b_aw(d_conv_ini,aw) + s2 = alpha*(q-(fxp-aw*d_conv_ini)*i0)/cp_w+omg_m*beta*rho*sep + d_conv2=(2.0*xz*timestep/s1)*s2 + if ( d_conv2 < zero ) then + d_conv = zero + exit iter_conv + endif + d_conv = sqrt(d_conv2) + if ( abs(d_conv-d_conv_ini) < eps_conv .and. n <= niter_conv ) exit iter_conv + d_conv_ini = d_conv + enddo iter_conv + d_conv = max(zero,min(d_conv,z_w_max)) + endif ! if ( i0 <= zero ) then + + endif ! if ( s1 == zero ) then + + ! if ( d_conv > 0.01 ) then + ! write(*,'(a,i4,i3,10f9.3,3f10.6,f10.1,f6.2)') ' d_conv : ',kdt,n,d_conv,d_conv_ini,q,i0,rho,cp_w,timestep,xt,xs,xz,sep, & + ! s1,s2,d_conv2,aw + ! endif + + end subroutine convdepth + + !>\ingroup gfs_nst_main_mod + subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & + alpha,beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) + ! + ! determine xz iteratively (starting wit fw = 0.5) and then update the other 6 variables + ! + + integer,intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts, & + hl_ts,rho,alpha,beta,alon,sinlat,soltim,grav,le + real(kind=kind_phys), intent(out) :: xt,xs,xu,xv,xz,xzts,xtts + real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0 + real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1 + real(kind=kind_phys) :: fw,aw,q_warm,ft0,fs0,fu0,fv0,fz0,ft1,fs1,fu1,fv1,fz1 + real(kind=kind_phys) :: coeff1,coeff2,ftime,z_w,z_w_tmp,fc,warml,alat + integer :: n + ! + ! input variables + ! + ! timestep: time step in seconds + ! tox : x wind stress (n*m^-2 or kg/m/s^2) + ! toy : y wind stress (n*m^-2 or kg/m/s^2) + ! i0 : solar radiation flux at the surface (wm^-2) + ! q : non-solar heat flux at the surface (wm^-2) + ! sss : salinity (ppt) + ! sep : sr(e-p) (ppt*m/s) + ! rho : sea water density (kg*m^-3) + ! alpha : thermal expansion coefficient (1/k) + ! beta : saline contraction coefficient (1/ppt) + ! alon : longitude + ! sinlat : sine(latitude) + ! grav : gravity accelleration + ! le : le=(2.501-.00237*tsea)*1e6 + ! + ! output variables + ! + ! xt : onset t content in dtl + ! xs : onset s content in dtl + ! xu : onset u content in dtl + ! xv : onset v content in dtl + ! xz : onset dtl thickness (m) + ! xzts : onset d(xz)/d(ts) (m/k ) + ! xtts : onset d(xt)/d(ts) (m) + + fc=1.46/10000.0/2.0*sinlat + alat = asin(sinlat) + ! + ! initializing dtl (just before the onset) + ! + xt0 = zero + xs0 = zero + xu0 = zero + xv0 = zero + + z_w_tmp=z_w_ini + + call sw_ps_9b(z_w_tmp,fw) + ! fw=0.5 ! + q_warm=fw*i0-q !total heat abs in warm layer -!>\ingroup gfs_nst_main_mod -!! This subroutine applies maximum temperature adjustment (mta). - subroutine dtm_1p_mta(dta,xt,xtts,xz,xzts) - -! apply xz adjustment: maximum temperature adjustment (mta) -! - real(kind=kind_phys), intent(in) :: dta,xt,xtts - real(kind=kind_phys), intent(inout) :: xz,xzts -! local variables - real(kind=kind_phys) :: ta -! - ta = max(zero,2.0*xt/xz-dta) - if ( ta > zero ) then - xz = 2.0*xt/ta - else - xz = z_w_max - endif -! xzts = 2.0*xtts/ta - - end subroutine dtm_1p_mta + if ( abs(alat) > 1.0 ) then + ftime=sqrt((2.0-2.0*cos(fc*timestep))/(fc*fc*timestep)) + else + ftime=timestep + endif -!>\ingroup gfs_nst_main_mod -!! This subroutine calculates depth for convective adjustment. -subroutine convdepth(kdt,timestep,i0,q,sss,sep,rho,alpha,beta,xt,xs,xz,d_conv) - -! -! calculate depth for convective adjustment -! - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,i0,q,sss,sep,rho,alpha,beta - real(kind=kind_phys), intent(in) :: xt,xs,xz - real(kind=kind_phys), intent(out) :: d_conv - real(kind=kind_phys) :: t,s,d_conv_ini,d_conv2,fxp,aw,s1,s2,fac1 - integer :: n -! -! input variables -! -! timestep: time step in seconds -! i0 : solar radiation flux at the surface (wm^-2) -! q : non-solar heat flux at the surface (wm^-2) -! sss : salinity (ppt) -! sep : sr(e-p) (ppt*m/s) -! rho : sea water density (kg*m^-3) -! alpha : thermal expansion coefficient (1/k) -! beta : saline contraction coefficient (1/ppt) -! xt : initial heat content (k*m) -! xs : initial salinity content (ppt*m) -! xz : initial dtl thickness (m) -! -! output variables -! -! d_conv : free convection depth (m) - -! t : initial diurnal warming t (k) -! s : initial diurnal warming s (ppt) - - n = 0 - t = 2.0*xt/xz - s = 2.0*xs/xz - - s1 = alpha*rho*t-omg_m*beta*rho*s - - if ( s1 == zero ) then - d_conv = zero - else - - fac1 = alpha*q/cp_w+omg_m*beta*rho*sep - if ( i0 <= zero ) then - d_conv2=(2.0*xz*timestep/s1)*fac1 - if ( d_conv2 > zero ) then - d_conv = sqrt(d_conv2) - else - d_conv = zero - endif - elseif ( i0 > zero ) then - - d_conv_ini = zero - - iter_conv: do n = 1, niter_conv - call sw_ps_9b(d_conv_ini,fxp) - call sw_ps_9b_aw(d_conv_ini,aw) - s2 = alpha*(q-(fxp-aw*d_conv_ini)*i0)/cp_w+omg_m*beta*rho*sep - d_conv2=(2.0*xz*timestep/s1)*s2 - if ( d_conv2 < zero ) then - d_conv = zero - exit iter_conv - endif - d_conv = sqrt(d_conv2) - if ( abs(d_conv-d_conv_ini) < eps_conv .and. n <= niter_conv ) exit iter_conv - d_conv_ini = d_conv - enddo iter_conv - d_conv = max(zero,min(d_conv,z_w_max)) - endif ! if ( i0 <= zero ) then + coeff1=alpha*grav/cp_w + coeff2=omg_m*beta*grav*rho + warml = coeff1*q_warm-coeff2*sep + + if ( warml > zero .and. q_warm > zero) then + iters_z_w: do n = 1,niter_z_w + if ( warml > zero .and. q_warm > zero ) then + z_w=sqrt(2.0*rich*ftime/rho)*sqrt(tox**2+toy**2)/sqrt(warml) + else + z_w = z_w_max + exit iters_z_w + endif + + ! write(*,'(a,i4,i4,10f9.3,f9.6,f3.0)') ' z_w = ',kdt,n,z_w,z_w_tmp,timestep,q_warm,q,i0,fw,tox,toy,sep,warml,omg_m + + if (abs(z_w - z_w_tmp) < eps_z_w .and. z_w/=z_w_max .and. n < niter_z_w) exit iters_z_w + z_w_tmp=z_w + call sw_ps_9b(z_w_tmp,fw) + q_warm = fw*i0-q + warml = coeff1*q_warm-coeff2*sep + end do iters_z_w + else + z_w=z_w_max + endif - endif ! if ( s1 == zero ) then + xz0 = max(z_w,z_w_min) -! if ( d_conv > 0.01 ) then -! write(*,'(a,i4,i3,10f9.3,3f10.6,f10.1,f6.2)') ' d_conv : ',kdt,n,d_conv,d_conv_ini,q,i0,rho,cp_w,timestep,xt,xs,xz,sep, & -! s1,s2,d_conv2,aw -! endif + ! + ! update xt, xs, xu, xv + ! + if ( z_w < z_w_max .and. q_warm > zero) then - end subroutine convdepth + call sw_ps_9b(z_w,fw) + q_warm=fw*i0-q !total heat abs in warm layer -!>\ingroup gfs_nst_main_mod - subroutine dtm_onset(kdt,timestep,rich,tox,toy,i0,q,sss,sep,q_ts,hl_ts,rho, & - alpha,beta,alon,sinlat,soltim,grav,le,xt,xs,xu,xv,xz,xzts,xtts) -! -! determine xz iteratively (starting wit fw = 0.5) and then update the other 6 variables -! - - integer,intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,rich,tox,toy,i0,q,sss,sep,q_ts,& - hl_ts,rho,alpha,beta,alon,sinlat,soltim,grav,le - real(kind=kind_phys), intent(out) :: xt,xs,xu,xv,xz,xzts,xtts - real(kind=kind_phys) :: xt0,xs0,xu0,xv0,xz0 - real(kind=kind_phys) :: xt1,xs1,xu1,xv1,xz1 - real(kind=kind_phys) :: fw,aw,q_warm,ft0,fs0,fu0,fv0,fz0,ft1,fs1,fu1,fv1,fz1 - real(kind=kind_phys) :: coeff1,coeff2,ftime,z_w,z_w_tmp,fc,warml,alat - integer :: n -! -! input variables -! -! timestep: time step in seconds -! tox : x wind stress (n*m^-2 or kg/m/s^2) -! toy : y wind stress (n*m^-2 or kg/m/s^2) -! i0 : solar radiation flux at the surface (wm^-2) -! q : non-solar heat flux at the surface (wm^-2) -! sss : salinity (ppt) -! sep : sr(e-p) (ppt*m/s) -! rho : sea water density (kg*m^-3) -! alpha : thermal expansion coefficient (1/k) -! beta : saline contraction coefficient (1/ppt) -! alon : longitude -! sinlat : sine(latitude) -! grav : gravity accelleration -! le : le=(2.501-.00237*tsea)*1e6 -! -! output variables -! -! xt : onset t content in dtl -! xs : onset s content in dtl -! xu : onset u content in dtl -! xv : onset v content in dtl -! xz : onset dtl thickness (m) -! xzts : onset d(xz)/d(ts) (m/k ) -! xtts : onset d(xt)/d(ts) (m) - - fc=1.46/10000.0/2.0*sinlat - alat = asin(sinlat) -! -! initializing dtl (just before the onset) -! - xt0 = zero - xs0 = zero - xu0 = zero - xv0 = zero - - z_w_tmp=z_w_ini - - call sw_ps_9b(z_w_tmp,fw) -! fw=0.5 ! - q_warm=fw*i0-q !total heat abs in warm layer - - if ( abs(alat) > 1.0 ) then - ftime=sqrt((2.0-2.0*cos(fc*timestep))/(fc*fc*timestep)) - else - ftime=timestep - endif - - coeff1=alpha*grav/cp_w - coeff2=omg_m*beta*grav*rho - warml = coeff1*q_warm-coeff2*sep - - if ( warml > zero .and. q_warm > zero) then - iters_z_w: do n = 1,niter_z_w - if ( warml > zero .and. q_warm > zero ) then - z_w=sqrt(2.0*rich*ftime/rho)*sqrt(tox**2+toy**2)/sqrt(warml) - else - z_w = z_w_max - exit iters_z_w - endif - -! write(*,'(a,i4,i4,10f9.3,f9.6,f3.0)') ' z_w = ',kdt,n,z_w,z_w_tmp,timestep,q_warm,q,i0,fw,tox,toy,sep,warml,omg_m - - if (abs(z_w - z_w_tmp) < eps_z_w .and. z_w/=z_w_max .and. n < niter_z_w) exit iters_z_w - z_w_tmp=z_w - call sw_ps_9b(z_w_tmp,fw) - q_warm = fw*i0-q - warml = coeff1*q_warm-coeff2*sep - end do iters_z_w - else - z_w=z_w_max - endif - - xz0 = max(z_w,z_w_min) - -! -! update xt, xs, xu, xv -! - if ( z_w < z_w_max .and. q_warm > zero) then - - call sw_ps_9b(z_w,fw) - q_warm=fw*i0-q !total heat abs in warm layer + ft0 = q_warm/(rho*cp_w) + fs0 = sep + fu0 = fc*xv0+tox/rho + fv0 = -fc*xu0+toy/rho - ft0 = q_warm/(rho*cp_w) - fs0 = sep - fu0 = fc*xv0+tox/rho - fv0 = -fc*xu0+toy/rho + xt1 = xt0 + timestep*ft0 + xs1 = xs0 + timestep*fs0 + xu1 = xu0 + timestep*fu0 + xv1 = xv0 + timestep*fv0 - xt1 = xt0 + timestep*ft0 - xs1 = xs0 + timestep*fs0 - xu1 = xu0 + timestep*fu0 - xv1 = xv0 + timestep*fv0 + fz0 = xz0*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz0*xz0/(4.0*rich) & + -alpha*grav*q_warm*xz0*xz0/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) + xz1 = xz0 + timestep*fz0 - fz0 = xz0*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz0*xz0/(4.0*rich) & - -alpha*grav*q_warm*xz0*xz0/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) - xz1 = xz0 + timestep*fz0 + xz1 = max(xz1,z_w_min) - xz1 = max(xz1,z_w_min) + if ( xt1 < zero .or. xz1 > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) + return + endif - if ( xt1 < zero .or. xz1 > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) - return - endif + call sw_ps_9b(xz1,fw) + q_warm=fw*i0-q !total heat abs in warm layer - call sw_ps_9b(xz1,fw) - q_warm=fw*i0-q !total heat abs in warm layer + ft1 = q_warm/(rho*cp_w) + fs1 = sep + fu1 = fc*xv1+tox/rho + fv1 = -fc*xu1+toy/rho - ft1 = q_warm/(rho*cp_w) - fs1 = sep - fu1 = fc*xv1+tox/rho - fv1 = -fc*xu1+toy/rho + fz1 = xz1*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz1*xz1/(4.0*rich) & + -alpha*grav*q_warm*xz1*xz1/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) - fz1 = xz1*((tox*xu1+toy*xv1)/rho+omg_m*beta*grav*sep*xz1*xz1/(4.0*rich) & - -alpha*grav*q_warm*xz1*xz1/(4.0*rich*cp_w*rho))/(xu1*xu1+xv1*xv1) + xt = xt0 + 0.5*timestep*(ft0+ft1) + xs = xs0 + 0.5*timestep*(fs0+fs1) + xu = xu0 + 0.5*timestep*(fu0+fu1) + xv = xv0 + 0.5*timestep*(fv0+fv1) + xz = xz0 + 0.5*timestep*(fz0+fz1) - xt = xt0 + 0.5*timestep*(ft0+ft1) - xs = xs0 + 0.5*timestep*(fs0+fs1) - xu = xu0 + 0.5*timestep*(fu0+fu1) - xv = xv0 + 0.5*timestep*(fv0+fv1) - xz = xz0 + 0.5*timestep*(fz0+fz1) + xz = max(xz,z_w_min) - xz = max(xz,z_w_min) + call sw_ps_9b_aw(xz,aw) - call sw_ps_9b_aw(xz,aw) + ! xzts = (q_ts+(cp_w*omg_m*beta*sss/(le*alpha))*hl_ts)*xz/(i0*xz*aw+2.0*q_warm-2.0*(rho*cp_w*omg_m*beta*sss/alpha)*(sep/sss)) + xzts = (q_ts+omg_m*rho*cp_w*beta*sss*hl_ts*xz/(le*alpha))/(i0*xz*aw+2.0*q_warm-2.0*omg_m*rho*cp_w*beta*sss*sep/(le*alpha)) + xtts = timestep*(i0*aw*xzts-q_ts)/(rho*cp_w) + endif -! xzts = (q_ts+(cp_w*omg_m*beta*sss/(le*alpha))*hl_ts)*xz/(i0*xz*aw+2.0*q_warm-2.0*(rho*cp_w*omg_m*beta*sss/alpha)*(sep/sss)) - xzts = (q_ts+omg_m*rho*cp_w*beta*sss*hl_ts*xz/(le*alpha))/(i0*xz*aw+2.0*q_warm-2.0*omg_m*rho*cp_w*beta*sss*sep/(le*alpha)) - xtts = timestep*(i0*aw*xzts-q_ts)/(rho*cp_w) - endif + if ( xt < zero .or. xz > z_w_max ) then + call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) + endif - if ( xt < zero .or. xz > z_w_max ) then - call dtl_reset(xt,xs,xu,xv,xz,xtts,xzts) - endif + return - return + end subroutine dtm_onset + + !>\ingroup gfs_nst_main_mod + !! This subroutine computes coefficients (\a w_0 and \a w_d) to + !! calculate d(tw)/d(ts). + subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) + ! + ! abstract: calculate w_0,w_d + ! + ! input variables + ! + ! kdt : the number of time step + ! xt : dtl heat content + ! xz : dtl depth + ! xzts : d(zw)/d(ts) + ! xtts : d(xt)/d(ts) + ! + ! output variables + ! + ! w_0 : coefficint 1 to calculate d(tw)/d(ts) + ! w_d : coefficint 2 to calculate d(tw)/d(ts) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xz,xt,xzts,xtts + real(kind=kind_phys), intent(out) :: w_0,w_d + + w_0 = 2.0*(xtts-xt*xzts/xz)/xz + w_d = (2.0*xt*xzts/xz**2-w_0)/xz + + ! if ( 2.0*xt/xz > 1.0 ) then + ! write(*,'(a,i4,2f9.3,4f10.4))') ' cal_w : ',kdt,xz,xt,w_0,w_d,xzts,xtts + ! endif + end subroutine cal_w + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates the diurnal warming amount at the top layer + !! with thickness of \a delz. + subroutine cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop) + ! + ! abstract: calculate + ! + ! input variables + ! + ! kdt : the number of record + ! timestep : the number of record + ! q_warm : total heat abs in layer dz + ! rho : sea water density + ! dz : dz = max(delz,d_conv) top layer thickness defined to adjust xz + ! xt : heat content in dtl at previous time + ! xz : dtl thickness at previous time + ! + ! output variables + ! + ! ttop : the diurnal warming amount at the top layer with thickness of delz + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: timestep,q_warm,rho,dz,xt,xz + real(kind=kind_phys), intent(out) :: ttop + real(kind=kind_phys) :: dt_warm,t0 + + dt_warm = (xt+xt)/xz + t0 = dt_warm*(1.0-dz/(xz+xz)) + ttop = t0 + q_warm*timestep/(rho*cp_w*dz) + + end subroutine cal_ttop + + !>\ingroup gfs_nst_main_mod + !! This subroutine adjust dtm-1p dtl thickness by applying shear flow stability + !! with assumed exponential profile. + subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) + ! + ! abstract: adjust dtm-1p dtl thickness by applying shear flow stability with assumed exponetial profile + ! + ! input variables + ! + ! kdt : the number of record + ! xt : heat content in dtl + ! xs : salinity content in dtl + ! xu : u-current content in dtl + ! xv : v-current content in dtl + ! alpha + ! beta + ! grav + ! d_1p : dtl depth before sfs applied + ! + ! output variables + ! + ! xz : dtl depth + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xt,xs,xu,xv,alpha,beta,grav,d_1p + real(kind=kind_phys), intent(out) :: xz + ! real(kind=kind_phys) :: ze,cc,xz0,l,d_sfs, t_sfs, tem + real(kind=kind_phys) :: cc,l,d_sfs,tem + real(kind=kind_phys), parameter :: c2 = 0.3782 + + cc = ri_g/(grav*c2) + + tem = alpha*xt - beta*xs + if (tem > zero) then + d_sfs = sqrt(2.0*cc*(xu*xu+xv*xv)/tem) + else + d_sfs = zero + endif - end subroutine dtm_onset + ! xz0 = d_1p + ! iter_sfs: do n = 1, niter_sfs + ! l = int_epn(0.0,xz0,0.0,xz0,2) + ! d_sfs = cc*(xu*xu+xv*xv)/((alpha*xt-beta*xs)*l) + ! write(*,'(a,i6,i3,4f9.4))') ' app_sfs_iter : ',kdt,n,cc,l,xz0,d_sfs + ! if ( abs(d_sfs-xz0) < eps_sfs .and. n <= niter_sfs ) exit iter_sfs + ! xz0 = d_sfs + ! enddo iter_sfs -!>\ingroup gfs_nst_main_mod -!! This subroutine computes coefficients (\a w_0 and \a w_d) to -!! calculate d(tw)/d(ts). - subroutine cal_w(kdt,xz,xt,xzts,xtts,w_0,w_d) -! -! abstract: calculate w_0,w_d -! -! input variables -! -! kdt : the number of time step -! xt : dtl heat content -! xz : dtl depth -! xzts : d(zw)/d(ts) -! xtts : d(xt)/d(ts) -! -! output variables -! -! w_0 : coefficint 1 to calculate d(tw)/d(ts) -! w_d : coefficint 2 to calculate d(tw)/d(ts) - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: xz,xt,xzts,xtts - real(kind=kind_phys), intent(out) :: w_0,w_d - - w_0 = 2.0*(xtts-xt*xzts/xz)/xz - w_d = (2.0*xt*xzts/xz**2-w_0)/xz - -! if ( 2.0*xt/xz > 1.0 ) then -! write(*,'(a,i4,2f9.3,4f10.4))') ' cal_w : ',kdt,xz,xt,w_0,w_d,xzts,xtts -! endif - end subroutine cal_w + ! ze = a2*d_sfs ! not used! -!>\ingroup gfs_nst_main_mod -!! This subroutine calculates the diurnal warming amount at the top layer -!! with thickness of \a delz. - subroutine cal_ttop(kdt,timestep,q_warm,rho,dz,xt,xz,ttop) -! -! abstract: calculate -! -! input variables -! -! kdt : the number of record -! timestep : the number of record -! q_warm : total heat abs in layer dz -! rho : sea water density -! dz : dz = max(delz,d_conv) top layer thickness defined to adjust xz -! xt : heat content in dtl at previous time -! xz : dtl thickness at previous time -! -! output variables -! -! ttop : the diurnal warming amount at the top layer with thickness of delz - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: timestep,q_warm,rho,dz,xt,xz - real(kind=kind_phys), intent(out) :: ttop - real(kind=kind_phys) :: dt_warm,t0 - - dt_warm = (xt+xt)/xz - t0 = dt_warm*(1.0-dz/(xz+xz)) - ttop = t0 + q_warm*timestep/(rho*cp_w*dz) - - end subroutine cal_ttop + l = int_epn(zero,d_sfs,zero,d_sfs,2) -!>\ingroup gfs_nst_main_mod -!! This subroutine adjust dtm-1p dtl thickness by applying shear flow stability -!! with assumed exponential profile. - subroutine app_sfs(kdt,xt,xs,xu,xv,alpha,beta,grav,d_1p,xz) -! -! abstract: adjust dtm-1p dtl thickness by applying shear flow stability with assumed exponetial profile -! -! input variables -! -! kdt : the number of record -! xt : heat content in dtl -! xs : salinity content in dtl -! xu : u-current content in dtl -! xv : v-current content in dtl -! alpha -! beta -! grav -! d_1p : dtl depth before sfs applied -! -! output variables -! -! xz : dtl depth - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: xt,xs,xu,xv,alpha,beta,grav,d_1p - real(kind=kind_phys), intent(out) :: xz -! real(kind=kind_phys) :: ze,cc,xz0,l,d_sfs, t_sfs, tem - real(kind=kind_phys) :: cc,l,d_sfs,tem - real(kind=kind_phys), parameter :: c2 = 0.3782 - integer :: n - - cc = ri_g/(grav*c2) - - tem = alpha*xt - beta*xs - if (tem > zero) then - d_sfs = sqrt(2.0*cc*(xu*xu+xv*xv)/tem) - else - d_sfs = zero - endif - -! xz0 = d_1p -! iter_sfs: do n = 1, niter_sfs -! l = int_epn(0.0,xz0,0.0,xz0,2) -! d_sfs = cc*(xu*xu+xv*xv)/((alpha*xt-beta*xs)*l) -! write(*,'(a,i6,i3,4f9.4))') ' app_sfs_iter : ',kdt,n,cc,l,xz0,d_sfs -! if ( abs(d_sfs-xz0) < eps_sfs .and. n <= niter_sfs ) exit iter_sfs -! xz0 = d_sfs -! enddo iter_sfs - -! ze = a2*d_sfs ! not used! - - l = int_epn(zero,d_sfs,zero,d_sfs,2) - -! t_sfs = xt/l -! xz = (xt+xt) / t_sfs + ! t_sfs = xt/l + ! xz = (xt+xt) / t_sfs xz = l + l -! write(*,'(a,i6,6f9.4))') ' app_sfs : ',kdt,xz0,d_sfs,d_1p,xz,2.0*xt/d_1p,t_sfs - end subroutine app_sfs - -!>\ingroup gfs_nst_main_mod -!! This subroutine calculates d(tz)/d(ts). - subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) -! -! abstract: calculate d(tz)/d(ts) -! -! input variables -! -! kdt : the number of record -! xt : heat content in dtl -! xz : dtl depth (m) -! c_0 : coefficint 1 to calculate d(tc)/d(ts) -! c_d : coefficint 2 to calculate d(tc)/d(ts) -! w_0 : coefficint 1 to calculate d(tw)/d(ts) -! w_d : coefficint 2 to calculate d(tw)/d(ts) -! -! output variables -! -! tztr : d(tz)/d(tr) - - integer, intent(in) :: kdt - real(kind=kind_phys), intent(in) :: xt,c_0,c_d,w_0,w_d,zc,zw,z - real(kind=kind_phys), intent(out) :: tztr - - if ( xt > zero ) then - if ( z <= zc ) then -! tztr = 1.0/(1.0-w_0+c_0)+z*(w_d-c_d)/(1.0-w_0+c_0) - tztr = (1.0+z*(w_d-c_d))/(1.0-w_0+c_0) - elseif ( z > zc .and. z < zw ) then -! tztr = (1.0+c_0)/(1.0-w_0+c_0)+z*w_d/(1.0-w_0+c_0) - tztr = (1.0+c_0+z*w_d)/(1.0-w_0+c_0) - elseif ( z >= zw ) then - tztr = 1.0 - endif - elseif ( xt == zero ) then - if ( z <= zc ) then -! tztr = 1.0/(1.0+c_0)-z*c_d/(1.0+c_0) - tztr = (1.0-z*c_d)/(1.0+c_0) - else + ! write(*,'(a,i6,6f9.4))') ' app_sfs : ',kdt,xz0,d_sfs,d_1p,xz,2.0*xt/d_1p,t_sfs + end subroutine app_sfs + + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates d(tz)/d(ts). + subroutine cal_tztr(kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr) + ! + ! abstract: calculate d(tz)/d(ts) + ! + ! input variables + ! + ! kdt : the number of record + ! xt : heat content in dtl + ! xz : dtl depth (m) + ! c_0 : coefficint 1 to calculate d(tc)/d(ts) + ! c_d : coefficint 2 to calculate d(tc)/d(ts) + ! w_0 : coefficint 1 to calculate d(tw)/d(ts) + ! w_d : coefficint 2 to calculate d(tw)/d(ts) + ! + ! output variables + ! + ! tztr : d(tz)/d(tr) + + integer, intent(in) :: kdt + real(kind=kind_phys), intent(in) :: xt,c_0,c_d,w_0,w_d,zc,zw,z + real(kind=kind_phys), intent(out) :: tztr + + if ( xt > zero ) then + if ( z <= zc ) then + ! tztr = 1.0/(1.0-w_0+c_0)+z*(w_d-c_d)/(1.0-w_0+c_0) + tztr = (1.0+z*(w_d-c_d))/(1.0-w_0+c_0) + elseif ( z > zc .and. z < zw ) then + ! tztr = (1.0+c_0)/(1.0-w_0+c_0)+z*w_d/(1.0-w_0+c_0) + tztr = (1.0+c_0+z*w_d)/(1.0-w_0+c_0) + elseif ( z >= zw ) then + tztr = 1.0 + endif + elseif ( xt == zero ) then + if ( z <= zc ) then + ! tztr = 1.0/(1.0+c_0)-z*c_d/(1.0+c_0) + tztr = (1.0-z*c_d)/(1.0+c_0) + else + tztr = 1.0 + endif + else tztr = 1.0 - endif - else - tztr = 1.0 - endif - -! write(*,'(a,i4,9f9.4))') ' cal_tztr : ',kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr - end subroutine cal_tztr - -!>\ingroup gfs_nst_main_mod -!> This subroutine contains the upper ocean cool-skin parameterization -!! (Fairall et al, 1996 \cite fairall_et_al_1996). -subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le,deltat_c,z_c,c_0,c_d) -! -! upper ocean cool-skin parameterizaion, fairall et al, 1996. -! -! input: -! ustar_a : atmosphreic friction velocity at the air-sea interface (m/s) -! f_nsol : the "nonsolar" part of the surface heat flux (w/m^s) -! f_sol_0 : solar radiation at the ocean surface (w/m^2) -! evap : latent heat flux (w/m^2) -! sss : ocean upper mixed layer salinity (ppu) -! alpha : thermal expansion coefficient -! beta : saline contraction coefficient -! rho_w : oceanic density -! rho_a : atmospheric density -! ts : oceanic surface temperature -! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes -! hl_ts : d(hl)/d(ts) -! grav : gravity -! le : -! -! output: -! deltat_c: cool-skin temperature correction (degrees k) -! z_c : molecular sublayer (cool-skin) thickness (m) -! c_0 : coefficient1 to calculate d(tz)/d(ts) -! c_d : coefficient2 to calculate d(tz)/d(ts) - -! - real(kind=kind_phys), intent(in) :: ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le - real(kind=kind_phys), intent(out):: deltat_c,z_c,c_0,c_d -! declare local variables - real(kind=kind_phys), parameter :: a1=0.065, a2=11.0, a3=6.6e-5, a4=8.0e-4, tcw=0.6 & - , tcwi=1.0/tcw - real(kind=kind_phys) :: a_c,b_c,zc_ts,bc1,bc2 - real(kind=kind_phys) :: xi,hb,ustar1_a,bigc,deltaf,fxp - real(kind=kind_phys) :: zcsq - real(kind=kind_phys) :: cc1,cc2,cc3 - - - z_c = z_c_ini ! initial guess - - ustar1_a = max(ustar_a,ustar_a_min) - - call sw_rad_skin(z_c,fxp) - deltaf = f_sol_0*fxp - - hb = alpha*(f_nsol-deltaf)+beta*sss*cp_w*evap/le - bigc = 16*grav*cp_w*(rho_w*visw)**3/(rho_a*rho_a*kw*kw) - - if ( hb > 0 ) then - xi = 6./(1+(bigc*hb/ustar1_a**4)**0.75)**0.3333333 - else - xi = 6.0 - endif - z_c = min(z_c_max,xi*visw/(sqrt(rho_a/rho_w)*ustar1_a )) - - call sw_rad_skin(z_c,fxp) - - deltaf = f_sol_0*fxp - deltaf = f_nsol - deltaf - if ( deltaf > 0 ) then - deltat_c = deltaf * z_c / kw - else - deltat_c = zero - z_c = zero - endif -! -! calculate c_0 & c_d -! - if ( z_c > zero ) then - cc1 = 6.0*visw / (tcw*ustar1_a*sqrt(rho_a/rho_w)) - cc2 = bigc*alpha / max(ustar_a,ustar_a_min)**4 - cc3 = beta*sss*cp_w/(alpha*le) - zcsq = z_c * z_c - a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) - - if ( hb > zero .and. zcsq > zero .and. alpha > zero) then - bc1 = zcsq * (q_ts+cc3*hl_ts) - bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) - zc_ts = bc1/bc2 -! b_c = z_c**2*(q_ts+cc3*hl_ts)/(z_c**2*f_sol_0*a_c-4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*z_c**2)) ! d(z_c)/d(ts) - b_c = (q_ts+cc3*hl_ts)/(f_sol_0*a_c & - - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq*zcsq)) ! d(z_c)/d(ts) - c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi - c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi + endif + ! write(*,'(a,i4,9f9.4))') ' cal_tztr : ',kdt,xt,c_0,c_d,w_0,w_d,zc,zw,z,tztr + end subroutine cal_tztr + + !>\ingroup gfs_nst_main_mod + !> This subroutine contains the upper ocean cool-skin parameterization + !! (Fairall et al, 1996 \cite fairall_et_al_1996). + subroutine cool_skin(ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le,deltat_c,z_c,c_0,c_d) + ! + ! upper ocean cool-skin parameterizaion, fairall et al, 1996. + ! + ! input: + ! ustar_a : atmosphreic friction velocity at the air-sea interface (m/s) + ! f_nsol : the "nonsolar" part of the surface heat flux (w/m^s) + ! f_sol_0 : solar radiation at the ocean surface (w/m^2) + ! evap : latent heat flux (w/m^2) + ! sss : ocean upper mixed layer salinity (ppu) + ! alpha : thermal expansion coefficient + ! beta : saline contraction coefficient + ! rho_w : oceanic density + ! rho_a : atmospheric density + ! ts : oceanic surface temperature + ! q_ts : d(q)/d(ts) : q = the sum of non-solar heat fluxes + ! hl_ts : d(hl)/d(ts) + ! grav : gravity + ! le : + ! + ! output: + ! deltat_c: cool-skin temperature correction (degrees k) + ! z_c : molecular sublayer (cool-skin) thickness (m) + ! c_0 : coefficient1 to calculate d(tz)/d(ts) + ! c_d : coefficient2 to calculate d(tz)/d(ts) + + ! + real(kind=kind_phys), intent(in) :: ustar_a,f_nsol,f_sol_0,evap,sss,alpha,beta,rho_w,rho_a,ts,q_ts,hl_ts,grav,le + real(kind=kind_phys), intent(out) :: deltat_c,z_c,c_0,c_d + ! declare local variables + real(kind=kind_phys), parameter :: a1=0.065, a2=11.0, a3=6.6e-5, a4=8.0e-4, tcw=0.6, tcwi=1.0/tcw + real(kind=kind_phys) :: a_c,b_c,zc_ts,bc1,bc2 + real(kind=kind_phys) :: xi,hb,ustar1_a,bigc,deltaf,fxp + real(kind=kind_phys) :: zcsq + real(kind=kind_phys) :: cc1,cc2,cc3 + + + z_c = z_c_ini ! initial guess + + ustar1_a = max(ustar_a,ustar_a_min) + + call sw_rad_skin(z_c,fxp) + deltaf = f_sol_0*fxp + + hb = alpha*(f_nsol-deltaf)+beta*sss*cp_w*evap/le + bigc = 16*grav*cp_w*(rho_w*visw)**3/(rho_a*rho_a*kw*kw) + + if ( hb > 0 ) then + xi = 6./(1+(bigc*hb/ustar1_a**4)**0.75)**0.3333333 else - b_c = zero - zc_ts = zero - c_0 = z_c*q_ts*tcwi - c_d = -q_ts*tcwi + xi = 6.0 endif + z_c = min(z_c_max,xi*visw/(sqrt(rho_a/rho_w)*ustar1_a )) -! if ( c_0 < 0.0 ) then -! write(*,'(a,2f12.6,10f10.6)') ' c_0, c_d = ',c_0,c_d,b_c,zc_ts,hb,bc1,bc2,z_c,cc1,cc2,cc3,z_c**2 -! endif + call sw_rad_skin(z_c,fxp) -! c_0 = z_c*q_ts/tcw -! c_d = -q_ts/tcw + deltaf = f_sol_0*fxp + deltaf = f_nsol - deltaf + if ( deltaf > 0 ) then + deltat_c = deltaf * z_c / kw + else + deltat_c = zero + z_c = zero + endif + ! + ! calculate c_0 & c_d + ! + if ( z_c > zero ) then + cc1 = 6.0*visw / (tcw*ustar1_a*sqrt(rho_a/rho_w)) + cc2 = bigc*alpha / max(ustar_a,ustar_a_min)**4 + cc3 = beta*sss*cp_w/(alpha*le) + zcsq = z_c * z_c + a_c = a2 + a3/zcsq - (a3/(a4*z_c)+a3/zcsq) * exp(-z_c/a4) + + if ( hb > zero .and. zcsq > zero .and. alpha > zero) then + bc1 = zcsq * (q_ts+cc3*hl_ts) + bc2 = zcsq * f_sol_0*a_c - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq) + zc_ts = bc1/bc2 + ! b_c = z_c**2*(q_ts+cc3*hl_ts)/(z_c**2*f_sol_0*a_c-4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*z_c**2)) ! d(z_c)/d(ts) + b_c = (q_ts+cc3*hl_ts)/(f_sol_0*a_c & + - 4.0*(cc1*tcw)**3*(hb/alpha)**0.25/(cc2**0.75*zcsq*zcsq)) ! d(z_c)/d(ts) + c_0 = (z_c*q_ts+(f_nsol-deltaf-f_sol_0*a_c*z_c)*b_c)*tcwi + c_d = (f_sol_0*a_c*z_c*b_c-q_ts)*tcwi + + else + b_c = zero + zc_ts = zero + c_0 = z_c*q_ts*tcwi + c_d = -q_ts*tcwi + endif - else - c_0 = zero - c_d = zero - endif ! if ( z_c > 0.0 ) then + ! if ( c_0 < 0.0 ) then + ! write(*,'(a,2f12.6,10f10.6)') ' c_0, c_d = ',c_0,c_d,b_c,zc_ts,hb,bc1,bc2,z_c,cc1,cc2,cc3,z_c**2 + ! endif - end subroutine cool_skin -! -!====================== -! -!>\ingroup gfs_nst_main_mod -!! This function calculates a definitive integral of an exponential curve (power of 2). - real function int_epn(z1,z2,zmx,ztr,n) -! -! abstract: calculate a definitive integral of an exponetial curve (power of 2) -! - real(kind_phys) :: z1,z2,zmx,ztr,zi - real(kind_phys) :: fa,fb,fi,int - integer :: m,i,n - - m = nint((z2-z1)/delz) - fa = exp(-exp_const*((z1-zmx)/(ztr-zmx))**n) - fb = exp(-exp_const*((z2-zmx)/(ztr-zmx))**n) - int = zero - do i = 1, m-1 - zi = z1 + delz*float(i) - fi = exp(-exp_const*((zi-zmx)/(ztr-zmx))**n) - int = int + fi - enddo - int_epn = delz*((fa+fb)/2.0 + int) - end function int_epn + ! c_0 = z_c*q_ts/tcw + ! c_d = -q_ts/tcw -!>\ingroup gfs_nst_main_mod -!! This subroutine resets the value of xt,xs,xu,xv,xz. - subroutine dtl_reset_cv(xt,xs,xu,xv,xz) - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz + else + c_0 = zero + c_d = zero + endif ! if ( z_c > 0.0 ) then + + end subroutine cool_skin + ! + !====================== + ! + !>\ingroup gfs_nst_main_mod + !! This function calculates a definitive integral of an exponential curve (power of 2). + real function int_epn(z1,z2,zmx,ztr,n) + ! + ! abstract: calculate a definitive integral of an exponetial curve (power of 2) + ! + real(kind_phys) :: z1,z2,zmx,ztr,zi + real(kind_phys) :: fa,fb,fi,int + integer :: m,i,n + + m = nint((z2-z1)/delz) + fa = exp(-exp_const*((z1-zmx)/(ztr-zmx))**n) + fb = exp(-exp_const*((z2-zmx)/(ztr-zmx))**n) + int = zero + do i = 1, m-1 + zi = z1 + delz*float(i) + fi = exp(-exp_const*((zi-zmx)/(ztr-zmx))**n) + int = int + fi + enddo + int_epn = delz*((fa+fb)/2.0 + int) + end function int_epn + + !>\ingroup gfs_nst_main_mod + !! This subroutine resets the value of xt,xs,xu,xv,xz. + subroutine dtl_reset_cv(xt,xs,xu,xv,xz) + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz xt = zero xs = zero xu = zero xv = zero xz = z_w_max - end subroutine dtl_reset_cv + end subroutine dtl_reset_cv -!>\ingroup gfs_nst_main_mod -!! This subroutine resets the value of xt,xs,xu,xv,xz,xtts,xzts. - subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) - real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts + !>\ingroup gfs_nst_main_mod + !! This subroutine resets the value of xt,xs,xu,xv,xz,xtts,xzts. + subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) + real(kind=kind_phys), intent(inout) :: xt,xs,xu,xv,xz,xzts,xtts xt = zero xs = zero xu = zero @@ -974,6 +971,6 @@ subroutine dtl_reset(xt,xs,xu,xv,xz,xzts,xtts) xz = z_w_max xtts = zero xzts = zero - end subroutine dtl_reset + end subroutine dtl_reset end module nst_module diff --git a/physics/module_nst_parameters.f90 b/physics/module_nst_parameters.f90 index 1e1a39ca1..5308345e2 100644 --- a/physics/module_nst_parameters.f90 +++ b/physics/module_nst_parameters.f90 @@ -9,70 +9,83 @@ !! history: !! 20210305: X.Li, reduce z_w_max from 30 m to 20 m module module_nst_parameters + use machine, only : kind_phys ! ! air constants and coefficients from the atmospehric model - use physcons, only: & - eps => con_eps & !< con_rd/con_rv (nd) - ,cp_a => con_cp & !< spec heat air @p (j/kg/k) - ,epsm1 => con_epsm1 & !< eps - 1 (nd) - ,hvap => con_hvap & !< lat heat h2o cond (j/kg) - ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) - ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) - ,omega => con_omega & !< ang vel of earth (1/s) - ,rvrdm1 => con_fvirt & !< con_rv/con_rd-1. (nd) - ,rd => con_rd & !< gas constant air (j/kg/k) - ,rocp => con_rocp & !< r/cp - ,pi => con_pi + use physcons, only: & + eps => con_eps & !< con_rd/con_rv (nd) + ,cp_a => con_cp & !< spec heat air @p (j/kg/k) + ,epsm1 => con_epsm1 & !< eps - 1 (nd) + ,hvap => con_hvap & !< lat heat h2o cond (j/kg) + ,sigma_r => con_sbc & !< stefan-boltzmann (w/m2/k4) + ,grav => con_g & !< acceleration due to gravity (kg/m/s^2) + ,omega => con_omega & !< ang vel of earth (1/s) + ,rvrdm1 => con_fvirt & !< con_rv/con_rd-1. (nd) + ,rd => con_rd & !< gas constant air (j/kg/k) + ,rocp => con_rocp & !< r/cp + ,pi => con_pi + + implicit none + + private + + public :: sigma_r + public :: zero, one, half + public :: niter_conv, niter_z_w, niter_sfs + public :: z_w_max, z_w_min, z_w_ini, z_c_max, z_c_ini, eps_z_w, eps_conv, eps_sfs + public :: ri_c, ri_g, omg_m, omg_sh, tc_w, visw, cp_w, t0k, ustar_a_min, delz, exp_const + public :: rad2deg, const_rot, tw_max, sst_max, solar_time_6am, tau_min, wd_max + + real(kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, half = 0.5_kind_phys ! ! note: take timestep from here later - public integer :: & niter_conv = 5, & niter_z_w = 5, & niter_sfs = 5 - real (kind=kind_phys), parameter :: & - ! - ! general constants - sec_in_day=86400. & - ,sec_in_hour=3600. & - ,solar_time_6am=21600.0 & - ,const_rot=0.000073 & !< constant to calculate corioli force - ,ri_c=0.65 & - ,ri_g=0.25 & - ,eps_z_w=0.01 & !< criteria to finish iterations for z_w - ,eps_conv=0.01 & !< criteria to finish iterations for d_conv - ,eps_sfs=0.01 & !< criteria to finish iterations for d_sfs - ,z_w_max=20.0 & !< max warm layer thickness - ,z_w_min=0.2 & !< min warm layer thickness - ,z_w_ini=0.2 & !< initial warm layer thickness in dtl_onset - ,z_c_max=0.01 & !< maximum of sub-layer thickness (m) - ,z_c_ini=0.001 & !< initial value of z_c - ,ustar_a_min=0.031 & !< minimum of friction wind speed (m/s): 0.031 ~ 1m/s at 10 m hight - ,tau_min=0.005 & !< minimum of wind stress for dtm - ,exp_const=9.5 & !< coefficient in exponet profile - ,delz=0.1 & !< vertical increment for integral calculation (m) - ,von=0.4 & !< von karman's "constant" - ,t0k=273.16 & !< celsius to kelvin - ,gray=0.97 & - ,sst_max=308.16 & - ,tw_max=5.0 & - ,wd_max=2.0 & - ,omg_m =1.0 & !< trace factor to apply salinity effect - ,omg_rot = 1.0 & !< trace factor to apply rotation effect - ,omg_sh = 1.0 & !< trace factor to apply sensible heat due to rainfall effect - ,visw=1.e-6 & !< m2/s kinematic viscosity water - ,novalue=0 & - ,smallnumber=1.e-6 & - ,timestep_oc=sec_in_day/8. & !< time step in the ocean model (3 hours) - ,radian=2.*pi/180. & - ,rad2deg=180./pi & - ,cp_w=4000. & !< specific heat water (j/kg/k ) - ,rho0_w=1022.0 & !< density water (kg/m3 ) (or 1024.438) - ,vis_w=1.e-6 & !< kinematic viscosity water (m2/s ) - ,tc_w=0.6 & !< thermal conductivity water (w/m/k ) - ,capa_w =3950.0 & !< heat capacity of sea water ! - ,thref =1.0e-3 !< reference value of specific volume (m**3/kg) + ! + ! general constants + real (kind=kind_phys), parameter :: & + sec_in_day = 86400. & + ,sec_in_hour = 3600. & + ,solar_time_6am = 21600.0 & + ,const_rot = 0.000073 & !< constant to calculate corioli force + ,ri_c = 0.65 & + ,ri_g = 0.25 & + ,eps_z_w = 0.01 & !< criteria to finish iterations for z_w + ,eps_conv = 0.01 & !< criteria to finish iterations for d_conv + ,eps_sfs = 0.01 & !< criteria to finish iterations for d_sfs + ,z_w_max = 20.0 & !< max warm layer thickness + ,z_w_min = 0.2 & !< min warm layer thickness + ,z_w_ini = 0.2 & !< initial warm layer thickness in dtl_onset + ,z_c_max = 0.01 & !< maximum of sub-layer thickness (m) + ,z_c_ini = 0.001 & !< initial value of z_c + ,ustar_a_min = 0.031 & !< minimum of friction wind speed (m/s): 0.031 ~ 1m/s at 10 m hight + ,tau_min = 0.005 & !< minimum of wind stress for dtm + ,exp_const = 9.5 & !< coefficient in exponet profile + ,delz = 0.1 & !< vertical increment for integral calculation (m) + ,von = 0.4 & !< von karman's "constant" + ,t0k = 273.16 & !< celsius to kelvin + ,gray = 0.97 & + ,sst_max = 308.16 & + ,tw_max = 5.0 & + ,wd_max = 2.0 & + ,omg_m = 1.0 & !< trace factor to apply salinity effect + ,omg_rot = 1.0 & !< trace factor to apply rotation effect + ,omg_sh = 1.0 & !< trace factor to apply sensible heat due to rainfall effect + ,visw = 1.e-6 & !< m2/s kinematic viscosity water + ,novalue = 0 & + ,smallnumber = 1.e-6 & + ,timestep_oc = sec_in_day/8. & !< time step in the ocean model (3 hours) + ,radian = 2.*pi/180. & + ,rad2deg = 180./pi & + ,cp_w = 4000. & !< specific heat water (j/kg/k ) + ,rho0_w = 1022.0 & !< density water (kg/m3 ) (or 1024.438) + ,vis_w = 1.e-6 & !< kinematic viscosity water (m2/s ) + ,tc_w = 0.6 & !< thermal conductivity water (w/m/k ) + ,capa_w = 3950.0 & !< heat capacity of sea water ! + ,thref = 1.0e-3 !< reference value of specific volume (m**3/kg) !!$!============================================ !!$ diff --git a/physics/module_nst_water_prop.f90 b/physics/module_nst_water_prop.f90 index 2b36be5df..858659e90 100644 --- a/physics/module_nst_water_prop.f90 +++ b/physics/module_nst_water_prop.f90 @@ -1,3 +1,4 @@ + !>\file module_nst_water_prop.f90 !! This file contains GFS NSST water property subroutines. @@ -5,46 +6,45 @@ !!This module contains GFS NSST water property subroutines. !!\ingroup gfs_nst_main_mod module module_nst_water_prop - use machine, only : kind_phys - use module_nst_parameters, only : t0k + use machine , only : kind_phys + use module_nst_parameters , only : t0k, zero, one, half + + implicit none ! private - public :: rhocoef,density,sw_rad,sw_rad_aw,sw_rad_sum,sw_rad_upper,sw_rad_upper_aw,sw_rad_skin,grv,solar_time_from_julian,compjd, & - sw_ps_9b,sw_ps_9b_aw,get_dtzm_point,get_dtzm_2d + public :: rhocoef, density, sw_rad_skin, grv, sw_ps_9b, sw_ps_9b_aw, get_dtzm_point, get_dtzm_2d - integer, parameter :: kp = kind_phys - real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp, half=0.5_kp ! interface sw_ps_9b module procedure sw_ps_9b - end interface + end interface sw_ps_9b interface sw_ps_9b_aw module procedure sw_ps_9b_aw - end interface + end interface sw_ps_9b_aw ! interface sw_rad module procedure sw_fairall_6exp_v1 ! sw_wick_v1 - end interface + end interface sw_rad interface sw_rad_aw module procedure sw_fairall_6exp_v1_aw - end interface + end interface sw_rad_aw interface sw_rad_sum module procedure sw_fairall_6exp_v1_sum - end interface + end interface sw_rad_sum interface sw_rad_upper module procedure sw_soloviev_3exp_v2 - end interface + end interface sw_rad_upper interface sw_rad_upper_aw module procedure sw_soloviev_3exp_v2_aw - end interface + end interface sw_rad_upper_aw interface sw_rad_skin module procedure sw_ohlmann_v1 - end interface + end interface sw_rad_skin contains ! ------------------------------------------------------ -!>\ingroup gfs_nst_main_mod -!! This subroutine computes thermal expansion coefficient (alpha) -!! and saline contraction coefficient (beta). + !>\ingroup gfs_nst_main_mod + !! This subroutine computes thermal expansion coefficient (alpha) + !! and saline contraction coefficient (beta). subroutine rhocoef(t, s, rhoref, alpha, beta) ! ------------------------------------------------------ @@ -55,7 +55,6 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) ! dynamical oceanography, pp310. ! note: compression effects are not included - implicit none real(kind=kind_phys), intent(in) :: t, s, rhoref real(kind=kind_phys), intent(out) :: alpha, beta real(kind=kind_phys) :: tc @@ -87,11 +86,10 @@ subroutine rhocoef(t, s, rhoref, alpha, beta) end subroutine rhocoef ! ---------------------------------------- -!>\ingroup gfs_nst_main_mod -!! This subroutine computes sea water density. + !>\ingroup gfs_nst_main_mod + !! This subroutine computes sea water density. subroutine density(t, s, rho) ! ---------------------------------------- - implicit none ! input real(kind=kind_phys), intent(in) :: t !unit, k @@ -125,9 +123,9 @@ end subroutine density ! !====================== ! -!>\ingroup gfs_nst_main_mod -!! This subroutine computes the fraction of the solar radiation absorbed -!! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . + !>\ingroup gfs_nst_main_mod + !! This subroutine computes the fraction of the solar radiation absorbed + !! by the depth z following Paulson and Simpson (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_ps_9b(z,fxp) ! ! fraction of the solar radiation absorbed by the ocean at the depth z @@ -139,17 +137,15 @@ elemental subroutine sw_ps_9b(z,fxp) ! output: ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none real(kind=kind_phys), intent(in) :: z real(kind=kind_phys), intent(out) :: fxp - real(kind=kind_phys), dimension(9), parameter :: & - f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>zero) then - fxp=one-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & - f(4)*exp(-z/gamma(4))+f(5)*exp(-z/gamma(5))+f(6)*exp(-z/gamma(6))+ & - f(7)*exp(-z/gamma(7))+f(8)*exp(-z/gamma(8))+f(9)*exp(-z/gamma(9))) + fxp=one-(f(1)*exp(-z/gamma(1))+f(2)*exp(-z/gamma(2))+f(3)*exp(-z/gamma(3))+ & + f(4)*exp(-z/gamma(4))+f(5)*exp(-z/gamma(5))+f(6)*exp(-z/gamma(6))+ & + f(7)*exp(-z/gamma(7))+f(8)*exp(-z/gamma(8))+f(9)*exp(-z/gamma(9))) else fxp=zero endif @@ -161,8 +157,8 @@ end subroutine sw_ps_9b ! !====================== ! -!>\ingroup gfs_nst_main_mod -!! This subroutine + !>\ingroup gfs_nst_main_mod + !! This subroutine elemental subroutine sw_ps_9b_aw(z,aw) ! ! d(fw)/d(z) for 9-band @@ -173,17 +169,15 @@ elemental subroutine sw_ps_9b_aw(z,aw) ! output: ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none real(kind=kind_phys), intent(in) :: z real(kind=kind_phys), intent(out) :: aw - real(kind=kind_phys), dimension(9), parameter :: & - f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) ! if(z>zero) then - aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & - (f(1)/gamma(4))*exp(-z/gamma(4))+(f(2)/gamma(5))*exp(-z/gamma(5))+(f(6)/gamma(6))*exp(-z/gamma(6))+ & - (f(1)/gamma(7))*exp(-z/gamma(7))+(f(2)/gamma(8))*exp(-z/gamma(8))+(f(9)/gamma(9))*exp(-z/gamma(9)) + aw=(f(1)/gamma(1))*exp(-z/gamma(1))+(f(2)/gamma(2))*exp(-z/gamma(2))+(f(3)/gamma(3))*exp(-z/gamma(3))+ & + (f(1)/gamma(4))*exp(-z/gamma(4))+(f(2)/gamma(5))*exp(-z/gamma(5))+(f(6)/gamma(6))*exp(-z/gamma(6))+ & + (f(1)/gamma(7))*exp(-z/gamma(7))+(f(2)/gamma(8))*exp(-z/gamma(8))+(f(9)/gamma(9))*exp(-z/gamma(9)) else aw=zero endif @@ -191,10 +185,10 @@ elemental subroutine sw_ps_9b_aw(z,aw) end subroutine sw_ps_9b_aw ! !====================== -!>\ingroup gfs_nst_main_mod -!! This subroutine computes fraction of the solar radiation absorbed by the ocean at the depth -!! z (Fairall et al. (1996) \cite fairall_et_al_1996, p. 1298) following Paulson and Simpson -!! (1981) \cite paulson_and_simpson_1981 . + !>\ingroup gfs_nst_main_mod + !! This subroutine computes fraction of the solar radiation absorbed by the ocean at the depth + !! z (Fairall et al. (1996) \cite fairall_et_al_1996, p. 1298) following Paulson and Simpson + !! (1981) \cite paulson_and_simpson_1981 . elemental subroutine sw_fairall_6exp_v1(z,fxp) ! ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) @@ -206,13 +200,13 @@ elemental subroutine sw_fairall_6exp_v1(z,fxp) ! output: ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: fxp - real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) - real(kind=kind_phys),dimension(9) :: zgamma - real(kind=kind_phys),dimension(9) :: f_c + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp + + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_c ! if(z>zero) then zgamma=z/gamma @@ -227,10 +221,10 @@ end subroutine sw_fairall_6exp_v1 !====================== ! ! -!>\ingroup gfs_nst_main_mod -!! This subroutine calculates fraction of the solar radiation absorbed by the -!! ocean at the depth z (fairall et al.(1996) \cite fairall_et_al_1996; p.1298) -!! following Paulson and Simpson (1981) \cite paulson_and_simpson_1981. + !>\ingroup gfs_nst_main_mod + !! This subroutine calculates fraction of the solar radiation absorbed by the + !! ocean at the depth z (fairall et al.(1996) \cite fairall_et_al_1996; p.1298) + !! following Paulson and Simpson (1981) \cite paulson_and_simpson_1981. elemental subroutine sw_fairall_6exp_v1_aw(z,aw) ! ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) @@ -244,34 +238,31 @@ elemental subroutine sw_fairall_6exp_v1_aw(z,aw) ! ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: aw - real(kind=kind_phys) :: fxp - real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) & - ,gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) - real(kind=kind_phys),dimension(9) :: zgamma - real(kind=kind_phys),dimension(9) :: f_aw + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + + real(kind=kind_phys), dimension(9), parameter :: f=(/0.237,0.36,0.179,0.087,0.08,0.0246,0.025,0.007,0.0004/) + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_aw ! if(z>zero) then zgamma=z/gamma f_aw=(f/z)*((gamma/z)*(one-exp(-zgamma))-exp(-zgamma)) aw=sum(f_aw) - -! write(*,'(a,f6.2,f12.6,9f10.4)') 'z,aw in sw_rad_aw : ',z,aw,f_aw - + ! write(*,'(a,f6.2,f12.6,9f10.4)') 'z,aw in sw_rad_aw : ',z,aw,f_aw else aw=zero endif ! end subroutine sw_fairall_6exp_v1_aw ! -!>\ingroup gfs_nst_main_mod -!! This subroutine computes fraction of the solar radiation absorbed by the ocean at the -!! depth z (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1298) following Paulson and -!! Simpson (1981) \cite paulson_and_simpson_1981 . -!>\param[in] z depth (m) -!>\param[out] sum for convection depth calculation + !>\ingroup gfs_nst_main_mod + !! This subroutine computes fraction of the solar radiation absorbed by the ocean at the + !! depth z (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1298) following Paulson and + !! Simpson (1981) \cite paulson_and_simpson_1981 . + !>\param[in] z depth (m) + !>\param[out] sum for convection depth calculation elemental subroutine sw_fairall_6exp_v1_sum(z,sum) ! ! fraction of the solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) @@ -284,30 +275,30 @@ elemental subroutine sw_fairall_6exp_v1_sum(z,sum) ! sum: for convection depth calculation ! ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: sum + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: sum + real(kind=kind_phys), dimension(9), parameter :: gamma=(/34.8,2.27,3.15e-2,5.48e-3,8.32e-4,1.26e-4,3.13e-4,7.82e-5,1.44e-5/) - real(kind=kind_phys),dimension(9) :: zgamma - real(kind=kind_phys),dimension(9) :: f_sum + real(kind=kind_phys), dimension(9) :: zgamma + real(kind=kind_phys), dimension(9) :: f_sum ! -! zgamma=z/gamma -! f_sum=(zgamma/z)*exp(-zgamma) -! sum=sum(f_sum) + ! zgamma=z/gamma + ! f_sum=(zgamma/z)*exp(-zgamma) + ! sum=sum(f_sum) - sum=(one/gamma(1))*exp(-z/gamma(1))+(one/gamma(2))*exp(-z/gamma(2))+(one/gamma(3))*exp(-z/gamma(3))+ & - (one/gamma(4))*exp(-z/gamma(4))+(one/gamma(5))*exp(-z/gamma(5))+(one/gamma(6))*exp(-z/gamma(6))+ & - (one/gamma(7))*exp(-z/gamma(7))+(one/gamma(8))*exp(-z/gamma(8))+(one/gamma(9))*exp(-z/gamma(9)) + sum=( one/gamma(1))*exp(-z/gamma(1))+(one/gamma(2))*exp(-z/gamma(2))+(one/gamma(3))*exp(-z/gamma(3))+ & + (one/gamma(4))*exp(-z/gamma(4))+(one/gamma(5))*exp(-z/gamma(5))+(one/gamma(6))*exp(-z/gamma(6))+ & + (one/gamma(7))*exp(-z/gamma(7))+(one/gamma(8))*exp(-z/gamma(8))+(one/gamma(9))*exp(-z/gamma(9)) ! end subroutine sw_fairall_6exp_v1_sum ! !====================== -!>\ingroup gfs_nst_main_mod -!! Solar radiation absorbed by the ocean at the depth z (Fairall et al. (1996) -!! \cite fairall_et_al_1996, p.1298) -!!\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) -!!\param[in] z depth (m) -!!\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + !>\ingroup gfs_nst_main_mod + !! Solar radiation absorbed by the ocean at the depth z (Fairall et al. (1996) + !! \cite fairall_et_al_1996, p.1298) + !!\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !!\param[in] z depth (m) + !!\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) elemental subroutine sw_fairall_simple_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1298) @@ -319,9 +310,8 @@ elemental subroutine sw_fairall_simple_v1(f_sol_0,z,df_sol_z) ! output: ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z,f_sol_0 - real(kind=kind_phys),intent(out):: df_sol_z + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z ! if(z>zero) then df_sol_z=f_sol_0*(0.137+11.0*z-6.6e-6/z*(one-exp(-z/8.e-4))) @@ -333,12 +323,12 @@ end subroutine sw_fairall_simple_v1 ! !====================== ! -!>\ingroup gfs_nst_main_mod -!! solar radiation absorbed by the ocean at the depth z (Zeng and Beljaars (2005) -!! \cite zeng_and_beljaars_2005 , p.5). -!>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) -!>\param[in] z depth (m) -!>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + !>\ingroup gfs_nst_main_mod + !! solar radiation absorbed by the ocean at the depth z (Zeng and Beljaars (2005) + !! \cite zeng_and_beljaars_2005 , p.5). + !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !>\param[in] z depth (m) + !>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (zeng and beljaars, 2005, p.5) @@ -350,9 +340,8 @@ elemental subroutine sw_wick_v1(f_sol_0,z,df_sol_z) ! output: ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z,f_sol_0 - real(kind=kind_phys),intent(out):: df_sol_z + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z ! if(z>zero) then df_sol_z=f_sol_0*(0.065+11.0*z-6.6e-5/z*(one-exp(-z/8.e-4))) @@ -364,13 +353,13 @@ end subroutine sw_wick_v1 ! !====================== ! -!>\ingroup gfs_nst_main_mod -!! This subroutine computes solar radiation absorbed by the ocean at the depth z -!! (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1301) following -!! Soloviev and Vershinsky (1982) \cite soloviev_and_vershinsky_1982. -!>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) -!>\param[in] z depth (m) -!>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) + !>\ingroup gfs_nst_main_mod + !! This subroutine computes solar radiation absorbed by the ocean at the depth z + !! (Fairall et al.(1996) \cite fairall_et_al_1996 , p.1301) following + !! Soloviev and Vershinsky (1982) \cite soloviev_and_vershinsky_1982. + !>\param[in] f_sol_0 solar radiation at the ocean surface (\f$W m^{-2}\f$) + !>\param[in] z depth (m) + !>\param[out] df_sol_z solar radiation absorbed by the ocean at depth z (\f$W m^{-2}\f$) elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) @@ -383,12 +372,11 @@ elemental subroutine sw_soloviev_3exp_v1(f_sol_0,z,df_sol_z) ! output: ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z,f_sol_0 - real(kind=kind_phys),intent(out):: df_sol_z - real(kind=kind_phys),dimension(3) :: f_c - real(kind=kind_phys), dimension(3), parameter :: f=(/0.45,0.27,0.28/) & - ,gamma=(/12.8,0.357,0.014/) + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z + real(kind=kind_phys), dimension(3) :: f_c + real(kind=kind_phys), dimension(3), parameter :: f=(/0.45,0.27,0.28/) + real(kind=kind_phys), dimension(3), parameter :: gamma=(/12.82,0.357,0.014/) ! if(z>zero) then f_c = f*gamma(int(one-exp(-z/gamma))) @@ -401,7 +389,7 @@ end subroutine sw_soloviev_3exp_v1 ! !====================== ! -!>\ingroup gfs_nst_main_mod + !>\ingroup gfs_nst_main_mod elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! ! solar radiation absorbed by the ocean at the depth z (fairall et all, 1996, p. 1301) @@ -414,9 +402,8 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! output: ! df_sol_z: solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z,f_sol_0 - real(kind=kind_phys),intent(out):: df_sol_z + real(kind=kind_phys), intent(in) :: z,f_sol_0 + real(kind=kind_phys), intent(out) :: df_sol_z ! if(z>zero) then df_sol_z=f_sol_0*(one & @@ -430,7 +417,7 @@ elemental subroutine sw_soloviev_3exp_v2(f_sol_0,z,df_sol_z) ! end subroutine sw_soloviev_3exp_v2 -!>\ingroup gfs_nst_main_mod + !>\ingroup gfs_nst_main_mod elemental subroutine sw_soloviev_3exp_v2_aw(z,aw) ! ! aw = d(fxp)/d(z) @@ -442,10 +429,9 @@ elemental subroutine sw_soloviev_3exp_v2_aw(z,aw) ! output: ! aw: d(fxp)/d(z) ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: aw - real(kind=kind_phys):: fxp + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: aw + real(kind=kind_phys) :: fxp ! if(z>zero) then fxp=(one & @@ -462,7 +448,7 @@ end subroutine sw_soloviev_3exp_v2_aw ! !====================== ! -!>\ingroup gfs_nst_main_mod + !>\ingroup gfs_nst_main_mod elemental subroutine sw_ohlmann_v1(z,fxp) ! ! fraction of the solar radiation absorbed by the ocean at the depth z @@ -473,9 +459,8 @@ elemental subroutine sw_ohlmann_v1(z,fxp) ! output: ! fxp: fraction of the solar radiation absorbed by the ocean at depth z (w/m^2) ! - implicit none - real(kind=kind_phys),intent(in):: z - real(kind=kind_phys),intent(out):: fxp + real(kind=kind_phys), intent(in) :: z + real(kind=kind_phys), intent(out) :: fxp ! if(z>zero) then fxp=.065+11.*z-6.6e-5/z*(one-exp(-z/8.0e-4)) @@ -486,276 +471,264 @@ elemental subroutine sw_ohlmann_v1(z,fxp) end subroutine sw_ohlmann_v1 ! -!>\ingroup gfs_nst_main_mod -function grv(x) - real(kind=kind_phys) :: x !< sin(lat) - real(kind=kind_phys) :: gamma,c1,c2,c3,c4 - gamma=9.7803267715 - c1=0.0052790414 - c2=0.0000232718 - c3=0.0000001262 - c4=0.0000000007 - - grv=gamma*(1.0+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) -end function grv - -!>\ingroup gfs_nst_main_mod -!>This subroutine computes solar time from the julian date. -subroutine solar_time_from_julian(jday,xlon,soltim) - ! - ! calculate solar time from the julian date + !>\ingroup gfs_nst_main_mod + real(kind_phys) function grv(x) + real(kind=kind_phys) :: x !< sin(lat) + real(kind=kind_phys) :: gamma,c1,c2,c3,c4 + gamma=9.7803267715 + c1=0.0052790414 + c2=0.0000232718 + c3=0.0000001262 + c4=0.0000000007 + + grv=gamma*(one+(c1*x**2)+(c2*x**4)+(c3*x**6)+(c4*x**8)) + end function grv + + !>\ingroup gfs_nst_main_mod + !>This subroutine computes solar time from the julian date. + subroutine solar_time_from_julian(jday,xlon,soltim) + ! + ! calculate solar time from the julian date + ! + real(kind=kind_phys), intent(in) :: jday + real(kind=kind_phys), intent(in) :: xlon + real(kind=kind_phys), intent(out) :: soltim + real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime + ! + fjd=jday-floor(jday) + fjd=jday + xhr=floor(fjd*24.0)-sign(12.0,fjd-half) + xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-half))*60.0 + xsec=zero + intime=xhr+xmin/60.0+xsec/3600.0+24.0 + soltim=mod(xlon/15.0+intime,24.0)*3600.0 + end subroutine solar_time_from_julian + ! - implicit none - real(kind=kind_phys), intent(in) :: jday - real(kind=kind_phys), intent(in) :: xlon - real(kind=kind_phys), intent(out) :: soltim - real(kind=kind_phys) :: fjd,xhr,xmin,xsec,intime - integer :: nn + !*********************************************************************** ! - fjd=jday-floor(jday) - fjd=jday - xhr=floor(fjd*24.0)-sign(12.0,fjd-half) - xmin=nint(fjd*1440.0)-(xhr+sign(12.0,fjd-half))*60.0 - xsec=zero - intime=xhr+xmin/60.0+xsec/3600.0+24.0 - soltim=mod(xlon/15.0+intime,24.0)*3600.0 -end subroutine solar_time_from_julian - -! -!*********************************************************************** -! -!>\ingroup gfs_nst_main_mod -!> This subroutine computes julian day and fraction from year, -!! month, day and time UTC. - subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) -!fpp$ noconcur r -!$$$ subprogram documentation block -! . . . . -! subprogram: compjd computes julian day and fraction -! prgmmr: kenneth campana org: w/nmc23 date: 89-07-07 -! -! abstract: computes julian day and fraction -! from year, month, day and time utc. -! -! program history log: -! 77-05-06 ray orzol,gfdl -! 98-05-15 iredell y2k compliance -! -! usage: call compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) -! input argument list: -! jyr - year (4 digits) -! jmnth - month -! jday - day -! jhr - hour -! jmn - minutes -! output argument list: -! jd - julian day. -! fjd - fraction of the julian day. -! -! subprograms called: -! iw3jdn compute julian day number -! -! attributes: -! language: fortran. -! -!$$$ - use machine , only :kind_phys - implicit none -! - integer jyr,jmnth,jday,jhr,jmn,jd - integer iw3jdn - real (kind=kind_phys) fjd - jd=iw3jdn(jyr,jmnth,jday) - if(jhr.lt.12) then - jd=jd-1 - fjd=half+jhr/24.+jmn/1440. - else - fjd=(jhr-12)/24.+jmn/1440. - endif - end subroutine compjd - -!>\ingroup gfs_nst_main_mod -!>This subroutine computes dtm (the mean of \f$dT(z)\f$). - subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) -! ===================================================================== ! -! ! -! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! -! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! -! ! -! usage: ! -! ! -! call get_dtm12 ! -! ! -! inputs: ! -! (xt,xz,dt_cool,zc,z1,z2, ! -! outputs: ! -! dtm) ! -! ! -! program history log: ! -! ! -! 2015 -- xu li createad original code ! -! inputs: ! -! xt - real, heat content in dtl 1 ! -! xz - real, dtl thickness 1 ! -! dt_cool - real, sub-layer cooling amount 1 ! -! zc - sub-layer cooling thickness 1 ! -! z1 - lower bound of depth of sea temperature 1 ! -! z2 - upper bound of depth of sea temperature 1 ! -! outputs: ! -! dtm - mean of dT(z) (z1 to z2) 1 ! -! - use machine , only : kind_phys - - implicit none - - real (kind=kind_phys), intent(in) :: xt,xz,dt_cool,zc,z1,z2 - real (kind=kind_phys), intent(out) :: dtm -! Local variables - real (kind=kind_phys) :: dt_warm,dtw,dtc - -! -! get the mean warming in the range of z=z1 to z=z2 -! - dtw = zero - if ( xt > zero ) then - dt_warm = (xt+xt)/xz ! Tw(0) - if ( z1 < z2) then - if ( z2 < xz ) then - dtw = dt_warm*(one-(z1+z2)/(xz+xz)) - elseif ( z1 < xz .and. z2 >= xz ) then - dtw = half*(one-z1/xz)*dt_warm*(xz-z1)/(z2-z1) - endif - elseif ( z1 == z2 ) then - if ( z1 < xz ) then - dtw = dt_warm*(one-z1/xz) - endif + !>\ingroup gfs_nst_main_mod + !> This subroutine computes julian day and fraction from year, + !! month, day and time UTC. + subroutine compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) + !fpp$ noconcur r + !$$$ subprogram documentation block + ! . . . . + ! subprogram: compjd computes julian day and fraction + ! prgmmr: kenneth campana org: w/nmc23 date: 89-07-07 + ! + ! abstract: computes julian day and fraction + ! from year, month, day and time utc. + ! + ! program history log: + ! 77-05-06 ray orzol,gfdl + ! 98-05-15 iredell y2k compliance + ! + ! usage: call compjd(jyr,jmnth,jday,jhr,jmn,jd,fjd) + ! input argument list: + ! jyr - year (4 digits) + ! jmnth - month + ! jday - day + ! jhr - hour + ! jmn - minutes + ! output argument list: + ! jd - julian day. + ! fjd - fraction of the julian day. + ! + ! subprograms called: + ! iw3jdn compute julian day number + ! + ! attributes: + ! language: fortran. + ! + !$$$ + ! + integer :: jyr,jmnth,jday,jhr,jmn,jd + integer :: iw3jdn + real (kind=kind_phys) fjd + jd=iw3jdn(jyr,jmnth,jday) + if(jhr.lt.12) then + jd=jd-1 + fjd=half+jhr/24.+jmn/1440. + else + fjd=(jhr-12)/24.+jmn/1440. endif - endif -! -! get the mean cooling in the range of z=z1 to z=z2 -! - dtc = zero - if ( zc > zero ) then - if ( z1 < z2) then - if ( z2 < zc ) then - dtc = dt_cool*(one-(z1+z2)/(zc+zc)) - elseif ( z1 < zc .and. z2 >= zc ) then - dtc = half*(one-z1/zc)*dt_cool*(zc-z1)/(z2-z1) - endif - elseif ( z1 == z2 ) then - if ( z1 < zc ) then - dtc = dt_cool*(one-z1/zc) - endif + end subroutine compjd + + !>\ingroup gfs_nst_main_mod + !>This subroutine computes dtm (the mean of \f$dT(z)\f$). + subroutine get_dtzm_point(xt,xz,dt_cool,zc,z1,z2,dtm) + ! ===================================================================== ! + ! ! + ! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! + ! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! + ! ! + ! usage: ! + ! ! + ! call get_dtm12 ! + ! ! + ! inputs: ! + ! (xt,xz,dt_cool,zc,z1,z2, ! + ! outputs: ! + ! dtm) ! + ! ! + ! program history log: ! + ! ! + ! 2015 -- xu li createad original code ! + ! inputs: ! + ! xt - real, heat content in dtl 1 ! + ! xz - real, dtl thickness 1 ! + ! dt_cool - real, sub-layer cooling amount 1 ! + ! zc - sub-layer cooling thickness 1 ! + ! z1 - lower bound of depth of sea temperature 1 ! + ! z2 - upper bound of depth of sea temperature 1 ! + ! outputs: ! + ! dtm - mean of dT(z) (z1 to z2) 1 ! + ! + real (kind=kind_phys), intent(in) :: xt,xz,dt_cool,zc,z1,z2 + real (kind=kind_phys), intent(out) :: dtm + ! Local variables + real (kind=kind_phys) :: dt_warm,dtw,dtc + + ! + ! get the mean warming in the range of z=z1 to z=z2 + ! + dtw = zero + if ( xt > zero ) then + dt_warm = (xt+xt)/xz ! Tw(0) + if ( z1 < z2) then + if ( z2 < xz ) then + dtw = dt_warm*(one-(z1+z2)/(xz+xz)) + elseif ( z1 < xz .and. z2 >= xz ) then + dtw = half*(one-z1/xz)*dt_warm*(xz-z1)/(z2-z1) + endif + elseif ( z1 == z2 ) then + if ( z1 < xz ) then + dtw = dt_warm*(one-z1/xz) + endif + endif endif - endif - -! -! get the mean T departure from Tf in the range of z=z1 to z=z2 -! - dtm = dtw - dtc - - end subroutine get_dtzm_point - -!>\ingroup gfs_nst_main_mod - subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,dtm) -!subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) -! ===================================================================== ! -! ! -! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! -! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! -! ! -! usage: ! -! ! -! call get_dtzm_2d ! -! ! -! inputs: ! -! (xt,xz,dt_cool,zc,z1,z2, ! -! outputs: ! -! dtm) ! -! ! -! program history log: ! -! ! -! 2015 -- xu li createad original code ! -! inputs: ! -! xt - real, heat content in dtl 1 ! -! xz - real, dtl thickness 1 ! -! dt_cool - real, sub-layer cooling amount 1 ! -! zc - sub-layer cooling thickness 1 ! -! wet - logical, flag for wet point (ocean or lake) 1 ! -! icy - logical, flag for ice point (ocean or lake) 1 ! -! nx - integer, dimension in x-direction (zonal) 1 ! -! ny - integer, dimension in y-direction (meridional) 1 ! -! z1 - lower bound of depth of sea temperature 1 ! -! z2 - upper bound of depth of sea temperature 1 ! -! nth - integer, num of openmp thread 1 ! -! outputs: ! -! dtm - mean of dT(z) (z1 to z2) 1 ! -! - use machine , only : kind_phys - - implicit none - - integer, intent(in) :: nx,ny, nth - real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc - logical, dimension(nx,ny), intent(in) :: wet -! logical, dimension(nx,ny), intent(in) :: wet,icy - real (kind=kind_phys), intent(in) :: z1,z2 - real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm -! Local variables - integer :: i,j - real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi - - -!$omp parallel do num_threads (nth) private(j,i,dtw,dtc,xzi) - do j = 1, ny - do i= 1, nx - - dtm(i,j) = zero ! initialize dtm - - if ( wet(i,j) ) then -! -! get the mean warming in the range of z=z1 to z=z2 -! - dtw = zero - if ( xt(i,j) > zero ) then - xzi = one / xz(i,j) - dt_warm = (xt(i,j)+xt(i,j)) * xzi ! Tw(0) - if (z1 < z2) then - if ( z2 < xz(i,j) ) then - dtw = dt_warm * (one-half*(z1+z2)*xzi) - elseif (z1 < xz(i,j) .and. z2 >= xz(i,j) ) then - dtw = half*(one-z1*xzi)*dt_warm*(xz(i,j)-z1)/(z2-z1) - endif - elseif (z1 == z2 ) then - if (z1 < xz(i,j) ) then - dtw = dt_warm * (one-z1*xzi) - endif + ! + ! get the mean cooling in the range of z=z1 to z=z2 + ! + dtc = zero + if ( zc > zero ) then + if ( z1 < z2) then + if ( z2 < zc ) then + dtc = dt_cool*(one-(z1+z2)/(zc+zc)) + elseif ( z1 < zc .and. z2 >= zc ) then + dtc = half*(one-z1/zc)*dt_cool*(zc-z1)/(z2-z1) endif - endif -! -! get the mean cooling in the range of z=0 to z=zsea -! - dtc = zero - if ( zc(i,j) > zero ) then - if ( z1 < z2) then - if ( z2 < zc(i,j) ) then - dtc = dt_cool(i,j) * (one-(z1+z2)/(zc(i,j)+zc(i,j))) - elseif ( z1 < zc(i,j) .and. z2 >= zc(i,j) ) then - dtc = half*(one-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) - endif - elseif ( z1 == z2 ) then - if ( z1 < zc(i,j) ) then - dtc = dt_cool(i,j) * (one-z1/zc(i,j)) - endif + elseif ( z1 == z2 ) then + if ( z1 < zc ) then + dtc = dt_cool*(one-z1/zc) endif - endif -! get the mean T departure from Tf in the range of z=z1 to z=z2 - dtm(i,j) = dtw - dtc - endif ! if ( wet(i,j)) then + endif + endif + + ! + ! get the mean T departure from Tf in the range of z=z1 to z=z2 + ! + dtm = dtw - dtc + + end subroutine get_dtzm_point + + !>\ingroup gfs_nst_main_mod + subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,z1,z2,nx,ny,nth,dtm) + !subroutine get_dtzm_2d(xt,xz,dt_cool,zc,wet,icy,z1,z2,nx,ny,dtm) + ! ===================================================================== ! + ! ! + ! description: get dtm = mean of dT(z) (z1 - z2) with NSST dT(z) ! + ! dT(z) = (1-z/xz)*dt_warm - (1-z/zc)*dt_cool ! + ! ! + ! usage: ! + ! ! + ! call get_dtzm_2d ! + ! ! + ! inputs: ! + ! (xt,xz,dt_cool,zc,z1,z2, ! + ! outputs: ! + ! dtm) ! + ! ! + ! program history log: ! + ! ! + ! 2015 -- xu li createad original code ! + ! inputs: ! + ! xt - real, heat content in dtl 1 ! + ! xz - real, dtl thickness 1 ! + ! dt_cool - real, sub-layer cooling amount 1 ! + ! zc - sub-layer cooling thickness 1 ! + ! wet - logical, flag for wet point (ocean or lake) 1 ! + ! icy - logical, flag for ice point (ocean or lake) 1 ! + ! nx - integer, dimension in x-direction (zonal) 1 ! + ! ny - integer, dimension in y-direction (meridional) 1 ! + ! z1 - lower bound of depth of sea temperature 1 ! + ! z2 - upper bound of depth of sea temperature 1 ! + ! nth - integer, num of openmp thread 1 ! + ! outputs: ! + ! dtm - mean of dT(z) (z1 to z2) 1 ! + ! + integer, intent(in) :: nx,ny, nth + real (kind=kind_phys), dimension(nx,ny), intent(in) :: xt,xz,dt_cool,zc + logical, dimension(nx,ny), intent(in) :: wet + ! logical, dimension(nx,ny), intent(in) :: wet,icy + real (kind=kind_phys), intent(in) :: z1,z2 + real (kind=kind_phys), dimension(nx,ny), intent(out) :: dtm + ! Local variables + integer :: i,j + real (kind=kind_phys) :: dt_warm, dtw, dtc, xzi + + + !$omp parallel do num_threads (nth) private(j,i,dtw,dtc,xzi) + do j = 1, ny + do i= 1, nx + + dtm(i,j) = zero ! initialize dtm + + if ( wet(i,j) ) then + ! + ! get the mean warming in the range of z=z1 to z=z2 + ! + dtw = zero + if ( xt(i,j) > zero ) then + xzi = one / xz(i,j) + dt_warm = (xt(i,j)+xt(i,j)) * xzi ! Tw(0) + if (z1 < z2) then + if ( z2 < xz(i,j) ) then + dtw = dt_warm * (one-half*(z1+z2)*xzi) + elseif (z1 < xz(i,j) .and. z2 >= xz(i,j) ) then + dtw = half*(one-z1*xzi)*dt_warm*(xz(i,j)-z1)/(z2-z1) + endif + elseif (z1 == z2 ) then + if (z1 < xz(i,j) ) then + dtw = dt_warm * (one-z1*xzi) + endif + endif + endif + ! + ! get the mean cooling in the range of z=0 to z=zsea + ! + dtc = zero + if ( zc(i,j) > zero ) then + if ( z1 < z2) then + if ( z2 < zc(i,j) ) then + dtc = dt_cool(i,j) * (one-(z1+z2)/(zc(i,j)+zc(i,j))) + elseif ( z1 < zc(i,j) .and. z2 >= zc(i,j) ) then + dtc = half*(one-z1/zc(i,j))*dt_cool(i,j)*(zc(i,j)-z1)/(z2-z1) + endif + elseif ( z1 == z2 ) then + if ( z1 < zc(i,j) ) then + dtc = dt_cool(i,j) * (one-z1/zc(i,j)) + endif + endif + endif + ! get the mean T departure from Tf in the range of z=z1 to z=z2 + dtm(i,j) = dtw - dtc + endif ! if ( wet(i,j)) then + enddo enddo - enddo -! + ! - end subroutine get_dtzm_2d + end subroutine get_dtzm_2d end module module_nst_water_prop diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f deleted file mode 100644 index 2ca70666d..000000000 --- a/physics/sfc_nst.f +++ /dev/null @@ -1,696 +0,0 @@ -!>\file sfc_nst.f -!! This file contains the GFS NSST model. - -!> This module contains the CCPP-compliant GFS near-surface sea temperature scheme. - module sfc_nst - - contains - -!>\defgroup gfs_nst_main_mod GFS Near-Surface Sea Temperature Module -!! This module contains the CCPP-compliant GFS near-surface sea temperature scheme. -!> @{ -!! This subroutine calls the Thermal Skin-layer and Diurnal Thermocline models to update the NSST profile. -!! \section arg_table_sfc_nst_run Argument Table -!! \htmlinclude sfc_nst_run.html -!! -!> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm - subroutine sfc_nst_run & - & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: - & pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & - & lseaspray, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & - & sinlat, stress, & - & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & - & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & - & nstf_name5, lprnt, ipr, thsfc_loc, & - & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & - & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: - & ) -! -! ===================================================================== ! -! description: ! -! ! -! ! -! usage: ! -! ! -! call sfc_nst ! -! inputs: ! -! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! -! lseaspray, fm, fm10, ! -! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! -! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! -! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! -! nstf_name5, lprnt, ipr, thsfc_loc, ! -! input/outputs: ! -! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! -! z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, ! -! -- outputs: -! qsurf, gflux, cmm, chh, evap, hflx, ep ! -! ) -! ! -! ! -! subprogram/functions called: w3movdat, iw3jdn, fpvs, density, ! -! rhocoef, cool_skin, warm_layer, jacobi_temp. ! -! ! -! program history log: ! -! 2007 -- xu li createad original code ! -! 2008 -- s. moorthi adapted to the parallel version ! -! may 2009 -- y.-t. hou modified to include input lw surface ! -! emissivity from radiation. also replaced the ! -! often comfusing combined sw and lw suface ! -! flux with separate sfc net sw flux (defined ! -! as dn-up) and lw flux. added a program doc block. ! -! sep 2009 -- s. moorthi removed rcl and additional reformatting ! -! and optimization + made pa as input pressure unit.! -! 2009 -- xu li recreatead the code ! -! feb 2010 -- s. moorthi added some changes made to the previous ! -! version ! -! Jul 2016 -- X. Li, modify the diurnal warming event reset ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! inputs: size ! -! im - integer, horiz dimension 1 ! -! ps - real, surface pressure (pa) im ! -! u1, v1 - real, u/v component of surface layer wind (m/s) im ! -! t1 - real, surface layer mean temperature ( k ) im ! -! q1 - real, surface layer mean specific humidity im ! -! tref - real, reference/foundation temperature ( k ) im ! -! cm - real, surface exchange coeff for momentum (m/s) im ! -! ch - real, surface exchange coeff heat & moisture(m/s) im ! -! lseaspray- logical, .t. for parameterization for sea spray 1 ! -! fm - real, a stability profile function for momentum im ! -! fm10 - real, a stability profile function for momentum im ! -! at 10m ! -! prsl1 - real, surface layer mean pressure (pa) im ! -! prslki - real, im ! -! prsik1 - real, im ! -! prslk1 - real, im ! -! wet - logical, =T if any ocn/lake water (F otherwise) im ! -! use_lake_model- logical, =T if flake model is used for lake im ! -! icy - logical, =T if any ice im ! -! xlon - real, longitude (radians) im ! -! sinlat - real, sin of latitude im ! -! stress - real, wind stress (n/m**2) im ! -! sfcemis - real, sfc lw emissivity (fraction) im ! -! dlwflx - real, total sky sfc downward lw flux (w/m**2) im ! -! sfcnsw - real, total sky sfc netsw flx into ocean (w/m**2) im ! -! rain - real, rainfall rate (kg/m**2/s) im ! -! timestep - real, timestep interval (second) 1 ! -! kdt - integer, time step counter 1 ! -! solhr - real, fcst hour at the end of prev time step 1 ! -! xcosz - real, consine of solar zenith angle 1 ! -! wind - real, wind speed (m/s) im ! -! flag_iter- logical, execution or not im ! -! when iter = 1, flag_iter = .true. for all grids im ! -! when iter = 2, flag_iter = .true. when wind < 2 im ! -! for both land and ocean (when nstf_name1 > 0) im ! -! flag_guess-logical, .true.= guess step to get CD et al im ! -! when iter = 1, flag_guess = .true. when wind < 2 im ! -! when iter = 2, flag_guess = .false. for all grids im ! -! nstf_name - integers , NSST related flag parameters 1 ! -! nstf_name1 : 0 = NSSTM off 1 ! -! 1 = NSSTM on but uncoupled 1 ! -! 2 = NSSTM on and coupled 1 ! -! nstf_name4 : zsea1 in mm 1 ! -! nstf_name5 : zsea2 in mm 1 ! -! lprnt - logical, control flag for check print out 1 ! -! ipr - integer, grid index for check print out 1 ! -! thsfc_loc- logical, flag for reference pressure in theta 1 ! -! ! -! input/outputs: -! li added for oceanic components -! tskin - real, ocean surface skin temperature ( k ) im ! -! tsurf - real, the same as tskin ( k ) but for guess run im ! -! xt - real, heat content in dtl im ! -! xs - real, salinity content in dtl im ! -! xu - real, u-current content in dtl im ! -! xv - real, v-current content in dtl im ! -! xz - real, dtl thickness im ! -! zm - real, mxl thickness im ! -! xtts - real, d(xt)/d(ts) im ! -! xzts - real, d(xz)/d(ts) im ! -! dt_cool - real, sub-layer cooling amount im ! -! d_conv - real, thickness of free convection layer (fcl) im ! -! z_c - sub-layer cooling thickness im ! -! c_0 - coefficient1 to calculate d(tz)/d(ts) im ! -! c_d - coefficient2 to calculate d(tz)/d(ts) im ! -! w_0 - coefficient3 to calculate d(tz)/d(ts) im ! -! w_d - coefficient4 to calculate d(tz)/d(ts) im ! -! ifd - real, index to start dtlm run or not im ! -! qrain - real, sensible heat flux due to rainfall (watts) im ! - -! outputs: ! - -! qsurf - real, surface air saturation specific humidity im ! -! gflux - real, soil heat flux (w/m**2) im ! -! cmm - real, im ! -! chh - real, im ! -! evap - real, evaperation from latent heat flux im ! -! hflx - real, sensible heat flux im ! -! ep - real, potential evaporation im ! -! ! -! ===================================================================== ! - use machine , only : kind_phys - use funcphys, only : fpvs - use date_def, only : idate - use module_nst_water_prop, only: get_dtzm_point - use module_nst_parameters, only : t0k,cp_w,omg_m,omg_sh, & - & sigma_r,solar_time_6am,ri_c,z_w_max,delz,wd_max, & - & rad2deg,const_rot,tau_min,tw_max,sst_max - use module_nst_water_prop, only: solar_time_from_julian, & - & density,rhocoef,compjd,grv & - &, sw_ps_9b - use nst_module, only : cool_skin,dtm_1p,cal_w,cal_ttop, & - & convdepth,dtm_1p_fca,dtm_1p_tla, & - & dtm_1p_mwa,dtm_1p_mda,dtm_1p_mta, & - & dtl_reset -! - implicit none - - integer, parameter :: kp = kind_phys -! -! --- constant parameters: - real (kind=kind_phys), parameter :: f24 = 24.0_kp ! hours/day - real (kind=kind_phys), parameter :: f1440 = 1440.0_kp ! minutes/day - real (kind=kind_phys), parameter :: czmin = 0.0001_kp ! cos(89.994) - real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp - - -! --- inputs: - integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, & - & nstf_name5 - real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & - & epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice - real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & - & t1, q1, tref, cm, ch, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, xlon, xcosz, & - & sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind - real (kind=kind_phys), intent(in) :: timestep - real (kind=kind_phys), intent(in) :: solhr - -! For sea spray effect - logical, intent(in) :: lseaspray -! - logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet - integer, dimension(:), intent(in) :: use_lake_model -! &, icy - logical, intent(in) :: lprnt - logical, intent(in) :: thsfc_loc - -! --- input/outputs: -! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation - real (kind=kind_phys), dimension(:), intent(inout) :: tskin, & - & tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: & - & qsurf, gflux, cmm, chh, evap, hflx, ep - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! -! locals -! - integer :: k,i -! - real (kind=kind_phys), dimension(im) :: q0, qss, rch, - & rho_a, theta1, tv1, wndmag - - real(kind=kind_phys) elocp,tem,cpinv,hvapi -! -! nstm related prognostic fields -! - logical flag(im) - real (kind=kind_phys), dimension(im) :: - & xt_old, xs_old, xu_old, xv_old, xz_old,zm_old,xtts_old, - & xzts_old, ifd_old, tref_old, tskin_old, dt_cool_old,z_c_old - - real(kind=kind_phys) ulwflx(im), nswsfc(im) -! real(kind=kind_phys) rig(im), -! & ulwflx(im),dlwflx(im), -! & slrad(im),nswsfc(im) - real(kind=kind_phys) alpha,beta,rho_w,f_nsol,sss,sep, - & cosa,sina,taux,tauy,grav,dz,t0,ttop0,ttop - - real(kind=kind_phys) le,fc,dwat,dtmp,wetc,alfac,ustar_a,rich - real(kind=kind_phys) rnl_ts,hs_ts,hl_ts,rf_ts,q_ts - real(kind=kind_phys) fw,q_warm - real(kind=kind_phys) t12,alon,tsea,sstc,dta,dtz - real(kind=kind_phys) zsea1,zsea2,soltim - logical do_nst - -! external functions called: iw3jdn - integer :: iw3jdn -! -! parameters for sea spray effect -! - real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1, - & bb1, hflxs, evaps, ptem -! -! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1, -! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0, -! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2, - real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, - & ws10cr=30., conlf=7.2e-9, consf=6.4e-8 -! -!====================================================================================================== -cc - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (nstf_name1 == 0) return ! No NSST model used - - cpinv = one/cp - hvapi = one/hvap - elocp = hvap/cp - - sss = 34.0_kp ! temporarily, when sea surface salinity data is not ready -! -! flag for open water and where the iteration is on -! - do_nst = .false. - do i = 1, im -! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) - flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1 - do_nst = do_nst .or. flag(i) - enddo - if (.not. do_nst) return -! -! save nst-related prognostic fields for guess run -! - do i=1, im -! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then - if(wet(i) .and. flag_guess(i) .and. use_lake_model(i)/=1) then - xt_old(i) = xt(i) - xs_old(i) = xs(i) - xu_old(i) = xu(i) - xv_old(i) = xv(i) - xz_old(i) = xz(i) - zm_old(i) = zm(i) - xtts_old(i) = xtts(i) - xzts_old(i) = xzts(i) - ifd_old(i) = ifd(i) - tskin_old(i) = tskin(i) - dt_cool_old(i) = dt_cool(i) - z_c_old(i) = z_c(i) - endif - enddo - - -! --- ... initialize variables. all units are m.k.s. unless specified. -! ps is in pascals, wind is wind speed, theta1 is surface air -! estimated from level 1 temperature, rho_a is air density and -! qss is saturation specific humidity at the water surface -!! - do i = 1, im - if ( flag(i) ) then - - nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) - wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - - q0(i) = max(q1(i), 1.0e-8_kp) - - if(thsfc_loc) then ! Use local potential temperature - theta1(i) = t1(i) * prslki(i) - else ! Use potential temperature referenced to 1000 hPa - theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer - endif - - tv1(i) = t1(i) * (one + rvrdm1*q0(i)) - rho_a(i) = prsl1(i) / (rd*tv1(i)) - qss(i) = fpvs(tsurf(i)) ! pa - qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) ! pa -! - evap(i) = zero - hflx(i) = zero - gflux(i) = zero - ep(i) = zero - -! --- ... rcp = rho cp ch v - - rch(i) = rho_a(i) * cp * ch(i) * wind(i) - cmm(i) = cm (i) * wind(i) - chh(i) = rho_a(i) * ch(i) * wind(i) - -!> - Calculate latent and sensible heat flux over open water with tskin. -! at previous time step - evap(i) = elocp * rch(i) * (qss(i) - q0(i)) - qsurf(i) = qss(i) - - if(thsfc_loc) then ! Use local potential temperature - hflx(i) = rch(i) * (tsurf(i) - theta1(i)) - else ! Use potential temperature referenced to 1000 hPa - hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) - endif - -! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', -! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) -! &,' tsurf=',tsurf(i) - endif - enddo - -! run nst model: dtm + slm -! - zsea1 = 0.001_kp*real(nstf_name4) - zsea2 = 0.001_kp*real(nstf_name5) - -!> - Call module_nst_water_prop::density() to compute sea water density. -!> - Call module_nst_water_prop::rhocoef() to compute thermal expansion -!! coefficient (\a alpha) and saline contraction coefficient (\a beta). - do i = 1, im - if ( flag(i) ) then - tsea = tsurf(i) - t12 = tsea*tsea - ulwflx(i) = sfcemis(i) * sbc * t12 * t12 - alon = xlon(i)*rad2deg - grav = grv(sinlat(i)) - soltim = mod(alon/15.0_kp + solhr, 24.0_kp)*3600.0_kp - call density(tsea,sss,rho_w) ! sea water density - call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta -! -!> - Calculate sensible heat flux (\a qrain) due to rainfall. -! - le = (2.501_kp-0.00237_kp*tsea)*1e6_kp - dwat = 2.11e-5_kp*(t1(i)/t0k)**1.94_kp ! water vapor diffusivity - dtmp = (one+3.309e-3_kp*(t1(i)-t0k)-1.44e-6_kp*(t1(i)-t0k) - & * (t1(i)-t0k))*0.02411_kp/(rho_a(i)*cp) ! heat diffusivity - wetc = 622.0_kp*le*qss(i)/(rd*t1(i)*t1(i)) - alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor - tem = (1.0e3_kp * rain(i) / rho_w) * alfac * cp_w - qrain(i) = tem * (tsea-t1(i)+1.0e3_kp*(qss(i)-q0(i))*le/cp) - -!> - Calculate input non solar heat flux as upward = positive to models here - - f_nsol = hflx(i) + evap(i) + ulwflx(i) - dlwflx(i) - & + omg_sh*qrain(i) - -! if (lprnt .and. i == ipr) print *,' f_nsol=',f_nsol,' hflx=', -! &hflx(i),' evap=',evap(i),' ulwflx=',ulwflx(i),' dlwflx=',dlwflx(i) -! &,' omg_sh=',omg_sh,' qrain=',qrain(i) - - sep = sss*(evap(i)/le-rain(i))/rho_w - ustar_a = sqrt(stress(i)/rho_a(i)) ! air friction velocity -! -! sensitivities of heat flux components to ts -! - rnl_ts = 4.0_kp*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) - hs_ts = rch(i) - hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) - rf_ts = tem * (one+rch(i)*hl_ts) - q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts -! -!> - Call cool_skin(), which is the sub-layer cooling parameterization -!! (Fairfall et al. (1996) \cite fairall_et_al_1996). -! & calculate c_0, c_d -! - call cool_skin(ustar_a,f_nsol,nswsfc(i),evap(i),sss,alpha,beta - &, rho_w,rho_a(i),tsea,q_ts,hl_ts,grav,le - &, dt_cool(i),z_c(i),c_0(i),c_d(i)) - - tem = one / wndmag(i) - cosa = u1(i)*tem - sina = v1(i)*tem - taux = max(stress(i),tau_min)*cosa - tauy = max(stress(i),tau_min)*sina - fc = const_rot*sinlat(i) -! -! Run DTM-1p system. -! - if ( (soltim > solar_time_6am .and. ifd(i) == zero) ) then - else - ifd(i) = one -! -! calculate fcl thickness with current forcing and previous time's profile -! -! if (lprnt .and. i == ipr) print *,' beg xz=',xz(i) - -!> - Call convdepth() to calculate depth for convective adjustments. - if ( f_nsol > zero .and. xt(i) > zero ) then - call convdepth(kdt,timestep,nswsfc(i),f_nsol,sss,sep,rho_w - &, alpha,beta,xt(i),xs(i),xz(i),d_conv(i)) - else - d_conv(i) = zero - endif - -! if (lprnt .and. i == ipr) print *,' beg xz1=',xz(i) -! -! determine rich: wind speed dependent (right now) -! -! if ( wind(i) < 1.0 ) then -! rich = 0.25 + 0.03*wind(i) -! elseif ( wind(i) >= 1.0 .and. wind(i) < 1.5 ) then -! rich = 0.25 + 0.1*wind(i) -! elseif ( wind(i) >= 1.5 .and. wind(i) < 6.0 ) then -! rich = 0.25 + 0.6*wind(i) -! elseif ( wind(i) >= 6.0 ) then -! rich = 0.25 + min(0.8*wind(i),0.50) -! endif - - rich = ri_c - -!> - Call the diurnal thermocline layer model dtm_1p(). - call dtm_1p(kdt,timestep,rich,taux,tauy,nswsfc(i), - & f_nsol,sss,sep,q_ts,hl_ts,rho_w,alpha,beta,alon, - & sinlat(i),soltim,grav,le,d_conv(i), - & xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) - -! apply mda - if ( xt(i) > zero ) then -!> - If \a dtl heat content \a xt > 0.0, call dtm_1p_mda() to apply -!! minimum depth adjustment (mda). - call dtm_1p_mda(xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then -!> - If \a dtl thickness >= module_nst_parameters::z_w_max, call dtl_reset() -!! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max. - call dtl_reset(xt(i),xs(i),xu(i),xv(i),xz(i),xtts(i), - & xzts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz3=',xz(i),' z_w_max=' -! &,z_w_max - endif - -! apply fca - if ( d_conv(i) > zero ) then -!> - If thickness of free convection layer > 0.0, call dtm_1p_fca() -!! to apply free convection adjustment. -!> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() -!! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max(). - call dtm_1p_fca(d_conv(i),xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - -! if (lprnt .and. i == ipr) print *,' beg xz4=',xz(i) - -! apply tla - dz = min(xz(i),max(d_conv(i),delz)) -! -!> - Call sw_ps_9b() to compute the fraction of the solar radiation -!! absorbed by the depth \a delz (Paulson and Simpson (1981) \cite paulson_and_simpson_1981). -!! And calculate the total heat absorbed in warm layer. - call sw_ps_9b(delz,fw) - q_warm = fw*nswsfc(i)-f_nsol !total heat absorbed in warm layer - -!> - Call cal_ttop() to calculate the diurnal warming amount at the top layer with -!! thickness of \a dz. - if ( q_warm > zero ) then - call cal_ttop(kdt,timestep,q_warm,rho_w,dz, - & xt(i),xz(i),ttop0) - -! if (lprnt .and. i == ipr) print *,' d_conv=',d_conv(i),' delz=', -! &delz,' kdt=',kdt,' timestep=',timestep,' nswsfc=',nswsfc(i), -! &' f_nsol=',f_nsol,' rho_w=',rho_w,' dz=',dz,' xt=',xt(i), -! &' xz=',xz(i),' qrain=',qrain(i) - - ttop = ((xt(i)+xt(i))/xz(i))*(one-dz/((xz(i)+xz(i)))) - -! if (lprnt .and. i == ipr) print *,' beg xz4a=',xz(i) -! &,' ttop=',ttop,' ttop0=',ttop0,' xt=',xt(i),' dz=',dz -! &,' xznew=',(xt(i)+sqrt(xt(i)*(xt(i)-dz*ttop0)))/ttop0 - -!> - Call dtm_1p_tla() to apply top layer adjustment. - if ( ttop > ttop0 ) then - call dtm_1p_tla(dz,ttop0,xt(i),xtts(i),xz(i),xzts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz4b=',xz(i),'z_w_max=', -! &z_w_max - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - endif ! if ( q_warm > 0.0 ) then - -! if (lprnt .and. i == ipr) print *,' beg xz5=',xz(i) - -! apply mwa -!> - Call dt_1p_mwa() to apply maximum warming adjustment. - t0 = (xt(i)+xt(i))/xz(i) - if ( t0 > tw_max ) then - call dtm_1p_mwa(xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - -! if (lprnt .and. i == ipr) print *,' beg xz6=',xz(i) - -! apply mta -!> - Call dtm_1p_mta() to apply maximum temperature adjustment. - sstc = tref(i) + (xt(i)+xt(i))/xz(i) - dt_cool(i) - - if ( sstc > sst_max ) then - dta = sstc - sst_max - call dtm_1p_mta(dta,xt(i),xtts(i),xz(i),xzts(i)) -! write(*,'(a,f3.0,7f8.3)') 'mta, sstc,dta :',islimsk(i), -! & sstc,dta,tref(i),xt(i),xz(i),2.0*xt(i)/xz(i),dt_cool(i) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif -! - endif ! if ( xt(i) > 0.0 ) then -! reset dtl at midnight and when solar zenith angle > 89.994 degree - if ( abs(soltim) < 2.0_kp*timestep ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - - endif ! if (solar_time > solar_time_6am .and. ifd(i) == 0.0 ) then: too late to start the first day - -! if (lprnt .and. i == ipr) print *,' beg xz7=',xz(i) - -! update tsurf (when flag(i) .eqv. .true. ) -!> - Call get_dtzm_point() to computes \a dtz and \a tsurf. - call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), - & zsea1,zsea2,dtz) - tsurf(i) = max(tgice, tref(i) + dtz ) - -! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', -! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) - -!> - Call cal_w() to calculate \a w_0 and \a w_d. - if ( xt(i) > zero ) then - call cal_w(kdt,xz(i),xt(i),xzts(i),xtts(i),w_0(i),w_d(i)) - else - w_0(i) = zero - w_d(i) = zero - endif - -! if ( xt(i) > 0.0 ) then -! rig(i) = grav*xz(i)*xz(i)*(alpha*xt(i)-beta*xs(i)) -! & /(2.0*(xu(i)*xu(i)+xv(i)*xv(i))) -! else -! rig(i) = 0.25 -! endif - -! qrain(i) = rig(i) - zm(i) = wind(i) - - endif - enddo - -! restore nst-related prognostic fields for guess run - do i=1, im -! if (wet(i) .and. .not.icy(i)) then - if (wet(i) .and. use_lake_model(i)/=1) then - if (flag_guess(i)) then ! when it is guess of - xt(i) = xt_old(i) - xs(i) = xs_old(i) - xu(i) = xu_old(i) - xv(i) = xv_old(i) - xz(i) = xz_old(i) - zm(i) = zm_old(i) - xtts(i) = xtts_old(i) - xzts(i) = xzts_old(i) - ifd(i) = ifd_old(i) - tskin(i) = tskin_old(i) - dt_cool(i) = dt_cool_old(i) - z_c(i) = z_c_old(i) - else -! -! update tskin when coupled and not guess run -! (all other NSST variables have been updated in this case) -! - if ( nstf_name1 > 1 ) then - tskin(i) = tsurf(i) - endif ! if nstf_name1 > 1 then - endif ! if flag_guess(i) then - endif ! if wet(i) .and. .not.icy(i) then - enddo - -! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) - - if ( nstf_name1 > 1 ) then -!> - Calculate latent and sensible heat flux over open water with updated tskin -!! for the grids of open water and the iteration is on. - do i = 1, im - if ( flag(i) ) then - qss(i) = fpvs( tskin(i) ) - qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) - qsurf(i) = qss(i) - evap(i) = elocp*rch(i) * (qss(i) - q0(i)) - - if(thsfc_loc) then ! Use local potential temperature - hflx(i) = rch(i) * (tskin(i) - theta1(i)) - else ! Use potential temperature referenced to 1000 hPa - hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) - endif - - endif - enddo - endif ! if ( nstf_name1 > 1 ) then -! -!> - Include sea spray effects -! - do i=1,im - if(lseaspray .and. flag(i)) then - f10m = fm10(i) / fm(i) - u10m = f10m * u1(i) - v10m = f10m * v1(i) - ws10 = sqrt(u10m*u10m + v10m*v10m) - ws10 = max(ws10,1.) - ws10 = min(ws10,ws10cr) - tem = .015 * ws10 * ws10 - ru10 = 1. - .087 * log(10./tem) - qss1 = fpvs(t1(i)) - qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1) - tem = rd * cp * t1(i) * t1(i) - tem = 1. + eps * hvap * hvap * qss1 / tem - bb1 = 1. / tem - evaps = conlf * (ws10**5.4) * ru10 * bb1 - evaps = evaps * rho_a(i) * hvap * (qss1 - q0(i)) - evap(i) = evap(i) + alps * evaps - hflxs = consf * (ws10**3.4) * ru10 - hflxs = hflxs * rho_a(i) * cp * (tskin(i) - t1(i)) - ptem = alps - gams - hflx(i) = hflx(i) + bets * hflxs - ptem * evaps - endif - enddo -! - do i=1,im - if ( flag(i) ) then - tem = one / rho_a(i) - hflx(i) = hflx(i) * tem * cpinv - evap(i) = evap(i) * tem * hvapi - endif - enddo -! -! if (lprnt) print *,' tskin=',tskin(ipr) - - return - end subroutine sfc_nst_run -!> @} - end module sfc_nst diff --git a/physics/sfc_nst.f90 b/physics/sfc_nst.f90 new file mode 100644 index 000000000..08b1b48e4 --- /dev/null +++ b/physics/sfc_nst.f90 @@ -0,0 +1,664 @@ +!>\file sfc_nst.f90 +!! This file contains the GFS NSST model. + +!> This module contains the CCPP-compliant GFS near-surface sea temperature scheme. +module sfc_nst + + use machine , only : kind_phys, kp => kind_phys + use funcphys , only : fpvs + use module_nst_parameters , only : one, zero, half + use module_nst_parameters , only : t0k, cp_w, omg_m, omg_sh, sigma_r, solar_time_6am, sst_max + use module_nst_parameters , only : ri_c, z_w_max, delz, wd_max, rad2deg, const_rot, tau_min, tw_max + use module_nst_water_prop , only : get_dtzm_point, density, rhocoef, grv, sw_ps_9b + use nst_module , only : cool_skin, dtm_1p, cal_w, cal_ttop, convdepth, dtm_1p_fca + use nst_module , only : dtm_1p_tla, dtm_1p_mwa, dtm_1p_mda, dtm_1p_mta, dtl_reset + ! + implicit none +contains + + !>\defgroup gfs_nst_main_mod GFS Near-Surface Sea Temperature Module + !! This module contains the CCPP-compliant GFS near-surface sea temperature scheme. + !> @{ + !! This subroutine calls the Thermal Skin-layer and Diurnal Thermocline models to update the NSST profile. + !! \section arg_table_sfc_nst_run Argument Table + !! \htmlinclude sfc_nst_run.html + !! + !> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm + subroutine sfc_nst_run & + ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: + pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & + lseaspray, fm, fm10, & + prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & + sinlat, stress, & + sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & + wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & + nstf_name5, lprnt, ipr, thsfc_loc, & + tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: + z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & + qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: + ) + ! + ! ===================================================================== ! + ! description: ! + ! ! + ! ! + ! usage: ! + ! ! + ! call sfc_nst ! + ! inputs: ! + ! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! + ! lseaspray, fm, fm10, ! + ! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! + ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! + ! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! + ! nstf_name5, lprnt, ipr, thsfc_loc, ! + ! input/outputs: ! + ! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! + ! z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, ! + ! -- outputs: + ! qsurf, gflux, cmm, chh, evap, hflx, ep ! + ! ) + ! ! + ! ! + ! subprogram/functions called: fpvs, density, rhocoef, cool_skin ! + ! ! + ! program history log: ! + ! 2007 -- xu li createad original code ! + ! 2008 -- s. moorthi adapted to the parallel version ! + ! may 2009 -- y.-t. hou modified to include input lw surface ! + ! emissivity from radiation. also replaced the ! + ! often comfusing combined sw and lw suface ! + ! flux with separate sfc net sw flux (defined ! + ! as dn-up) and lw flux. added a program doc block. ! + ! sep 2009 -- s. moorthi removed rcl and additional reformatting ! + ! and optimization + made pa as input pressure unit.! + ! 2009 -- xu li recreatead the code ! + ! feb 2010 -- s. moorthi added some changes made to the previous ! + ! version ! + ! Jul 2016 -- X. Li, modify the diurnal warming event reset ! + ! ! + ! ! + ! ==================== definition of variables ==================== ! + ! ! + ! inputs: size ! + ! im - integer, horiz dimension 1 ! + ! ps - real, surface pressure (pa) im ! + ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! + ! t1 - real, surface layer mean temperature ( k ) im ! + ! q1 - real, surface layer mean specific humidity im ! + ! tref - real, reference/foundation temperature ( k ) im ! + ! cm - real, surface exchange coeff for momentum (m/s) im ! + ! ch - real, surface exchange coeff heat & moisture(m/s) im ! + ! lseaspray- logical, .t. for parameterization for sea spray 1 ! + ! fm - real, a stability profile function for momentum im ! + ! fm10 - real, a stability profile function for momentum im ! + ! at 10m ! + ! prsl1 - real, surface layer mean pressure (pa) im ! + ! prslki - real, im ! + ! prsik1 - real, im ! + ! prslk1 - real, im ! + ! wet - logical, =T if any ocn/lake water (F otherwise) im ! + ! use_lake_model- logical, =T if flake model is used for lake im ! + ! icy - logical, =T if any ice im ! + ! xlon - real, longitude (radians) im ! + ! sinlat - real, sin of latitude im ! + ! stress - real, wind stress (n/m**2) im ! + ! sfcemis - real, sfc lw emissivity (fraction) im ! + ! dlwflx - real, total sky sfc downward lw flux (w/m**2) im ! + ! sfcnsw - real, total sky sfc netsw flx into ocean (w/m**2) im ! + ! rain - real, rainfall rate (kg/m**2/s) im ! + ! timestep - real, timestep interval (second) 1 ! + ! kdt - integer, time step counter 1 ! + ! solhr - real, fcst hour at the end of prev time step 1 ! + ! xcosz - real, consine of solar zenith angle 1 ! + ! wind - real, wind speed (m/s) im ! + ! flag_iter- logical, execution or not im ! + ! when iter = 1, flag_iter = .true. for all grids im ! + ! when iter = 2, flag_iter = .true. when wind < 2 im ! + ! for both land and ocean (when nstf_name1 > 0) im ! + ! flag_guess-logical, .true.= guess step to get CD et al im ! + ! when iter = 1, flag_guess = .true. when wind < 2 im ! + ! when iter = 2, flag_guess = .false. for all grids im ! + ! nstf_name - integers , NSST related flag parameters 1 ! + ! nstf_name1 : 0 = NSSTM off 1 ! + ! 1 = NSSTM on but uncoupled 1 ! + ! 2 = NSSTM on and coupled 1 ! + ! nstf_name4 : zsea1 in mm 1 ! + ! nstf_name5 : zsea2 in mm 1 ! + ! lprnt - logical, control flag for check print out 1 ! + ! ipr - integer, grid index for check print out 1 ! + ! thsfc_loc- logical, flag for reference pressure in theta 1 ! + ! ! + ! input/outputs: + ! li added for oceanic components + ! tskin - real, ocean surface skin temperature ( k ) im ! + ! tsurf - real, the same as tskin ( k ) but for guess run im ! + ! xt - real, heat content in dtl im ! + ! xs - real, salinity content in dtl im ! + ! xu - real, u-current content in dtl im ! + ! xv - real, v-current content in dtl im ! + ! xz - real, dtl thickness im ! + ! zm - real, mxl thickness im ! + ! xtts - real, d(xt)/d(ts) im ! + ! xzts - real, d(xz)/d(ts) im ! + ! dt_cool - real, sub-layer cooling amount im ! + ! d_conv - real, thickness of free convection layer (fcl) im ! + ! z_c - sub-layer cooling thickness im ! + ! c_0 - coefficient1 to calculate d(tz)/d(ts) im ! + ! c_d - coefficient2 to calculate d(tz)/d(ts) im ! + ! w_0 - coefficient3 to calculate d(tz)/d(ts) im ! + ! w_d - coefficient4 to calculate d(tz)/d(ts) im ! + ! ifd - real, index to start dtlm run or not im ! + ! qrain - real, sensible heat flux due to rainfall (watts) im ! + + ! outputs: ! + + ! qsurf - real, surface air saturation specific humidity im ! + ! gflux - real, soil heat flux (w/m**2) im ! + ! cmm - real, im ! + ! chh - real, im ! + ! evap - real, evaperation from latent heat flux im ! + ! hflx - real, sensible heat flux im ! + ! ep - real, potential evaporation im ! + ! ! + ! ===================================================================== ! + + + + ! --- inputs: + integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, nstf_name5 + real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & + epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice + real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & + t1, q1, tref, cm, ch, fm, fm10, & + prsl1, prslki, prsik1, prslk1, xlon, xcosz, & + sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind + real (kind=kind_phys), intent(in) :: timestep + real (kind=kind_phys), intent(in) :: solhr + + ! For sea spray effect + logical, intent(in) :: lseaspray + ! + logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet + integer, dimension(:), intent(in) :: use_lake_model + logical, intent(in) :: lprnt + logical, intent(in) :: thsfc_loc + + ! --- input/outputs: + ! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation + real (kind=kind_phys), dimension(:), intent(inout) :: tskin, & + tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & + z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain + + ! --- outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: qsurf, gflux, cmm, chh, evap, hflx, ep + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! + ! locals + ! + integer :: k,i + ! + real (kind=kind_phys), dimension(im) :: q0, qss, rch, rho_a, theta1, tv1, wndmag + + real(kind=kind_phys) :: elocp,tem,cpinv,hvapi + ! + ! nstm related prognostic fields + ! + logical :: flag(im) + real (kind=kind_phys), dimension(im) :: xt_old, xs_old, xu_old, xv_old, xz_old, & + zm_old,xtts_old, xzts_old, ifd_old, tref_old, tskin_old, dt_cool_old,z_c_old + + real(kind=kind_phys) :: ulwflx(im), nswsfc(im) + ! real(kind=kind_phys) rig(im), + ! & ulwflx(im),dlwflx(im), + ! & slrad(im),nswsfc(im) + real(kind=kind_phys) :: alpha,beta,rho_w,f_nsol,sss,sep, cosa,sina,taux,tauy, & + grav,dz,t0,ttop0,ttop + + real(kind=kind_phys) :: le,fc,dwat,dtmp,wetc,alfac,ustar_a,rich + real(kind=kind_phys) :: rnl_ts,hs_ts,hl_ts,rf_ts,q_ts + real(kind=kind_phys) :: fw,q_warm + real(kind=kind_phys) :: t12,alon,tsea,sstc,dta,dtz + real(kind=kind_phys) :: zsea1,zsea2,soltim + logical :: do_nst + ! + ! parameters for sea spray effect + ! + real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1, & + bb1, hflxs, evaps, ptem + ! + ! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1, + ! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0, + ! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2, + real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, & + ws10cr=30., conlf=7.2e-9, consf=6.4e-8 + ! + !====================================================================================================== + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (nstf_name1 == 0) return ! No NSST model used + + cpinv = one/cp + hvapi = one/hvap + elocp = hvap/cp + + sss = 34.0_kp ! temporarily, when sea surface salinity data is not ready + ! + ! flag for open water and where the iteration is on + ! + do_nst = .false. + do i = 1, im + ! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) + flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1 + do_nst = do_nst .or. flag(i) + enddo + if (.not. do_nst) return + ! + ! save nst-related prognostic fields for guess run + ! + do i=1, im + ! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then + if(wet(i) .and. flag_guess(i) .and. use_lake_model(i)/=1) then + xt_old(i) = xt(i) + xs_old(i) = xs(i) + xu_old(i) = xu(i) + xv_old(i) = xv(i) + xz_old(i) = xz(i) + zm_old(i) = zm(i) + xtts_old(i) = xtts(i) + xzts_old(i) = xzts(i) + ifd_old(i) = ifd(i) + tskin_old(i) = tskin(i) + dt_cool_old(i) = dt_cool(i) + z_c_old(i) = z_c(i) + endif + enddo + + + ! --- ... initialize variables. all units are m.k.s. unless specified. + ! ps is in pascals, wind is wind speed, theta1 is surface air + ! estimated from level 1 temperature, rho_a is air density and + ! qss is saturation specific humidity at the water surface + !! + do i = 1, im + if ( flag(i) ) then + + nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) + wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) + + q0(i) = max(q1(i), 1.0e-8_kp) + + if(thsfc_loc) then ! Use local potential temperature + theta1(i) = t1(i) * prslki(i) + else ! Use potential temperature referenced to 1000 hPa + theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer + endif + + tv1(i) = t1(i) * (one + rvrdm1*q0(i)) + rho_a(i) = prsl1(i) / (rd*tv1(i)) + qss(i) = fpvs(tsurf(i)) ! pa + qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) ! pa + ! + evap(i) = zero + hflx(i) = zero + gflux(i) = zero + ep(i) = zero + + ! --- ... rcp = rho cp ch v + + rch(i) = rho_a(i) * cp * ch(i) * wind(i) + cmm(i) = cm (i) * wind(i) + chh(i) = rho_a(i) * ch(i) * wind(i) + + !> - Calculate latent and sensible heat flux over open water with tskin. + ! at previous time step + evap(i) = elocp * rch(i) * (qss(i) - q0(i)) + qsurf(i) = qss(i) + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tsurf(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) + endif + + ! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', + ! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) + ! &,' tsurf=',tsurf(i) + endif + enddo + + ! run nst model: dtm + slm + ! + zsea1 = 0.001_kp*real(nstf_name4) + zsea2 = 0.001_kp*real(nstf_name5) + + !> - Call module_nst_water_prop::density() to compute sea water density. + !> - Call module_nst_water_prop::rhocoef() to compute thermal expansion + !! coefficient (\a alpha) and saline contraction coefficient (\a beta). + do i = 1, im + if ( flag(i) ) then + tsea = tsurf(i) + t12 = tsea*tsea + ulwflx(i) = sfcemis(i) * sbc * t12 * t12 + alon = xlon(i)*rad2deg + grav = grv(sinlat(i)) + soltim = mod(alon/15.0_kp + solhr, 24.0_kp)*3600.0_kp + call density(tsea,sss,rho_w) ! sea water density + call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta + ! + !> - Calculate sensible heat flux (\a qrain) due to rainfall. + ! + le = (2.501_kp-0.00237_kp*tsea)*1.0e6_kp + dwat = 2.11e-5_kp*(t1(i)/t0k)**1.94_kp ! water vapor diffusivity + dtmp = (one+3.309e-3_kp*(t1(i)-t0k)-1.44e-6_kp*(t1(i)-t0k) & + * (t1(i)-t0k))*0.02411_kp/(rho_a(i)*cp) ! heat diffusivity + wetc = 622.0_kp*le*qss(i)/(rd*t1(i)*t1(i)) + alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor + tem = (1.0e3_kp * rain(i) / rho_w) * alfac * cp_w + qrain(i) = tem * (tsea-t1(i)+1.0e3_kp*(qss(i)-q0(i))*le/cp) + + !> - Calculate input non solar heat flux as upward = positive to models here + + f_nsol = hflx(i) + evap(i) + ulwflx(i) - dlwflx(i) + omg_sh*qrain(i) + + ! if (lprnt .and. i == ipr) print *,' f_nsol=',f_nsol,' hflx=', + ! &hflx(i),' evap=',evap(i),' ulwflx=',ulwflx(i),' dlwflx=',dlwflx(i) + ! &,' omg_sh=',omg_sh,' qrain=',qrain(i) + + sep = sss*(evap(i)/le-rain(i))/rho_w + ustar_a = sqrt(stress(i)/rho_a(i)) ! air friction velocity + ! + ! sensitivities of heat flux components to ts + ! + rnl_ts = 4.0_kp*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) + hs_ts = rch(i) + hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) + rf_ts = tem * (one+rch(i)*hl_ts) + q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts + ! + !> - Call cool_skin(), which is the sub-layer cooling parameterization + !! (Fairfall et al. (1996) \cite fairall_et_al_1996). + ! & calculate c_0, c_d + ! + call cool_skin(ustar_a,f_nsol,nswsfc(i),evap(i),sss,alpha,beta, & + rho_w,rho_a(i),tsea,q_ts,hl_ts,grav,le, & + dt_cool(i),z_c(i),c_0(i),c_d(i)) + + tem = one / wndmag(i) + cosa = u1(i)*tem + sina = v1(i)*tem + taux = max(stress(i),tau_min)*cosa + tauy = max(stress(i),tau_min)*sina + fc = const_rot*sinlat(i) + ! + ! Run DTM-1p system. + ! + if ( (soltim > solar_time_6am .and. ifd(i) == zero) ) then + else + ifd(i) = one + ! + ! calculate fcl thickness with current forcing and previous time's profile + ! + ! if (lprnt .and. i == ipr) print *,' beg xz=',xz(i) + + !> - Call convdepth() to calculate depth for convective adjustments. + if ( f_nsol > zero .and. xt(i) > zero ) then + call convdepth(kdt,timestep,nswsfc(i),f_nsol,sss,sep,rho_w, & + alpha,beta,xt(i),xs(i),xz(i),d_conv(i)) + else + d_conv(i) = zero + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz1=',xz(i) + ! + ! determine rich: wind speed dependent (right now) + ! + ! if ( wind(i) < 1.0 ) then + ! rich = 0.25 + 0.03*wind(i) + ! elseif ( wind(i) >= 1.0 .and. wind(i) < 1.5 ) then + ! rich = 0.25 + 0.1*wind(i) + ! elseif ( wind(i) >= 1.5 .and. wind(i) < 6.0 ) then + ! rich = 0.25 + 0.6*wind(i) + ! elseif ( wind(i) >= 6.0 ) then + ! rich = 0.25 + min(0.8*wind(i),0.50) + ! endif + + rich = ri_c + + !> - Call the diurnal thermocline layer model dtm_1p(). + call dtm_1p(kdt,timestep,rich,taux,tauy,nswsfc(i), & + f_nsol,sss,sep,q_ts,hl_ts,rho_w,alpha,beta,alon, & + sinlat(i),soltim,grav,le,d_conv(i), & + xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) + + ! apply mda + if ( xt(i) > zero ) then + !> - If \a dtl heat content \a xt > 0.0, call dtm_1p_mda() to apply + !! minimum depth adjustment (mda). + call dtm_1p_mda(xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + !> - If \a dtl thickness >= module_nst_parameters::z_w_max, call dtl_reset() + !! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max. + call dtl_reset(xt(i),xs(i),xu(i),xv(i),xz(i),xtts(i), xzts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz3=',xz(i),' z_w_max=' + ! &,z_w_max + endif + + ! apply fca + if ( d_conv(i) > zero ) then + !> - If thickness of free convection layer > 0.0, call dtm_1p_fca() + !! to apply free convection adjustment. + !> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() + !! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max(). + call dtm_1p_fca(d_conv(i),xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz4=',xz(i) + + ! apply tla + dz = min(xz(i),max(d_conv(i),delz)) + ! + !> - Call sw_ps_9b() to compute the fraction of the solar radiation + !! absorbed by the depth \a delz (Paulson and Simpson (1981) \cite paulson_and_simpson_1981). + !! And calculate the total heat absorbed in warm layer. + call sw_ps_9b(delz,fw) + q_warm = fw*nswsfc(i)-f_nsol !total heat absorbed in warm layer + + !> - Call cal_ttop() to calculate the diurnal warming amount at the top layer with + !! thickness of \a dz. + if ( q_warm > zero ) then + call cal_ttop(kdt,timestep,q_warm,rho_w,dz, xt(i),xz(i),ttop0) + + ! if (lprnt .and. i == ipr) print *,' d_conv=',d_conv(i),' delz=', + ! &delz,' kdt=',kdt,' timestep=',timestep,' nswsfc=',nswsfc(i), + ! &' f_nsol=',f_nsol,' rho_w=',rho_w,' dz=',dz,' xt=',xt(i), + ! &' xz=',xz(i),' qrain=',qrain(i) + + ttop = ((xt(i)+xt(i))/xz(i))*(one-dz/((xz(i)+xz(i)))) + + ! if (lprnt .and. i == ipr) print *,' beg xz4a=',xz(i) + ! &,' ttop=',ttop,' ttop0=',ttop0,' xt=',xt(i),' dz=',dz + ! &,' xznew=',(xt(i)+sqrt(xt(i)*(xt(i)-dz*ttop0)))/ttop0 + + !> - Call dtm_1p_tla() to apply top layer adjustment. + if ( ttop > ttop0 ) then + call dtm_1p_tla(dz,ttop0,xt(i),xtts(i),xz(i),xzts(i)) + + ! if (lprnt .and. i == ipr) print *,' beg xz4b=',xz(i),'z_w_max=', + ! &z_w_max + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + endif ! if ( q_warm > 0.0 ) then + + ! if (lprnt .and. i == ipr) print *,' beg xz5=',xz(i) + + ! apply mwa + !> - Call dt_1p_mwa() to apply maximum warming adjustment. + t0 = (xt(i)+xt(i))/xz(i) + if ( t0 > tw_max ) then + call dtm_1p_mwa(xt(i),xtts(i),xz(i),xzts(i)) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + + ! if (lprnt .and. i == ipr) print *,' beg xz6=',xz(i) + + ! apply mta + !> - Call dtm_1p_mta() to apply maximum temperature adjustment. + sstc = tref(i) + (xt(i)+xt(i))/xz(i) - dt_cool(i) + + if ( sstc > sst_max ) then + dta = sstc - sst_max + call dtm_1p_mta(dta,xt(i),xtts(i),xz(i),xzts(i)) + ! write(*,'(a,f3.0,7f8.3)') 'mta, sstc,dta :',islimsk(i), + ! & sstc,dta,tref(i),xt(i),xz(i),2.0*xt(i)/xz(i),dt_cool(i) + if ( xz(i) >= z_w_max ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + endif + ! + endif ! if ( xt(i) > 0.0 ) then + ! reset dtl at midnight and when solar zenith angle > 89.994 degree + if ( abs(soltim) < 2.0_kp*timestep ) then + call dtl_reset (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) + endif + + endif ! if (solar_time > solar_time_6am .and. ifd(i) == 0.0 ) then: too late to start the first day + + ! if (lprnt .and. i == ipr) print *,' beg xz7=',xz(i) + + ! update tsurf (when flag(i) .eqv. .true. ) + !> - Call get_dtzm_point() to computes \a dtz and \a tsurf. + call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), zsea1,zsea2,dtz) + tsurf(i) = max(tgice, tref(i) + dtz ) + + ! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', + ! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) + + !> - Call cal_w() to calculate \a w_0 and \a w_d. + if ( xt(i) > zero ) then + call cal_w(kdt,xz(i),xt(i),xzts(i),xtts(i),w_0(i),w_d(i)) + else + w_0(i) = zero + w_d(i) = zero + endif + + ! if ( xt(i) > 0.0 ) then + ! rig(i) = grav*xz(i)*xz(i)*(alpha*xt(i)-beta*xs(i)) + ! & /(2.0*(xu(i)*xu(i)+xv(i)*xv(i))) + ! else + ! rig(i) = 0.25 + ! endif + + ! qrain(i) = rig(i) + zm(i) = wind(i) + + endif + enddo + + ! restore nst-related prognostic fields for guess run + do i=1, im + ! if (wet(i) .and. .not.icy(i)) then + if (wet(i) .and. use_lake_model(i)/=1) then + if (flag_guess(i)) then ! when it is guess of + xt(i) = xt_old(i) + xs(i) = xs_old(i) + xu(i) = xu_old(i) + xv(i) = xv_old(i) + xz(i) = xz_old(i) + zm(i) = zm_old(i) + xtts(i) = xtts_old(i) + xzts(i) = xzts_old(i) + ifd(i) = ifd_old(i) + tskin(i) = tskin_old(i) + dt_cool(i) = dt_cool_old(i) + z_c(i) = z_c_old(i) + else + ! + ! update tskin when coupled and not guess run + ! (all other NSST variables have been updated in this case) + ! + if ( nstf_name1 > 1 ) then + tskin(i) = tsurf(i) + endif ! if nstf_name1 > 1 then + endif ! if flag_guess(i) then + endif ! if wet(i) .and. .not.icy(i) then + enddo + + ! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) + + if ( nstf_name1 > 1 ) then + !> - Calculate latent and sensible heat flux over open water with updated tskin + !! for the grids of open water and the iteration is on. + do i = 1, im + if ( flag(i) ) then + qss(i) = fpvs( tskin(i) ) + qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) + qsurf(i) = qss(i) + evap(i) = elocp*rch(i) * (qss(i) - q0(i)) + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tskin(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) + endif + + endif + enddo + endif ! if ( nstf_name1 > 1 ) then + ! + !> - Include sea spray effects + ! + do i=1,im + if(lseaspray .and. flag(i)) then + f10m = fm10(i) / fm(i) + u10m = f10m * u1(i) + v10m = f10m * v1(i) + ws10 = sqrt(u10m*u10m + v10m*v10m) + ws10 = max(ws10,1.) + ws10 = min(ws10,ws10cr) + tem = .015 * ws10 * ws10 + ru10 = 1. - .087 * log(10./tem) + qss1 = fpvs(t1(i)) + qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1) + tem = rd * cp * t1(i) * t1(i) + tem = 1. + eps * hvap * hvap * qss1 / tem + bb1 = 1. / tem + evaps = conlf * (ws10**5.4) * ru10 * bb1 + evaps = evaps * rho_a(i) * hvap * (qss1 - q0(i)) + evap(i) = evap(i) + alps * evaps + hflxs = consf * (ws10**3.4) * ru10 + hflxs = hflxs * rho_a(i) * cp * (tskin(i) - t1(i)) + ptem = alps - gams + hflx(i) = hflx(i) + bets * hflxs - ptem * evaps + endif + enddo + ! + do i=1,im + if ( flag(i) ) then + tem = one / rho_a(i) + hflx(i) = hflx(i) * tem * cpinv + evap(i) = evap(i) * tem * hvapi + endif + enddo + ! + ! if (lprnt) print *,' tskin=',tskin(ipr) + + return + end subroutine sfc_nst_run + !> @} +end module sfc_nst diff --git a/physics/sfc_nst_post.f b/physics/sfc_nst_post.f deleted file mode 100644 index 83bc2f273..000000000 --- a/physics/sfc_nst_post.f +++ /dev/null @@ -1,93 +0,0 @@ -!> \file sfc_nst_post.f -!! This file contains code to be executed after the GFS NSST model. - - module sfc_nst_post - - contains - -! \defgroup GFS_NSST_POST GFS Near-Surface Sea Temperature Post - -!> \section arg_table_sfc_nst_post_run Argument Table -!! \htmlinclude sfc_nst_post_run.html -!! -! \section NSST_general_post_algorithm General Algorithm -! -! \section NSST_detailed_post_algorithm Detailed Algorithm -! @{ - subroutine sfc_nst_post_run & - & ( im, kdt, rlapse, tgice, wet, use_lake_model, icy, oro, & - & oro_uf, nstf_name1, & - & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & - & tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & - & ) - - use machine , only : kind_phys - use module_nst_water_prop, only: get_dtzm_2d - - implicit none - - integer, parameter :: kp = kind_phys - -! --- inputs: - integer, intent(in) :: im, kdt, nthreads - logical, dimension(:), intent(in) :: wet, icy - integer, dimension(:), intent(in) :: use_lake_model - real (kind=kind_phys), intent(in) :: rlapse, tgice - real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf - integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 - real (kind=kind_phys), dimension(:), intent(in) :: xt, xz, & - & dt_cool, z_c, tref, xlon - -! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, & - & tsfc_wat - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(out) :: dtzm - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - real(kind=kind_phys) :: zsea1, zsea2 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -! if (lprnt) print *,' tseaz2=',tseal(ipr),' tref=',tref(ipr), -! & ' dt_cool=',dt_cool(ipr),' dt_warm=',2.0*xt(ipr)/xz(ipr), -! & ' kdt=',kdt - -! do i = 1, im -! if (wet(i) .and. .not. icy(i)) then -! tsurf_wat(i) = tsurf_wat(i) - (oro(i)-oro_uf(i)) * rlapse -! endif -! enddo - -! --- ... run nsst model ... --- - - if (nstf_name1 > 1) then - zsea1 = 0.001_kp*real(nstf_name4) - zsea2 = 0.001_kp*real(nstf_name5) - call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, & - & im, 1, nthreads, dtzm) - do i = 1, im -! if (wet(i) .and. .not.icy(i)) then -! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then - if (wet(i) .and. use_lake_model(i) /=1) then - tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) -! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & -! (oro(i)-oro_uf(i))*rlapse - endif - enddo - endif - -! if (lprnt) print *,' tseaz2=',tsea(ipr),' tref=',tref(ipr), & -! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt - - return - end subroutine sfc_nst_post_run - - end module sfc_nst_post diff --git a/physics/sfc_nst_post.f90 b/physics/sfc_nst_post.f90 new file mode 100644 index 000000000..174d5df76 --- /dev/null +++ b/physics/sfc_nst_post.f90 @@ -0,0 +1,87 @@ +!> \file sfc_nst_post.f90 +!! This file contains code to be executed after the GFS NSST model. + +module sfc_nst_post + + use machine , only : kind_phys, kp => kind_phys + use module_nst_water_prop , only : get_dtzm_2d + + implicit none + +contains + + ! \defgroup GFS_NSST_POST GFS Near-Surface Sea Temperature Post + + !> \section arg_table_sfc_nst_post_run Argument Table + !! \htmlinclude sfc_nst_post_run.html + !! + ! \section NSST_general_post_algorithm General Algorithm + ! + ! \section NSST_detailed_post_algorithm Detailed Algorithm + ! @{ + subroutine sfc_nst_post_run & + ( im, kdt, rlapse, tgice, wet, use_lake_model, icy, oro, & + oro_uf, nstf_name1, & + nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & + tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & + ) + ! --- inputs: + integer, intent(in) :: im, kdt, nthreads + logical, dimension(:), intent(in) :: wet, icy + integer, dimension(:), intent(in) :: use_lake_model + real (kind=kind_phys), intent(in) :: rlapse, tgice + real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf + integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 + real (kind=kind_phys), dimension(:), intent(in) :: xt, xz, dt_cool, z_c, tref, xlon + + ! --- input/outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, tsfc_wat + + ! --- outputs: + real (kind=kind_phys), dimension(:), intent(out) :: dtzm + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! --- locals + integer :: i + real(kind=kind_phys) :: zsea1, zsea2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! if (lprnt) print *,' tseaz2=',tseal(ipr),' tref=',tref(ipr), + ! & ' dt_cool=',dt_cool(ipr),' dt_warm=',2.0*xt(ipr)/xz(ipr), + ! & ' kdt=',kdt + + ! do i = 1, im + ! if (wet(i) .and. .not. icy(i)) then + ! tsurf_wat(i) = tsurf_wat(i) - (oro(i)-oro_uf(i)) * rlapse + ! endif + ! enddo + + ! --- ... run nsst model ... --- + + if (nstf_name1 > 1) then + zsea1 = 0.001_kp*real(nstf_name4) + zsea2 = 0.001_kp*real(nstf_name5) + call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, im, 1, nthreads, dtzm) + do i = 1, im + ! if (wet(i) .and. .not.icy(i)) then + ! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then + if (wet(i) .and. use_lake_model(i) /=1) then + tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) + ! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & + ! (oro(i)-oro_uf(i))*rlapse + endif + enddo + endif + + ! if (lprnt) print *,' tseaz2=',tsea(ipr),' tref=',tref(ipr), & + ! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt + + return + end subroutine sfc_nst_post_run + +end module sfc_nst_post diff --git a/physics/sfc_nst_pre.f b/physics/sfc_nst_pre.f deleted file mode 100644 index 77ff61f00..000000000 --- a/physics/sfc_nst_pre.f +++ /dev/null @@ -1,96 +0,0 @@ -!> \file sfc_nst_pre.f -!! This file contains preparation for the GFS NSST model. - - module sfc_nst_pre - - contains - -!> \defgroup GFS_NSST_PRE GFS Near-Surface Sea Temperature Pre -!! -!! The NSST scheme is one of the three schemes used to represent the -!! surface in the GFS physics suite. The other two are the Noah land -!! surface model and the sice simplified ice model. -!! -!! \section arg_table_sfc_nst_pre_run Argument Table -!! \htmlinclude sfc_nst_pre_run.html -!! -!> \section NSST_general_pre_algorithm General Algorithm - subroutine sfc_nst_pre_run - & (im, wet, tgice, tsfco, tsurf_wat, - & tseal, xt, xz, dt_cool, z_c, tref, cplflx, - & oceanfrac, nthreads, errmsg, errflg) - - use machine , only : kind_phys - use module_nst_water_prop, only: get_dtzm_2d - - implicit none - - integer, parameter :: kp = kind_phys - -! --- inputs: - integer, intent(in) :: im, nthreads - logical, dimension(:), intent(in) :: wet - real (kind=kind_phys), intent(in) :: tgice - real (kind=kind_phys), dimension(:), intent(in) :: - & tsfco, xt, xz, dt_cool, z_c, oceanfrac - logical, intent(in) :: cplflx - -! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: - & tsurf_wat, tseal, tref - -! --- outputs: - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - real(kind=kind_phys), parameter :: zero = 0.0_kp, - & one = 1.0_kp, - & half = 0.5_kp, - & omz1 = 2.0_kp - real(kind=kind_phys) :: tem1, tem2, dnsst - real(kind=kind_phys), dimension(im) :: dtzm, z_c_0 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - if (wet(i) .and. oceanfrac(i) > 0.0) then -! tem = (oro(i)-oro_uf(i)) * rlapse - ! DH* 20190927 simplyfing this code because tem is zero - !tem = zero - !tseal(i) = tsfco(i) + tem - tseal(i) = tsfco(i) - !tsurf_wat(i) = tsurf_wat(i) + tem - ! *DH - endif - enddo -! -! update tsfc & tref with T1 from OGCM & NSST Profile if coupled -! - if (cplflx) then - z_c_0 = zero - call get_dtzm_2d (xt, xz, dt_cool, & - & z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm) - do i=1,im - if (wet(i) .and. oceanfrac(i) > zero ) then -! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf - tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile -! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update -! tseal(i) = tsfc_wat(i) - if (abs(xz(i)) > zero) then - tem2 = one / xz(i) - else - tem2 = zero - endif - tseal(i) = tref(i) + (xt(i)+xt(i)) * tem2 - dt_cool(i) - tsurf_wat(i) = tseal(i) - endif - enddo - endif - - return - end subroutine sfc_nst_pre_run - end module sfc_nst_pre diff --git a/physics/sfc_nst_pre.f90 b/physics/sfc_nst_pre.f90 new file mode 100644 index 000000000..3e77f2d6b --- /dev/null +++ b/physics/sfc_nst_pre.f90 @@ -0,0 +1,89 @@ +!> \file sfc_nst_pre.f90 +!! This file contains preparation for the GFS NSST model. + +module sfc_nst_pre + + use machine , only : kind_phys + use module_nst_water_prop , only : get_dtzm_2d + use module_nst_parameters , only : zero, one + + implicit none + +contains + + !> \defgroup GFS_NSST_PRE GFS Near-Surface Sea Temperature Pre + !! + !! The NSST scheme is one of the three schemes used to represent the + !! surface in the GFS physics suite. The other two are the Noah land + !! surface model and the sice simplified ice model. + !! + !! \section arg_table_sfc_nst_pre_run Argument Table + !! \htmlinclude sfc_nst_pre_run.html + !! + !> \section NSST_general_pre_algorithm General Algorithm + subroutine sfc_nst_pre_run & + (im, wet, tgice, tsfco, tsurf_wat, & + tseal, xt, xz, dt_cool, z_c, tref, cplflx, & + oceanfrac, nthreads, errmsg, errflg) + + ! --- inputs: + integer, intent(in) :: im, nthreads + logical, dimension(:), intent(in) :: wet + real (kind=kind_phys), intent(in) :: tgice + real (kind=kind_phys), dimension(:), intent(in) :: tsfco, xt, xz, dt_cool, z_c, oceanfrac + logical, intent(in) :: cplflx + + ! --- input/outputs: + real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, tseal, tref + + ! --- outputs: + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! --- locals + integer :: i + real(kind=kind_phys), parameter :: omz1 = 2.0_kind_phys + real(kind=kind_phys) :: tem2, dnsst + real(kind=kind_phys), dimension(im) :: dtzm, z_c_0 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1,im + if (wet(i) .and. oceanfrac(i) > 0.0) then + ! tem = (oro(i)-oro_uf(i)) * rlapse + ! DH* 20190927 simplyfing this code because tem is zero + !tem = zero + !tseal(i) = tsfco(i) + tem + tseal(i) = tsfco(i) + !tsurf_wat(i) = tsurf_wat(i) + tem + ! *DH + endif + enddo + ! + ! update tsfc & tref with T1 from OGCM & NSST Profile if coupled + ! + if (cplflx) then + z_c_0 = zero + call get_dtzm_2d (xt, xz, dt_cool, z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm) + do i=1,im + if (wet(i) .and. oceanfrac(i) > zero ) then + ! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf + tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile + ! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update + ! tseal(i) = tsfc_wat(i) + if (abs(xz(i)) > zero) then + tem2 = one / xz(i) + else + tem2 = zero + endif + tseal(i) = tref(i) + (xt(i)+xt(i)) * tem2 - dt_cool(i) + tsurf_wat(i) = tseal(i) + endif + enddo + endif + + return + end subroutine sfc_nst_pre_run +end module sfc_nst_pre From 1fb6b842b4952a37d61426fbd2876d6d8f8ab15a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 28 Nov 2023 17:01:03 +0000 Subject: [PATCH 102/132] Bug fix in metadata --- physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta | 2 +- physics/MP/GFDL/gfdl_cloud_microphys.meta | 4 +++- physics/MP/Thompson/mp_thompson.meta | 4 +++- physics/MP/{Thompson => }/module_mp_radar.F90 | 0 4 files changed, 7 insertions(+), 3 deletions(-) rename physics/MP/{Thompson => }/module_mp_radar.F90 (100%) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta index 5701909fd..758b9d8b8 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_physics_post type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/MP/GFDL/gfdl_cloud_microphys.meta b/physics/MP/GFDL/gfdl_cloud_microphys.meta index 35b216d4a..719a340e5 100644 --- a/physics/MP/GFDL/gfdl_cloud_microphys.meta +++ b/physics/MP/GFDL/gfdl_cloud_microphys.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = gfdl_cloud_microphys type = scheme - dependencies = ../../hooks/machine.F,module_gfdl_cloud_microphys.F90 + dependencies = ../../hooks/machine.F + dependencies = ../module_mp_radar.F90 + dependencies = module_gfdl_cloud_microphys.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/MP/Thompson/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index be0720531..ffe34bafb 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = mp_thompson type = scheme - dependencies = ../../hooks/machine.F,module_mp_radar.F90,module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 + dependencies = ../../hooks/machine.F + dependencies = ../module_mp_radar.F90 + dependencies = module_mp_thompson.F90,module_mp_thompson_make_number_concentrations.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/MP/Thompson/module_mp_radar.F90 b/physics/MP/module_mp_radar.F90 similarity index 100% rename from physics/MP/Thompson/module_mp_radar.F90 rename to physics/MP/module_mp_radar.F90 From 562377cc0b337f8f335eb5eec2b68ea3e9ec74e6 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Tue, 28 Nov 2023 15:30:10 -0500 Subject: [PATCH 103/132] remove files from old version --- physics/GFS_ccpp_suite_sim_pre.F90 | 442 ----------------------- physics/GFS_ccpp_suite_sim_pre.meta | 174 --------- physics/ccpp_suite_simulator.F90 | 212 ----------- physics/ccpp_suite_simulator.meta | 201 ----------- physics/module_ccpp_suite_simulator.F90 | 328 ----------------- physics/module_ccpp_suite_simulator.meta | 24 -- 6 files changed, 1381 deletions(-) delete mode 100644 physics/GFS_ccpp_suite_sim_pre.F90 delete mode 100644 physics/GFS_ccpp_suite_sim_pre.meta delete mode 100644 physics/ccpp_suite_simulator.F90 delete mode 100644 physics/ccpp_suite_simulator.meta delete mode 100644 physics/module_ccpp_suite_simulator.F90 delete mode 100644 physics/module_ccpp_suite_simulator.meta diff --git a/physics/GFS_ccpp_suite_sim_pre.F90 b/physics/GFS_ccpp_suite_sim_pre.F90 deleted file mode 100644 index fbaf5a1d9..000000000 --- a/physics/GFS_ccpp_suite_sim_pre.F90 +++ /dev/null @@ -1,442 +0,0 @@ -! ######################################################################################## -! -! Description: Interstitial CCPP suite to couple UFS physics to ccpp_suite_simulator. -! -! Contains: -! - load_ccpp_suite_sim(): read and load data into type used by ccpp_suite_simulator. -! called once during model initialization -! - GFS_ccpp_suite_sim_pre_run(): prepare GFS diagnostic physics tendencies for -! ccpp_suite_simulator. -! -! ######################################################################################## -module GFS_ccpp_suite_sim_pre - use machine, only: kind_phys - use module_ccpp_suite_simulator, only: base_physics_process - use netcdf - implicit none - public GFS_ccpp_suite_sim_pre_run, load_ccpp_suite_sim -contains - - ! ###################################################################################### - ! - ! SUBROUTINE GFS_ccpp_suite_sim_pre_run - ! - ! ###################################################################################### -!! \section arg_table_GFS_ccpp_suite_sim_pre_run -!! \htmlinclude GFS_ccpp_suite_sim_pre_run.html -!! - subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, & - index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & - index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & - index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & - physics_process, iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, & - errmsg, errflg) - - ! Inputs - logical, intent(in) :: do_ccpp_suite_sim - integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & - index_of_process_shortwave, index_of_process_scnv, & - index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & - index_of_temperature, index_of_x_wind, index_of_y_wind - integer, intent(in), dimension(:,:) :: dtidx - real(kind_phys), intent(in) :: dtp - real(kind_phys), intent(in), dimension(:,:,:) :: dtend - type(base_physics_process),intent(in) :: physics_process(:) - integer, intent(in) :: iactive_T, iactive_u, iactive_v, iactive_q - - ! Outputs - real(kind_phys), intent(out) :: active_phys_tend(:,:,:) - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Locals - integer :: idtend, iactive - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. do_ccpp_suite_sim) return - - ! Get tendency for "active" process. - - ! ###################################################################################### - ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional - ! array, CCPP standard_name = cumulative_change_of_state_variables. - ! These are not the instantaneous physics tendencies that are applied to the state by - ! the physics suites. Not all suites output physics tendencies... - ! Rather these are intended for diagnostic puposes and are accumulated over some - ! interval. - ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option - ! "fhzero". For this to work, you need to clear the diagnostic buckets after each - ! physics timestep when running in the UFS/SCM. - ! - ! In the SCM this is done by adding the following runtime options: - ! --n_itt_out 1 --n_itt_diag 1 - ! - ! ###################################################################################### - if (physics_process(1)%active_name == "LWRAD") iactive = index_of_process_longwave - if (physics_process(1)%active_name == "SWRAD") iactive = index_of_process_shortwave - if (physics_process(1)%active_name == "PBL") iactive = index_of_process_pbl - if (physics_process(1)%active_name == "GWD") iactive = index_of_process_orographic_gwd - if (physics_process(1)%active_name == "SCNV") iactive = index_of_process_scnv - if (physics_process(1)%active_name == "DCNV") iactive = index_of_process_dcnv - if (physics_process(1)%active_name == "cldMP") iactive = index_of_process_mp - - ! Heat - idtend = dtidx(index_of_temperature,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_T) = dtend(:,:,idtend)/dtp - endif - - ! u-wind - idtend = dtidx(index_of_x_wind,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_u) = dtend(:,:,idtend)/dtp - endif - - ! v-wind - idtend = dtidx(index_of_y_wind,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_v) = dtend(:,:,idtend)/dtp - endif - - ! Moisture - idtend = dtidx(100+ntqv,iactive) - if (idtend >= 1) then - active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp - endif - - end subroutine GFS_ccpp_suite_sim_pre_run - - ! ###################################################################################### - subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, & - iactive_u, iactive_v, iactive_q, errmsg, errflg) - - ! Inputs - integer, intent (in) :: nlunit - character(len=*), intent (in) :: nml_file - - ! Outputs - type(base_physics_process),intent(inout),allocatable :: physics_process(:) - integer, intent(inout) :: iactive_T, iactive_u, iactive_v, iactive_q - integer, intent(out) :: errflg - character(len=256), intent(out) :: errmsg - - ! Local variables - integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data - character(len=256) :: suite_sim_file - logical :: exists, do_ccpp_suite_sim - integer :: nprc_sim - - ! For each process there is a corresponding namelist entry, which is constructed as - ! follows: - ! {use_suite_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} - integer, dimension(3) :: & - prc_LWRAD_cfg = (/0,0,0/), & - prc_SWRAD_cfg = (/0,0,0/), & - prc_PBL_cfg = (/0,0,0/), & - prc_GWD_cfg = (/0,0,0/), & - prc_SCNV_cfg = (/0,0,0/), & - prc_DCNV_cfg = (/0,0,0/), & - prc_cldMP_cfg = (/0,0,0/) - - ! Namelist - namelist / ccpp_suite_sim_nml / do_ccpp_suite_sim, suite_sim_file, nprc_sim, & - prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & - prc_DCNV_cfg, prc_cldMP_cfg - - errmsg = '' - errflg = 0 - - ! Read in namelist - inquire (file = trim (nml_file), exist = exists) - if (.not. exists) then - errmsg = 'CCPP suite simulator namelist file: '//trim(nml_file)//' does not exist.' - errflg = 1 - return - else - open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = ccpp_suite_sim_nml, iostat=status) - close (nlunit) - - ! Only proceed if suite simulator requested. - if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & - prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & - prc_cldMP_cfg(1) == 1 ) then - else - return - endif - - ! Check that input data file exists. - inquire (file = trim (suite_sim_file), exist = exists) - if (.not. exists) then - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not exist' - errflg = 1 - return - endif - - ! - ! Read data file... - ! - - ! Open file - status = nf90_open(trim(suite_sim_file), NF90_NOWRITE, ncid) - if (status /= nf90_noerr) then - errmsg = 'Error reading in CCPP suite simulator file: '//trim(suite_sim_file) - errflg = 1 - return - endif - - ! Metadata (dimensions) - status = nf90_inq_dimid(ncid, 'time', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) - else - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [time] dimension' - errflg = 1 - return - endif - - status = nf90_inq_dimid(ncid, 'lev', dimid) - if (status == nf90_noerr) then - status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) - else - errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [lev] dimension' - errflg = 1 - return - endif - - ! Allocate space and read in data - allocate(physics_process(nprc_sim)) - physics_process(1)%active_name = '' - physics_process(1)%iactive_scheme = 0 - physics_process(1)%active_tsp = .false. - do iprc = 1,nprc_sim - allocate(physics_process(iprc)%tend1d%T( nlev_data )) - allocate(physics_process(iprc)%tend1d%u( nlev_data )) - allocate(physics_process(iprc)%tend1d%v( nlev_data )) - allocate(physics_process(iprc)%tend1d%q( nlev_data )) - allocate(physics_process(iprc)%tend2d%time( ntime_data)) - allocate(physics_process(iprc)%tend2d%T( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%u( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%v( nlev_data, ntime_data)) - allocate(physics_process(iprc)%tend2d%q( nlev_data, ntime_data)) - - ! Temporal info - status = nf90_inq_varid(ncid, 'times', varID) - if (status == nf90_noerr) then - status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) - else - errmsg = 'SCM data tendency file: '//trim(suite_sim_file)//' does not contain times variable' - errflg = 1 - return - endif - - if (iprc == prc_SWRAD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SWRAD" - if (prc_SWRAD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 1 - iactive_T = 1 - endif - if (prc_SWRAD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - endif - - if (iprc == prc_LWRAD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "LWRAD" - if (prc_LWRAD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 1 - iactive_T = 1 - endif - if (prc_LWRAD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - endif - - if (iprc == prc_GWD_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "GWD" - if (prc_GWD_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 3 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - endif - if (prc_GWD_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - endif - - if (iprc == prc_PBL_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "PBL" - if (prc_PBL_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_PBL_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - endif - - if (iprc == prc_SCNV_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "SCNV" - if (prc_SCNV_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_SCNV_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - if (iprc == prc_DCNV_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "DCNV" - if (prc_DCNV_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 4 - iactive_T = 1 - iactive_u = 2 - iactive_v = 3 - iactive_q = 4 - endif - if (prc_DCNV_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) - status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) - status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - if (iprc == prc_cldMP_cfg(3)) then - ! Metadata - physics_process(iprc)%order = iprc - physics_process(iprc)%name = "cldMP" - if (prc_cldMP_cfg(1) == 1) then - physics_process(iprc)%use_sim = .true. - else - physics_process(1)%nprg_active = 2 - iactive_T = 1 - iactive_q = 2 - endif - if (prc_cldMP_cfg(2) == 1) then - physics_process(iprc)%time_split = .true. - endif - - ! Data - status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) - status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) - if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) - endif - - ! Which process-suite is "active"? Is process time-split? - if (.not. physics_process(iprc)%use_sim) then - physics_process(1)%iactive_scheme = iprc - physics_process(1)%active_name = physics_process(iprc)%name - if (physics_process(iprc)%time_split) then - physics_process(1)%active_tsp = .true. - endif - endif - - enddo - - if (physics_process(1)%iactive_scheme == 0) then - errflg = 1 - errmsg = "ERROR: No active suite set for CCPP suite simulator" - return - endif - - print*, "-----------------------------------" - print*, "--- Using CCPP suite simulator ---" - print*, "-----------------------------------" - do iprc = 1,nprc_sim - if (physics_process(iprc)%use_sim) then - print*," simulate_suite: ", trim(physics_process(iprc)%name) - print*," order: ", physics_process(iprc)%order - print*," time_split: ", physics_process(iprc)%time_split - else - print*, " active_suite: ", trim(physics_process(1)%active_name) - print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order - print*, " time_split : ", physics_process(1)%active_tsp - endif - enddo - print*, "-----------------------------------" - print*, "-----------------------------------" - - end subroutine load_ccpp_suite_sim - -end module GFS_ccpp_suite_sim_pre diff --git a/physics/GFS_ccpp_suite_sim_pre.meta b/physics/GFS_ccpp_suite_sim_pre.meta deleted file mode 100644 index cc73813fa..000000000 --- a/physics/GFS_ccpp_suite_sim_pre.meta +++ /dev/null @@ -1,174 +0,0 @@ -[ccpp-table-properties] - name = GFS_ccpp_suite_sim_pre - type = scheme - dependencies = machine.F,module_ccpp_suite_simulator.F90 - -######################################################################## -[ccpp-arg-table] - name = GFS_ccpp_suite_sim_pre_run - type = scheme -[do_ccpp_suite_sim] - standard_name = flag_for_ccpp_suite_simulator - long_name = flag for ccpp suite simulator - units = flag - dimensions = () - type = logical - intent = in -[physics_process] - standard_name = physics_process_type_for_CCPP_suite_simulator - long_name = physics process type for CCPP suite simulator - units = mixed - dimensions = (number_of_physics_process_in_CCPP_suite_simulator) - type = base_physics_process - intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) - type = real - kind = kind_phys - intent = in -[dtidx] - standard_name = cumulative_change_of_state_variables_outer_index - long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index - units = index - dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) - type = integer - intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[index_of_process_dcnv] - standard_name = index_of_deep_convection_process_process_in_cumulative_change_index - long_name = index of deep convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_longwave] - standard_name = index_of_longwave_heating_process_in_cumulative_change_index - long_name = index of longwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_shortwave] - standard_name = index_of_shortwave_heating_process_in_cumulative_change_index - long_name = index of shortwave heating process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_orographic_gwd] - standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index - long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_scnv] - standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index - long_name = index of shallow convection process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_pbl] - standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index - long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_process_mp] - standard_name = index_of_microphysics_process_process_in_cumulative_change_index - long_name = index of microphysics transport process in second dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_temperature] - standard_name = index_of_temperature_in_cumulative_change_index - long_name = index of temperature in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_x_wind] - standard_name = index_of_x_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[index_of_y_wind] - standard_name = index_of_y_wind_in_cumulative_change_index - long_name = index of x-wind in first dimension of array cumulative change index - units = index - dimensions = () - type = integer - intent = in -[ntqv] - standard_name = index_of_specific_humidity_in_tracer_concentration_array - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in -[active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_suite_simulator - long_name = tendencies for active physics process in ccpp suite simulator - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) - type = real - kind = kind_phys - intent = out -[iactive_T] - standard_name = index_for_active_T_in_CCPP_suite_simulator - long_name = index into active process tracer array for temperature in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_u] - standard_name = index_for_active_u_in_CCPP_suite_simulator - long_name = index into active process tracer array for zonal wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_v] - standard_name = index_for_active_v_in_CCPP_suite_simulator - long_name = index into active process tracer array for meridional wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_q] - standard_name = index_for_active_q_in_CCPP_suite_simulator - long_name = index into active process tracer array for moisture in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/ccpp_suite_simulator.F90 b/physics/ccpp_suite_simulator.F90 deleted file mode 100644 index c1592263d..000000000 --- a/physics/ccpp_suite_simulator.F90 +++ /dev/null @@ -1,212 +0,0 @@ -! ######################################################################################## -! -! Description: This suite simulates the evolution of the internal physics state -! represented by a CCPP Suite Definition File (SDF). -! -! To activate this suite it must be a) embedded within the SDF and b) activated through -! the physics namelist. -! The derived-data type "base_physics_process" contains the metadata needed to reconstruct -! the temporal evolution of the state. An array of base_physics_process, physics_process, -! is populated by the host during initialization and passed to the physics. Additionally, -! this type holds any data, or type-bound procedures, required by the suite simulator(s). -! -! For this initial demonstration we are using 2-dimensional (height, time) forcing data, -! which is on the same native vertical grid as the SCM. The dataset has a temporal -! resolution of 1-hour, created by averaging all local times from a Tropical Warm Pool -! International Cloud Experiment (TWPICE) case. This was to create a dataset with a -! (constant) diurnal cycle. -! -! ######################################################################################## -module ccpp_suite_simulator - use machine, only: kind_phys - use module_ccpp_suite_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & - sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP - implicit none - public ccpp_suite_simulator_run -contains - - ! ###################################################################################### - ! - ! SUBROUTINE ccpp_suite_simulator_run - ! - ! ###################################################################################### -!! \section arg_table_ccpp_suite_simulator_run -!! \htmlinclude ccpp_suite_simulator_run.html -!! - subroutine ccpp_suite_simulator_run(do_ccpp_suite_sim, kdt, nCol, nLay, dtp, jdat, & - iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,& - in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,& - gv0, gq0, errmsg, errflg) - - ! Inputs - logical, intent(in) :: do_ccpp_suite_sim - integer, intent(in) :: kdt, nCol, nLay, jdat(8), iactive_T, iactive_u, & - iactive_v, iactive_q - real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & - active_phys_tend(:,:,:) - ! Outputs - type(base_physics_process),intent(inout) :: physics_process(:) - real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:) - character(len=*),intent(out) :: errmsg - integer, intent(out) :: errflg - integer, intent(inout) :: proc_start, proc_end - logical, intent(inout) :: in_pre_active, in_post_active - - ! Locals - integer :: iCol, year, month, day, hour, min, sec, iprc - real(kind_phys), dimension(nCol,nLay) :: gt1, gu1, gv1, dTdt, dudt, dvdt, gq1, dqdt - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. do_ccpp_suite_sim) return - - ! Current forecast time (Data-format specific) - year = jdat(1) - month = jdat(2) - day = jdat(3) - hour = jdat(5) - min = jdat(6) - sec = jdat(7) - - ! Set state at beginning of the physics timestep. - gt1(:,:) = tgrs(:,:) - gu1(:,:) = ugrs(:,:) - gv1(:,:) = vgrs(:,:) - gq1(:,:) = qgrs(:,:,1) - dTdt(:,:) = 0. - dudt(:,:) = 0. - dvdt(:,:) = 0. - dqdt(:,:) = 0. - - ! - ! Set bookeeping indices - ! - if (in_pre_active) then - proc_start = 1 - proc_end = max(1,physics_process(1)%iactive_scheme-1) - endif - if (in_post_active) then - proc_start = physics_process(1)%iactive_scheme - proc_end = size(physics_process) - endif - - ! - ! Simulate internal physics timestep evolution. - ! - do iprc = proc_start,proc_end - do iCol = 1,nCol - - ! Reset locals - physics_process(iprc)%tend1d%T(:) = 0. - physics_process(iprc)%tend1d%u(:) = 0. - physics_process(iprc)%tend1d%v(:) = 0. - physics_process(iprc)%tend1d%q(:) = 0. - - ! Using scheme simulator - ! Very simple... - ! Interpolate 2D data (time,level) tendency to local time. - ! Here the data is already on the SCM vertical coordinate. - ! - ! In theory the data can be of any dimensionality and the onus falls on the - ! developer to extend the type "base_physics_process" to work with for their - ! application. - ! - if (physics_process(iprc)%use_sim) then - if (physics_process(iprc)%name == "LWRAD") then - call sim_LWRAD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "SWRAD")then - call sim_SWRAD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "GWD")then - call sim_GWD(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "PBL")then - call sim_PBL(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "SCNV")then - call sim_SCNV(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "DCNV")then - call sim_DCNV(year, month, day, hour, min, sec, physics_process(iprc)) - endif - if (physics_process(iprc)%name == "cldMP")then - call sim_cldMP(year, month, day, hour, min, sec, physics_process(iprc)) - endif - - ! Using data tendency from "active" scheme(s). - else - if (iactive_T > 0) physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,iactive_T) - if (iactive_u > 0) physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,iactive_u) - if (iactive_v > 0) physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,iactive_v) - if (iactive_q > 0) physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,iactive_q) - endif - - ! Update state now? (time-split scheme) - if (physics_process(iprc)%time_split) then - gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp - gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp - gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp - gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp - dTdt(iCol,:) = 0. - dudt(iCol,:) = 0. - dvdt(iCol,:) = 0. - dqdt(iCol,:) = 0. - ! Accumulate tendencies, update later? (process-split scheme) - else - dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T - dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u - dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v - dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q - endif - enddo ! END: Loop over columns - - ! Print diagnostics - if (physics_process(iprc)%use_sim) then - if (physics_process(iprc)%time_split) then - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (simulated)' - else - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (simulated)' - endif - else - if (physics_process(iprc)%time_split) then - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (active)' - else - write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (active)' - endif - write(*,'(a25,i2)') ' # prog. vars.: ',physics_process(1)%nprg_active - endif - enddo ! END: Loop over physics processes - - ! - ! Update state with accumulated tendencies (process-split only) - ! (Suites where active scheme is last physical process) - ! - iprc = minval([iprc,proc_end]) - if (.not. physics_process(iprc)%time_split) then - do iCol = 1,nCol - gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp - gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp - gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp - gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp - enddo - endif - - ! - ! Update bookeeping indices - ! - if (in_pre_active) then - in_pre_active = .false. - in_post_active = .true. - endif - - if (size(physics_process) == proc_end) then - in_pre_active = .true. - in_post_active = .false. - endif - - end subroutine ccpp_suite_simulator_run - -end module ccpp_suite_simulator diff --git a/physics/ccpp_suite_simulator.meta b/physics/ccpp_suite_simulator.meta deleted file mode 100644 index bfa664922..000000000 --- a/physics/ccpp_suite_simulator.meta +++ /dev/null @@ -1,201 +0,0 @@ -[ccpp-table-properties] - name = ccpp_suite_simulator - type = scheme - dependencies = machine.F,module_ccpp_suite_simulator.F90 - -[ccpp-arg-table] - name = ccpp_suite_simulator_run - type = scheme -[do_ccpp_suite_sim] - standard_name = flag_for_ccpp_suite_simulator - long_name = flag for ccpp suite simulator - units = flag - dimensions = () - type = logical - intent = in -[kdt] - standard_name = index_of_timestep - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in -[nCol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in -[nLay] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[jdat] - standard_name = date_and_time_of_forecast_in_united_states_order - long_name = current forecast date and time - units = none - dimensions = (8) - type = integer - intent = in -[proc_start] - standard_name = index_for_first_physics_process_in_CCPP_suite_simulator - long_name = index for first physics process in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = inout -[proc_end] - standard_name = index_for_last_physics_process_in_CCPP_suite_simulator - long_name = index for last physics process in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = inout -[in_pre_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme - long_name = flag to indicate location in physics process loop before active scheme - units = flag - dimensions = () - type = logical - intent = inout -[in_post_active] - standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme - long_name = flag to indicate location in physics process loop after active scheme - units = flag - dimensions = () - type = logical - intent = inout -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ugrs] - standard_name = x_wind - long_name = zonal wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[vgrs] - standard_name = y_wind - long_name = meridional wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs] - standard_name = tracer_concentration - long_name = model layer mean tracer concentration - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = in -[active_phys_tend] - standard_name = tendencies_for_active_process_in_ccpp_suite_simulator - long_name = tendencies for active physics process in ccpp suite simulator - units = mixed - dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) - type = real - kind = kind_phys - intent = in -[iactive_T] - standard_name = index_for_active_T_in_CCPP_suite_simulator - long_name = index into active process tracer array for temperature in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_u] - standard_name = index_for_active_u_in_CCPP_suite_simulator - long_name = index into active process tracer array for zonal wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_v] - standard_name = index_for_active_v_in_CCPP_suite_simulator - long_name = index into active process tracer array for meridional wind in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[iactive_q] - standard_name = index_for_active_q_in_CCPP_suite_simulator - long_name = index into active process tracer array for moisture in CCPP suite simulator - units = count - dimensions = () - type = integer - intent = in -[gt0] - standard_name = air_temperature_of_new_state - long_name = temperature updated by physics - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gu0] - standard_name = x_wind_of_new_state - long_name = zonal wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gv0] - standard_name = y_wind_of_new_state - long_name = meridional wind updated by physics - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[gq0] - standard_name = specific_humidity_of_new_state - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[physics_process] - standard_name = physics_process_type_for_CCPP_suite_simulator - long_name = physics process type for CCPP suite simulator - units = mixed - dimensions = (number_of_physics_process_in_CCPP_suite_simulator) - type = base_physics_process - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/module_ccpp_suite_simulator.F90 b/physics/module_ccpp_suite_simulator.F90 deleted file mode 100644 index c4f9fc4e4..000000000 --- a/physics/module_ccpp_suite_simulator.F90 +++ /dev/null @@ -1,328 +0,0 @@ -! ######################################################################################## -! -! This module contains the type, base_physics_process, and supporting subroutines needed -! by the ccpp suite simulator. -! -! ######################################################################################## -module module_ccpp_suite_simulator -!> \section arg_table_module_ccpp_suite_simulator Argument table -!! \htmlinclude module_ccpp_suite_simulator.html -!! - use machine, only : kind_phys - implicit none - - public base_physics_process - - ! Type containing 1D (time) physics tendencies. - type phys_tend_1d - real(kind_phys), dimension(:), allocatable :: T - real(kind_phys), dimension(:), allocatable :: u - real(kind_phys), dimension(:), allocatable :: v - real(kind_phys), dimension(:), allocatable :: q - real(kind_phys), dimension(:), allocatable :: p - real(kind_phys), dimension(:), allocatable :: z - end type phys_tend_1d - - ! Type containing 2D (lev,time) physics tendencies. - type phys_tend_2d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:,:), allocatable :: T - real(kind_phys), dimension(:,:), allocatable :: u - real(kind_phys), dimension(:,:), allocatable :: v - real(kind_phys), dimension(:,:), allocatable :: q - real(kind_phys), dimension(:,:), allocatable :: p - real(kind_phys), dimension(:,:), allocatable :: z - end type phys_tend_2d - - ! Type containing 3D (loc,lev,time) physics tendencies. - type phys_tend_3d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:), allocatable :: lon - real(kind_phys), dimension(:), allocatable :: lat - real(kind_phys), dimension(:,:,:), allocatable :: T - real(kind_phys), dimension(:,:,:), allocatable :: u - real(kind_phys), dimension(:,:,:), allocatable :: v - real(kind_phys), dimension(:,:,:), allocatable :: q - end type phys_tend_3d - - ! Type containing 4D (lon,lat,lev,time) physics tendencies. - type phys_tend_4d - real(kind_phys), dimension(:), allocatable :: time - real(kind_phys), dimension(:,:), allocatable :: lon - real(kind_phys), dimension(:,:), allocatable :: lat - real(kind_phys), dimension(:,:,:,:), allocatable :: T - real(kind_phys), dimension(:,:,:,:), allocatable :: u - real(kind_phys), dimension(:,:,:,:), allocatable :: v - real(kind_phys), dimension(:,:,:,:), allocatable :: q - end type phys_tend_4d - -! This type contains the meta information and data for each physics process. - -!> \section arg_table_base_physics_process Argument Table -!! \htmlinclude base_physics_process.html -!! - type base_physics_process - character(len=16) :: name ! Physics process name - logical :: time_split = .false. ! Is process time-split? - logical :: use_sim = .false. ! Is process "active"? - integer :: order ! Order of process in process-loop - type(phys_tend_1d) :: tend1d ! Instantaneous data - type(phys_tend_2d) :: tend2d ! 2-dimensional data - type(phys_tend_3d) :: tend3d ! Not used. Placeholder for 3-dimensional spatial data. - type(phys_tend_4d) :: tend4d ! Not used. Placeholder for 4-dimensional spatio-tempo data. - character(len=16) :: active_name ! "Active" scheme: Physics process name - integer :: iactive_scheme ! "Active" scheme: Order of process in process-loop - logical :: active_tsp ! "Active" scheme: Is process time-split? - integer :: nprg_active ! "Active" scheme: Number of prognostic variables - contains - generic, public :: linterp => linterp_1D, linterp_2D - procedure, private :: linterp_1D - procedure, private :: linterp_2D - procedure, public :: find_nearest_loc_2d_1d - procedure, public :: cmp_time_wts - end type base_physics_process - -contains - - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. - ! #################################################################################### - function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: err_message - integer :: ti(1), tf(1), ntime - real(kind_phys) :: w1, w2 - - ! Interpolation weights - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - ntime = size(this%tend2d%T(1,:)) - - select case(var_name) - case("T") - if (tf(1) .le. ntime) then - this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) - else - this%tend1d%T = this%tend2d%T(:,1) - endif - case("u") - if (tf(1) .le. ntime) then - this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) - else - this%tend1d%u = this%tend2d%u(:,1) - endif - case("v") - if (tf(1) .le. ntime) then - this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) - else - this%tend1d%v = this%tend2d%v(:,1) - endif - case("q") - if (tf(1) .le. ntime) then - this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) - else - this%tend1d%q = this%tend2d%q(:,1) - endif - end select - - end function linterp_1D - - ! #################################################################################### - ! Type-bound procedure to compute tendency profile for time-of-day. - ! - ! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. - ! This assumes that the location dimension has a [longitude, latitude] allocated with - ! each location. - ! #################################################################################### - function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) - class(base_physics_process), intent(inout) :: this - character(len=*), intent(in) :: var_name - integer, intent(in) :: year, month, day, hour, min, sec - real(kind_phys), intent(in) :: lon, lat - character(len=128) :: err_message - integer :: ti(1), tf(1), iNearest - real(kind_phys) :: w1, w2 - - ! Interpolation weights (temporal) - call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) - - ! Grab data tendency closest to column [lon,lat] - iNearest = this%find_nearest_loc_2d_1d(lon,lat) - - select case(var_name) - case("T") - this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) - case("u") - this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) - case("v") - this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) - case("q") - this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) - end select - end function linterp_2D - - ! #################################################################################### - ! Type-bound procedure to find nearest location. - ! For use with linterp_2D, NOT YET IMPLEMENTED. - ! #################################################################################### - pure function find_nearest_loc_2d_1d(this, lon, lat) - class(base_physics_process), intent(in) :: this - real(kind_phys), intent(in) :: lon, lat - integer :: find_nearest_loc_2d_1d - - find_nearest_loc_2d_1d = 1 - end function find_nearest_loc_2d_1d - - ! #################################################################################### - ! Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) - ! forcing. - ! #################################################################################### - subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) - ! Inputs - class(base_physics_process), intent(in) :: this - integer, intent(in) :: year, month, day, hour, minute, sec - ! Outputs - integer,intent(out) :: ti(1), tf(1) - real(kind_phys),intent(out) :: w1, w2 - ! Locals - real(kind_phys) :: hrofday - - hrofday = hour*3600. + minute*60. + sec - ti = max(hour,1) - tf = min(ti + 1,24) - w1 = ((hour+1)*3600 - hrofday)/3600 - w2 = 1 - w1 - - end subroutine cmp_time_wts - - ! #################################################################################### - ! #################################################################################### - subroutine sim_LWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_LWRAD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_SWRAD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - - end subroutine sim_SWRAD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_GWD( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - - end subroutine sim_GWD - - ! #################################################################################### - ! #################################################################################### - subroutine sim_PBL( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_PBL - - ! #################################################################################### - ! #################################################################################### - subroutine sim_DCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_DCNV - - ! #################################################################################### - ! #################################################################################### - subroutine sim_SCNV( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%u)) then - errmsg = process%linterp("u", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%v)) then - errmsg = process%linterp("v", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - - end subroutine sim_SCNV - - ! #################################################################################### - ! #################################################################################### - subroutine sim_cldMP( year, month, day, hour, min, sec, process) - type(base_physics_process), intent(inout) :: process - integer, intent(in) :: year, month, day, hour, min, sec - character(len=128) :: errmsg - - if (allocated(process%tend2d%T)) then - errmsg = process%linterp("T", year,month,day,hour,min,sec) - endif - if (allocated(process%tend2d%q)) then - errmsg = process%linterp("q", year,month,day,hour,min,sec) - endif - end subroutine sim_cldMP - -end module module_ccpp_suite_simulator diff --git a/physics/module_ccpp_suite_simulator.meta b/physics/module_ccpp_suite_simulator.meta deleted file mode 100644 index cd8e3db1b..000000000 --- a/physics/module_ccpp_suite_simulator.meta +++ /dev/null @@ -1,24 +0,0 @@ -[ccpp-table-properties] - name = base_physics_process - type = ddt - dependencies = - -[ccpp-arg-table] - name = base_physics_process - type = ddt - -######################################################################## -[ccpp-table-properties] - name = module_ccpp_suite_simulator - type = module - dependencies = machine.F - -[ccpp-arg-table] - name = module_ccpp_suite_simulator - type = module -[base_physics_process] - standard_name = base_physics_process - long_name = definition of type base_physics_process - units = DDT - dimensions = () - type = base_physics_process From 12cd9c698ad9bc97bb4c84a2225542ccaf0ce3bc Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Tue, 28 Nov 2023 15:35:12 -0500 Subject: [PATCH 104/132] update files satmedmfvdifq.F samfshalcnv.f sfc_diff.f --- physics/samfshalcnv.f | 2 +- physics/satmedmfvdifq.F | 2 +- physics/scm_sfc_flux_spec.F90 | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index 3869ea6ea..d0bab05dd 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -191,7 +191,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & parameter(cinacrmx=-120.,shevf=2.0) parameter(dtmax=10800.,dtmin=600.) parameter(bb1=4.0,bb2=0.8,csmf=0.2) - parameter(tkcrt=2.,cmxfac=15.) + parameter(tkcrt=2.,cmxfac=10.) ! parameter(bet1=1.875,cd1=.506,f1=2.0,gam1=.5) parameter(betaw=.03,dxcrtc0=9.e3) parameter(h1=0.33333333) diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 73fc4aff8..7b54b6d12 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -271,7 +271,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(elmfac=1.0,elefac=1.0,cql=100.) parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=1000.) parameter(qlcr=3.5e-5,zstblmax=2500.) - parameter(xkinv1=0.15,xkinv2=0.3) + parameter(xkinv1=0.4,xkinv2=0.3) parameter(h1=0.33333333,hcrinv=250.) parameter(vegflo=0.1,vegfup=1.0,z0lo=0.1,z0up=1.0) parameter(vc0=1.0,zc0=1.0) diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/scm_sfc_flux_spec.F90 index e835b77ff..835b468ff 100644 --- a/physics/scm_sfc_flux_spec.F90 +++ b/physics/scm_sfc_flux_spec.F90 @@ -58,9 +58,9 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, use machine, only: kind_phys integer, intent(in) :: im, lkm - integer, intent(inout) :: islmsk(:), use_lake_model(:) + integer, intent(inout) :: islmsk(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:) From c6ba923815172c07652e0c0536dea9628bb10d08 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Fri, 1 Dec 2023 18:32:56 +0000 Subject: [PATCH 105/132] "Add GF convective transport & wet removal of smoke/dust" --- physics/cu_gf_deep.F90 | 256 +++++++++++++++++++++++++++++---- physics/cu_gf_driver.F90 | 22 ++- physics/cu_gf_driver.meta | 38 +++++ physics/cu_gf_driver_post.F90 | 11 +- physics/cu_gf_driver_post.meta | 44 ++++++ physics/cu_gf_driver_pre.F90 | 10 ++ physics/cu_gf_driver_pre.meta | 44 ++++++ 7 files changed, 395 insertions(+), 30 deletions(-) diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index 0d1fc68c7..ab72c662c 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -3,6 +3,7 @@ module cu_gf_deep use machine , only : kind_phys + use physcons, only : qamin real(kind=kind_phys), parameter::g=9.81 real(kind=kind_phys), parameter:: cp=1004. real(kind=kind_phys), parameter:: xlv=2.5e6 @@ -124,6 +125,11 @@ subroutine cu_gf_deep_run( & ,frh_out & ! fractional coverage ,ierr & ! ierr flags are error flags, used for debugging ,ierrc & ! the following should be set to zero if not available + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_deep & + ,do_smoke_transport & ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist ,rand_clos & ! for stochastics closures, if temporal and spatial patterns exist @@ -144,7 +150,7 @@ subroutine cu_gf_deep_run( & ,intent (in ) :: & nranflag,itf,ktf,its,ite, kts,kte,ipr,imid integer, intent (in ) :: & - ichoice + ichoice,nchem real(kind=kind_phys), dimension (its:ite,4) & ,intent (in ) :: rand_clos real(kind=kind_phys), dimension (its:ite) & @@ -163,17 +169,17 @@ subroutine cu_gf_deep_run( & ! outq = output q tendency (per s) ! outqc = output qc tendency (per s) ! pre = output precip - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout ) :: & cnvwt,outu,outv,outt,outq,outqc,cupclw - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (out ) :: & frh_out - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (inout ) :: & pre,xmb_out !$acc declare copy(cnvwt,outu,outv,outt,outq,outqc,cupclw,frh_out,pre,xmb_out) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & hfx,qfx,xmbm_in,xmbs_in !$acc declare copyin(hfx,qfx,xmbm_in,xmbs_in) @@ -190,29 +196,35 @@ subroutine cu_gf_deep_run( & ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off ! convection for this call only and at that particular gridpoint ! - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (in ) :: & dhdt,rho,t,po,us,vs,tn !$acc declare copyin(dhdt,rho,t,po,us,vs,tn) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout ) :: & omeg !$acc declare copy(omeg) - real(kind=kind_phys), dimension (its:ite,kts:kte) & + real(kind=kind_phys), dimension (its:ite,kts:kte) & ,intent (inout) :: & q,qo,zuo,zdo,zdm !$acc declare copy(q,qo,zuo,zdo,zdm) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & dx,z1,psur,xland !$acc declare copyin(dx,z1,psur,xland) - real(kind=kind_phys), dimension (its:ite) & + real(kind=kind_phys), dimension (its:ite) & ,intent (inout ) :: & mconv,ccn !$acc declare copy(mconv,ccn) + real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) & + ,intent (inout) :: & + chem3d + logical, intent (in) :: do_smoke_transport + real(kind=kind_phys), dimension (its:ite,nchem) & + , intent (out) :: wetdpc_deep + real(kind=kind_phys), intent (in) :: fscav(:) - - real(kind=kind_phys) & + real(kind=kind_phys) & ,intent (in ) :: & dtime,ccnclean @@ -220,11 +232,11 @@ subroutine cu_gf_deep_run( & ! ! local ensemble dependent variables in this routine ! - real(kind=kind_phys), dimension (its:ite,1) :: & + real(kind=kind_phys), dimension (its:ite,1) :: & xaa0_ens - real(kind=kind_phys), dimension (its:ite,1) :: & + real(kind=kind_phys), dimension (its:ite,1) :: & edtc - real(kind=kind_phys), dimension (its:ite,kts:kte,1) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte,1) :: & dellat_ens,dellaqc_ens,dellaq_ens,pwo_ens !$acc declare create(xaa0_ens,edtc,dellat_ens,dellaqc_ens,dellaq_ens,pwo_ens) ! @@ -292,8 +304,18 @@ subroutine cu_gf_deep_run( & ! xmb = total base mass flux ! hc = cloud moist static energy ! hkb = moist static energy at originating level - - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) :: & + chem + real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) :: & + chem_cup,chem_up,chem_down,dellac,dellac2,chem_c,chem_pw,chem_pwd + real(kind=kind_phys), dimension (its:ite,nchem) :: & + chem_pwav,chem_psum + real(kind=kind_phys):: dtime_max,sum1,sum2 + real(kind=kind_phys), dimension (kts:kte) :: trac,trcflx_in,trcflx_out,trc,trco + real(kind=kind_phys), dimension (its:ite,kts:kte) :: pwdper, massflx + integer :: nv + + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & entr_rate_2d,mentrd_rate_2d,he,hes,qes,z, heo,heso,qeso,zo, & xhe,xhes,xqes,xz,xt,xq,qes_cup,q_cup,he_cup,hes_cup,z_cup, & p_cup,gamma_cup,t_cup, qeso_cup,qo_cup,heo_cup,heso_cup, & @@ -330,13 +352,13 @@ subroutine cu_gf_deep_run( & ! xaa0 = cloud work function with cloud effects (ensemble dependent) ! edt = epsilon - real(kind=kind_phys), dimension (its:ite) :: & - edt,edto,edtm,aa1,aa0,xaa0,hkb, & + real(kind=kind_phys), dimension (its:ite) :: & + edt,edto,edtm,aa1,aa0,xaa0,hkb, & hkbo,xhkb, & xmb,pwavo,ccnloss, & pwevo,bu,bud,cap_max, & cap_max_increment,closure_n,psum,psumh,sig,sigd - real(kind=kind_phys), dimension (its:ite) :: & + real(kind=kind_phys), dimension (its:ite) :: & axx,edtmax,edtmin,entr_rate integer, dimension (its:ite) :: & kzdown,kdet,k22,jmin,kstabi,kstabm,k22x,xland1, & @@ -372,10 +394,10 @@ subroutine cu_gf_deep_run( & character*50 :: ierrc(its:ite) character*4 :: cumulus - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & up_massentr,up_massdetr,c1d & ,up_massentro,up_massdetro,dd_massentro,dd_massdetro - real(kind=kind_phys), dimension (its:ite,kts:kte) :: & + real(kind=kind_phys), dimension (its:ite,kts:kte) :: & up_massentru,up_massdetru,dd_massentru,dd_massdetru !$acc declare create(up_massentr,up_massdetr,c1d,up_massentro,up_massdetro,dd_massentro,dd_massdetro, & !$acc up_massentru,up_massdetru,dd_massentru,dd_massdetru) @@ -401,6 +423,7 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (its:ite,kts:kte) :: dtempdz integer, dimension (its:ite,kts:kte) :: k_inv_layers real(kind=kind_phys), dimension (its:ite) :: c0 ! HCB + real(kind=kind_phys), dimension (its:ite,kts:kte) :: c0t3d ! hli for smoke/dust wet scavenging !$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0) ! rainevap from sas @@ -1058,14 +1081,14 @@ subroutine cu_gf_deep_run( & if(imid.eq.1)then call cup_up_moisture('mid',ierr,zo_cup,qco,qrco,pwo,pwavo, & p_cup,kbcon,ktop,dbyo,clw_all,xland1, & - qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & + qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, & 1,itf,ktf, & its,ite, kts,kte) else call cup_up_moisture('deep',ierr,zo_cup,qco,qrco,pwo,pwavo, & p_cup,kbcon,ktop,dbyo,clw_all,xland1, & - qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0, & + qo,gammao_cup,zuo,qeso_cup,k22,qo_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,tn_cup,autoconv,up_massentr,up_massdetr,psum,psumh, & 1,itf,ktf, & its,ite, kts,kte) @@ -2013,6 +2036,185 @@ subroutine cu_gf_deep_run( & kts,kte,ierr,kbcon,xmb,psur,xland,qo_cup, & po_cup,qes_cup,pwavo,edto,pwevo,pre,outt,outq) !,outbuoy) +! +! +!>- atmospheric composition tracers +! +!> ## Determine whether to perform aerosol transport + if (do_smoke_transport .and. nchem > 0) then +! +! initialize tracers if they exist +! + chem (:,:,:) = 0. + do nv = 1,nchem + do k = 1, ktf + do i = 1, itf + chem(i,k,nv) = max(qamin, chem3d(i,k,nv)) + enddo + enddo + enddo + + wetdpc_deep = 0. + + chem_pwav(:,:) = 0. + chem_psum(:,:) = 0. + chem_pw (:,:,:) = 0. + chem_pwd (:,:,:) = 0. + pwdper (:,:) = 0. + chem_down(:,:,:) = 0. + chem_up (:,:,:) = 0. + chem_c (:,:,:) = 0. + chem_cup (:,:,:) = 0. + + do i=its,itf + if(ierr(i).eq.0)then + do k=kts,jmin(i) + pwdper(i,k)=-edtc(i,1)*pwdo(i,k)/pwavo(i) + enddo + pwdper(i,:)=0. + do nv=1,nchem + do k=kts+1,ktf + chem_cup(i,k,nv)=.5*(chem(i,k-1,nv)+chem(i,k,nv)) + enddo + chem_cup(i,kts,nv)=chem(i,kts,nv) +! +! in updraft +! + do k=1,k22(i) + chem_up(i,k,nv)=chem_cup(i,k,nv) + enddo + do k=k22(i)+1,ktop(i) + chem_up(i,k,nv)=(chem_up(i,k-1,nv)*zuo(i,k-1) & + -.5*up_massdetr(i,k-1)*chem_up(i,k-1,nv)+ & + up_massentr(i,k-1)*chem(i,k-1,nv)) / & + (zuo(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1)) + chem_c(i,k,nv)=fscav(nv)*chem_up(i,k,nv) + dz=zo_cup(i,K)-zo_cup(i,K-1) + trash2=chem_up(i,k,nv)-chem_c(i,k,nv) + trash=chem_c(i,k,nv)/(1.+c0t3d(i,k)*dz) + chem_pw=c0t3d(i,k)*dz*trash*zuo(i,k) + chem_up(i,k,nv)=trash2+trash +! chem_pw(i,k,nv)=min(chem_up(i,k,nv),chem_c(i,k,nv)*pwo(i,k)/zuo(i,k)/(1.e-8+qrco(i,k))) +! chem_up(i,k,nv)=chem_up(i,k,nv)-chem_pw(i,k,nv) + chem_pwav(i,nv)=chem_pwav(i,nv)+chem_pw(i,k,nv)! *g/dp + enddo + do k=ktop(i)+1,ktf + chem_up(i,k,nv)=chem_cup(i,k,nv) + enddo +! +! in downdraft +! + chem_down(i,jmin(i)+1,nv)=chem_cup(i,jmin(i)+1,nv) + chem_psum(i,nv)=0. + do ki=jmin(i),2,-1 + dp=100.*(po_cup(i,ki)-po_cup(i,ki+1)) + chem_down(i,ki,nv)=(chem_down(i,ki+1,nv)*zdo(i,ki+1) & + -.5*dd_massdetro(i,ki)*chem_down(i,ki+1,nv)+ & + dd_massentro(i,ki)*chem(i,ki,nv)) / & + (zdo(i,ki+1)-.5*dd_massdetro(i,ki)+dd_massentro(i,ki)) + chem_down(i,ki,nv)=chem_down(i,ki,nv)+pwdper(i,ki)*chem_pwav(i,nv) + chem_pwd(i,ki,nv)=max(0.,pwdper(i,ki)*chem_pwav(i,nv)) + enddo +! total wet deposition + do k=1,ktf-1 + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + chem_psum(i,nv)=chem_psum(i,nv)+chem_pw(i,k,nv)*g !/dp + enddo + chem_psum(i,nv)=chem_psum(i,nv)*xmb(i)*dtime +! + enddo ! nchem + endif ! ierr=0 + enddo ! i + + dellac(:,:,:)=0. + + do nv=1,nchem + do i=its,itf + if(ierr(i).eq.0)then + dp=100.*(po_cup(i,1)-po_cup(i,2)) + dellac(i,1,nv)=dellac(i,1,nv)+(edto(i)*zdo(i,2)*chem_down(i,2,nv))*g/dp*xmb(i) + if(k22(i).eq.2)then + entupk=zuo(i,2) + dellac(i,1,nv)=dellac(i,1,nv)-entupk*chem_cup(i,2,nv)*g/dp*xmb(i) + endif + do k=kts+1,ktop(i)-1 + detup=0. + detdo=0. + entup=0. + entdo=0. + entdoj=0. + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + ! entrainment/detrainment for updraft + entdo=edto(i)*dd_massentro(i,k)*chem(i,k,nv) + detdo=edto(i)*dd_massdetro(i,k)*.5*(chem_down(i,k+1,nv)+chem_down(i,k,nv)) + entup=up_massentro(i,k)*chem(i,k,nv) + detup=up_massdetro(i,k)*.5*(chem_up(i,k+1,nv)+chem_up(i,k,nv)) + ! special levels + if(k == k22(i)-1) then + entup=zuo(i,k+1)*chem_cup(i,k+1,nv) + detup=0. + endif + if(k.eq.jmin(i))entdoj=edto(i)*zdo(i,k)*chem_cup(i,k,nv) +! mass budget + dellac(i,k,nv) =dellac(i,k,nv) + (detup+detdo-entdo-entup-entdoj)*g/dp*xmb(i) + enddo + dellac(i,ktop(i),nv)=zuo(i,ktop(i))*chem_up(i,ktop(i),nv)*g/dp*xmb(i) + endif ! ierr + enddo ! i + enddo ! nchem loop + +! fct for subsidence + dellac2(:,:,:)=0. + massflx(:,:)=0. + do nv=1,nchem + do i=its,itf + if(ierr(i).eq.0)then + trcflx_in(:)=0. + dtime_max=dtime + +! initialize fct routine + do k=kts,ktop(i) + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + dtime_max=min(dtime_max,.5*dp) + massflx(i,k)=-xmb(i)*(zuo(i,k)-edto(i)*zdo(i,k)) + trcflx_in(k)=massflx(i,k)*chem_cup(i,k,nv) + enddo + trcflx_in(1)=0. + massflx(i,1)=0. + call fct1d3(ktop(i),kte,dtime_max,po_cup(i,:),chem(i,:,nv),massflx(i,:), & + trcflx_in,dellac2(i,:,nv),g) + do k=kts,ktop(i) + trash=chem (i,k,nv) + chem (i,k,nv)=chem (i,k,nv) + (dellac(i,k,nv)+dellac2(i,k,nv))*dtime + if(chem(i,k,nv).lt.qamin)then + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + wetdpc_deep(i,nv)=wetdpc_deep(i,nv)+(qamin-chem(i,k,nv))*dp/g/dtime + chem(i,k,nv)=qamin + endif + enddo + endif + + enddo ! i + enddo ! nchem loop + +!> - Store aerosol concentrations if present + do nv = 1, nchem + do i = 1, itf + do k = 1, ktf + if(ierr(i).eq.0) then + if (k <= ktop(i)) then + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + wetdpc_deep(i,nv)=wetdpc_deep(i,nv) + ((chem3d(i,k,nv)-chem(i,k,nv))*dp/(g*dtime)) + chem3d(i,k,nv) = chem(i,k,nv) + endif + endif + enddo + wetdpc_deep(i,nv)=max(wetdpc_deep(i,nv),qamin) + enddo + enddo + + endif ! nchem > 0 + k=1 !$acc kernels do i=its,itf @@ -4101,7 +4303,7 @@ end subroutine cup_output_ens_3d !> Calculates moisture properties of the updraft. subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & p_cup,kbcon,ktop,dby,clw_all,xland1, & - q,gamma_cup,zu,qes_cup,k22,qe_cup,c0, & + q,gamma_cup,zu,qes_cup,k22,qe_cup,c0,c0t3d, & zqexec,ccn,ccnclean,rho,c1d,t,autoconv, & up_massentr,up_massdetr,psum,psumh, & itest,itf,ktf, & @@ -4137,6 +4339,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & zqexec,c0 + real(kind=kind_phys), dimension (its:ite,kts:kte), intent (out) :: c0t3d ! entr= entrainment rate integer, dimension (its:ite) & ,intent (in ) :: & @@ -4218,6 +4421,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & c0_iceconv=0.01 c1d_b=c1d bdsp(:)=bdispm + c0t3d = 0. ! !--- no precip for small clouds @@ -4288,6 +4492,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & else c0t = c0(i) * exp(c0_iceconv * (t(i,k) - 273.16)) endif + c0t3d(i,k)=c0t qc(i,k)= (qc(i,k-1)*zu(i,k-1)-.5*up_massdetr(i,k-1)* qc(i,k-1)+ & up_massentr(i,k-1)*q(i,k-1)) / & (zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1)) @@ -4320,6 +4525,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & c0t = c0(i) * exp(c0_iceconv * (t(i,k) - 273.16)) endif if(is_mid)c0t=0.004 + c0t3d(i,k)=c0t if(autoconv .gt.1) c0t=c0(i) denom=zu(i,k-1)-.5*up_massdetr(i,k-1)+up_massentr(i,k-1) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index d85b7ac52..d8bc11629 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -67,8 +67,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& fhour,fh_dfi_radar,ix_dfi_radar,num_dfi_radar,cap_suppress, & dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in,ichoice_s_in, & - spp_cu_deep,spp_wts_cu_deep, & - errmsg,errflg) + spp_cu_deep,spp_wts_cu_deep,nchem,chem3d,fscav,wetdpc_deep, & + do_smoke_transport,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -86,7 +86,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& & spp_wts_cu_deep real(kind=kind_phys) :: spp_wts_cu_deep_tmp - logical, intent(in) :: do_cap_suppress + logical, intent(in) :: do_cap_suppress, do_smoke_transport real(kind=kind_phys), parameter :: aodc0=0.14 real(kind=kind_phys), parameter :: aodreturn=30. real(kind=kind_phys) :: dts,fpi,fp @@ -94,7 +94,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, parameter :: dicycle_m=0 !- diurnal cycle flag integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- - integer :: its,ite, jts,jte, kts,kte + integer :: its,ite, jts,jte, kts,kte, nchem integer, intent(in ) :: im,km,ntracer integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf @@ -154,6 +154,9 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in ) :: imfshalcnv integer, dimension(:), intent(inout) :: cactiv,cactiv_m + real(kind_phys), dimension(:), intent(in) :: fscav + real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d + real(kind_phys), dimension(:,:), intent(inout) :: wetdpc_deep !$acc declare copy(cactiv,cactiv_m) character(len=*), intent(out) :: errmsg @@ -179,6 +182,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& real(kind=kind_phys), dimension (im) :: tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi real(kind=kind_phys), dimension (im) :: pret,prets,pretm,hexec real(kind=kind_phys), dimension (im,10) :: forcing,forcing2 + real(kind=kind_phys), dimension (im,nchem) :: wetdpc_mid integer, dimension (im) :: kbcon, ktop,ierr,ierrs,ierrm,kpbli integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm @@ -743,6 +747,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,frhm & ,ierrm & ,ierrcm & + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_mid & + ,do_smoke_transport & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist @@ -825,6 +834,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,frhd & ,ierr & ,ierrc & + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_deep & + ,do_smoke_transport & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 08e9de201..d6d874f7e 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -612,6 +612,44 @@ dimensions = () type = integer intent = in +[nchem] + standard_name = number_of_chemical_species_vertically_mixed + long_name = number of chemical vertically mixed + units = count + dimensions = () + type = integer + intent = in +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout +[fscav] + standard_name = smoke_dust_conv_wet_coef + long_name = smoke dust convetive wet scavanging coefficents + units = none + dimensions = (3) + type = real + kind = kind_phys + intent = in +[do_smoke_transport] + standard_name = do_smoke_conv_transport + long_name = flag for rrfs smoke convective transport + units = flag + dimensions = () + type = logical + intent = in +[wetdpc_deep] + standard_name = conv_wet_deposition_smoke_dust + long_name = convective wet removal of smoke and dust + units = kg kg-1 + dimensions = (horizontal_loop_extent,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cu_gf_driver_post.F90 b/physics/cu_gf_driver_post.F90 index 111bf0863..1700fbde9 100644 --- a/physics/cu_gf_driver_post.F90 +++ b/physics/cu_gf_driver_post.F90 @@ -15,7 +15,7 @@ module cu_gf_driver_post !> \section arg_table_cu_gf_driver_post_run Argument Table !! \htmlinclude cu_gf_driver_post_run.html !! - subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, errmsg, errflg) + subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, errmsg, errflg) use machine, only: kind_phys @@ -31,6 +31,9 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m integer, intent(in) :: cactiv_m(:) real(kind_phys), intent(out) :: conv_act(:) real(kind_phys), intent(out) :: conv_act_m(:) + logical, intent(in) :: rrfs_sd + integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm + real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) character(len=*), intent(out) :: errmsg !$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) integer, intent(out) :: errflg @@ -60,6 +63,12 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m enddo !$acc end kernels + if (rrfs_sd) then + gq0(:,:,ntsmoke ) = chem3d(:,:,1) + gq0(:,:,ntdust ) = chem3d(:,:,2) + gq0(:,:,ntcoarsepm) = chem3d(:,:,3) + endif + end subroutine cu_gf_driver_post_run end module cu_gf_driver_post diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 6c6ceeb66..4c04224dc 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -83,6 +83,34 @@ type = real kind = kind_phys intent = out +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[ntsmoke] + standard_name = index_for_smoke_in_tracer_concentration_array + long_name = tracer index for smoke + units = index + dimensions = () + type = integer + intent = in +[ntdust] + standard_name = index_for_dust_in_tracer_concentration_array + long_name = tracer index for dust + units = index + dimensions = () + type = integer + intent = in +[ntcoarsepm] + standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array + long_name = tracer index for coarse particulate matter + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -91,6 +119,22 @@ type = character kind = len=* intent = out +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [errflg] standard_name = ccpp_error_code long_name = error code for error handling in CCPP diff --git a/physics/cu_gf_driver_pre.F90 b/physics/cu_gf_driver_pre.F90 index 98cc76b95..6be7b8aec 100644 --- a/physics/cu_gf_driver_pre.F90 +++ b/physics/cu_gf_driver_pre.F90 @@ -17,6 +17,7 @@ module cu_gf_driver_pre !! subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, prevst, prevsq, & forcet, forceq, cactiv, cactiv_m, conv_act, conv_act_m, & + rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, & errmsg, errflg) use machine, only: kind_phys @@ -25,6 +26,7 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, logical, intent(in) :: flag_init logical, intent(in) :: flag_restart + logical, intent(in) :: rrfs_sd integer, intent(in) :: kdt real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: dtp @@ -37,9 +39,11 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, real(kind_phys), intent(out) :: forceq(:,:) integer, intent(out) :: cactiv(:) integer, intent(out) :: cactiv_m(:) + integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm !$acc declare copyout(forcet,forceq,cactiv,cactiv_m) real(kind_phys), intent(in) :: conv_act(:) real(kind_phys), intent(in) :: conv_act_m(:) + real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) !$acc declare copyin(conv_act,conv_act_m) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -79,6 +83,12 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, cactiv_m(:)=nint(conv_act_m(:)) !$acc end kernels + if (rrfs_sd) then + chem3d(:,:,1) = gq0(:,:,ntsmoke) + chem3d(:,:,2) = gq0(:,:,ntdust) + chem3d(:,:,3) = gq0(:,:,ntcoarsepm) + endif + end subroutine cu_gf_driver_pre_run end module cu_gf_driver_pre diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta index 7fd66d19b..6d8787d06 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/cu_gf_driver_pre.meta @@ -122,6 +122,50 @@ type = real kind = kind_phys intent = in +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[ntsmoke] + standard_name = index_for_smoke_in_tracer_concentration_array + long_name = tracer index for smoke + units = index + dimensions = () + type = integer + intent = in +[ntdust] + standard_name = index_for_dust_in_tracer_concentration_array + long_name = tracer index for dust + units = index + dimensions = () + type = integer + intent = in +[ntcoarsepm] + standard_name = index_for_coarse_particulate_matter_in_tracer_concentration_array + long_name = tracer index for coarse particulate matter + units = index + dimensions = () + type = integer + intent = in +[chem3d] + standard_name = chem3d_mynn_pbl_transport + long_name = mynn pbl transport of smoke and dust + units = various + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = tracer_concentration_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 55427235fbf67a9d55bf5dca5b63e9b5d1f884bd Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Sun, 3 Dec 2023 00:21:15 +0000 Subject: [PATCH 106/132] "update for RRFS-SD code freeze" --- physics/smoke_dust/coarsepm_settling_mod.F90 | 12 +- physics/smoke_dust/dep_data_mod.F90 | 193 +++++ physics/smoke_dust/dep_dry_mod_emerson.F90 | 431 +++++++++++ ...dep_dry_mod.F90 => dep_dry_simple_mod.F90} | 22 +- physics/smoke_dust/dust_fengsha_mod.F90 | 9 +- physics/smoke_dust/module_add_emiss_burn.F90 | 313 +++----- physics/smoke_dust/module_plumerise1.F90 | 33 +- physics/smoke_dust/module_smoke_plumerise.F90 | 14 +- physics/smoke_dust/module_wetdep_ls.F90 | 17 +- physics/smoke_dust/plume_data_mod.F90 | 2 +- physics/smoke_dust/rrfs_smoke_config.F90 | 66 +- physics/smoke_dust/rrfs_smoke_postpbl.meta | 3 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 728 +++++++++++------- physics/smoke_dust/rrfs_smoke_wrapper.meta | 423 +++++----- 14 files changed, 1529 insertions(+), 737 deletions(-) create mode 100755 physics/smoke_dust/dep_data_mod.F90 create mode 100755 physics/smoke_dust/dep_dry_mod_emerson.F90 rename physics/smoke_dust/{dep_dry_mod.F90 => dep_dry_simple_mod.F90} (75%) diff --git a/physics/smoke_dust/coarsepm_settling_mod.F90 b/physics/smoke_dust/coarsepm_settling_mod.F90 index 9061840c3..49f229453 100755 --- a/physics/smoke_dust/coarsepm_settling_mod.F90 +++ b/physics/smoke_dust/coarsepm_settling_mod.F90 @@ -8,7 +8,7 @@ module coarsepm_settling_mod CONTAINS -SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, & +SUBROUTINE coarsepm_settling_driver(dt,t_phy, & chem,rho_phy,dz8w,p8w,p_phy,sedim, & area,g,num_chem, & ids,ide, jds,jde, kds,kde, & @@ -24,7 +24,7 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, & its,ite, jts,jte, kts,kte REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),INTENT(INOUT ) :: chem REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & - INTENT(IN ) :: t_phy,p_phy,dz8w,p8w,rho_phy,rel_hum + INTENT(IN ) :: t_phy,p_phy,dz8w,p8w,rho_phy REAL(kind_phys), DIMENSION( ims:ime , jms:jme ),INTENT(IN ) :: area REAL(kind_phys), INTENT(IN ) :: dt,g @@ -64,7 +64,7 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, & airmas(1,1,kk)=-(p8w(i,k+1,j)-p8w(i,k,j))*area(i,j)/g airden(1,1,kk)=rho_phy(i,k,j) tmp(1,1,kk)=t_phy(i,k,j) - rh(1,1,kk) = rel_hum(i,k,j) ! hli +! rh(1,1,kk) = rel_hum(i,k,j) ! hli do nv = 1, num_chem chem_before(i,j,k,nv) = chem(i,k,j,nv) enddo @@ -82,7 +82,7 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy,rel_hum, & call settling(1, 1, lmx, 1,g,dyn_visc, & dust, tmp, p_mid, delz, airmas, & - den_dust, reff_dust, dt, bstl_dust, rh, idust, airden) + den_dust, reff_dust, dt, bstl_dust, idust, airden) kk = 0 do k = kts,kte @@ -111,7 +111,7 @@ END SUBROUTINE coarsepm_settling_driver subroutine settling(imx,jmx, lmx, nmx,g0,dyn_visc, & tc, tmp, p_mid, delz, airmas, & - den, reff, dt, bstl, rh, idust, airden) + den, reff, dt, bstl, idust, airden) ! **************************************************************************** ! * * ! * Calculate the loss by settling, using an implicit method * @@ -131,7 +131,7 @@ subroutine settling(imx,jmx, lmx, nmx,g0,dyn_visc, & INTEGER :: ntdt REAL(kind_phys), INTENT(IN) :: dt,g0,dyn_visc REAL(kind_phys), INTENT(IN) :: tmp(imx,jmx,lmx), delz(imx,jmx,lmx), & - airmas(imx,jmx,lmx), rh(imx,jmx,lmx), & + airmas(imx,jmx,lmx), & den(nmx), reff(nmx),p_mid(imx,jmx,lmx),& airden(imx,jmx,lmx) REAL(kind_phys), INTENT(INOUT) :: tc(imx,jmx,lmx,nmx) diff --git a/physics/smoke_dust/dep_data_mod.F90 b/physics/smoke_dust/dep_data_mod.F90 new file mode 100755 index 000000000..bf9ae7f0c --- /dev/null +++ b/physics/smoke_dust/dep_data_mod.F90 @@ -0,0 +1,193 @@ +!>\file dep_data_mod.F90 +!! This file contains data for the dry deposition modules. +module dep_data_mod + + use machine , only : kind_phys + + integer, parameter :: nvegtype = 25 + real(kind_phys), dimension(nvegtype), parameter :: & + kpart = (/500., 500., 500., 500., 500., & + 500., 500., 500., 500., 500., & + 500., 500., 500., 500., 500., & + 500., 500., 500., 500., 500., & + 500., 500., 500., 500., 500. /) + real(kind_phys), parameter :: max_dep_vel = 0.005 ! m/s (may need to set per species) + real(kind_phys), parameter :: dep_ref_hgt = 2.0 ! Meters + real(kind_phys), parameter :: pi = 3.1415926536 +! 3*PI + REAL(kind_phys), PARAMETER :: threepi=3.0*pi + real(kind_phys), parameter :: gravity = 9.81 +! mean gravitational acceleration [ m/sec**2 ] + REAL(kind_phys), PARAMETER :: grav=9.80622 + real(kind_phys), parameter :: boltzmann = 1.3807e-16 +! universal gas constant [ J/mol-K ] + REAL(kind_phys), PARAMETER :: rgasuniv=8.314510 +! Avogadro's Constant [ 1/mol ] + REAL, PARAMETER :: avo=6.0221367E23 + ! Boltzmann's Constant [ J / K ]i\ + REAL(kind_phys), PARAMETER :: boltz=rgasuniv/avo + real(kind_phys), parameter :: Cb = 2., Cim = 0.4, alpha = 0.8, Cin = 2.5, vv = 0.8 + real(kind_phys), parameter :: A_for = 0.1 ! forest + real(kind_phys), parameter :: A_grs = 0.2 ! grass + real(kind_phys), parameter :: A_wat = 100. ! water + real(kind_phys), parameter :: eps0_for = 0.8*0.01 ! forest + real(kind_phys), parameter :: eps0_grs = 0.4*0.01 ! grass + real(kind_phys), parameter :: eps0_wat = 0.6*0.01 ! water + + REAL(kind_phys), PARAMETER :: one3=1.0/3.0 + REAL(kind_phys), PARAMETER :: two3=2.0/3.0 +! SQRT( 2 ) + REAL(kind_phys), PARAMETER :: sqrt2=1.4142135623731 +! SQRT( PI ) + REAL(kind_phys), PARAMETER :: sqrtpi=1.7724539 + REAL(kind_phys) :: karman = 0.4 ! von Karman constant + REAL(kind_phys), PARAMETER :: conmin= 1.E-16 + REAL(kind_phys), PARAMETER :: pirs=3.14159265358979324 + REAL(kind_phys), PARAMETER :: f6dpi=6.0/pirs + REAL(kind_phys), PARAMETER :: f6dpim9=1.0E-9*f6dpi + REAL(kind_phys), PARAMETER :: rhosmoke = 1.4E3 + REAL(kind_phys), PARAMETER :: rhodust = 2.6E3 + REAL(kind_phys), PARAMETER :: smokefac=f6dpim9/rhosmoke + REAL(kind_phys), PARAMETER :: dustfac=f6dpim9/rhodust +! starting standard surface temperature [ K ] + REAL(kind_phys), PARAMETER :: tss0=288.15 + REAL(kind_phys), PARAMETER :: sigma1 = 1.8 + REAL(kind_phys), PARAMETER :: mean_diameter1 = 4.e-8 + REAL(kind_phys), PARAMETER :: fact_wfa = 1.e-9*6.0/pirs*exp(4.5*log(sigma1)**2)/mean_diameter1**3 + REAL(kind_phys), PARAMETER :: sginia=2.00 +! initial sigma-G for nucleimode + REAL(kind_phys), PARAMETER :: sginin=1.70 +! initial sigma-G for coarse mode + REAL(kind_phys), PARAMETER :: sginic=2.5 +! starting standard surface pressure [ Pa ] + REAL(kind_phys), PARAMETER :: pss0=101325.0 +! lowest particle diameter ( m ) + REAL(kind_phys), PARAMETER :: dgmin=1.0E-09 +! lowest particle density ( Kg/m**3 ) + REAL(kind_phys), PARAMETER :: densmin=1.0E03 +! index for Aitken mode number + INTEGER, PARAMETER :: vdnnuc=1 +! index for accumulation mode number + INTEGER, PARAMETER :: vdnacc=2 +! index for coarse mode number + INTEGER, PARAMETER :: vdncor=3 +! index for Aitken mode mass + INTEGER, PARAMETER :: vdmnuc=4 +! index for accumulation mode + INTEGER, PARAMETER :: vdmacc=5 +! index for fine mode mass (Aitken + accumulation) + INTEGER, PARAMETER :: vdmfine=6 +! index for coarse mode mass + INTEGER, PARAMETER :: vdmcor=7 +! index for Aitken mode number + INTEGER, PARAMETER :: vsnnuc=1 +! index for Accumulation mode number + INTEGER, PARAMETER :: vsnacc=2 +! index for coarse mode number + INTEGER, PARAMETER :: vsncor=3 +! index for Aitken mode mass + INTEGER, PARAMETER :: vsmnuc=4 +! index for accumulation mode mass + INTEGER, PARAMETER :: vsmacc=5 +! index for coarse mass + INTEGER, PARAMETER :: vsmcor=6 +! coarse mode exp( log^2( sigmag )/8 ) +! nuclei **4 + REAL(kind_phys) :: esn04 +! accumulation + REAL(kind_phys) :: esa04 + REAL(kind_phys) :: esc04 +! coarse +! nuclei **5 + REAL(kind_phys) :: esn05 + REAL(kind_phys) :: esa05 +! accumulation +! nuclei **8 + REAL(kind_phys) :: esn08 +! accumulation + REAL(kind_phys) :: esa08 + REAL(kind_phys) :: esc08 +! coarse +! nuclei **9 + REAL(kind_phys) :: esn09 + REAL(kind_phys) :: esa09 +! accumulation +! nuclei **12 + REAL(kind_phys) :: esn12 +! accumulation + REAL(kind_phys) :: esa12 + REAL(kind_phys) :: esc12 +! coarse mode +! nuclei **16 + REAL(kind_phys) :: esn16 +! accumulation + REAL(kind_phys) :: esa16 + REAL(kind_phys) :: esc16 +! coarse +! nuclei **20 + REAL(kind_phys) :: esn20 +! accumulation + REAL(kind_phys) :: esa20 + REAL(kind_phys) :: esc20 +! coarse +! nuclei **25 + REAL(kind_phys) :: esn25 + REAL(kind_phys) :: esa25 +! accumulation +! nuclei **24 + REAL(kind_phys) :: esn24 +! accumulation + REAL(kind_phys) :: esa24 + REAL(kind_phys) :: esc24 +! coarse +! nuclei **28 + REAL(kind_phys) :: esn28 +! accumulation + REAL(kind_phys) :: esa28 + REAL(kind_phys) :: esc28 +! coarse +! nuclei **32 + REAL(kind_phys) :: esn32 +! accumulation + REAL(kind_phys) :: esa32 + REAL(kind_phys) :: esc32 +! coarese +! nuclei **36 + REAL(kind_phys) :: esn36 +! accumulation + REAL(kind_phys) :: esa36 + REAL(kind_phys) :: esc36 +! coarse +! nuclei **49 + REAL(kind_phys) :: esn49 + REAL(kind_phys) :: esa49 +! accumulation +! nuclei **52 + REAL(kind_phys) :: esn52 + REAL(kind_phys) :: esa52 +! accumulation +! nuclei **64 + REAL(kind_phys) :: esn64 +! accumulation + REAL(kind_phys) :: esa64 + REAL(kind_phys) :: esc64 +! coarse + REAL(kind_phys) :: esn100 +! nuclei **100 +! nuclei **(-20) + REAL(kind_phys) :: esnm20 +! accumulation + REAL(kind_phys) :: esam20 + REAL(kind_phys) :: escm20 +! coarse +! nuclei **(-32) + REAL(kind_phys) :: esnm32 +! accumulation + REAL(kind_phys) :: esam32 + REAL(kind_phys) :: escm32 +!SAM 10/08 Gaussian quadrature constants for SOA_VBS deposition numerical +!integration + INTEGER, PARAMETER :: NGAUSdv= 7 ! Number of Gaussian Quadrature Points + REAL(kind_phys) :: xxlsgn, xxlsga, xxlsgc + REAL(kind_phys) :: Y_GQ(NGAUSdv), WGAUS(NGAUSdv) +end module dep_data_mod diff --git a/physics/smoke_dust/dep_dry_mod_emerson.F90 b/physics/smoke_dust/dep_dry_mod_emerson.F90 new file mode 100755 index 000000000..d2d34bb4e --- /dev/null +++ b/physics/smoke_dust/dep_dry_mod_emerson.F90 @@ -0,0 +1,431 @@ +!>\file dep_dry_mod.F90 +!! This file is for the dry depostion driver. +!-------------REVISION HISTORY---------------! +! XX/XX/XXXX : original implementation (Ravan Ahmadov) +! 08/17/2023 : modified to follow Emerson et al., (2020) (Jordan Schnell) +! 08/17/2023 : gravitational settling folowing the coarse pm settling driver (Jordan Schnell) + +module dep_dry_emerson_mod + + use machine , only : kind_phys + use dep_data_mod ! JLS + use rrfs_smoke_config + + implicit none + + private + + public :: dry_dep_driver_emerson + +contains + subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & + chem,delz,snowh,t_phy,p_phy,rho_phy,ivgtyp,g0,dt, & + settling_flag,drydep_flux,settling_flux, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) +! +! compute dry deposition velocity for aerosol particles +! Based on Emerson et al. (2020), PNAS, +! www.pnas.org/cgi/doi/10.1073/pnas.2014761117 +! Code adapted from Hee-Ryu and Min, (2022): +! https://agupubs.onlinelibrary.wiley.com/doi/epdf/10.1029/2021MS002792 +!---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: settling_flag,ndvel, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & + INTENT(INOUT) :: ustar, rmol, znt, snowh + REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & + INTENT(IN ) :: t_phy, rho_phy, p_phy, delz + INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: ivgtyp + REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & + INTENT(INOUT ) :: chem + REAL(kind_phys), INTENT(IN) :: g0,dt + ! + ! Output arrays + REAL(kind_phys), DIMENSION( ims:ime, jms:jme, ndvel ), INTENT(INOUT) :: ddvel + REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, ndvel), & + INTENT(OUT) :: vgrav + REAL(kind_phys), DIMENSION( ims:ime, jms:jme, ndvel ), INTENT(OUT) :: settling_flux, drydep_flux + ! Local + REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) :: aer_res + REAL(kind_phys), DIMENSION( ndvel ) :: cblk + ! Modpar variables, mass, density, diameter, knudsen number, mean free path + REAL(kind_phys) :: pmasssn,pmassa,pmassc,pdensn,pdensa,pdensc, & + dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm + real(kind_phys) :: Cc ! Cunningham/slip correction factor [-] + real(kind_phys) :: DDp, Eb ! Brownian diffusion [] + real(kind_phys) :: Eim ! Impaction [] + real(kind_phys) :: Ein ! Interception [] + real(kind_phys) :: Sc ! Schmit number [] + real(kind_phys) :: St ! Stokes number [] + real(kind_phys) :: vg ! gravitational settling [cm/s] + real(kind_phys) :: A, eps0, dumalnsg ! land surface params [-] + real(kind_phys) :: amu, amu_corrected ! dynamic viscosity [g/s] + real(kind_phys) :: airkinvisc ! Air kinetic viscosity [cm2/s] + real(kind_phys) :: freepath ! Air molecular freepath [cm] + real(kind_phys) :: dp ! aerosol diameter [cm] + real(kind_phys) :: aerodens ! aerosol density [g/cm3] + real(kind_phys) :: Rs ! Surface resistance + real(kind_phys) :: vgpart + real(kind_phys) :: growth_fac,vsettl,dtmax,conver,converi,dzmin + real(kind_phys), dimension( kts:kte) :: rho_col, delz_col + real(kind_phys), dimension(ndvel) :: dt_settl, chem_before, chem_after + real(kind_phys), dimension( kts:kte, ndvel ) :: cblk_col, vg_col + integer, dimension(ndvel) :: ndt_settl + integer :: i, j, k, ntdt, nv + ! chem pointers (p_*) are not sequentially numbered, need to define so nv loops work + integer, dimension(ndvel) :: chem_pointers +!> -- Gas constant + real(kind_phys), parameter :: RSI = 8.314510 + chem_pointers(1) = p_smoke + chem_pointers(2) = p_dust_1 + chem_pointers(3) = p_coarse_pm + + growth_fac = 1.0 + conver=1.e-9 + converi=1.e9 + + do j = jts, jte + do i = its, ite + aer_res(i,j) = 0.0 + do k = kts, kte + delz_col(k) = delz(i,k,j) + rho_col(k) = rho_phy(i,k,j) + do nv = 1, ndvel + cblk(nv) = chem(i,k,j,chem_pointers(nv)) + if ( k == kts ) then + ddvel(i,j,nv) = 0.0 + dt_settl(nv) = 0.0 + endif ! k==kts + end do ! nv + ! *** U.S. Standard Atmosphere 1962 page 14 expression + ! for dynamic viscosity = beta * T * sqrt(T) / ( T + S) + ! where beta = 1.458e-6 [ kg sec^-1 K**-0.5 ], s = 110.4 [ K ]. + amu = 1.458E-6 * t_phy(i,k,j) * sqrt(t_phy(i,k,j)) / ( t_phy(i,k,j) + 110.4 ) + ! Aerodynamic resistance + call depvel( rmol(i,j), dep_ref_hgt, znt(i,j), ustar(i,j), vgpart, aer_res(i,j) ) + ! depvel uses meters, need to convert to s/cm + aer_res(i,j) = max(aer_res(i,j)/100.,0.) + ! Get the aerosol properties dp and aerodens and mean free path (xlm) + ! FOR RRFS-SD, diameters and densities are explicityly defined + !call modpar( cblk,t_phy(i,k,j),p_phy(i,k,j), amu, & + ! pmasssn,pmassa,pmassc,pdensn,pdensa,pdensc, & + ! dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm, ndvel ) + ! Air kinematic viscosity (cm^2/s) + airkinvisc = ( 1.8325e-4 * ( 416.16 / ( t_phy(i,k,j) + 120.0 ) ) * & + ( ( t_phy(i,k,j) / 296.16 )**1.5 ) ) / ( rho_phy(i,k,j) / 28.966e3 ) ! Convert density to mol/cm^3 + ! Air molecular freepath (cm) ! Check against XLM from above + freepath = 7.39758e-4 * airkinvisc / sqrt( t_phy(i,k,j) ) + do nv = 1, ndvel + if ( chem_pointers(nv) == p_smoke ) then + dp = 4.E-8 !dgacc + aerodens = 1.4e+3 !pdensa + elseif ( chem_pointers(nv) == p_dust_1) then + dp = 1.E-6 !dgacc + aerodens = 2.6e+3 !pdensa + elseif ( chem_pointers(nv) == p_coarse_pm ) then + dp = 4.5E-6 !dgcor + aerodens = 2.6e+3 !pdensc + else + continue + endif + ! Convert diameter to cm and aerodens to g/cm3 + aerodens = aerodens / 1000. + dp = dp * 1e+2 + ! Cunningham correction factor + Cc = 1. + 2. * freepath / dp * ( 1.257 + 0.4*exp( -0.55 * dp / freepath ) ) + ! Corrected dynamic viscosity (used for settling) + amu_corrected = amu / Cc + ! Gravitational Settling + vg = aerodens * dp * dp * gravity * 100. * Cc / & ! Convert gravity to cm/s^2 + ( 18. * airkinvisc * ( rho_phy(i,k,j) / 28.966e3 ) ) ! Convert density to mol/cm^3 + ! -- Rest of loop for the surface when deposition velocity needs to be cacluated + if ( k == kts ) then + ! Brownian Diffusion + DDp = ( boltzmann * t_phy(i,k,j) ) * Cc / (3. * pi * airkinvisc * ( rho_phy(i,k,j) / 28.966e3 ) * dp) ! Convert density to mol/cm^3 + ! Schmit number + Sc = airkinvisc / DDp + ! Brownian Diffusion + Eb = Cb * Sc**(-0.666666667) + ! Stokes number + St = ( 100. * ustar(i,j) ) * ( 100.* ustar(i,j) ) * vg / airkinvisc / ( gravity * 100.) ! Convert ustar to cm/s, gravity to cm/s^2 + ! Impaction + Eim = Cim * ( St / ( alpha + St ) )**1.7 + ! MODIS type lu, large roughness lengths (e.g., urban or forest) + ! ----------------------------------------------------------------------- + ! *** TO DO -- set A and eps0 for all land surface types *** !!! + ! ----------------------------------------------------------------------- + if ( ivgtyp(i,j) .eq. 13 .or. ivgtyp(i,j) .le. 5 ) then ! Forest + A = A_for + eps0 = eps0_for + else if ( ivgtyp(i,j) .eq. 17 ) then ! water + A = A_wat + eps0 = eps0_wat + else ! otherwise + A = A_grs + eps0 = eps0_grs + end if + ! Set if snow greater than 1 cm +! if ( snowh(i,j) .gt. 0.01 ) then ! snow +! A = A_wat +! eps0 = eps0_wat +! endif + ! Interception + Ein = Cin * ( dp / A )**vv + ! Surface resistance + Rs = 1. / ( ( ustar(i,j) * 100.) * ( Eb + Eim + Ein) * eps0 ) ! Convert ustar to cm/s + ! Compute final ddvel = aer_res + RS, set max at max_dep_vel in dep_data_mod.F[ m/s] + ! The /100. term converts from cm/s to m/s, required for MYNN. + ddvel(i,j,nv) = min( (1. / (aer_res(i,j) + Rs ))/100., max_dep_vel) + drydep_flux(i,j,nv) = chem(i,kts,j,chem_pointers(nv))*p_phy(i,kts,j) / & + (RSI*t_phy(i,kts,j))*ddvel(i,j,nv)*dt*1.E-6 + endif ! k == kts + vgrav(i,k,j,nv) = vg + ! Fill column variables + cblk_col(k,nv) = cblk(nv) + vg_col(k,nv) = vg + enddo ! nv + enddo ! k + ! -- Get necessary info for settling + ! -- Determine the maximum time-step satisying the CFL condition: + dzmin = minval(delz_col) + ntdt=INT(dt) + do nv = 1, ndvel + ! -- NOTE, diameters and densities are NOT converted to cm and g/cm3 like above + ! -- dt_settl calculations (from original coarsepm_settling) + if ( chem_pointers(nv) == p_smoke ) then + dp = 4.E-8 !dgacc + aerodens = 1.4e+3 !pdensa + elseif ( chem_pointers(nv) == p_dust_1) then + dp = 1.E-6 !dgacc + aerodens = 2.6e+3 !pdensa + elseif ( chem_pointers(nv) == p_coarse_pm ) then + dp = 4.5E-6 !dgcor + aerodens = 2.6e+3 !pdensc + else + continue + endif + ! 1.5E-5 = dyn_visc --> dust_data_mod.F90 + vsettl = 2.0 / 9.0 * g0 * aerodens * ( growth_fac * ( 0.5 * dp ))**2.0 / ( 0.5 * 1.5E-5 ) + dtmax = dzmin / vsettl + ndt_settl(nv) = MAX( 1, INT( ntdt /dtmax) ) + ! Limit maximum number of iterations + IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12 + dt_settl(nv) = REAL(ntdt) / REAL(ndt_settl(nv)) + enddo + do nv = 1, ndvel + do k = kts, kte + chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 + enddo + enddo + ! Perform gravitational settling if desired + if ( settling_flag == 1 ) then + call particle_settling(cblk_col,rho_col,delz_col,vg_col,dt_settl,ndt_settl,ndvel,kts,kte) + endif + ! Put cblk back into chem array + do nv= 1, ndvel + do k = kts, kte + chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv) + chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 + enddo ! k + settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2 + enddo ! nv + end do ! j + end do ! i +end subroutine dry_dep_driver_emerson +! +!-------------------------------------------------------------------------------- +! +subroutine depvel( rmol, zr, z0, ustar, vgpart, aer_res ) +!-------------------------------------------------- +! THIS FUNCTION HAS BEEN DESIGNED TO EVALUATE AN UPPER LIMIT +! FOR THE POLLUTANT DEPOSITION VELOCITY AS A FUNCTION OF THE +! SURFACE ROUGHNESS AND METEOROLOGICAL CONDITIONS. +! PROGRAM WRITTEN BY GREGORY J.MCRAE (NOVEMBER 1977) +! Modified by Darrell A. Winner (Feb. 1991) +! by Winfried Seidl (Aug. 1997) +!.....PROGRAM VARIABLES... +! RMOL - RECIPROCAL OF THE MONIN-OBUKHOV LENGTH +! ZR - REFERENCE HEIGHT +! Z0 - SURFACE ROUGHNESS HEIGHT +! USTAR - FRICTION VELOCITY U* +! AER_RES - AERODYNAMIC RESISTANCE +!.....REFERENCES... +! MCRAE, G.J. ET AL. (1983) MATHEMATICAL MODELING OF PHOTOCHEMICAL +! AIR POLLUTION, ENVIRONMENTAL QUALITY LABORATORY REPORT 18, +! CALIFORNIA INSTITUTE OF TECHNOLOGY, PASADENA, CALIFORNIA. +!.....RESTRICTIONS... +! 1. THE MODEL EDDY DIFFUSIVITIES ARE BASED ON MONIN-OBUKHOV +! SIMILARITY THEORY AND SO ARE ONLY APPLICABLE IN THE +! SURFACE LAYER, A HEIGHT OF O(30M). +! 2. ALL INPUT UNITS MUST BE CONSISTENT +! 3. THE PHI FUNCTIONS USED TO CALCULATE THE FRICTION +! VELOCITY U* AND THE POLLUTANT INTEGRALS ARE BASED +! ON THE WORK OF BUSINGER ET AL.(1971). +! 4. THE MOMENTUM AND POLLUTANT DIFFUSIVITIES ARE NOT +! THE SAME FOR THE CASES L<0 AND L>0. +!-------------------------------------------------- +! .. Scalar Arguments .. +!-------------------------------------------------- + REAL(kind_phys), intent(in) :: ustar, z0, zr + REAL(kind_phys), intent(out) :: vgpart, aer_res + REAL(kind_phys), intent(inout) :: rmol +!-------------------------------------------------- +! .. Local Scalars .. +!-------------------------------------------------- + INTEGER :: l + REAL(kind_phys) :: ao, ar, polint, vk +!-------------------------------------------------- +! .. Intrinsic Functions .. +!-------------------------------------------------- + INTRINSIC alog +!-------------------------------------------------- +! Set the von Karman constant +!-------------------------------------------------- + vk = karman +!-------------------------------------------------- +! DETERMINE THE STABILITY BASED ON THE CONDITIONS +! 1/L < 0 UNSTABLE +! 1/L = 0 NEUTRAL +! 1/L > 0 STABLE +!-------------------------------------------------- + if(abs(rmol) < 1.E-6 ) rmol = 0. + IF (rmol<0) THEN + ar = ((1.0-9.0*zr*rmol)**(0.25)+0.001)**2 + ao = ((1.0-9.0*z0*rmol)**(0.25)+0.001)**2 + polint = 0.74*(alog((ar-1.0)/(ar+1.0))-alog((ao-1.0)/(ao+1.0))) + ELSE IF (rmol==0.) THEN + polint = 0.74*alog(zr/z0) + ELSE + polint = 0.74*alog(zr/z0) + 4.7*rmol*(zr-z0) + END IF + vgpart = ustar*vk/polint + aer_res = polint/(karman*max(ustar,1.0e-4)) +end subroutine depvel +! +!-------------------------------------------------------------------------------- +! +subroutine modpar( cblk, blkta, blkprs, amu, & + pmassn,pmassa,pmassc, pdensn,pdensa,pdensc, & + dgnuc,dgacc,dgcor,knnuc,knacc,kncor, xlm,ndvel ) + IMPLICIT NONE + + INTEGER, INTENT(IN) :: ndvel + REAL(kind_phys), DIMENSION(ndvel), INTENT( IN) :: cblk + REAL(kind_phys), INTENT(IN ) :: blkta, blkprs, amu + REAL(kind_phys), INTENT(OUT) :: pmassn,pmassa,pmassc,pdensn,pdensa,pdensc, & + dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm +! +! Local + REAL(kind_phys) :: xxlsgn,xxlsga,xxlsgc,l2sginin,l2sginia,l2sginic, & + en1,ea1,ec1,esn04,esa04,esc04, & + esn08,esa08,esc08,esn16,esa16,esc16, & + esn20,esa20,esc20,esn36,esa36,esc36 + REAL(kind_phys), DIMENSION( 6 ) :: nblk ! number densities +! Pointers + INTEGER, PARAMETER :: vnu0 = 1 + INTEGER, PARAMETER :: vac0 = 2 + INTEGER, PARAMETER :: vcorn = 3 + INTEGER, PARAMETER :: vnu3 = 4 + INTEGER, PARAMETER :: vac3 = 5 + INTEGER, PARAMETER :: vcor3 = 6 +! + xxlsgn = log(sginin) + xxlsga = log(sginia) + xxlsgc = log(sginic) + l2sginin = xxlsgn**2 + l2sginia = xxlsga**2 + l2sginic = xxlsgc**2 + en1 = exp(0.125*l2sginin) + ea1 = exp(0.125*l2sginia) + ec1 = exp(0.125*l2sginic) + esn04 = en1**4 + esa04 = ea1**4 + esc04 = ec1**4 + esn08 = esn04*esn04 + esa08 = esa04*esa04 + esc08 = esc04*esc04 + esn16 = esn08*esn08 + esa16 = esa08*esa08 + esc16 = esc08*esc08 + esn20 = esn16*esn04 + esa20 = esa16*esa04 + esc20 = esc16*esc04 + esn36 = esn16*esn20 + esa36 = esa16*esa20 + esc36 = esc16*esc20 +! First step in WRF-Chem is to add together the aitken, accumulation, and coarse modes +! Calculate number densities + nblk(vnu0) = max(conmin,0.0) + nblk(vnu3) = max(conmin,0.0) + nblk(vac0) = max(conmin, (cblk(1)/rhosmoke + cblk(2)/rhodust)*fact_wfa) + nblk(vcorn) = max(conmin, cblk(3)/rhodust*fact_wfa) + nblk(vac3) = max(conmin,smokefac*cblk(2) + dustfac*cblk(1)) ! Accumulation is smoke + fine dust + nblk(vcor3) = max(conmin,dustfac*cblk(3)) +! Dust in coarse + pmassn = max(conmin,0.0) + pmassa = max(conmin,cblk(1) + cblk(2)) + pmassc = max(conmin,cblk(3)) + pdensn = max(conmin,0.0) + pdensa = max(densmin,(f6dpim9*pmassa/nblk(vac3))) + pdensc = max(densmin,(f6dpim9*pmassc/nblk(vcor3))) +! Calculate mean free path + xlm = 6.6328E-8*pss0*blkta/(tss0*blkprs*1.e3) +! Calculate diameters + dgnuc = max(dgmin,0.0) + dgacc = max(dgmin,(nblk(vac3)/(nblk(vac0)*esa36))**one3) + dgcor = max(dgmin,(nblk(vcor3)/(nblk(vcorn)*esc36))**one3) +! Calculate Knudsen numbers + knnuc = 2.0*xlm/dgnuc + knacc = 2.0*xlm/dgacc + kncor = 2.0*xlm/dgcor +end subroutine modpar +! +!-------------------------------------------------------------------------------- +! +subroutine particle_settling(cblk,rho_phy,delz,vg,dt_settl,ndt_settl,ndvel,kts,kte) + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: kts, kte, ndvel + REAL(kind_phys), DIMENSION(kts:kte), INTENT (IN) :: rho_phy, delz + REAL(kind_phys), DIMENSION(kts:kte,ndvel), INTENT(IN) :: vg + REAL(kind_phys), DIMENSION(kts:kte,ndvel), INTENT(INOUT) :: cblk + REAL(kind_phys), DIMENSION(ndvel), INTENT(IN) :: dt_settl + INTEGER, DIMENSION(ndvel), INTENT(IN) :: ndt_settl +! +!--- Local------ + INTEGER :: k,nv,n,l2 + REAL(kind_phys) :: temp_tc, transfer_to_below_level, vd_wrk1 + REAL(kind_phys), DIMENSION(kts:kte) :: delz_flip + + do k = kts,kte + delz_flip(k) = delz(kte-k+kts) + enddo + + do nv = 1, ndvel + do n = 1,ndt_settl(nv) + transfer_to_below_level = 0.0 + do k = kte,kts,-1 + l2 = kte - k + 1 + + temp_tc = cblk(k,nv) + + vd_wrk1 = dt_settl(nv) * vg(k,nv)/100. / delz_flip(l2) ! convert vg to m/s + + cblk(k,nv)= cblk(k,nv) * (1. - vd_wrk1) + transfer_to_below_level + if (k.gt.kts) then + transfer_to_below_level =(temp_tc*vd_wrk1)*((delz_flip(l2) & + *rho_phy(k))/(delz_flip(l2+1)*rho_phy(k-1))) ! [ug/kg] + endif + enddo ! k + enddo ! n + enddo ! nv +end subroutine particle_settling + +! +end module dep_dry_emerson_mod diff --git a/physics/smoke_dust/dep_dry_mod.F90 b/physics/smoke_dust/dep_dry_simple_mod.F90 similarity index 75% rename from physics/smoke_dust/dep_dry_mod.F90 rename to physics/smoke_dust/dep_dry_simple_mod.F90 index ea7dd9963..91e2997c5 100755 --- a/physics/smoke_dust/dep_dry_mod.F90 +++ b/physics/smoke_dust/dep_dry_simple_mod.F90 @@ -1,7 +1,7 @@ -!>\file dep_dry_mod.F90 +!>\file dep_dry_simple_mod.F90 !! This file is for the dry depostion driver. -module dep_dry_mod +module dep_dry_simple_mod use machine , only : kind_phys @@ -9,11 +9,11 @@ module dep_dry_mod private - public :: dry_dep_driver + public :: dry_dep_driver_simple contains - subroutine dry_dep_driver(rmol,ust,ndvel,ddvel,rel_hum, & + subroutine dry_dep_driver_simple(rmol,ust,ndvel,ddvel, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) @@ -26,8 +26,8 @@ subroutine dry_dep_driver(rmol,ust,ndvel,ddvel,rel_hum, & its,ite, jts,jte, kts,kte REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & INTENT(INOUT) :: ust, rmol - REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & - INTENT(IN ) :: rel_hum +! REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & +! INTENT(IN ) :: rel_hum REAL(kind_phys), PARAMETER :: kpart=500. REAL(kind_phys) :: dvpart @@ -56,14 +56,14 @@ subroutine dry_dep_driver(rmol,ust,ndvel,ddvel,rel_hum, & dvpart = dvpart*(1.+(-300.*rmol(i,j))**0.66667) ENDIF - IF (rel_hum(i,1,j)>0.8) THEN ! HIGH RELATIVE HUMIDITY CORRECTION - dvpart = dvpart*(1.+0.37*exp((rel_hum(i,1,j)-0.8)/0.2)) - END IF +! IF (rel_hum(i,1,j)>0.8) THEN ! HIGH RELATIVE HUMIDITY CORRECTION +! dvpart = dvpart*(1.+0.37*exp((rel_hum(i,1,j)-0.8)/0.2)) +! END IF ddvel(i,j,nv) = MIN(0.50,dvpart) ! m/s enddo enddo enddo -end subroutine dry_dep_driver +end subroutine dry_dep_driver_simple -end module dep_dry_mod +end module dep_dry_simple_mod diff --git a/physics/smoke_dust/dust_fengsha_mod.F90 b/physics/smoke_dust/dust_fengsha_mod.F90 index 1e24c8947..3902d6508 100755 --- a/physics/smoke_dust/dust_fengsha_mod.F90 +++ b/physics/smoke_dust/dust_fengsha_mod.F90 @@ -22,7 +22,7 @@ module dust_fengsha_mod subroutine gocart_dust_fengsha_driver(dt, & chem,rho_phy,smois,p8w,ssm, & - isltyp,vegfra,snowh,xland,area,g,emis_dust, & + isltyp,snowh,xland,area,g,emis_dust, & ust,znt,clay,sand,rdrag,uthr, & num_emis_dust,num_chem,num_soil_layers, & ids,ide, jds,jde, kds,kde, & @@ -37,7 +37,6 @@ subroutine gocart_dust_fengsha_driver(dt, & ! 2d input variables REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: ssm ! Sediment supply map - REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: vegfra ! vegetative fraction (-) REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: snowh ! snow height (m) REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: xland ! dominant land use type REAL(kind_phys), DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: area ! area of grid cell @@ -141,9 +140,9 @@ subroutine gocart_dust_fengsha_driver(dt, & endif ! limit where there is lots of vegetation - if (vegfra(i,j) .gt. .17) then - ilwi = 0 - endif + !if (sum(vegfra(i,:,j)) .gt. .17) then + ! ilwi = 0 + !endif ! limit where there is snow on the ground if (snowh(i,j) .gt. 0) then diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index 6cdd2e071..70c14c54c 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -6,23 +6,16 @@ module module_add_emiss_burn use machine , only : kind_phys use rrfs_smoke_config CONTAINS - subroutine add_emis_burn(dtstep,dz8w,rho_phy,rel_hum, & - chem,julday,gmt,xlat,xlong, & - !luf_igbp,lu_fire1, & - vegtype,vfrac,peak_hr, & - time_int,ebu, & ! RAR - r_q,fhist,ext3d_smoke,ext3d_dust, & - ! nwfa,nifa, & - rainc,rainnc, swdown,smoke_forecast, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - -! USE module_configure, only: grid_config_rec_type -! USE module_state_description - IMPLICIT NONE + subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & + chem,julday,gmt,xlat,xlong, & + fire_end_hr, peak_hr,time_int, & + coef_bb_dc, fhist, hwp, hwp_prevd, & + swdown,ebb_dcycle, ebu_in, ebu,fire_type,& + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) -! TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + IMPLICIT NONE INTEGER, INTENT(IN ) :: julday, & ids,ide, jds,jde, kds,kde, & @@ -30,193 +23,135 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,rel_hum, & its,ite, jts,jte, kts,kte real(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & - INTENT(INOUT ) :: chem + INTENT(INOUT ) :: chem ! shall we set num_chem=1 here? real(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), & - INTENT(IN) :: ebu - - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong, rainc,rainnc,swdown, peak_hr, vfrac - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: r_q ! RAR: - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fhist ! RAR: - real(kind_phys), DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(OUT) :: ext3d_smoke, ext3d_dust ! RAR: - integer, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: vegtype - - real(kind_phys), DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(IN) :: dz8w,rho_phy,rel_hum -! real(kind_phys), DIMENSION(ims:ime,1:nlcat,jms:jme), INTENT(IN) :: luf_igbp - -! real(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ) , & -! OPTIONAL, INTENT(INOUT ) :: nwfa,nifa ! RAR: - - real(kind_phys), INTENT(IN) :: dtstep, gmt - real(kind_phys), INTENT(IN) :: time_int ! RAR: time in seconds since start of simulation - integer, INTENT(IN) :: smoke_forecast - - integer :: i,j,k,n,m - real(kind_phys) :: conv_rho, conv, ext2, dm_smoke, daero_num_wfa, daero_num_ifa !, lu_sum1_5, lu_sum12_14 - !real(kind_phys) :: ebumax -! CHARACTER (LEN=80) :: message - - INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise - ! Diameters and standard deviations for emissions - ! the diameters are the volume (mass) geometric mean diameters, following MADE_SORGAM - real(kind_phys), PARAMETER :: dgvem_i= 0.08E-6 !0.03E-6 ! [ m ] - real(kind_phys), PARAMETER :: sgem_i = 1.8 !1.7 - - ! *** Accumulation mode: - real(kind_phys), PARAMETER :: dgvem_j= 0.3E-6 ! [ m ] - real(kind_phys), PARAMETER :: sgem_j = 2.0 - - ! *** Coarse mode - real(kind_phys), PARAMETER :: dgvem_c= 6.0E-6 ! [ m ] - real(kind_phys), PARAMETER :: sgem_c= 2.2 - real(kind_phys), PARAMETER :: pic= 3.14159 - - ! RAR: factors for getting number emissions rate from mass emissions rate following made_sorgam - real(kind_phys), PARAMETER :: fact_numn= 1.e-9*6.0/pic*exp(4.5*log(sgem_i)**2)/dgvem_i**3 ! Aitken mode - real(kind_phys), PARAMETER :: fact_numa= 1.e-9*6.0/pic*exp(4.5*log(sgem_j)**2)/dgvem_j**3 ! accumulation mode - real(kind_phys), PARAMETER :: fact_numc= 1.e-9*6.0/pic*exp(4.5*log(sgem_c)**2)/dgvem_c**3 ! coarse mode - - real(kind_phys), PARAMETER :: dens_oc_aer=1.4e3, dens_ec_aer=1.7e3 ! kg/m3 -! real(kind_phys), PARAMETER :: rinti=2.1813936e-8, cx=2.184936* 3600, timeq_max=3600.*24. ! constants for the diurnal cycle calculations - real(kind_phys), PARAMETER :: ax1=531., cx1=7800. ! For cropland, urban and small fires -! real(kind_phys), PARAMETER :: rinti=2.1813936e-8, ax2=3200., const2=100., coef2=10.6712963e-4, cx=2.184936* 3600, timeq_max=3600.*24. - real(kind_phys), PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. ! New parameters - real(kind_phys), PARAMETER :: sc_me= 4.0, ab_me=0.5 ! m2/g, scattering and absorption efficiency for smoke - -! Parameters used for the wfa and ifa in mp physics per Trude E. (NCAR) -! Water friendly: radius: 0.04 micron, standard deviation: 1.8, kappa (for hygroscopic growth): 0.2, real index of refraction: 1.53, imaginary index of refraction: 1e-7 -! Ice friendly: radius: 0.4 micron, standard deviation: 1.8, kappa : 0.04, real index of refraction: 1.56, imaginary index of refraction: 3e-3 + INTENT(INOUT ) :: ebu + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong, swdown + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp, peak_hr, fire_end_hr, ebu_in !, vfrac + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: coef_bb_dc ! RAR: + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp_prevd + + real(kind_phys), DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(IN) :: dz8w,rho_phy !,rel_hum + real(kind_phys), INTENT(IN) :: dtstep, gmt + real(kind_phys), INTENT(IN) :: time_int,pi ! RAR: time in seconds since start of simulation + INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: fire_type + integer, INTENT(IN) :: ebb_dcycle ! RAR: this is going to be namelist dependent, ebb_dcycle=means + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fhist +!>--local + integer :: i,j,k,n,m + real(kind_phys) :: conv_rho, conv, dm_smoke, dc_hwp, dc_gp, dc_fn !daero_num_wfa, daero_num_ifa !, lu_sum1_5, lu_sum12_14 + + INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise + ! real, parameter :: cx = 2.184936 * 3600., rinti = 2.1813936e-8 , ax = 2000.6038 ! bx_bburn = 20.041288 * 3600., RAR: this depends on the vegetation class, location (local time) etc. - real(kind_phys) :: timeq, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation + real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation + ! For Gaussian diurnal cycle + REAL, PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later + REAL, PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., & + coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. +!>-- Fire parameters + real(kind=kind_phys), dimension(1:5), parameter :: avg_fire_dur = (/8.9, 4.2, 3.3, 3.0, 1.4/) + real(kind=kind_phys), dimension(1:5), parameter :: sigma_fire_dur = (/8.7, 6.0, 5.5, 5.2, 2.4/) timeq= gmt*3600. + real(time_int,4) timeq= mod(timeq,timeq_max) -! Main loops to add BB emissions - do j=jts,jte - do i=its,ite - !if( luf_igbp(i,17,j)>0.99 .OR. ebu(i,1,j,p_ebu_smoke) < 1.e-6) cycle ! no BB emissions or water pixels - if( (1.-vfrac (i,j))>0.99 .OR. ebu(i,1,j) < 1.e-6) cycle ! no BB emissions or water pixels - - ! RAR: the decrease in the BB emissions after >18 hrs of forecast, the decrease occurs at night. The decrease occurs at night. - IF (time_int>64800. .AND. swdown(i,j)<.1 .AND. fhist(i,j)>.75 ) THEN - fhist(i,j)= 0.75 - ENDIF - - IF (time_int>129600. .AND. swdown(i,j)<.1 .AND. fhist(i,j)>.5 ) THEN ! After 36 hr forecast - fhist(i,j)= 0.5 - ENDIF - IF ( (rainc(i,j) + rainnc(i,j))>=10. .AND. fhist(i,j)>.3 ) THEN ! If it rains more than 1cm, then the BB emissions are reduced - fhist(i,j)= 0.3 - ENDIF - -! RAR: Grasslands (29% of ther western HRRR CONUS domain) probably also need to be added below, check this later -! RAR: In the HRRR CONUS domain (western part) crop 11%, 2% cropland/natural vegetation and 0.4% urban of pixels -!.OR. lu_index(i,j)==14) then ! Croplands(12), Urban and Built-Up(13), cropland/natural vegetation (14) mosaic in MODI-RUC vegetation classes +! RAR: Grasslands (29% of ther western HRRR CONUS domain) probably also need to +! be added below, check this later +! RAR: In the HRRR CONUS domain (western part) crop 11%, 2% cropland/natural +! vegetation and 0.4% urban of pixels +!.OR. lu_index(i,j)==14) then ! Croplands(12), Urban and Built-Up(13), +!cropland/natural vegetation (14) mosaic in MODI-RUC vegetation classes ! Peak hours for the fire activity depending on the latitude -! if (xlong(i,j)<-130.) then max_ti= 24.041288* 3600. ! peak at 24 UTC, fires in Alaska -! elseif (xlong(i,j)<-100.) then max_ti= 22.041288* 3600. ! peak at 22 UTC, fires in the western US -! elseif (xlong(i,j)<-70.) then ! peak at 20 UTC, fires in the eastern US, max_ti= 20.041288* 3600. +! if (xlong(i,j)<-130.) then max_ti= 24.041288* 3600. ! +! peak at 24 UTC, fires in Alaska +! elseif (xlong(i,j)<-100.) then max_ti= 22.041288* 3600. +! ! peak at 22 UTC, fires in the western US +! elseif (xlong(i,j)<-70.) then ! peak at 20 UTC, fires in +! the eastern US, max_ti= 20.041288* 3600. ! else max_ti= 18.041288* 3600. ! endif - - !IF ( lu_fire1(i,j)>0.9 ) then !Ag, urban fires, bare land etc. - IF ( vegtype(i,j)==12 .or. vegtype(i,j)==13 ) then !Ag, urban fires, bare land etc. - ! these fires will have exponentially decreasing diurnal cycle, these fires decrease 55% in 2 hours, end in 5 hours - r_q(i,j) = rinti* ax1 * exp(- (time_int**2)/(cx1**2) ) - ELSE - ! RAR: Gaussian profile for wildfires - dt1= abs(timeq - peak_hr(i,j)) - dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400. - dtm= MIN(dt1,dt2) - r_q(i,j) = rinti*( ax2 * exp(- dtm**2/(2.*cx2**2) ) + const2 - coef2*timeq ) - ENDIF - - r_q(i,j) = fhist(i,j)* max(0.,r_q(i,j)*timeq_max) - - !IF (swdown(i,j)<.1) THEN - ! r_q(i,j)= MIN(0.5,r_q(i,j)) ! lower BB emissions at night - !ENDIF - - !IF (.NOT. config_flags%bb_dcycle) THEN - !IF (.NOT. bb_dcycle) THEN - ! r_q(i,j)= fhist(i,j) ! no diurnal cycle - !END IF - - !IF (smoke_forecast == 0) THEN - r_q(i,j)= 1. - !END IF - - do k=kts,kfire_max - conv= r_q(i,j)*dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) - - ! RAR: in this case tracer_1 is fire emitted CO - ! conv_rho=r_q*4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.) - ! chem(i,k,j,p_tracer_1) = chem(i,k,j,p_tracer_1) + ebu(i,k,j,p_ebu_co)*conv_rho - -! dm_oc_bb = conv* ebu(i,k,j,p_ebu_oc) ! Assume that BB primary PM25 is mostly OC, 1.25 is OM/OC ratio -! dm_p25_bb= conv* ebu(i,k,j,p_ebu_pm25) -! dm_ec_bb = conv* ebu(i,k,j,p_ebu_bc) -! dm_smk = conv* ebu(i,k,j,p_ebu_smoke) - !IF (k==kts) THEN ! Partition takes place here to avoid double counting of smold. and flam. BB emiss. - ! C11= (1.-flam_frac(i,j))*r_q(i,j) - !ELSE - ! C11= flam_frac(i,j)*r_q(i,j) - !ENDIF - dm_smoke= conv*ebu(i,k,j) -! print*,'hli dm_smoke',dm_smoke,conv,ebu(i,k,j,p_ebu_smoke) - - chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke - chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) - - ! if ( k==kts ) then - ! WRITE(6,*) 'add_emiss_burn: gmt,dtstep,time_int ',gmt,dtstep,time_int - ! WRITE(*,*) 'add_emiss_burn: i,j,xlat(i,j),xlong(i,j) ',i,j,xlat(i,j),xlong(i,j) - !WRITE(*,*) 'add_emiss_burn: luf_igbp(i,:,j) ',luf_igbp(i,:,j) - !WRITE(*,*) 'add_emiss_burn: lu_fire1(i,j) ',lu_fire1(i,j) - ! WRITE(6,*) 'add_emiss_burn: timeq,peak_hr(i,j),fhist(i,j),r_q(i,j) ',timeq,peak_hr(i,j),fhist(i,j),r_q(i,j) - ! WRITE(*,*) 'add_emiss_burn: rainc(i,j),rainnc(i,j) ', rainc(i,j),rainnc(i,j) - ! endif - if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then - WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k - WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv ',rho_phy(i,k,j),dz8w(i,k,j),conv - WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke - endif - - enddo - enddo - enddo - - ext2= sc_me + ab_me - do j=jts,jte - do k=kts,kte - do i=its,ite - - ! Check for NaNs, negative and too large numbers - IF (.NOT. (chem(i,k,j,p_smoke)>=0. .AND. chem(i,k,j,p_smoke)<1.1e+4)) THEN - chem(i,k,j,p_smoke)=1.e-16 - END IF - - ext3d_smoke(i,k,j)= 1.e-6* ext2* chem(i,k,j,p_smoke )*rho_phy(i,k,j)*dz8w(i,k,j) - ext3d_dust (i,k,j)= 1.e-6* ext2* chem(i,k,j,p_dust_1)*rho_phy(i,k,j)*dz8w(i,k,j) - enddo - enddo - enddo - - IF ( dbg_opt ) then - WRITE(*,*) 'add_emis_burn: i,j,k,ext2 ',i,j,k,ext2 - WRITE(*,*) 'add_emis_burn: rel_hum(its,kts,jts),rel_hum(ite,kfire_max,jte) ',rel_hum(its,kts,jts),rel_hum(ite,kfire_max,jte) - WRITE(*,*) 'add_emis_burn: ext3d_smoke(its,kts,jts),ext3d_smoke(ite,kfire_max,jte) ',ext3d_smoke(its,kts,jts),ext3d_smoke(ite,kfire_max,jte) - WRITE(*,*) 'add_emis_burn: ext3d_dust(its,kts,jts),ext3d_dust(ite,kfire_max,jte) ',ext3d_dust(its,kts,jts),ext3d_dust(ite,kfire_max,jte) - END IF - -! CASE DEFAULT -! call wrf_debug(15,'nothing done with burn emissions for chem array') -! END SELECT emiss_select +! RAR: for option #1 ebb and frp are ingested for 24 hours. No modification is +! applied! + if (ebb_dcycle==1) then + do k=kts,kte + do i=its,ite + ebu(i,k,1)=ebu_in(i,1) ! RAR: + enddo + enddo + endif + + if (ebb_dcycle==2) then + + ! Constants for the fire diurnal cycle calculation + do j=jts,jte + do i=its,ite + fire_age= time_int + (fire_end_hr(i,j))*3600. + + SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. + CASE (1) + ! these fires will have exponentially decreasing diurnal cycle, + ! these fires decrease 55% in 2 hours, end in 5 hours + ! r_q(i,j) = rinti* ax1 * exp(- (time_int**2)/(cx1**2) ) + ! We assume 1hr latency in ingesting the sat. data + coef_bb_dc(i,j) = 1./((2*pi)**0.5 * sigma_fire_dur(1) *fire_age) * & + exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2*sigma_fire_dur(1)**2 )) + CASE (3) + age_hr= fire_age/3600. + + IF (swdown(i,j)<.1 .AND. age_hr> 12. .AND. fhist(i,j)>0.75) THEN + fhist(i,j)= 0.75 + ENDIF + IF (swdown(i,j)<.1 .AND. age_hr> 24. .AND. fhist(i,j)>0.5) THEN + fhist(i,j)= 0.5 + ENDIF + IF (swdown(i,j)<.1 .AND. age_hr> 48. .AND. fhist(i,j)>0.25) THEN + fhist(i,j)= 0.25 + ENDIF + + ! this is based on hwp, hourly or instantenous TBD + dc_hwp= ebu_in(i,j)* hwp(i,j)/ MAX(1.,hwp_prevd(i,j)) + dc_hwp= MAX(0.,dc_hwp) + + !coef_bb_dc(i,j)= sc_factor* fhist(i,j)* rate_ebb2(i,j)* (1. + log( + !hwp_(i,j)/ hwp_day_avg(i,j))) + + ! RAR: Gaussian profile for wildfires + dt1= abs(timeq - peak_hr(i,j)) + dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400. + dtm= MIN(dt1,dt2) + dc_gp = rinti*( ax2 * exp(- dtm**2/(2.*cx2**2) ) + const2 - coef2*timeq ) + dc_gp = MAX(0.,dc_gp) + + dc_fn = MAX(dc_hwp/dc_gp,3.) + coef_bb_dc(i,j) = sc_factor* fhist(i,j)* dc_fn + + do k=kts,kfire_max + conv= coef_bb_dc(i,j)*dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) + + dm_smoke= conv*ebu(i,k,j) + ! print*,'hli dm_smoke',dm_smoke,conv,ebu(i,k,j,p_ebu_smoke) + + chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke + chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) + + if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then + WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k + WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv ',rho_phy(i,k,j),dz8w(i,k,j),conv + WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke + endif + enddo + CASE DEFAULT + END SELECT + enddo + enddo + endif END subroutine add_emis_burn END module module_add_emiss_burn + diff --git a/physics/smoke_dust/module_plumerise1.F90 b/physics/smoke_dust/module_plumerise1.F90 index 3c23faa6a..f98350130 100755 --- a/physics/smoke_dust/module_plumerise1.F90 +++ b/physics/smoke_dust/module_plumerise1.F90 @@ -34,11 +34,12 @@ module module_plumerise1 ! 'aggr' /) ! grassland CONTAINS -subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & +subroutine ebu_driver ( flam_frac,ebu_in,ebu,coef_bb_dc, & t_phy,q_vap, & ! RAR: moist is replaced with q_vap rho_phy,vvel,u_phy,v_phy,p_phy, & z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags - plume_frp, k_min, k_max, & ! RAR: + frp_hr, k_min, k_max, & ! RAR: + wind_eff_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, errmsg, errflg) @@ -51,7 +52,7 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & REAL(kind_phys), PARAMETER :: frp_threshold= 1.e+7 ! Minimum FRP (Watts) to have plume rise - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme, 2 ), INTENT(IN ) :: plume_frp ! RAR: FRP etc. array + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: frp_hr ! RAR: FRP array ! TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags character(*), intent(inout) :: errmsg @@ -59,13 +60,15 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + INTEGER, INTENT(IN ) :: wind_eff_opt ! real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), & ! INTENT(IN ) :: moist real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: ebu - + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: coef_bb_dc ! RAR: real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebb_smoke + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebu_in real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ) :: frp_hr_coef_bb_dc ! real(kind=kind_phys), DIMENSION( ims:ime, 1, jms:jme ), & ! INTENT(IN ) :: ebu_in @@ -130,12 +133,19 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & enddo !enddo +! Apply the diurnal cycle coefficient + do j=jts,jte + do i=its,ite + frp_hr_coef_bb_dc(i,j) = frp_hr(i,j)*coef_bb_dc(i,j) + enddo + enddo + ! For now the flammable fraction is constant, based on the namelist. The next ! step to use LU index and meteorology to parameterize it do j=jts,jte do i=its,ite flam_frac(i,j)= 0. - if (plume_frp(i,j,1) > frp_threshold) then + if (frp_hr_coef_bb_dc(i,j) > frp_threshold) then flam_frac(i,j)= 0.9 end if enddo @@ -171,7 +181,7 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & IF (dbg_opt) then WRITE(*,*) 'module_plumerise1: i,j ',i,j - WRITE(*,*) 'module_plumerise1: plume_frp(i,j,:) ',plume_frp(i,j,:) + WRITE(*,*) 'module_plumerise1: frp_hr(i,j) ',frp_hr_coef_bb_dc(i,j) WRITE(*,*) 'module_plumerise1: ebu(i,kts,j) ',ebu(i,kts,j) WRITE(*,*) 'module_plumerise1: u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) ',u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) WRITE(*,*) 'module_plumerise1: zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) ',zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) @@ -179,12 +189,13 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & END IF ! RAR: the plume rise calculation step: - CALL plumerise(kte,1,1,1,1,1,1, & + CALL plumerise(kte,1,1,1,1,1,1, & !firesize,mean_fct, & !num_ebu, eburn_in, eburn_out, & u_in, v_in, w_in, theta_in ,pi_in, & rho_phyin, qv_in, zmid, z_lev, & - plume_frp(i,j,1), k_min(i,j), & + wind_eff_opt, & + frp_hr_coef_bb_dc(i,j), k_min(i,j), & k_max(i,j), dbg_opt, g, con_cp, & con_rd, cpor, errmsg, errflg ) !k_max(i,j), config_flags%debug_chem ) @@ -195,9 +206,9 @@ subroutine ebu_driver ( flam_frac,ebb_smoke,ebu, & dz_plume= z_at_w(i,kp2,j) - z_at_w(i,kp1,j) do k=kp1,kp2-1 - ebu(i,k,j)= flam_frac(i,j)* ebb_smoke(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume + ebu(i,k,j)= flam_frac(i,j)* ebu_in(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume enddo - ebu(i,kts,j)= (1.-flam_frac(i,j))* ebb_smoke(i,j) + ebu(i,kts,j)= (1.-flam_frac(i,j))* ebu_in(i,j) IF ( dbg_opt ) then WRITE(*,*) 'module_plumerise1: i,j ',i,j diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index 61be06181..d80eaeb62 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -14,9 +14,9 @@ module module_smoke_plumerise use machine , only : kind_phys - use plume_data_mod, only : num_frp_plume, p_frp_hr, p_frp_std, & + use plume_data_mod, only : num_frp_plume, p_frp_hr, p_frp_std !tropical_forest, boreal_forest, savannah, grassland, & - wind_eff + ! wind_eff USE module_zero_plumegen_coms !real(kind=kind_phys),parameter :: rgas=r_d @@ -24,16 +24,18 @@ module module_smoke_plumerise CONTAINS ! RAR: - subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & + subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! firesize,mean_fct, & ! nspecies,eburn_in,eburn_out, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & + wind_eff_opt, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & cpor, errmsg, errflg ) implicit none LOGICAL, INTENT (IN) :: dbg_opt + INTEGER, INTENT (IN) :: wind_eff_opt ! INTEGER, PARAMETER :: ihr_frp=1, istd_frp=2!, imean_fsize=3, istd_fsize=4 ! RAR: @@ -43,6 +45,7 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & integer :: ng,m1,m2,m3,ia,iz,ja,jz,ibcon,mynum,i,j,k,imm,ixx,ispc !,nspecies + INTEGER, INTENT (OUT) :: k1,k2 character(*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -68,10 +71,13 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! integer, parameter :: grassland = 4 ! real(kind=kind_phys), dimension(nveg_agreg) :: firesize,mean_fct - INTEGER, PARAMETER :: wind_eff = 1 + INTEGER :: wind_eff type(plumegen_coms), pointer :: coms +! Set wind effect from namelist + wind_eff = wind_eff_opt + ! integer:: iloop !REAL(kind=kind_phys), INTENT (IN) :: convert_smold_to_flam diff --git a/physics/smoke_dust/module_wetdep_ls.F90 b/physics/smoke_dust/module_wetdep_ls.F90 index 87212920b..b9d52cb49 100755 --- a/physics/smoke_dust/module_wetdep_ls.F90 +++ b/physics/smoke_dust/module_wetdep_ls.F90 @@ -3,17 +3,18 @@ module module_wetdep_ls use machine , only : kind_phys - use rrfs_smoke_config, only : p_qc, alpha => wetdep_ls_alpha + use rrfs_smoke_config, only : p_smoke, p_dust_1, p_coarse_pm, p_qc, alpha => wetdep_ls_alpha contains subroutine wetdep_ls(dt,var,rain,moist, & - rho,nchem,num_moist,dz8w,vvel, & + rho,nchem,num_moist,ndvel,dz8w,vvel, & + wetdpr_smoke, wetdpr_dust, wetdpr_coarsepm, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) implicit none - integer, intent(in) :: nchem, num_moist, & + integer, intent(in) :: nchem, num_moist, ndvel, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte @@ -21,6 +22,8 @@ subroutine wetdep_ls(dt,var,rain,moist, real(kind_phys), dimension( ims:ime, kms:kme, jms:jme, num_moist),intent(in) :: moist real(kind_phys), dimension( ims:ime, kms:kme, jms:jme),intent(in) :: rho,dz8w,vvel real(kind_phys), dimension( ims:ime, kms:kme, jms:jme,1:nchem),intent(inout) :: var + real(kind_phys), dimension( ims:ime, jms:jme ), intent(out) :: & + wetdpr_smoke, wetdpr_dust, wetdpr_coarsepm real(kind_phys), dimension( ims:ime, jms:jme),intent(in) :: rain real(kind_phys), dimension( its:ite, jts:jte) :: var_sum,var_rmv real(kind_phys), dimension( its:ite, kts:kte, jts:jte) :: var_rmvl @@ -68,6 +71,14 @@ subroutine wetdep_ls(dt,var,rain,moist, if(var(i,k,j,nv).gt.1.e-16 .and. moist(i,k,j,p_qc).gt.0.)then factor = max(0.,frc(i,j)*rho(i,k,j)*dz8w(i,k,j)*vvel(i,k,j)) dvar=alpha*factor/(1+factor)*var(i,k,j,nv) +! Accumulate diags + if (nv .eq. p_smoke ) then + wetdpr_smoke(i,j) = wetdpr_smoke(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + elseif (nv .eq. p_dust_1 ) then + wetdpr_dust(i,j) = wetdpr_dust(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + elseif (nv .eq. p_coarse_pm ) then + wetdpr_coarsepm(i,j) = wetdpr_coarsepm(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + endif var(i,k,j,nv)=max(1.e-16,var(i,k,j,nv)-dvar) endif enddo diff --git a/physics/smoke_dust/plume_data_mod.F90 b/physics/smoke_dust/plume_data_mod.F90 index 3d4b21c37..2bf91dbfa 100755 --- a/physics/smoke_dust/plume_data_mod.F90 +++ b/physics/smoke_dust/plume_data_mod.F90 @@ -45,7 +45,7 @@ module plume_data_mod integer, parameter :: savannah = 3 integer, parameter :: grassland = 4 integer, parameter :: nveg_agreg = 4 - integer, parameter :: wind_eff = 1 +! integer, parameter :: wind_eff = 1 public diff --git a/physics/smoke_dust/rrfs_smoke_config.F90 b/physics/smoke_dust/rrfs_smoke_config.F90 index 58d4c5846..5f8f02e7b 100755 --- a/physics/smoke_dust/rrfs_smoke_config.F90 +++ b/physics/smoke_dust/rrfs_smoke_config.F90 @@ -15,28 +15,30 @@ module rrfs_smoke_config !-- constant paramters real(kind=kind_phys), parameter :: epsilc = 1.e-12 - !-- aerosol module configurations - integer :: chem_opt = 1 + integer :: chem_opt = 1 integer :: kemit = 1 integer :: dust_opt = 5 - integer :: seas_opt = 2 + integer :: seas_opt = 0 ! turn off by default logical :: do_plumerise = .true. integer :: addsmoke_flag = 1 + integer :: smoke_forecast = 1 integer :: plumerisefire_frq=60 integer :: wetdep_ls_opt = 1 integer :: drydep_opt = 1 - integer :: coarsepm_settling = 1 - logical :: bb_dcycle = .false. - logical :: aero_ind_fdb = .false. + integer :: pm_settling = 1 + integer :: nfire_types = 5 + integer :: ebb_dcycle = 2 ! 1: read in ebb_smoke(i,24), 2: daily logical :: dbg_opt = .true. - integer :: smoke_forecast = 0 ! 0 read in ebb_smoke(i,24) + logical :: aero_ind_fdb = .false. + logical :: do_rrfs_sd = .true. +! integer :: wind_eff_opt = 1 + logical :: extended_sd_diags = .false. real(kind_phys) :: wetdep_ls_alpha = .5 ! scavenging factor ! -- integer, parameter :: CHEM_OPT_GOCART= 1 - integer, parameter :: call_chemistry = 1 - integer, parameter :: num_moist=3, num_chem=20, num_emis_seas=5, num_emis_dust=5 + integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5 integer, parameter :: DUST_OPT_FENGSHA = 5 @@ -52,41 +54,19 @@ module rrfs_smoke_config integer :: numgas = 0 !-- tracers - integer, parameter :: p_so2=1 - integer, parameter :: p_sulf=2 - integer, parameter :: p_dms=3 - integer, parameter :: p_msa=4 - integer, parameter :: p_p25=5, p_smoke=5 - integer, parameter :: p_bc1=6 - integer, parameter :: p_bc2=7 - integer, parameter :: p_oc1=8 - integer, parameter :: p_oc2=9 - integer, parameter :: p_dust_1=10 - integer, parameter :: p_dust_2=11 - integer, parameter :: p_dust_3=12 - integer, parameter :: p_dust_4=13 - integer, parameter :: p_dust_5=14, p_coarse_pm=14 - integer, parameter :: p_seas_1=15 - integer, parameter :: p_seas_2=16 - integer, parameter :: p_seas_3=17 - integer, parameter :: p_seas_4=18 - integer, parameter :: p_seas_5=19 - integer, parameter :: p_p10 =20 - - integer, parameter :: p_edust1=1,p_edust2=2,p_edust3=3,p_edust4=4,p_edust5=5 - integer, parameter :: p_eseas1=1,p_eseas2=2,p_eseas3=3,p_eseas4=4,p_eseas5=5 - - integer :: p_ho=0,p_h2o2=0,p_no3=0 + integer, parameter :: p_smoke=5 + integer, parameter :: p_dust_1=10 + integer, parameter :: p_dust_2=11 + integer, parameter :: p_dust_3=12 + integer, parameter :: p_dust_4=13 + integer, parameter :: p_dust_5=14, p_coarse_pm=14 + integer, parameter :: p_seas_1=15 + integer, parameter :: p_seas_2=16 + integer, parameter :: p_seas_3=17 + integer, parameter :: p_seas_4=18 + integer, parameter :: p_seas_5=19 - ! constants - real(kind=kind_phys), PARAMETER :: airmw = 28.97 - real(kind=kind_phys), PARAMETER :: mw_so2_aer = 64.066 - real(kind=kind_phys), PARAMETER :: mw_so4_aer = 96.066 - real(kind=kind_phys), parameter :: smw = 32.00 - real(kind=kind_phys), parameter :: mwdry = 28. -! d is the molecular weight of dry air (28.966), w/d = 0.62197, and -! (d - w)/d = 0.37803 -! http://atmos.nmsu.edu/education_and_outreach/encyclopedia/humidity.htm + integer, parameter :: p_edust1=1,p_edust2=2,p_edust3=3,p_edust4=4,p_edust5=5 ! -- fire options ! integer, parameter :: num_plume_data = 1 diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 50f7afae7..5f8ca2a8e 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90 - + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] name = rrfs_smoke_postpbl_run diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index c9a6344b8..f4e28be3a 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -7,17 +7,18 @@ module rrfs_smoke_wrapper use machine , only : kind_phys use rrfs_smoke_config, only : kemit, dust_opt, seas_opt, do_plumerise, & addsmoke_flag, plumerisefire_frq, wetdep_ls_opt, & - drydep_opt, coarsepm_settling, aero_ind_fdb, & - dbg_opt, smoke_forecast, wetdep_ls_alpha, & + drydep_opt, pm_settling, aero_ind_fdb, ebb_dcycle, & + dbg_opt,smoke_forecast,wetdep_ls_alpha,do_rrfs_sd, & + ebb_dcycle, extended_sd_diags, & num_moist, num_chem, num_emis_seas, num_emis_dust, & DUST_OPT_FENGSHA, p_qv, p_atm_shum, p_atm_cldq, & p_smoke, p_dust_1, p_coarse_pm, epsilc - use dust_data_mod, only : dust_alpha, dust_gamma, dust_moist_opt, & + use dust_data_mod, only : dust_alpha, dust_gamma, dust_moist_opt, & dust_moist_correction, dust_drylimit_factor - use plume_data_mod, only : p_frp_std, p_frp_hr, num_frp_plume use seas_mod, only : gocart_seasalt_driver use dust_fengsha_mod, only : gocart_dust_fengsha_driver - use dep_dry_mod, only : dry_dep_driver + use dep_dry_simple_mod, only : dry_dep_driver_simple + use dep_dry_emerson_mod, only : dry_dep_driver_emerson use module_wetdep_ls, only : wetdep_ls use module_plumerise1, only : ebu_driver use module_add_emiss_burn, only : add_emis_burn @@ -27,13 +28,80 @@ module rrfs_smoke_wrapper private - public :: rrfs_smoke_wrapper_run + public :: rrfs_smoke_wrapper_run, rrfs_smoke_wrapper_init + + integer :: wind_eff_opt contains !>\defgroup rrfs_smoke_wrapper rrfs-sd emission driver Module !> \ingroup gsd_chem_group !! This is the rrfs-sd emission driver Module + +!> \section arg_table_rrfs_smoke_wrapper_init Argument Table +!! \htmlinclude rrfs_smoke_wrapper_init.html +!! + subroutine rrfs_smoke_wrapper_init( seas_opt_in, & ! sea salt namelist + drydep_opt_in, pm_settling_in, & ! Dry Dep namelist + wetdep_ls_opt_in,wetdep_ls_alpha_in, & ! Wet dep namelist + rrfs_sd, do_plumerise_in, plumerisefire_frq_in, & ! smoke namelist + wind_eff_opt_in, & ! smoke namelist + addsmoke_flag_in, ebb_dcycle_in, smoke_forecast_in, & ! Smoke namelist + dust_opt_in, dust_alpha_in, dust_gamma_in, & ! Dust namelist + dust_moist_opt_in, & ! Dust namelist + dust_moist_correction_in, dust_drylimit_factor_in, & ! Dust namelist + aero_ind_fdb_in, & ! Feedback namelist + extended_sd_diags_in,dbg_opt_in, & ! Other namelist + errmsg, errflg ) + + +!>-- Namelist + real(kind_phys), intent(in) :: dust_alpha_in, dust_gamma_in, wetdep_ls_alpha_in + real(kind_phys), intent(in) :: dust_moist_correction_in + real(kind_phys), intent(in) :: dust_drylimit_factor_in + integer, intent(in) :: dust_opt_in,dust_moist_opt_in, wetdep_ls_opt_in, pm_settling_in, seas_opt_in + integer, intent(in) :: drydep_opt_in + logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in, extended_sd_diags_in + integer, intent(in) :: smoke_forecast_in, wind_eff_opt_in, plumerisefire_frq_in + integer, intent(in) :: addsmoke_flag_in, ebb_dcycle_in + logical, intent(in) :: do_plumerise_in, rrfs_sd + character(len=*),intent(out):: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + +!>-- Assign namelist values + !>-Dust + dust_alpha = dust_alpha_in + dust_gamma = dust_gamma_in + dust_moist_opt = dust_moist_opt_in + dust_moist_correction = dust_moist_correction_in + dust_drylimit_factor = dust_drylimit_factor_in + dust_opt = dust_opt_in + !>-Sea Salt + seas_opt = seas_opt_in + !>-Dry and wet deposition + drydep_opt = drydep_opt_in + pm_settling = pm_settling_in + wetdep_ls_opt = wetdep_ls_opt_in + wetdep_ls_alpha = wetdep_ls_alpha_in + !>-Smoke + do_rrfs_sd = rrfs_sd + ebb_dcycle = ebb_dcycle_in + do_plumerise = do_plumerise_in + plumerisefire_frq = plumerisefire_frq_in + addsmoke_flag = addsmoke_flag_in + smoke_forecast = smoke_forecast_in + wind_eff_opt = wind_eff_opt_in + !>-Feedback + aero_ind_fdb = aero_ind_fdb_in + !>-Other + extended_sd_diags = extended_sd_diags_in + dbg_opt = dbg_opt_in + + end subroutine rrfs_smoke_wrapper_init + !! \section arg_table_rrfs_smoke_wrapper_run Argument Table !! \htmlinclude rrfs_smoke_wrapper_run.html !! @@ -42,126 +110,108 @@ module rrfs_smoke_wrapper subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, & u10m, v10m, ustar, rlat, rlon, tskin, pb2d, t2m, dpt2m, & pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w, & - nsoil, smc, vegtype, soiltyp, sigmaf, dswsfc, zorl, snow, julian, & - idat, rain_cpl, rainc_cpl, exch, hf2d, g, pi, con_cp, con_rd, con_fv, & - dust12m_in, emi_in, smoke_RRFS, ntrac, qgrs, gq0, chem3d, tile_num, & + nsoil, smc, vegtype_dom, vegtype_frac,soiltyp,nlcat, & + dswsfc, zorl, snow, julian,recmol, & + idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv, & + dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS, & + ntrac, qgrs, gq0, chem3d, tile_num, & ntsmoke, ntdust, ntcoarsepm, imp_physics, imp_physics_thompson, & - nwfa, nifa, emanoc, emdust, emseas, & - ebb_smoke_hr, frp_hr, frp_std_hr, & - coef_bb, ebu_smoke,fhist, min_fplume, max_fplume, hwp, wetness, & - smoke_ext, dust_ext, ndvel, ddvel_inout,rrfs_sd, & - dust_moist_opt_in, dust_moist_correction_in, dust_drylimit_factor_in, & - dust_alpha_in, dust_gamma_in, fire_in, & - seas_opt_in, dust_opt_in, drydep_opt_in, coarsepm_settling_in, & - do_plumerise_in, plumerisefire_frq_in, addsmoke_flag_in, & - wetdep_ls_opt_in,wetdep_ls_alpha_in, fire_heat_flux_out, & - frac_grid_burned_out, & - smoke_forecast_in, aero_ind_fdb_in,dbg_opt_in,errmsg,errflg) - + nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & + ebb_smoke_in, frp_input, coef_bb, ebu_smoke,fhist,min_fplume, & + max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, & + fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & + errmsg,errflg ) + implicit none integer, intent(in) :: im,kte,kme,ktau,nsoil,tile_num,jdate(8),idat(8) - integer, intent(in) :: ntrac, ntsmoke, ntdust, ntcoarsepm, ndvel + integer, intent(in) :: ntrac, ntsmoke, ntdust, ntcoarsepm, ndvel, nlcat real(kind_phys),intent(in) :: dt, julian, g, pi, con_cp, con_rd, con_fv - logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in - integer, intent(in) :: smoke_forecast_in integer, parameter :: ids=1,jds=1,jde=1, kds=1 integer, parameter :: ims=1,jms=1,jme=1, kms=1 integer, parameter :: its=1,jts=1,jte=1, kts=1 - integer, dimension(:), intent(in) :: land, vegtype, soiltyp - real(kind_phys), dimension(:,:), intent(in) :: smc - real(kind_phys), dimension(:,:,:), intent(in) :: dust12m_in - real(kind_phys), dimension(:,:,:), intent(in) :: smoke_RRFS - real(kind_phys), dimension(:,:), intent(in) :: emi_in - real(kind_phys), dimension(:), intent(in) :: u10m, v10m, ustar, dswsfc, & - garea, rlat,rlon, tskin, pb2d, sigmaf, zorl, snow, & - rain_cpl, rainc_cpl, hf2d, t2m, dpt2m - real(kind_phys), dimension(:,:), intent(in) :: ph3d, pr3d - real(kind_phys), dimension(:,:), intent(in) :: phl3d, prl3d, tk3d, & - us3d, vs3d, spechum, exch, w + integer, dimension(:), intent(in) :: land, vegtype_dom, soiltyp + real(kind_phys), dimension(:,:), intent(in) :: smc + real(kind_phys), dimension(:,:,:), intent(in) :: dust12m_in + real(kind_phys), dimension(:,:,:), intent(in) :: smoke_RRFS + real(kind_phys), dimension(:,:), intent(in) :: smoke2d_RRFS + real(kind_phys), dimension(:,:), intent(in) :: emi_ant_in + real(kind_phys), dimension(:), intent(in) :: u10m, v10m, ustar, dswsfc, & + recmol, garea, rlat,rlon, tskin, pb2d, zorl, snow, & + rain_cpl, rainc_cpl, hf2d, t2m, dpt2m + real(kind_phys), dimension(:,:), intent(in) :: vegtype_frac + real(kind_phys), dimension(:,:), intent(in) :: ph3d, pr3d + real(kind_phys), dimension(:,:), intent(in) :: phl3d, prl3d, tk3d, us3d, vs3d, spechum, w real(kind_phys), dimension(:,:,:), intent(inout) :: qgrs, gq0 real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d - real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc - real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_hr, frp_hr, frp_std_hr - real(kind_phys), dimension(:), intent(inout) :: coef_bb, fhist - real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke - real(kind_phys), dimension(:,:), intent(inout) :: fire_in - real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out - real(kind_phys), dimension(:), intent(out) :: frac_grid_burned_out - real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume - real(kind_phys), dimension(:), intent( out) :: hwp - real(kind_phys), dimension(:,:), intent(out) :: smoke_ext, dust_ext - real(kind_phys), dimension(:,:), intent(inout) :: nwfa, nifa - real(kind_phys), dimension(:,:), intent(inout) :: ddvel_inout - real(kind_phys), dimension(:), intent(in) :: wetness - real(kind_phys), intent(in) :: dust_alpha_in, dust_gamma_in, wetdep_ls_alpha_in - real(kind_phys), intent(in) :: dust_moist_correction_in - real(kind_phys), intent(in) :: dust_drylimit_factor_in - integer, intent(in) :: dust_moist_opt_in - integer, intent(in) :: imp_physics, imp_physics_thompson - integer, intent(in) :: seas_opt_in, dust_opt_in, drydep_opt_in, & - coarsepm_settling_in, plumerisefire_frq_in, & - addsmoke_flag_in, wetdep_ls_opt_in - logical, intent(in ) :: do_plumerise_in, rrfs_sd - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - + real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc + real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_input, fhist + real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke + real(kind_phys), dimension(:,:), intent(inout) :: fire_in + real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out + real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume + real(kind_phys), dimension(:), intent( out) :: hwp + real(kind_phys), dimension(:), intent(inout) :: hwp_ave + real(kind_phys), dimension(:,:), intent(inout) :: nwfa, nifa + real(kind_phys), dimension(:,:), intent(inout) :: ddvel_inout + real(kind_phys), dimension(:,:), intent(inout) :: drydep_flux_out + real(kind_phys), dimension(:,:), intent(inout) :: wetdpr + real(kind_phys), dimension(:), intent(in) :: wetness + integer, intent(in) :: imp_physics, imp_physics_thompson + integer, dimension(:), intent(in) :: kpbl + real(kind_phys), dimension(:), intent(in) :: oro + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +!>-- Local Variables real(kind_phys), dimension(ims:im, kms:kme, jms:jme) :: ebu real(kind_phys), dimension(1:im, 1:kme,jms:jme) :: rri, t_phy, u_phy, v_phy, & - p_phy, z_at_w, dz8w, p8w, t8w, rho_phy, vvel, zmid, exch_h - + p_phy, z_at_w, dz8w, p8w, t8w, rho_phy, vvel, zmid real(kind_phys), dimension(ims:im, jms:jme) :: u10, v10, ust, tsk, & - xland, xlat, xlong, dxy, pbl, hfx, rcav, rnav - + xland, xlat, xlong, dxy, pbl, hfx, rnav, hwp_local, & + wetdpr_smoke_local, wetdpr_dust_local, wetdpr_coarsepm_local !>- sea salt & chemistry variables real(kind_phys), dimension(ims:im, kms:kme, jms:jme, 1:num_moist) :: moist real(kind_phys), dimension(ims:im, kms:kme, jms:jme, 1:num_chem ) :: chem real(kind_phys), dimension(ims:im, 1, jms:jme, 1:num_emis_seas ) :: emis_seas real(kind_phys), dimension(ims:im, jms:jme) :: seashelp - +!>-- indexes, time integer :: ide, ime, ite, kde, julday - + real(kind_phys) :: gmt !>- dust & chemistry variables real(kind_phys), dimension(ims:im, jms:jme) :: ssm, rdrag, uthr, snowh ! fengsha dust - real(kind_phys), dimension(ims:im, jms:jme) :: vegfrac, rmol, swdown, znt, clayf, sandf + real(kind_phys), dimension(ims:im, nlcat, jms:jme) :: vegfrac + real(kind_phys), dimension(ims:im, jms:jme) :: rmol, swdown, znt, clayf, sandf real(kind_phys), dimension(ims:im, nsoil, jms:jme) :: smois real(kind_phys), dimension(ims:im, 1:1, jms:jme, 1:num_emis_dust) :: emis_dust integer, dimension(ims:im, jms:jme) :: isltyp, ivgtyp - !>- plume variables ! -- buffers - real(kind_phys), dimension(ims:im, jms:jme) :: ebu_in - real(kind_phys), dimension(ims:im, jms:jme, num_frp_plume ) :: plume_frp - real(kind_phys), dimension(ims:im, jms:jme ) :: coef_bb_dc, flam_frac, & - fire_hist, peak_hr - real(kind_phys), dimension(ims:im,kms:kme,jms:jme ) :: ext3d_smoke, ext3d_dust - integer, dimension(ims:im, jms:jme ) :: min_fplume2, max_fplume2 - logical :: call_fire + real(kind_phys), dimension(ims:im, jms:jme ) :: coef_bb_dc, flam_frac, frp_in, & + fire_hist, peak_hr, lu_nofire, lu_qfire, ebu_in, & + fire_end_hr, hwp_day_avg + integer, dimension(ims:im, jms:jme ) :: min_fplume2, max_fplume2, fire_type + logical :: call_fire, reset_hwp_ave !>- optical variables - real(kind_phys), dimension(ims:im, kms:kme, jms:jme) :: rel_hum - real(kind_phys), dimension(ims:im, jms:jme, ndvel) :: ddvel - + real(kind_phys), dimension(ims:im, jms:jme, ndvel) :: ddvel, settling_flux, drydep_flux_local + real(kind_phys), dimension(ims:im, kms:kme, jms:jme, ndvel) :: vgrav !>-- anthropogentic variables real(kind_phys), dimension(ims:im) :: emis_anoc real(kind_phys), dimension(ims:im, jms:jme, 1) :: sedim - - real(kind_phys) :: gmt - !> -- parameter to caluclate wfa&ifa (m) real(kind_phys), parameter :: mean_diameter1= 4.E-8, sigma1=1.8 real(kind_phys), parameter :: mean_diameter2= 1.E-6, sigma2=1.8 - real(kind_phys), parameter :: kappa_oc = 0.2 - real(kind_phys), parameter :: kappa_dust = 0.04 + ! real(kind_phys), parameter :: kappa_oc = 0.2 + ! real(kind_phys), parameter :: kappa_dust = 0.04 real(kind_phys) :: fact_wfa, fact_ifa !> -- aerosol density (kg/m3) real(kind_phys), parameter :: density_dust= 2.6e+3, density_sulfate=1.8e+3 real(kind_phys), parameter :: density_oc = 1.4e+3, density_seasalt=2.2e+3 - real(kind_phys), dimension(im) :: daero_emis_wfa, daero_emis_ifa -!>-- local variables +!> -- other real(kind_phys), dimension(im) :: wdgust, snoweq integer :: current_month, current_hour, hour_int real(kind_phys) :: curr_secs @@ -172,21 +222,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, errmsg = '' errflg = 0 - if (.not. rrfs_sd) return - -!>-- options to turn on/off sea-salt, dust, plume-rising - seas_opt = seas_opt_in - dust_opt = dust_opt_in - drydep_opt = drydep_opt_in - do_plumerise = do_plumerise_in - plumerisefire_frq = plumerisefire_frq_in - addsmoke_flag = addsmoke_flag_in - smoke_forecast = smoke_forecast_in - aero_ind_fdb = aero_ind_fdb_in - dbg_opt = dbg_opt_in - wetdep_ls_opt = wetdep_ls_opt_in - wetdep_ls_alpha = wetdep_ls_alpha_in - coarsepm_settling = coarsepm_settling_in + if (.not. do_rrfs_sd) return ! -- set domain ide=im @@ -199,19 +235,19 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, emis_seas = 0. emis_dust = 0. peak_hr = 0. + fire_type = 0 + lu_qfire = 0. + lu_nofire = 0. flam_frac = 0. - ext3d_smoke = 0. - ext3d_dust = 0. daero_emis_wfa = 0. daero_emis_ifa = 0. - rcav = 0. rnav = 0. curr_secs = ktau * dt current_month=jdate(2) ! needed for the dust input data current_hour =jdate(5)+1 ! =1 at 00Z - hour_int=ktau*dt/3600. ! hours since the simulation start + hour_int=ktau*dt/3600. ! hours since the simulation start gmt = real(mod(idat(5)+hour_int,24)) julday = int(julian) @@ -223,12 +259,13 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ! -- compute incremental convective and large-scale rainfall do i=its,ite - rcav(i,1)=max(rainc_cpl(i)*1000. , 0.) ! meter to mm rnav(i,1)=max((rain_cpl(i)-rainc_cpl(i))*1000., 0.) ! meter to mm coef_bb_dc(i,1) = coef_bb(i) fire_hist (i,1) = fhist (i) enddo + ! Is this a reset timestep (00:00 + dt)? + reset_hwp_ave = mod(int(curr_secs-dt),3600) == 0 ! plumerise frequency in minutes set up by the namelist input call_fire = (do_plumerise .and. (plumerisefire_frq > 0)) @@ -236,57 +273,35 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !>- get ready for chemistry run call rrfs_smoke_prep( & - current_month, current_hour, gmt, con_rd, con_fv, & + ktau,current_month, current_hour, gmt, con_rd, con_fv, & u10m,v10m,ustar,land,garea,rlat,rlon,tskin, & - pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,exch,w, & - nsoil,smc,vegtype,soiltyp,sigmaf,dswsfc,zorl, & - snow,dust12m_in,emi_in,smoke_RRFS, & - hf2d, pb2d, g, pi, hour_int, & + pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & + nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & + snow,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & + hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & - t8w,exch_h, & + t8w,recmol, & z_at_w,vvel,zmid, & ntrac,gq0, & num_chem,num_moist, & ntsmoke, ntdust,ntcoarsepm, & - moist,chem,plume_frp,ebu_in, & - ebb_smoke_hr, frp_hr, frp_std_hr, emis_anoc, & - smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & - snowh,clayf,rdrag,sandf,ssm,uthr,rel_hum, & + moist,chem,ebu_in,ebb_smoke_in, & + fhist,frp_in, hwp_day_avg, fire_end_hr, & + emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & + snowh,clayf,rdrag,sandf,ssm,uthr,oro, hwp_local, & + t2m,dpt2m,wetness,kpbl, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) - -! Make this global, calculate at 1st time step only -!>-- for plumerise -- + its,ite, jts,jte, kts,kte ) - do j=jts,jte - do i=its,ite - peak_hr(i,j)= fire_in(i,10) - enddo - enddo - - IF (ktau==1) THEN - do j=jts,jte - do i=its,ite - if (xlong(i,j)<230.) then - peak_hr(i,j)= 0.0* 3600. ! peak at 24 UTC, fires in Alaska - elseif(xlong(i,j)<245.) then - peak_hr(i,j)= 23.0* 3600. - elseif (xlong(i,j)<260.) then - peak_hr(i,j)= 22.0* 3600. ! peak at 22 UTC, fires in the western US - elseif (xlong(i,j)<275.) then - peak_hr(i,j)= 21.0* 3600. - elseif (xlong(i,j)<290.) then ! peak at 20 UTC, fires in the eastern US - peak_hr(i,j)= 20.0* 3600. - else - peak_hr(i,j)= 19.0* 3600. - endif - enddo - enddo - ENDIF + do j=jts,jte + do i=its,ite + peak_hr(i,j)= fire_in(i,1) + enddo + enddo - IF (ktau==1) THEN + IF (ktau==1) THEN ebu = 0. do j=jts,jte do i=its,ite @@ -296,18 +311,33 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, enddo enddo enddo - ELSE - do k=kts,kte - do i=its,ite - ebu(i,k,1)=ebu_smoke(i,k) - enddo - enddo - ENDIF + ENDIF +!RAR: change this to the fractional LU type; fire_type: 0- no fires, 1- Ag +! or urban fires, 2- prescribed fires in wooded area, 3- wildfires + do j=jts,jte + do i=its,ite + if (ebu_in(i,j)<0.01) then + fire_type(i,j) = 0 + else + ! Permanent wetlands, snow/ice, water, barren tundra + lu_nofire(i,j) = vegfrac(i,11,j) + vegfrac(i,15,j) + vegfrac(i,17,j) + vegfrac(i,20,j) + ! cropland, urban, cropland/natural mosaic, barren and sparsely vegetated + lu_qfire(i,j) = vegfrac(i,12,j) + vegfrac(i,13,j) + vegfrac(i,14,j) + vegfrac(i,16,j) + if (lu_nofire(i,j)>0.95) then + fire_type(i,j) = 0 + else if (lu_qfire(i,j)>0.95) then + fire_type(i,j) = 1 + else + fire_type(i,j) = 3 ! RAR: need to add another criteria for fire_type=2, i.e. prescribed fires + end if + end if + end do + end do !>- compute sea-salt - ! -- compute sea salt (opt=2) - if (seas_opt == 2) then + ! -- compute sea salt (opt=1) + if (seas_opt == 1) then call gocart_seasalt_driver(dt,rri,t_phy, & u_phy,v_phy,chem,rho_phy,dz8w,u10,v10,ust,p8w,tsk, & xland,xlat,xlong,dxy,g,emis_seas,pi, & @@ -319,14 +349,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !-- compute dust (opt=5) if (dust_opt==DUST_OPT_FENGSHA) then - ! Set at compile time in dust_data_mod: - dust_alpha = dust_alpha_in - dust_gamma = dust_gamma_in - dust_moist_opt = dust_moist_opt_in - dust_moist_correction = dust_moist_correction_in - dust_drylimit_factor = dust_drylimit_factor_in call gocart_dust_fengsha_driver(dt,chem,rho_phy,smois,p8w,ssm, & - isltyp,vegfrac,snowh,xland,dxy,g,emis_dust,ust,znt, & + isltyp,snowh,xland,dxy,g,emis_dust,ust,znt, & clayf,sandf,rdrag,uthr, & num_emis_dust,num_chem,nsoil, & ids,ide, jds,jde, kds,kde, & @@ -340,43 +364,50 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !-- /scratch2/BMC/ap-fc/Ravan/rapid-refresh/WRFV3.9/smoke ! Every hour (per namelist) the ebu_driver is called to calculate ebu, but ! the plumerise is controlled by the namelist option of plumerise_flag + !if (add_fire_heat_flux) then + do i = its,ite + if ( frp_in(i,1) .ge. 1.E7 ) then + fire_heat_flux_out(i) = min(max(0.,0.88*coef_bb_dc(i,1)*frp_in(i,1) / & + 0.55/dxy(i,1)) ,5000.) ! JLS - W m-2 [0 - 10,000] + frac_grid_burned_out(i) = min(max(0., 1.3*0.0006*coef_bb_dc(i,1)*frp_in(i,1)/dxy(i,1) ),1.) + else + fire_heat_flux_out(i) = 0.0 + frac_grid_burned_out(i) = 0.0 + endif + enddo + !endif if (call_fire) then call ebu_driver ( & flam_frac,ebu_in,ebu, & + coef_bb_dc, & t_phy,moist(:,:,:,p_qv), & rho_phy,vvel,u_phy,v_phy,p_phy, & z_at_w,zmid,g,con_cp,con_rd, & - plume_frp, min_fplume2, max_fplume2, & ! new approach + frp_in, min_fplume2, max_fplume2, & ! new approach + wind_eff_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, errmsg, errflg ) if(errflg/=0) return - do i = its,ite - if ( plume_frp(i,1,p_frp_hr) .ge. 1.E7 ) then - fire_heat_flux_out(i) = min(max(0.,0.88*plume_frp(i,1,p_frp_hr)/0.55/dxy(i,1)) ,50000.) ! JLS - W m-2 [0 - 10,000] - frac_grid_burned_out(i) = min(max(0., 1.3*0.0006*plume_frp(i,1,p_frp_hr)/dxy(i,1) ),1.) - else - fire_heat_flux_out(i) = 0.0 - frac_grid_burned_out(i) = 0.0 - endif - enddo end if + ! -- add biomass burning emissions at every timestep if (addsmoke_flag == 1) then - call add_emis_burn(dt,dz8w,rho_phy,rel_hum,chem, & - julday,gmt,xlat,xlong, & - ivgtyp, vegfrac, peak_hr, & ! RAR - curr_secs,ebu, & - coef_bb_dc,fire_hist,ext3d_smoke,ext3d_dust, & - rcav, rnav,swdown,smoke_forecast, & + call add_emis_burn(dt,dz8w,rho_phy,pi, & + chem,julday,gmt,xlat,xlong, & + fire_end_hr, peak_hr,curr_secs, & + coef_bb_dc,fire_hist,hwp_local,hwp_day_avg, & + swdown,ebb_dcycle,ebu_in,ebu,fire_type, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) endif - !>-- compute coarsepm setting - if (coarsepm_settling == 1) then - call coarsepm_settling_driver(dt,t_phy,rel_hum, & + !>-- compute coarsepm setting if using simple dry dep option and + ! pm_settling is on. This is necessary becasue the simple scheme + ! does not have an explicty settling routine, Emersion (opt=1) does. + if (drydep_opt == 2 .and. pm_settling == 1) then + call coarsepm_settling_driver(dt,t_phy, & chem(:,:,:,p_coarse_pm), & rho_phy,dz8w,p8w,p_phy,sedim, & dxy,g,1, & @@ -384,18 +415,29 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) endif - !>-- compute dry deposition + !>-- compute dry deposition, based on Emerson et al., (2020) if (drydep_opt == 1) then - - call dry_dep_driver(rmol,ust,ndvel,ddvel,rel_hum, & + call dry_dep_driver_emerson(rmol,ust,znt,ndvel,ddvel, & + vgrav,chem,dz8w,snowh,t_phy,p_phy,rho_phy,ivgtyp,g,dt, & + pm_settling,drydep_flux_local,settling_flux, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) - + its,ite, jts,jte, kts,kte ) do nv=1,ndvel - do i=its,ite - ddvel_inout(i,nv)=ddvel(i,1,nv) + do i=its,ite + ddvel_inout(i,nv)=ddvel(i,1,nv) + enddo enddo + !>-- compute dry deposition based on simple parameterization (HRRR-Smoke) + elseif (drydep_opt == 2) then + call dry_dep_driver_simple(rmol,ust,ndvel,ddvel, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + do nv=1,ndvel + do i=its,ite + ddvel_inout(i,nv)=ddvel(i,1,nv) + enddo enddo else ddvel_inout(:,:)=0. @@ -403,35 +445,49 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !>- large-scale wet deposition if (wetdep_ls_opt == 1) then - call wetdep_ls(dt,chem,rnav,moist, & - rho_phy,num_chem,num_moist,dz8w,vvel, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte) + call wetdep_ls(dt,chem,rnav,moist, & + rho_phy,num_chem,num_moist,ndvel, dz8w,vvel,& + wetdpr_smoke_local, wetdpr_dust_local, & + wetdpr_coarsepm_local, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + if ( extended_sd_diags ) then + do i = its, ite + wetdpr(i,1) = wetdpr(i,1) + wetdpr_smoke_local (i,1) + wetdpr(i,2) = wetdpr(i,2) + wetdpr_dust_local (i,1) + wetdpr(i,3) = wetdpr(i,3) + wetdpr_coarsepm_local(i,1) + enddo + endif endif +! Smoke emisisons diagnostic do k=kts,kte do i=its,ite ebu_smoke(i,k)=ebu(i,k,1) enddo enddo - !---- diagnostic output of hourly wildfire potential (07/2021) + if (ktau == 1 .or. reset_hwp_ave) then + hwp_ave = 0. + endif hwp = 0. do i=its,ite - wdgust(i)=max(1.68*sqrt(us3d(i,1)**2+vs3d(i,1)**2),3.) - snoweq(i)=max((25.-snow(i))/25.,0.) - hwp(i)=0.237*wdgust(i)**1.11*max(t2m(i)-dpt2m(i),15.)**0.92*((1.-wetness(i))**6.95)*snoweq(i) ! Eric 08/2022 - enddo - -!---- diagnostic output of smoke & dust optical extinction (12/2021) - do k=kts,kte - do i=its,ite - smoke_ext(i,k) = ext3d_smoke(i,k,1) - dust_ext (i,k) = ext3d_dust (i,k,1) - enddo + hwp(i)=hwp_local(i,1) + hwp_ave(i) = hwp_ave(i) + hwp(i)*dt enddo + +!---- diagnostic output of dry deposition & gravitational settling fluxes + if ( drydep_opt == 1 .and. extended_sd_diags ) then + do nv = 1, ndvel + do i=its,ite + drydep_flux_out(i,nv) = drydep_flux_out(i,nv) + & + drydep_flux_local(i,1,nv) + & + settling_flux(i,1,nv) + enddo + enddo + endif !------------------------------------- !---- put smoke stuff back into tracer array do k=kts,kte @@ -455,20 +511,19 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !------------------------------------- !-- to output for diagnostics do i = 1, im - emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s + !emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s + !emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s emdust (i) = emis_dust(i,1,1,1) + emis_dust(i,1,1,2) + & emis_dust(i,1,1,3) + emis_dust(i,1,1,4) ! dust emission: ug/m2/s - emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s coef_bb (i) = coef_bb_dc(i,1) + frp_input (i) = coef_bb_dc(i,1)*frp_in(i,1) fhist (i) = fire_hist (i,1) min_fplume (i) = real(min_fplume2(i,1)) max_fplume (i) = real(max_fplume2(i,1)) - emseas (i) = sandf(i,1) ! sand for dust - emanoc (i) = uthr (i,1) ! u threshold for dust enddo do i = 1, im - fire_in(i,10) = peak_hr(i,1) + fire_in(i,1) = peak_hr(i,1) enddo !-- to provide real aerosol emission for Thompson MP @@ -500,46 +555,51 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, end subroutine rrfs_smoke_wrapper_run - subroutine rrfs_smoke_prep( & - current_month,current_hour,gmt,con_rd,con_fv, & - u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & - pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,exch,w, & - nsoil,smc,vegtype,soiltyp,sigmaf,dswsfc,zorl, & - snow_cpl,dust12m_in,emi_in,smoke_RRFS, & - hf2d, pb2d, g, pi, hour_int, & - u10,v10,ust,tsk,xland,xlat,xlong,dxy, & - rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & - t8w,exch_h, & - z_at_w,vvel,zmid, & - ntrac,gq0, & - num_chem, num_moist, & - ntsmoke, ntdust, ntcoarsepm, & - moist,chem,plume_frp,ebu_in, & - ebb_smoke_hr, frp_hr, frp_std_hr, emis_anoc, & - smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & - snowh,clayf,rdrag,sandf,ssm,uthr,rel_hum, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & + subroutine rrfs_smoke_prep( & + ktau,current_month,current_hour,gmt,con_rd,con_fv, & + u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & + pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & + nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & + snow_cpl,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & + hf2d, pb2d, g, pi, hour_int, peak_hr, & + u10,v10,ust,tsk,xland,xlat,xlong,dxy, & + rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & + t8w,recmol, & + z_at_w,vvel,zmid, & + ntrac,gq0, & + num_chem, num_moist, & + ntsmoke, ntdust, ntcoarsepm, & + moist,chem,ebu_in,ebb_smoke_in, & + fhist,frp_in, hwp_day_avg, fire_end_hr, & + emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & + snowh,clayf,rdrag,sandf,ssm,uthr,oro,hwp_local, & + t2m,dpt2m,wetness,kpbl, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte) !Chem input configuration - integer, intent(in) :: current_month, current_hour, hour_int + integer, intent(in) :: current_month, current_hour, hour_int, nlcat !FV3 input variables - integer, intent(in) :: nsoil - integer, dimension(ims:ime), intent(in) :: land, vegtype, soiltyp + integer, intent(in) :: nsoil, ktau + integer, dimension(ims:ime), intent(in) :: land, vegtype_dom, soiltyp, kpbl integer, intent(in) :: ntrac real(kind=kind_phys), intent(in) :: g, pi, gmt, con_rd, con_fv real(kind=kind_phys), dimension(ims:ime), intent(in) :: & - u10m, v10m, ustar, garea, rlat, rlon, ts2d, sigmaf, dswsfc, & - zorl, snow_cpl, pb2d, hf2d + u10m, v10m, ustar, garea, rlat, rlon, ts2d, dswsfc, & + zorl, snow_cpl, pb2d, hf2d, oro, t2m, dpt2m, wetness, recmol + real(kind=kind_phys), dimension(ims:ime, nlcat), intent(in) :: vegtype_frac real(kind=kind_phys), dimension(ims:ime, nsoil), intent(in) :: smc real(kind=kind_phys), dimension(ims:ime, 12, 5), intent(in) :: dust12m_in - real(kind=kind_phys), dimension(ims:ime, 24, 3), intent(in) :: smoke_RRFS - real(kind=kind_phys), dimension(ims:ime, 1), intent(in) :: emi_in + real(kind=kind_phys), dimension(ims:ime, 24, 2), intent(in) :: smoke_RRFS +! This is a place holder for ebb_dcycle == 2, currently set to hold a single +! value, which is the previous day's average of hwp, frp, ebb, fire_end + real(kind=kind_phys), dimension(ims:ime, 4), intent(in) :: smoke2d_RRFS + real(kind=kind_phys), dimension(ims:ime, 4), intent(in) :: emi_ant_in real(kind=kind_phys), dimension(ims:ime, kms:kme), intent(in) :: pr3d,ph3d real(kind=kind_phys), dimension(ims:ime, kts:kte), intent(in) :: & - phl3d,tk3d,prl3d,us3d,vs3d,spechum,exch,w + phl3d,tk3d,prl3d,us3d,vs3d,spechum,w real(kind=kind_phys), dimension(ims:ime, kts:kte,ntrac), intent(in) :: gq0 @@ -551,37 +611,42 @@ subroutine rrfs_smoke_prep( & real(kind_phys), dimension(ims:ime, jms:jme),intent(out) :: ebu_in - real(kind_phys), dimension(ims:ime, jms:jme, num_frp_plume), intent(out) :: plume_frp + ! real(kind_phys), dimension(ims:ime, jms:jme, num_frp_plume), intent(out) :: plume_frp integer,dimension(ims:ime, jms:jme), intent(out) :: isltyp, ivgtyp real(kind_phys), dimension(ims:ime, kms:kme, jms:jme), intent(out) :: & rri, t_phy, u_phy, v_phy, p_phy, rho_phy, dz8w, p8w, t8w, vvel, & - zmid, exch_h, rel_hum + zmid real(kind_phys), dimension(ims:ime, jms:jme), intent(out) :: & - u10, v10, ust, tsk, xland, xlat, xlong, dxy, vegfrac, rmol, swdown, znt, & - pbl, hfx, snowh, clayf, rdrag, sandf, ssm, uthr + u10, v10, ust, tsk, xland, xlat, xlong, dxy, rmol, swdown, znt, & + pbl, hfx, snowh, clayf, rdrag, sandf, ssm, uthr, hwp_local + real(kind_phys), dimension(ims:ime, nlcat, jms:jme), intent(out) :: vegfrac real(kind_phys), dimension(ims:ime, kms:kme, jms:jme, num_moist), intent(out) :: moist real(kind_phys), dimension(ims:ime, kms:kme, jms:jme, num_chem), intent(out) :: chem real(kind_phys), dimension(ims:ime, kms:kme, jms:jme), intent(out) :: z_at_w real(kind_phys), dimension(ims:ime, nsoil, jms:jme), intent(out) :: smois - real(kind_phys), dimension(ims:ime), intent(inout) :: ebb_smoke_hr, frp_hr, frp_std_hr - real(kind_phys), dimension(ims:ime), intent(inout) :: emis_anoc - !real(kind_phys), dimension(ims:ime, jms:jme, num_plume_data) :: plume + real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: frp_in, fire_end_hr, fhist, coef_bb_dc + real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: hwp_day_avg, peak_hr + real(kind_phys), dimension(ims:ime), intent(inout) :: emis_anoc,ebb_smoke_in + ! real(kind_phys), dimension(ims:ime, jms:jme, num_plume_data) :: plume real(kind_phys), parameter :: conv_frp = 1.e+06_kind_phys ! FRP conversion factor, MW to W real(kind_phys), parameter :: frpc = 1._kind_phys ! FRP conversion factor (Regional) ! -- local variables - integer i,ip,j,k,kp,kk,kkp,nv,l,ll,n + integer i,ip,j,k,k1,kp,kk,kkp,nv,l,ll,n,nl + real(kind_phys) :: SFCWIND,WIND,DELWIND,DZ,wdgust,snoweq,THETA,ZSF + real(kind_phys), dimension(ims:ime, kms:kme, jms:jme) :: THETAV + real(kind_phys), dimension(ims:ime, jms:jme) :: windgustpot,kpbl_thetav + real(kind_phys), parameter :: delta_theta4gust = 0.5 ! -- initialize fire emissions - !plume = 0._kind_phys - plume_frp = 0._kind_phys ebu_in = 0._kind_phys - ebb_smoke_hr = 0._kind_phys + ebb_smoke_in = 0._kind_phys emis_anoc = 0._kind_phys - frp_hr = 0._kind_phys - frp_std_hr = 0._kind_phys + frp_in = 0._kind_phys + hwp_day_avg = 0._kind_phys + fire_end_hr = 0._kind_phys ! -- initialize output arrays isltyp = 0._kind_phys @@ -597,7 +662,6 @@ subroutine rrfs_smoke_prep( & t8w = 0._kind_phys vvel = 0._kind_phys zmid = 0._kind_phys - exch_h = 0._kind_phys u10 = 0._kind_phys v10 = 0._kind_phys ust = 0._kind_phys @@ -621,7 +685,6 @@ subroutine rrfs_smoke_prep( & moist = 0._kind_phys chem = 0._kind_phys z_at_w = 0._kind_phys - rel_hum = 0._kind_phys do i=its,ite u10 (i,1)=u10m (i) @@ -642,12 +705,14 @@ subroutine rrfs_smoke_prep( & sandf(i,1)=dust12m_in(i,current_month,3) ssm (i,1)=dust12m_in(i,current_month,4) uthr (i,1)=dust12m_in(i,current_month,5) - ivgtyp (i,1)=vegtype(i) + ivgtyp (i,1)=vegtype_dom (i) isltyp (i,1)=soiltyp(i) - vegfrac(i,1)=sigmaf (i) + do nl = 1,nlcat + vegfrac(i,nl,1)=vegtype_frac (i,nl) + enddo + rmol (i,1)=recmol (i) enddo - rmol=0. do k=1,nsoil do j=jts,jte @@ -690,38 +755,30 @@ subroutine rrfs_smoke_prep( & p_phy(i,k,j)=prl3d(i,kkp) u_phy(i,k,j)=us3d(i,kkp) v_phy(i,k,j)=vs3d(i,kkp) - rho_phy(i,k,j)=p_phy(i,k,j)/(con_rd*t_phy(i,k,j)*(1.+con_fv*spechum(i,kkp))) + ! from mp_thompson.F90 ; rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) + ! from mynnd + rho_phy(i,k,j)=p_phy(i,k,j)/(con_rd*t_phy(i,k,j)) !*(1.+con_fv*spechum(i,kkp))) rri(i,k,j)=1./rho_phy(i,k,j) vvel(i,k,j)=-w(i,kkp)*rri(i,k,j)/g moist(i,k,j,:)=0. moist(i,k,j,1)=gq0(i,kkp,p_atm_shum) if (t_phy(i,k,j) > 265.) then moist(i,k,j,2)=gq0(i,kkp,p_atm_cldq) - moist(i,k,j,3)=0. + !moist(i,k,j,3)=0. + ! TODO -- should we keep these limits? if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. else moist(i,k,j,2)=0. - moist(i,k,j,3)=gq0(i,kkp,p_atm_cldq) - if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. + ! moist(i,k,j,3)=gq0(i,kkp,p_atm_cldq) + ! TODO -- should we keep these limits? + ! if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. endif - !rel_hum(i,k,j) = min(0.95,spechum(i,kkp)) - rel_hum(i,k,j) = min(0.95, moist(i,k,j,1) / & - (3.80*exp(17.27*(t_phy(i,k,j)-273.)/ & - (t_phy(i,k,j)-36.))/(.01*p_phy(i,k,j)))) - rel_hum(i,k,j) = max(0.1,rel_hum(i,k,j)) !-- zmid(i,k,j)=phl3d(i,kkp)/g enddo enddo enddo - ! -- the imported atmospheric heat diffusivity is only available up to kte-1 - do k=kts,kte-1 - do i=its,ite - exch_h(i,k,1)=exch(i,k) - enddo - enddo - do j=jts,jte do k=2,kte do i=its,ite @@ -739,24 +796,124 @@ subroutine rrfs_smoke_prep( & ! -- anthropogenic organic carbon do i=its,ite - emis_anoc(i) = emi_in(i,1) + emis_anoc(i) = emi_ant_in(i,1) enddo - if (hour_int<24) then - do j=jts,jte - do i=its,ite - ebb_smoke_hr(i) = smoke_RRFS(i,hour_int+1,1) ! smoke - frp_hr (i) = smoke_RRFS(i,hour_int+1,2) ! frp - frp_std_hr (i) = smoke_RRFS(i,hour_int+1,3) ! std frp - ebu_in (i,j) = ebb_smoke_hr(i) - plume_frp(i,j,p_frp_hr ) = conv_frp* frp_hr (i) - plume_frp(i,j,p_frp_std) = conv_frp* frp_std_hr (i) - enddo - enddo +!---- Calculate PBLH and K-PBL based on virtual potential temperature profile +!---- First calculate THETAV + do j = jts,jte + do i = its,ite + do k = kts,kte + THETA = t_phy(i,k,j) * (1.E5/p_phy(i,k,j))**0.286 + THETAV(i,k,j) = THETA * (1. + 0.61 * (moist(i,k,j,p_qv))) + enddo + enddo + enddo +!---- Now use the UPP code to deterimine the height and level + do i = its, ite + do j = jts, jte + if ( THETAV(i,kts+1,j) .lt. ( THETAV(i,kts,j) + delta_theta4gust) ) then + ZSF = oro(i) + do k = kts+1, kte + k1 = k +!--- give theta-v at the sfc a 0.5K boost in the PBLH definition + if ( THETAV(i,kts+k-1,j) .gt. ( THETAV(i,kts,j) + delta_theta4gust) ) then + exit + endif + enddo + kpbl_thetav(i,j) = k1 + !pblh_thetav(i,j) = zmid(i,k+k1-1,j) * & + ! ((THETAV(i,kts,j)+delta_theta4gust) - THETAV(i,kts+k1-1,j)) & + ! * (zmid(i,kts+k1-1,j) - zmid(i,kts+k1-2,j)) & + ! / (THETAV(i,kts+k1-1,j) - THETAV(i,kts+k1-2,j)) - ZSF + else + !pblh_thetav(i,j) = 0.0 + kpbl_thetav(i,j) = kts + 1 + endif + enddo + enddo + +!---- Calculate wind gust potential and HWP + do i = its,ite + SFCWIND = sqrt(u10m(i)**2+v10m(i)**2) + windgustpot(i,1) = SFCWIND + if (kpbl_thetav(i,1)+1 .ge. kts+1 ) then + do k=kts+1,kpbl_thetav(i,1)+1 + WIND = sqrt(us3d(i,k)**2+vs3d(i,k)**2) + DELWIND = WIND - SFCWIND + DZ = zmid(i,k,1) - oro(i) + DELWIND = DELWIND*(1.0-MIN(0.5,DZ/2000.)) + windgustpot(i,1) = max(windgustpot(i,1),SFCWIND+DELWIND) + enddo + endif + enddo + hwp_local = 0. + do i=its,ite + wdgust=max(windgustpot(i,1),3.) + snoweq=max((25.-snow_cpl(i))/25.,0.) + ! hwp_local(i,1)=0.237*wdgust**1.11*max(t2m(i)-dpt2m(i),15.)**0.92*((1.-wetness(i))**6.95)*snoweq ! Eric original 08/2022 + hwp_local(i,1)=0.177*wdgust**0.97*max(t2m(i)-dpt2m(i),15.)**1.03*((1.-wetness(i))**0.4)*snoweq ! Eric update 11/2023 + enddo +! Set paramters for ebb_dcycle option + if (ebb_dcycle == 1 ) then + if (hour_int .le. 24) then + do j=jts,jte + do i=its,ite + + ebu_in (i,j) = smoke_RRFS(i,hour_int+1,1) ! smoke + frp_in (i,j) = smoke_RRFS(i,hour_int+1,2)*conv_frp ! frp + fire_end_hr(i,j) = 0.0 + hwp_day_avg(i,j) = 0.0 + ebb_smoke_in (i) = ebu_in(i,j) + if (ktau == 1) then + fhist (i,j) = 1. + coef_bb_dc (i,j) = 1. + endif + enddo + enddo + endif endif + ! RAR: here we need to initialize various arrays in order to apply HWP to + ! diurnal cycle + ! if ebb_dcycle/=2 then those arrays=0, we need to read in temporal + if (ebb_dcycle == 2) then + do i=its, ite + do j=jts, jte + ebu_in (i,j) = smoke2d_RRFS(i,1)!/86400. + frp_in (i,j) = smoke2d_RRFS(i,2)*conv_frp + fire_end_hr (i,j) = smoke2d_RRFS(i,3) + hwp_day_avg (i,j) = smoke2d_RRFS(i,4) + ebb_smoke_in(i ) = ebu_in(i,j) + ! Initialize to 1 on first time step, modified by add_emiss_burn thereafter + if (ktau == 1) then + fhist (i,j) = 1. + coef_bb_dc (i,j) = 1. + endif + enddo + enddo + end if - ! We will add a namelist variable, real :: flam_frac_global + if (ktau==1) then + do j=jts,jte + do i=its,ite + if (xlong(i,j)<230.) then + peak_hr(i,j)= 0.0* 3600. ! peak at 24 UTC, fires in Alaska + elseif(xlong(i,j)<245.) then + peak_hr(i,j)= 23.0* 3600. + elseif (xlong(i,j)<260.) then + peak_hr(i,j)= 22.0* 3600. ! peak at 22 UTC, fires in the western US + elseif (xlong(i,j)<275.) then + peak_hr(i,j)= 21.0* 3600. + elseif (xlong(i,j)<290.) then ! peak at 20 UTC, fires in the eastern US + peak_hr(i,j)= 20.0* 3600. + else + peak_hr(i,j)= 19.0* 3600. + endif + enddo + enddo + endif + ! We will add a namelist variable, real :: flam_frac_global do k=kms,kte do i=ims,ime chem(i,k,jts,p_smoke )=max(epsilc,gq0(i,k,ntsmoke )) @@ -765,9 +922,8 @@ subroutine rrfs_smoke_prep( & enddo enddo - - end subroutine rrfs_smoke_prep + !> @} end module rrfs_smoke_wrapper diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index 7b22b9799..fe664d31d 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,9 +1,184 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = dep_dry_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90 + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## +[ccpp-arg-table] + name = rrfs_smoke_wrapper_init + type = scheme +[seas_opt_in] + standard_name = control_for_smoke_sea_salt + long_name = rrfs smoke sea salt emission option + units = index + dimensions = () + type = integer + intent = in +[drydep_opt_in] + standard_name = control_for_smoke_dry_deposition + long_name = rrfs smoke dry deposition option + units = index + dimensions = () + type = integer + intent = in +[pm_settling_in] + standard_name = control_for_smoke_pm_settling + long_name = rrfs smoke pm settling option + units = index + dimensions = () + type = integer + intent = in +[wetdep_ls_opt_in] + standard_name = control_for_smoke_wet_deposition + long_name = rrfs smoke large scale wet deposition option + units = index + dimensions = () + type = integer + intent = in +[wetdep_ls_alpha_in] + standard_name = alpha_for_ls_wet_depoistion + long_name = alpha paramter for ls wet deposition + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[rrfs_sd] + standard_name = do_smoke_coupling + long_name = flag controlling rrfs_sd collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[do_plumerise_in] + standard_name = do_smoke_plumerise + long_name = rrfs smoke plumerise option + units = index + dimensions = () + type = logical + intent = in +[plumerisefire_frq_in] + standard_name = smoke_plumerise_frequency + long_name = rrfs smoke add smoke option + units = min + dimensions = () + type = integer + intent = in +[wind_eff_opt_in] + standard_name = option_for_wind_effects_on_smoke_plumerise + long_name = wind effect plumerise option + units = index + dimensions = () + type = integer + intent = in +[addsmoke_flag_in] + standard_name = control_for_smoke_biomass_burning_emissions + long_name = rrfs smoke add smoke option + units = index + dimensions = () + type = integer + intent = in +[ebb_dcycle_in] + standard_name = control_for_diurnal_cycle_of_biomass_burning_emissions + long_name = rrfs smoke diurnal cycle option + units = index + dimensions = () + type = integer + intent = in +[smoke_forecast_in] + standard_name = do_smoke_forecast + long_name = index for rrfs smoke forecast + units = index + dimensions = () + type = integer + intent = in +[dust_opt_in] + standard_name = control_for_smoke_dust + long_name = rrfs smoke dust chem option + units = index + dimensions = () + type = integer + intent = in +[dust_alpha_in] + standard_name = alpha_fengsha_dust_scheme + long_name = alpha paramter for fengsha dust scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[dust_gamma_in] + standard_name = gamma_fengsha_dust_scheme + long_name = gamma paramter for fengsha dust scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[dust_moist_opt_in] + standard_name = control_for_dust_soil_moisture_option + long_name = smoke dust moisture parameterization 1 - fecan 2 - shao + units = index + dimensions = () + type = integer + active = (do_smoke_coupling) + intent = in +[dust_moist_correction_in] + standard_name = dust_moist_correction_fengsha_dust_scheme + long_name = moisture correction term for fengsha dust emission + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) + intent = in +[dust_drylimit_factor_in] + standard_name = dust_drylimit_factor_fengsha_dust_scheme + long_name = moisture correction term for drylimit in fengsha dust emission + units = none + dimensions = () + type = real + kind = kind_phys + active = (do_smoke_coupling) + intent = in +[aero_ind_fdb_in] + standard_name = do_smoke_aerosol_indirect_feedback + long_name = flag for rrfs wfa ifa emission + units = flag + dimensions = () + type = logical + intent = in +[extended_sd_diags_in] + standard_name = flag_for_extended_smoke_dust_diagnostics + long_name = flag for extended smoke dust diagnostics + units = flag + dimensions = () + type = logical + intent = in +[dbg_opt_in] + standard_name = do_smoke_debug + long_name = flag for rrfs smoke plumerise debug + units = flag + dimensions = () + type = logical + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +##################################################################### [ccpp-arg-table] name = rrfs_smoke_wrapper_run type = scheme @@ -224,7 +399,7 @@ type = real kind = kind_phys intent = inout -[vegtype] +[vegtype_dom] standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index @@ -238,11 +413,18 @@ dimensions = (horizontal_loop_extent) type = integer intent = in -[sigmaf] - standard_name = bounded_vegetation_area_fraction - long_name = areal fractional cover of green vegetation bounded on the bottom +[nlcat] + standard_name = number_of_vegetation_categories + long_name = number of vegetation categories + units = count + dimensions = () + type = integer + intent = in +[vegtype_frac] + standard_name = fraction_of_vegetation_category + long_name = fraction of horizontal grid area occupied by given vegetation category units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_vegetation_categories) type = real kind = kind_phys intent = in @@ -278,6 +460,14 @@ type = real kind = kind_phys intent = in +[recmol] + standard_name = reciprocal_of_obukhov_length + long_name = one over obukhov length + units = m-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [idat] standard_name = date_and_time_at_model_initialization_in_iso_order long_name = initialization date and time @@ -301,14 +491,6 @@ type = real kind = kind_phys intent = in -[exch] - standard_name = atmosphere_heat_diffusivity - long_name = diffusivity for heat - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [hf2d] standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux valid for current call @@ -365,11 +547,11 @@ type = real kind = kind_phys intent = in -[emi_in] +[emi_ant_in] standard_name = anthropogenic_background_input long_name = anthropogenic background input units = various - dimensions = (horizontal_loop_extent,1) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -377,7 +559,15 @@ standard_name = emission_smoke_RRFS long_name = emission fire RRFS units = various - dimensions = (horizontal_loop_extent,24,3) + dimensions = (horizontal_loop_extent,24,2) + type = real + kind = kind_phys + intent = in +[smoke2d_RRFS] + standard_name = emission_smoke_prvd_RRFS + long_name = emission fire RRFS daily + units = various + dimensions = (horizontal_dimension,4) type = real kind = kind_phys intent = in @@ -494,7 +684,7 @@ type = real kind = kind_phys intent = inout -[ebb_smoke_hr] +[ebb_smoke_in] standard_name = surface_smoke_emission long_name = emission of surface smoke units = ug m-2 s-1 @@ -502,7 +692,7 @@ type = real kind = kind_phys intent = inout -[frp_hr] +[frp_input] standard_name = frp_hourly long_name = hourly fire radiative power units = MW @@ -510,14 +700,6 @@ type = real kind = kind_phys intent = inout -[frp_std_hr] - standard_name = frp_std_hourly - long_name = hourly stdandard deviation of fire radiative power - units = MW - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [coef_bb] standard_name = coef_bb_dc long_name = coef to estimate the fire emission @@ -558,6 +740,22 @@ type = real kind = kind_phys intent = inout +[drydep_flux_out] + standard_name = dry_deposition_flux + long_name = rrfs dry deposition flux + units = ug m-2 + dimensions = (horizontal_loop_extent,number_of_chemical_species_deposited) + type = real + kind = kind_phys + intent = inout +[wetdpr] + standard_name = mp_wet_deposition_smoke_dust + long_name = large scale wet deposition of smoke and dust + units = kg kg-1 + dimensions = (horizontal_loop_extent,number_of_chemical_species_vertically_mixed) + type = real + kind = kind_phys + intent = inout [hwp] standard_name = hourly_wildfire_potential long_name = rrfs hourly fire weather potential @@ -566,6 +764,14 @@ type = real kind = kind_phys intent = out +[hwp_ave] + standard_name = hourly_wildfire_potential_average + long_name = rrfs hourly fire weather potential average + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [wetness] standard_name = normalized_soil_wetness_for_land_surface_model long_name = normalized soil wetness @@ -574,22 +780,6 @@ type = real kind = kind_phys intent = in -[smoke_ext] - standard_name = extinction_coefficient_in_air_due_to_smoke - long_name = extinction coefficient in air due to smoke - units = various - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[dust_ext] - standard_name = extinction_coefficient_in_air_due_to_dust - long_name = extinction coefficient in air due to dust - units = various - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out [ndvel] standard_name = number_of_chemical_species_deposited long_name = number of chemical pbl deposited @@ -605,55 +795,6 @@ type = real kind = kind_phys intent = inout -[rrfs_sd] - standard_name = do_smoke_coupling - long_name = flag controlling rrfs_sd collection (default off) - units = flag - dimensions = () - type = logical - intent = in -[dust_moist_opt_in] - standard_name = control_for_dust_soil_moisture_option - long_name = smoke dust moisture parameterization 1 - fecan 2 - shao - units = index - dimensions = () - type = integer - active = (do_smoke_coupling) - intent = in -[dust_moist_correction_in] - standard_name = dust_moist_correction_fengsha_dust_scheme - long_name = moisture correction term for fengsha dust emission - units = none - dimensions = () - type = real - kind = kind_phys - active = (do_smoke_coupling) - intent = in -[dust_drylimit_factor_in] - standard_name = dust_drylimit_factor_fengsha_dust_scheme - long_name = moisture correction term for drylimit in fengsha dust emission - units = none - dimensions = () - type = real - kind = kind_phys - active = (do_smoke_coupling) - intent = in -[dust_alpha_in] - standard_name = alpha_fengsha_dust_scheme - long_name = alpha paramter for fengsha dust scheme - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[dust_gamma_in] - standard_name = gamma_fengsha_dust_scheme - long_name = gamma paramter for fengsha dust scheme - units = none - dimensions = () - type = real - kind = kind_phys - intent = in [fire_in] standard_name = smoke_fire_auxiliary_input long_name = smoke fire auxiliary input variables @@ -662,84 +803,6 @@ type = real kind = kind_phys intent = inout -[seas_opt_in] - standard_name = control_for_smoke_sea_salt - long_name = rrfs smoke sea salt emission option - units = index - dimensions = () - type = integer - intent = in -[dust_opt_in] - standard_name = control_for_smoke_dust - long_name = rrfs smoke dust chem option - units = index - dimensions = () - type = integer - intent = in -[drydep_opt_in] - standard_name = control_for_smoke_dry_deposition - long_name = rrfs smoke dry deposition option - units = index - dimensions = () - type = integer - intent = in -[coarsepm_settling_in] - standard_name = control_for_smoke_coarsepm_settling - long_name = rrfs smoke coarsepm settling option - units = index - dimensions = () - type = integer - intent = in -[wetdep_ls_opt_in] - standard_name = control_for_smoke_wet_deposition - long_name = rrfs smoke large scale wet deposition option - units = index - dimensions = () - type = integer - intent = in -[wetdep_ls_alpha_in] - standard_name = alpha_for_ls_wet_depoistion - long_name = alpha paramter for ls wet deposition - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[do_plumerise_in] - standard_name = do_smoke_plumerise - long_name = rrfs smoke plumerise option - units = index - dimensions = () - type = logical - intent = in -[plumerisefire_frq_in] - standard_name = smoke_plumerise_frequency - long_name = rrfs smoke add smoke option - units = min - dimensions = () - type = integer - intent = in -[addsmoke_flag_in] - standard_name = control_for_smoke_biomass_burning_emissions - long_name = rrfs smoke add smoke option - units = index - dimensions = () - type = integer - intent = in -[smoke_forecast_in] - standard_name = do_smoke_forecast - long_name = index for rrfs smoke forecast - units = index - dimensions = () - type = integer - intent = in -[aero_ind_fdb_in] - standard_name = do_smoke_aerosol_indirect_feedback - long_name = flag for rrfs wfa ifa emission - units = flag - dimensions = () - type = logical - intent = in [fire_heat_flux_out] standard_name = surface_fire_heat_flux long_name = heat flux of fire at the surface @@ -756,12 +819,20 @@ type = real kind = kind_phys intent = out -[dbg_opt_in] - standard_name = do_smoke_debug - long_name = flag for rrfs smoke plumerise debug - units = flag - dimensions = () - type = logical +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[oro] + standard_name = height_above_mean_sea_level + long_name = height_above_mean_sea_level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys intent = in [errmsg] standard_name = ccpp_error_message From 8180a05c4c44af50767d3cd32c724a9de6f2d21e Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 7 Dec 2023 16:59:57 +0000 Subject: [PATCH 107/132] Omission from previous merge --- physics/SFC_Layer/UFS/sfc_nst.f | 696 ------------------- physics/{ => SFC_Layer/UFS}/sfc_nst.f90 | 0 physics/SFC_Layer/UFS/sfc_nst_post.f | 93 --- physics/{ => SFC_Layer/UFS}/sfc_nst_post.f90 | 0 physics/SFC_Layer/UFS/sfc_nst_pre.f | 96 --- physics/{ => SFC_Layer/UFS}/sfc_nst_pre.f90 | 0 6 files changed, 885 deletions(-) delete mode 100644 physics/SFC_Layer/UFS/sfc_nst.f rename physics/{ => SFC_Layer/UFS}/sfc_nst.f90 (100%) delete mode 100644 physics/SFC_Layer/UFS/sfc_nst_post.f rename physics/{ => SFC_Layer/UFS}/sfc_nst_post.f90 (100%) delete mode 100644 physics/SFC_Layer/UFS/sfc_nst_pre.f rename physics/{ => SFC_Layer/UFS}/sfc_nst_pre.f90 (100%) diff --git a/physics/SFC_Layer/UFS/sfc_nst.f b/physics/SFC_Layer/UFS/sfc_nst.f deleted file mode 100644 index 2ca70666d..000000000 --- a/physics/SFC_Layer/UFS/sfc_nst.f +++ /dev/null @@ -1,696 +0,0 @@ -!>\file sfc_nst.f -!! This file contains the GFS NSST model. - -!> This module contains the CCPP-compliant GFS near-surface sea temperature scheme. - module sfc_nst - - contains - -!>\defgroup gfs_nst_main_mod GFS Near-Surface Sea Temperature Module -!! This module contains the CCPP-compliant GFS near-surface sea temperature scheme. -!> @{ -!! This subroutine calls the Thermal Skin-layer and Diurnal Thermocline models to update the NSST profile. -!! \section arg_table_sfc_nst_run Argument Table -!! \htmlinclude sfc_nst_run.html -!! -!> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm - subroutine sfc_nst_run & - & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: - & pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & - & lseaspray, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & - & sinlat, stress, & - & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & - & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & - & nstf_name5, lprnt, ipr, thsfc_loc, & - & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & - & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: - & ) -! -! ===================================================================== ! -! description: ! -! ! -! ! -! usage: ! -! ! -! call sfc_nst ! -! inputs: ! -! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! -! lseaspray, fm, fm10, ! -! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! -! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! -! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! -! nstf_name5, lprnt, ipr, thsfc_loc, ! -! input/outputs: ! -! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! -! z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, ! -! -- outputs: -! qsurf, gflux, cmm, chh, evap, hflx, ep ! -! ) -! ! -! ! -! subprogram/functions called: w3movdat, iw3jdn, fpvs, density, ! -! rhocoef, cool_skin, warm_layer, jacobi_temp. ! -! ! -! program history log: ! -! 2007 -- xu li createad original code ! -! 2008 -- s. moorthi adapted to the parallel version ! -! may 2009 -- y.-t. hou modified to include input lw surface ! -! emissivity from radiation. also replaced the ! -! often comfusing combined sw and lw suface ! -! flux with separate sfc net sw flux (defined ! -! as dn-up) and lw flux. added a program doc block. ! -! sep 2009 -- s. moorthi removed rcl and additional reformatting ! -! and optimization + made pa as input pressure unit.! -! 2009 -- xu li recreatead the code ! -! feb 2010 -- s. moorthi added some changes made to the previous ! -! version ! -! Jul 2016 -- X. Li, modify the diurnal warming event reset ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! inputs: size ! -! im - integer, horiz dimension 1 ! -! ps - real, surface pressure (pa) im ! -! u1, v1 - real, u/v component of surface layer wind (m/s) im ! -! t1 - real, surface layer mean temperature ( k ) im ! -! q1 - real, surface layer mean specific humidity im ! -! tref - real, reference/foundation temperature ( k ) im ! -! cm - real, surface exchange coeff for momentum (m/s) im ! -! ch - real, surface exchange coeff heat & moisture(m/s) im ! -! lseaspray- logical, .t. for parameterization for sea spray 1 ! -! fm - real, a stability profile function for momentum im ! -! fm10 - real, a stability profile function for momentum im ! -! at 10m ! -! prsl1 - real, surface layer mean pressure (pa) im ! -! prslki - real, im ! -! prsik1 - real, im ! -! prslk1 - real, im ! -! wet - logical, =T if any ocn/lake water (F otherwise) im ! -! use_lake_model- logical, =T if flake model is used for lake im ! -! icy - logical, =T if any ice im ! -! xlon - real, longitude (radians) im ! -! sinlat - real, sin of latitude im ! -! stress - real, wind stress (n/m**2) im ! -! sfcemis - real, sfc lw emissivity (fraction) im ! -! dlwflx - real, total sky sfc downward lw flux (w/m**2) im ! -! sfcnsw - real, total sky sfc netsw flx into ocean (w/m**2) im ! -! rain - real, rainfall rate (kg/m**2/s) im ! -! timestep - real, timestep interval (second) 1 ! -! kdt - integer, time step counter 1 ! -! solhr - real, fcst hour at the end of prev time step 1 ! -! xcosz - real, consine of solar zenith angle 1 ! -! wind - real, wind speed (m/s) im ! -! flag_iter- logical, execution or not im ! -! when iter = 1, flag_iter = .true. for all grids im ! -! when iter = 2, flag_iter = .true. when wind < 2 im ! -! for both land and ocean (when nstf_name1 > 0) im ! -! flag_guess-logical, .true.= guess step to get CD et al im ! -! when iter = 1, flag_guess = .true. when wind < 2 im ! -! when iter = 2, flag_guess = .false. for all grids im ! -! nstf_name - integers , NSST related flag parameters 1 ! -! nstf_name1 : 0 = NSSTM off 1 ! -! 1 = NSSTM on but uncoupled 1 ! -! 2 = NSSTM on and coupled 1 ! -! nstf_name4 : zsea1 in mm 1 ! -! nstf_name5 : zsea2 in mm 1 ! -! lprnt - logical, control flag for check print out 1 ! -! ipr - integer, grid index for check print out 1 ! -! thsfc_loc- logical, flag for reference pressure in theta 1 ! -! ! -! input/outputs: -! li added for oceanic components -! tskin - real, ocean surface skin temperature ( k ) im ! -! tsurf - real, the same as tskin ( k ) but for guess run im ! -! xt - real, heat content in dtl im ! -! xs - real, salinity content in dtl im ! -! xu - real, u-current content in dtl im ! -! xv - real, v-current content in dtl im ! -! xz - real, dtl thickness im ! -! zm - real, mxl thickness im ! -! xtts - real, d(xt)/d(ts) im ! -! xzts - real, d(xz)/d(ts) im ! -! dt_cool - real, sub-layer cooling amount im ! -! d_conv - real, thickness of free convection layer (fcl) im ! -! z_c - sub-layer cooling thickness im ! -! c_0 - coefficient1 to calculate d(tz)/d(ts) im ! -! c_d - coefficient2 to calculate d(tz)/d(ts) im ! -! w_0 - coefficient3 to calculate d(tz)/d(ts) im ! -! w_d - coefficient4 to calculate d(tz)/d(ts) im ! -! ifd - real, index to start dtlm run or not im ! -! qrain - real, sensible heat flux due to rainfall (watts) im ! - -! outputs: ! - -! qsurf - real, surface air saturation specific humidity im ! -! gflux - real, soil heat flux (w/m**2) im ! -! cmm - real, im ! -! chh - real, im ! -! evap - real, evaperation from latent heat flux im ! -! hflx - real, sensible heat flux im ! -! ep - real, potential evaporation im ! -! ! -! ===================================================================== ! - use machine , only : kind_phys - use funcphys, only : fpvs - use date_def, only : idate - use module_nst_water_prop, only: get_dtzm_point - use module_nst_parameters, only : t0k,cp_w,omg_m,omg_sh, & - & sigma_r,solar_time_6am,ri_c,z_w_max,delz,wd_max, & - & rad2deg,const_rot,tau_min,tw_max,sst_max - use module_nst_water_prop, only: solar_time_from_julian, & - & density,rhocoef,compjd,grv & - &, sw_ps_9b - use nst_module, only : cool_skin,dtm_1p,cal_w,cal_ttop, & - & convdepth,dtm_1p_fca,dtm_1p_tla, & - & dtm_1p_mwa,dtm_1p_mda,dtm_1p_mta, & - & dtl_reset -! - implicit none - - integer, parameter :: kp = kind_phys -! -! --- constant parameters: - real (kind=kind_phys), parameter :: f24 = 24.0_kp ! hours/day - real (kind=kind_phys), parameter :: f1440 = 1440.0_kp ! minutes/day - real (kind=kind_phys), parameter :: czmin = 0.0001_kp ! cos(89.994) - real (kind=kind_phys), parameter :: zero = 0.0_kp, one = 1.0_kp - - -! --- inputs: - integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, & - & nstf_name5 - real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & - & epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice - real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & - & t1, q1, tref, cm, ch, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, xlon, xcosz, & - & sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind - real (kind=kind_phys), intent(in) :: timestep - real (kind=kind_phys), intent(in) :: solhr - -! For sea spray effect - logical, intent(in) :: lseaspray -! - logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet - integer, dimension(:), intent(in) :: use_lake_model -! &, icy - logical, intent(in) :: lprnt - logical, intent(in) :: thsfc_loc - -! --- input/outputs: -! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation - real (kind=kind_phys), dimension(:), intent(inout) :: tskin, & - & tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & - & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: & - & qsurf, gflux, cmm, chh, evap, hflx, ep - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! -! locals -! - integer :: k,i -! - real (kind=kind_phys), dimension(im) :: q0, qss, rch, - & rho_a, theta1, tv1, wndmag - - real(kind=kind_phys) elocp,tem,cpinv,hvapi -! -! nstm related prognostic fields -! - logical flag(im) - real (kind=kind_phys), dimension(im) :: - & xt_old, xs_old, xu_old, xv_old, xz_old,zm_old,xtts_old, - & xzts_old, ifd_old, tref_old, tskin_old, dt_cool_old,z_c_old - - real(kind=kind_phys) ulwflx(im), nswsfc(im) -! real(kind=kind_phys) rig(im), -! & ulwflx(im),dlwflx(im), -! & slrad(im),nswsfc(im) - real(kind=kind_phys) alpha,beta,rho_w,f_nsol,sss,sep, - & cosa,sina,taux,tauy,grav,dz,t0,ttop0,ttop - - real(kind=kind_phys) le,fc,dwat,dtmp,wetc,alfac,ustar_a,rich - real(kind=kind_phys) rnl_ts,hs_ts,hl_ts,rf_ts,q_ts - real(kind=kind_phys) fw,q_warm - real(kind=kind_phys) t12,alon,tsea,sstc,dta,dtz - real(kind=kind_phys) zsea1,zsea2,soltim - logical do_nst - -! external functions called: iw3jdn - integer :: iw3jdn -! -! parameters for sea spray effect -! - real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1, - & bb1, hflxs, evaps, ptem -! -! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1, -! real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0, -! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2, - real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, - & ws10cr=30., conlf=7.2e-9, consf=6.4e-8 -! -!====================================================================================================== -cc - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (nstf_name1 == 0) return ! No NSST model used - - cpinv = one/cp - hvapi = one/hvap - elocp = hvap/cp - - sss = 34.0_kp ! temporarily, when sea surface salinity data is not ready -! -! flag for open water and where the iteration is on -! - do_nst = .false. - do i = 1, im -! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) - flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1 - do_nst = do_nst .or. flag(i) - enddo - if (.not. do_nst) return -! -! save nst-related prognostic fields for guess run -! - do i=1, im -! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then - if(wet(i) .and. flag_guess(i) .and. use_lake_model(i)/=1) then - xt_old(i) = xt(i) - xs_old(i) = xs(i) - xu_old(i) = xu(i) - xv_old(i) = xv(i) - xz_old(i) = xz(i) - zm_old(i) = zm(i) - xtts_old(i) = xtts(i) - xzts_old(i) = xzts(i) - ifd_old(i) = ifd(i) - tskin_old(i) = tskin(i) - dt_cool_old(i) = dt_cool(i) - z_c_old(i) = z_c(i) - endif - enddo - - -! --- ... initialize variables. all units are m.k.s. unless specified. -! ps is in pascals, wind is wind speed, theta1 is surface air -! estimated from level 1 temperature, rho_a is air density and -! qss is saturation specific humidity at the water surface -!! - do i = 1, im - if ( flag(i) ) then - - nswsfc(i) = sfcnsw(i) ! net solar radiation at the air-sea surface (positive downward) - wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - - q0(i) = max(q1(i), 1.0e-8_kp) - - if(thsfc_loc) then ! Use local potential temperature - theta1(i) = t1(i) * prslki(i) - else ! Use potential temperature referenced to 1000 hPa - theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer - endif - - tv1(i) = t1(i) * (one + rvrdm1*q0(i)) - rho_a(i) = prsl1(i) / (rd*tv1(i)) - qss(i) = fpvs(tsurf(i)) ! pa - qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) ! pa -! - evap(i) = zero - hflx(i) = zero - gflux(i) = zero - ep(i) = zero - -! --- ... rcp = rho cp ch v - - rch(i) = rho_a(i) * cp * ch(i) * wind(i) - cmm(i) = cm (i) * wind(i) - chh(i) = rho_a(i) * ch(i) * wind(i) - -!> - Calculate latent and sensible heat flux over open water with tskin. -! at previous time step - evap(i) = elocp * rch(i) * (qss(i) - q0(i)) - qsurf(i) = qss(i) - - if(thsfc_loc) then ! Use local potential temperature - hflx(i) = rch(i) * (tsurf(i) - theta1(i)) - else ! Use potential temperature referenced to 1000 hPa - hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) - endif - -! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', -! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) -! &,' tsurf=',tsurf(i) - endif - enddo - -! run nst model: dtm + slm -! - zsea1 = 0.001_kp*real(nstf_name4) - zsea2 = 0.001_kp*real(nstf_name5) - -!> - Call module_nst_water_prop::density() to compute sea water density. -!> - Call module_nst_water_prop::rhocoef() to compute thermal expansion -!! coefficient (\a alpha) and saline contraction coefficient (\a beta). - do i = 1, im - if ( flag(i) ) then - tsea = tsurf(i) - t12 = tsea*tsea - ulwflx(i) = sfcemis(i) * sbc * t12 * t12 - alon = xlon(i)*rad2deg - grav = grv(sinlat(i)) - soltim = mod(alon/15.0_kp + solhr, 24.0_kp)*3600.0_kp - call density(tsea,sss,rho_w) ! sea water density - call rhocoef(tsea,sss,rho_w,alpha,beta) ! alpha & beta -! -!> - Calculate sensible heat flux (\a qrain) due to rainfall. -! - le = (2.501_kp-0.00237_kp*tsea)*1e6_kp - dwat = 2.11e-5_kp*(t1(i)/t0k)**1.94_kp ! water vapor diffusivity - dtmp = (one+3.309e-3_kp*(t1(i)-t0k)-1.44e-6_kp*(t1(i)-t0k) - & * (t1(i)-t0k))*0.02411_kp/(rho_a(i)*cp) ! heat diffusivity - wetc = 622.0_kp*le*qss(i)/(rd*t1(i)*t1(i)) - alfac = one / (one + (wetc*le*dwat)/(cp*dtmp)) ! wet bulb factor - tem = (1.0e3_kp * rain(i) / rho_w) * alfac * cp_w - qrain(i) = tem * (tsea-t1(i)+1.0e3_kp*(qss(i)-q0(i))*le/cp) - -!> - Calculate input non solar heat flux as upward = positive to models here - - f_nsol = hflx(i) + evap(i) + ulwflx(i) - dlwflx(i) - & + omg_sh*qrain(i) - -! if (lprnt .and. i == ipr) print *,' f_nsol=',f_nsol,' hflx=', -! &hflx(i),' evap=',evap(i),' ulwflx=',ulwflx(i),' dlwflx=',dlwflx(i) -! &,' omg_sh=',omg_sh,' qrain=',qrain(i) - - sep = sss*(evap(i)/le-rain(i))/rho_w - ustar_a = sqrt(stress(i)/rho_a(i)) ! air friction velocity -! -! sensitivities of heat flux components to ts -! - rnl_ts = 4.0_kp*sfcemis(i)*sbc*tsea*tsea*tsea ! d(rnl)/d(ts) - hs_ts = rch(i) - hl_ts = rch(i)*elocp*eps*hvap*qss(i)/(rd*t12) - rf_ts = tem * (one+rch(i)*hl_ts) - q_ts = rnl_ts + hs_ts + hl_ts + omg_sh*rf_ts -! -!> - Call cool_skin(), which is the sub-layer cooling parameterization -!! (Fairfall et al. (1996) \cite fairall_et_al_1996). -! & calculate c_0, c_d -! - call cool_skin(ustar_a,f_nsol,nswsfc(i),evap(i),sss,alpha,beta - &, rho_w,rho_a(i),tsea,q_ts,hl_ts,grav,le - &, dt_cool(i),z_c(i),c_0(i),c_d(i)) - - tem = one / wndmag(i) - cosa = u1(i)*tem - sina = v1(i)*tem - taux = max(stress(i),tau_min)*cosa - tauy = max(stress(i),tau_min)*sina - fc = const_rot*sinlat(i) -! -! Run DTM-1p system. -! - if ( (soltim > solar_time_6am .and. ifd(i) == zero) ) then - else - ifd(i) = one -! -! calculate fcl thickness with current forcing and previous time's profile -! -! if (lprnt .and. i == ipr) print *,' beg xz=',xz(i) - -!> - Call convdepth() to calculate depth for convective adjustments. - if ( f_nsol > zero .and. xt(i) > zero ) then - call convdepth(kdt,timestep,nswsfc(i),f_nsol,sss,sep,rho_w - &, alpha,beta,xt(i),xs(i),xz(i),d_conv(i)) - else - d_conv(i) = zero - endif - -! if (lprnt .and. i == ipr) print *,' beg xz1=',xz(i) -! -! determine rich: wind speed dependent (right now) -! -! if ( wind(i) < 1.0 ) then -! rich = 0.25 + 0.03*wind(i) -! elseif ( wind(i) >= 1.0 .and. wind(i) < 1.5 ) then -! rich = 0.25 + 0.1*wind(i) -! elseif ( wind(i) >= 1.5 .and. wind(i) < 6.0 ) then -! rich = 0.25 + 0.6*wind(i) -! elseif ( wind(i) >= 6.0 ) then -! rich = 0.25 + min(0.8*wind(i),0.50) -! endif - - rich = ri_c - -!> - Call the diurnal thermocline layer model dtm_1p(). - call dtm_1p(kdt,timestep,rich,taux,tauy,nswsfc(i), - & f_nsol,sss,sep,q_ts,hl_ts,rho_w,alpha,beta,alon, - & sinlat(i),soltim,grav,le,d_conv(i), - & xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz2=',xz(i) - -! apply mda - if ( xt(i) > zero ) then -!> - If \a dtl heat content \a xt > 0.0, call dtm_1p_mda() to apply -!! minimum depth adjustment (mda). - call dtm_1p_mda(xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then -!> - If \a dtl thickness >= module_nst_parameters::z_w_max, call dtl_reset() -!! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max. - call dtl_reset(xt(i),xs(i),xu(i),xv(i),xz(i),xtts(i), - & xzts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz3=',xz(i),' z_w_max=' -! &,z_w_max - endif - -! apply fca - if ( d_conv(i) > zero ) then -!> - If thickness of free convection layer > 0.0, call dtm_1p_fca() -!! to apply free convection adjustment. -!> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() -!! to reset xt/xs/x/xv to zero, and xz to module_nst_parameters::z_w_max(). - call dtm_1p_fca(d_conv(i),xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - -! if (lprnt .and. i == ipr) print *,' beg xz4=',xz(i) - -! apply tla - dz = min(xz(i),max(d_conv(i),delz)) -! -!> - Call sw_ps_9b() to compute the fraction of the solar radiation -!! absorbed by the depth \a delz (Paulson and Simpson (1981) \cite paulson_and_simpson_1981). -!! And calculate the total heat absorbed in warm layer. - call sw_ps_9b(delz,fw) - q_warm = fw*nswsfc(i)-f_nsol !total heat absorbed in warm layer - -!> - Call cal_ttop() to calculate the diurnal warming amount at the top layer with -!! thickness of \a dz. - if ( q_warm > zero ) then - call cal_ttop(kdt,timestep,q_warm,rho_w,dz, - & xt(i),xz(i),ttop0) - -! if (lprnt .and. i == ipr) print *,' d_conv=',d_conv(i),' delz=', -! &delz,' kdt=',kdt,' timestep=',timestep,' nswsfc=',nswsfc(i), -! &' f_nsol=',f_nsol,' rho_w=',rho_w,' dz=',dz,' xt=',xt(i), -! &' xz=',xz(i),' qrain=',qrain(i) - - ttop = ((xt(i)+xt(i))/xz(i))*(one-dz/((xz(i)+xz(i)))) - -! if (lprnt .and. i == ipr) print *,' beg xz4a=',xz(i) -! &,' ttop=',ttop,' ttop0=',ttop0,' xt=',xt(i),' dz=',dz -! &,' xznew=',(xt(i)+sqrt(xt(i)*(xt(i)-dz*ttop0)))/ttop0 - -!> - Call dtm_1p_tla() to apply top layer adjustment. - if ( ttop > ttop0 ) then - call dtm_1p_tla(dz,ttop0,xt(i),xtts(i),xz(i),xzts(i)) - -! if (lprnt .and. i == ipr) print *,' beg xz4b=',xz(i),'z_w_max=', -! &z_w_max - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - endif ! if ( q_warm > 0.0 ) then - -! if (lprnt .and. i == ipr) print *,' beg xz5=',xz(i) - -! apply mwa -!> - Call dt_1p_mwa() to apply maximum warming adjustment. - t0 = (xt(i)+xt(i))/xz(i) - if ( t0 > tw_max ) then - call dtm_1p_mwa(xt(i),xtts(i),xz(i),xzts(i)) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif - -! if (lprnt .and. i == ipr) print *,' beg xz6=',xz(i) - -! apply mta -!> - Call dtm_1p_mta() to apply maximum temperature adjustment. - sstc = tref(i) + (xt(i)+xt(i))/xz(i) - dt_cool(i) - - if ( sstc > sst_max ) then - dta = sstc - sst_max - call dtm_1p_mta(dta,xt(i),xtts(i),xz(i),xzts(i)) -! write(*,'(a,f3.0,7f8.3)') 'mta, sstc,dta :',islimsk(i), -! & sstc,dta,tref(i),xt(i),xz(i),2.0*xt(i)/xz(i),dt_cool(i) - if ( xz(i) >= z_w_max ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - endif -! - endif ! if ( xt(i) > 0.0 ) then -! reset dtl at midnight and when solar zenith angle > 89.994 degree - if ( abs(soltim) < 2.0_kp*timestep ) then - call dtl_reset - & (xt(i),xs(i),xu(i),xv(i),xz(i),xzts(i),xtts(i)) - endif - - endif ! if (solar_time > solar_time_6am .and. ifd(i) == 0.0 ) then: too late to start the first day - -! if (lprnt .and. i == ipr) print *,' beg xz7=',xz(i) - -! update tsurf (when flag(i) .eqv. .true. ) -!> - Call get_dtzm_point() to computes \a dtz and \a tsurf. - call get_dtzm_point(xt(i),xz(i),dt_cool(i),z_c(i), - & zsea1,zsea2,dtz) - tsurf(i) = max(tgice, tref(i) + dtz ) - -! if (lprnt .and. i == ipr) print *,' tsurf=',tsurf(i),' tref=', -! &tref(i),' xz=',xz(i),' dt_cool=',dt_cool(i) - -!> - Call cal_w() to calculate \a w_0 and \a w_d. - if ( xt(i) > zero ) then - call cal_w(kdt,xz(i),xt(i),xzts(i),xtts(i),w_0(i),w_d(i)) - else - w_0(i) = zero - w_d(i) = zero - endif - -! if ( xt(i) > 0.0 ) then -! rig(i) = grav*xz(i)*xz(i)*(alpha*xt(i)-beta*xs(i)) -! & /(2.0*(xu(i)*xu(i)+xv(i)*xv(i))) -! else -! rig(i) = 0.25 -! endif - -! qrain(i) = rig(i) - zm(i) = wind(i) - - endif - enddo - -! restore nst-related prognostic fields for guess run - do i=1, im -! if (wet(i) .and. .not.icy(i)) then - if (wet(i) .and. use_lake_model(i)/=1) then - if (flag_guess(i)) then ! when it is guess of - xt(i) = xt_old(i) - xs(i) = xs_old(i) - xu(i) = xu_old(i) - xv(i) = xv_old(i) - xz(i) = xz_old(i) - zm(i) = zm_old(i) - xtts(i) = xtts_old(i) - xzts(i) = xzts_old(i) - ifd(i) = ifd_old(i) - tskin(i) = tskin_old(i) - dt_cool(i) = dt_cool_old(i) - z_c(i) = z_c_old(i) - else -! -! update tskin when coupled and not guess run -! (all other NSST variables have been updated in this case) -! - if ( nstf_name1 > 1 ) then - tskin(i) = tsurf(i) - endif ! if nstf_name1 > 1 then - endif ! if flag_guess(i) then - endif ! if wet(i) .and. .not.icy(i) then - enddo - -! if (lprnt .and. i == ipr) print *,' beg xz8=',xz(i) - - if ( nstf_name1 > 1 ) then -!> - Calculate latent and sensible heat flux over open water with updated tskin -!! for the grids of open water and the iteration is on. - do i = 1, im - if ( flag(i) ) then - qss(i) = fpvs( tskin(i) ) - qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) - qsurf(i) = qss(i) - evap(i) = elocp*rch(i) * (qss(i) - q0(i)) - - if(thsfc_loc) then ! Use local potential temperature - hflx(i) = rch(i) * (tskin(i) - theta1(i)) - else ! Use potential temperature referenced to 1000 hPa - hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) - endif - - endif - enddo - endif ! if ( nstf_name1 > 1 ) then -! -!> - Include sea spray effects -! - do i=1,im - if(lseaspray .and. flag(i)) then - f10m = fm10(i) / fm(i) - u10m = f10m * u1(i) - v10m = f10m * v1(i) - ws10 = sqrt(u10m*u10m + v10m*v10m) - ws10 = max(ws10,1.) - ws10 = min(ws10,ws10cr) - tem = .015 * ws10 * ws10 - ru10 = 1. - .087 * log(10./tem) - qss1 = fpvs(t1(i)) - qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1) - tem = rd * cp * t1(i) * t1(i) - tem = 1. + eps * hvap * hvap * qss1 / tem - bb1 = 1. / tem - evaps = conlf * (ws10**5.4) * ru10 * bb1 - evaps = evaps * rho_a(i) * hvap * (qss1 - q0(i)) - evap(i) = evap(i) + alps * evaps - hflxs = consf * (ws10**3.4) * ru10 - hflxs = hflxs * rho_a(i) * cp * (tskin(i) - t1(i)) - ptem = alps - gams - hflx(i) = hflx(i) + bets * hflxs - ptem * evaps - endif - enddo -! - do i=1,im - if ( flag(i) ) then - tem = one / rho_a(i) - hflx(i) = hflx(i) * tem * cpinv - evap(i) = evap(i) * tem * hvapi - endif - enddo -! -! if (lprnt) print *,' tskin=',tskin(ipr) - - return - end subroutine sfc_nst_run -!> @} - end module sfc_nst diff --git a/physics/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 similarity index 100% rename from physics/sfc_nst.f90 rename to physics/SFC_Layer/UFS/sfc_nst.f90 diff --git a/physics/SFC_Layer/UFS/sfc_nst_post.f b/physics/SFC_Layer/UFS/sfc_nst_post.f deleted file mode 100644 index 83bc2f273..000000000 --- a/physics/SFC_Layer/UFS/sfc_nst_post.f +++ /dev/null @@ -1,93 +0,0 @@ -!> \file sfc_nst_post.f -!! This file contains code to be executed after the GFS NSST model. - - module sfc_nst_post - - contains - -! \defgroup GFS_NSST_POST GFS Near-Surface Sea Temperature Post - -!> \section arg_table_sfc_nst_post_run Argument Table -!! \htmlinclude sfc_nst_post_run.html -!! -! \section NSST_general_post_algorithm General Algorithm -! -! \section NSST_detailed_post_algorithm Detailed Algorithm -! @{ - subroutine sfc_nst_post_run & - & ( im, kdt, rlapse, tgice, wet, use_lake_model, icy, oro, & - & oro_uf, nstf_name1, & - & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & - & tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & - & ) - - use machine , only : kind_phys - use module_nst_water_prop, only: get_dtzm_2d - - implicit none - - integer, parameter :: kp = kind_phys - -! --- inputs: - integer, intent(in) :: im, kdt, nthreads - logical, dimension(:), intent(in) :: wet, icy - integer, dimension(:), intent(in) :: use_lake_model - real (kind=kind_phys), intent(in) :: rlapse, tgice - real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf - integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 - real (kind=kind_phys), dimension(:), intent(in) :: xt, xz, & - & dt_cool, z_c, tref, xlon - -! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, & - & tsfc_wat - -! --- outputs: - real (kind=kind_phys), dimension(:), intent(out) :: dtzm - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - real(kind=kind_phys) :: zsea1, zsea2 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -! if (lprnt) print *,' tseaz2=',tseal(ipr),' tref=',tref(ipr), -! & ' dt_cool=',dt_cool(ipr),' dt_warm=',2.0*xt(ipr)/xz(ipr), -! & ' kdt=',kdt - -! do i = 1, im -! if (wet(i) .and. .not. icy(i)) then -! tsurf_wat(i) = tsurf_wat(i) - (oro(i)-oro_uf(i)) * rlapse -! endif -! enddo - -! --- ... run nsst model ... --- - - if (nstf_name1 > 1) then - zsea1 = 0.001_kp*real(nstf_name4) - zsea2 = 0.001_kp*real(nstf_name5) - call get_dtzm_2d (xt, xz, dt_cool, z_c, wet, zsea1, zsea2, & - & im, 1, nthreads, dtzm) - do i = 1, im -! if (wet(i) .and. .not.icy(i)) then -! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then - if (wet(i) .and. use_lake_model(i) /=1) then - tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) -! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & -! (oro(i)-oro_uf(i))*rlapse - endif - enddo - endif - -! if (lprnt) print *,' tseaz2=',tsea(ipr),' tref=',tref(ipr), & -! & ' dt_cool=',dt_cool(ipr),' dt_warm=',dt_warm(ipr),' kdt=',kdt - - return - end subroutine sfc_nst_post_run - - end module sfc_nst_post diff --git a/physics/sfc_nst_post.f90 b/physics/SFC_Layer/UFS/sfc_nst_post.f90 similarity index 100% rename from physics/sfc_nst_post.f90 rename to physics/SFC_Layer/UFS/sfc_nst_post.f90 diff --git a/physics/SFC_Layer/UFS/sfc_nst_pre.f b/physics/SFC_Layer/UFS/sfc_nst_pre.f deleted file mode 100644 index 77ff61f00..000000000 --- a/physics/SFC_Layer/UFS/sfc_nst_pre.f +++ /dev/null @@ -1,96 +0,0 @@ -!> \file sfc_nst_pre.f -!! This file contains preparation for the GFS NSST model. - - module sfc_nst_pre - - contains - -!> \defgroup GFS_NSST_PRE GFS Near-Surface Sea Temperature Pre -!! -!! The NSST scheme is one of the three schemes used to represent the -!! surface in the GFS physics suite. The other two are the Noah land -!! surface model and the sice simplified ice model. -!! -!! \section arg_table_sfc_nst_pre_run Argument Table -!! \htmlinclude sfc_nst_pre_run.html -!! -!> \section NSST_general_pre_algorithm General Algorithm - subroutine sfc_nst_pre_run - & (im, wet, tgice, tsfco, tsurf_wat, - & tseal, xt, xz, dt_cool, z_c, tref, cplflx, - & oceanfrac, nthreads, errmsg, errflg) - - use machine , only : kind_phys - use module_nst_water_prop, only: get_dtzm_2d - - implicit none - - integer, parameter :: kp = kind_phys - -! --- inputs: - integer, intent(in) :: im, nthreads - logical, dimension(:), intent(in) :: wet - real (kind=kind_phys), intent(in) :: tgice - real (kind=kind_phys), dimension(:), intent(in) :: - & tsfco, xt, xz, dt_cool, z_c, oceanfrac - logical, intent(in) :: cplflx - -! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: - & tsurf_wat, tseal, tref - -! --- outputs: - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals - integer :: i - real(kind=kind_phys), parameter :: zero = 0.0_kp, - & one = 1.0_kp, - & half = 0.5_kp, - & omz1 = 2.0_kp - real(kind=kind_phys) :: tem1, tem2, dnsst - real(kind=kind_phys), dimension(im) :: dtzm, z_c_0 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - if (wet(i) .and. oceanfrac(i) > 0.0) then -! tem = (oro(i)-oro_uf(i)) * rlapse - ! DH* 20190927 simplyfing this code because tem is zero - !tem = zero - !tseal(i) = tsfco(i) + tem - tseal(i) = tsfco(i) - !tsurf_wat(i) = tsurf_wat(i) + tem - ! *DH - endif - enddo -! -! update tsfc & tref with T1 from OGCM & NSST Profile if coupled -! - if (cplflx) then - z_c_0 = zero - call get_dtzm_2d (xt, xz, dt_cool, & - & z_c_0, wet, zero, omz1, im, 1, nthreads, dtzm) - do i=1,im - if (wet(i) .and. oceanfrac(i) > zero ) then -! dnsst = tsfc_wat(i) - tref(i) ! retrive/get difference of Ts and Tf - tref(i) = max(tgice, tsfco(i) - dtzm(i)) ! update Tf with T1 and NSST T-Profile -! tsfc_wat(i) = max(271.2,tref(i) + dnsst) ! get Ts updated due to Tf update -! tseal(i) = tsfc_wat(i) - if (abs(xz(i)) > zero) then - tem2 = one / xz(i) - else - tem2 = zero - endif - tseal(i) = tref(i) + (xt(i)+xt(i)) * tem2 - dt_cool(i) - tsurf_wat(i) = tseal(i) - endif - enddo - endif - - return - end subroutine sfc_nst_pre_run - end module sfc_nst_pre diff --git a/physics/sfc_nst_pre.f90 b/physics/SFC_Layer/UFS/sfc_nst_pre.f90 similarity index 100% rename from physics/sfc_nst_pre.f90 rename to physics/SFC_Layer/UFS/sfc_nst_pre.f90 From 3c1e819f5f1042917fcc68810254362252621315 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 7 Dec 2023 18:18:07 +0000 Subject: [PATCH 108/132] More metadata fixes --- physics/MP/GFDL/fv_sat_adj.meta | 4 +++- physics/SFC_Models/Land/Noah/lsm_noah.meta | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/physics/MP/GFDL/fv_sat_adj.meta b/physics/MP/GFDL/fv_sat_adj.meta index 8c3c9be42..c91e438b7 100644 --- a/physics/MP/GFDL/fv_sat_adj.meta +++ b/physics/MP/GFDL/fv_sat_adj.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = fv_sat_adj type = scheme - dependencies = ../../hooks/machine.F,../../hooks/physcons.F90,module_gfdl_cloud_microphys.F90,multi_gases.F90 + dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 + dependencies = module_gfdl_cloud_microphys.F90,multi_gases.F90 + dependencies = ../module_mp_radar.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index 44cb6aa5b..f3ce1d19b 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -2,7 +2,7 @@ name = lsm_noah type = scheme dependencies = ../../../tools/funcphys.f90,../../../hooks/machine.F - dependencies = set_soilveg.f,sflx.f,surface_perturbation.F90 + dependencies = set_soilveg.f,sflx.f,surface_perturbation.F90,namelist_soilveg.f ######################################################################## [ccpp-arg-table] From a7b8325bdf3f0a16f7354854276f40918b32549b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 14 Dec 2023 00:46:00 +0000 Subject: [PATCH 109/132] Bug in CMake file --- CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index bac0637a4..ee708d4c4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -108,8 +108,8 @@ set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte- # List of files that need to be compiled with different precision set(SCHEMES_DYNAMICS) -if(${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90fv_sat_adj.F90 IN_LIST SCHEMES) - list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90/fv_sat_adj.F90) +if(${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90 IN_LIST SCHEMES) + list(APPEND SCHEMES_DYNAMICS ${LOCAL_CURRENT_SOURCE_DIR}/physics/MP/GFDL/fv_sat_adj.F90) endif() # Remove files that need to be compiled with different precision From d65507afb07edc4a50ba246843284552b99e437d Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Thu, 14 Dec 2023 11:16:29 -0500 Subject: [PATCH 110/132] Fix CI 2 --- tools/check_encoding.py | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/tools/check_encoding.py b/tools/check_encoding.py index 1d24d4679..d964ebaab 100755 --- a/tools/check_encoding.py +++ b/tools/check_encoding.py @@ -15,11 +15,7 @@ if suffix in SUFFICES: with open(os.path.join(root, file)) as f: contents = f.read() - try: - contents.decode('ascii') - except UnicodeDecodeError: + if not contents.isascii(): for line in contents.split('\n'): - try: - line.decode('ascii') - except UnicodeDecodeError: + if not line.isascii(): raise Exception('Detected non-ascii characters in file {}, line: "{}"'.format(os.path.join(root, file), line)) From 3c3c91a57210a686f6c21bbe8cf614f37ac2b16b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 14 Dec 2023 22:37:37 +0000 Subject: [PATCH 111/132] bug fix: no concurrent NetCDF calls in GFS_phys_time_vary_init --- physics/GFS_phys_time_vary.fv3.F90 | 37 ------------------------------ 1 file changed, 37 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 4b6909f74..f53ab3928 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -222,24 +222,6 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,levs,idate) & -!$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & -!$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & -!$OMP shared (iamin, iamax, jamin, jamax, lsm_noahmp) & -!$OMP shared (iaerclm,iaermdl,ntrcaer,aer_nm,iflip,iccn) & -!$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & -!$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & -!$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & -!$OMP shared (do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau) & -!$OMP shared (isot,ivegsrc,nlunit,sncovr,sncovr_ice,lsm,lsm_ruc) & -!$OMP shared (min_seaice,fice,landfrac,vtype,weasd,snupx,salp_data) & -!$OMP shared (ozphys) & -!$OMP private (ix,i,j,rsnow,vegtyp,myerrmsg,myerrflg) - -!$OMP sections - -!$OMP section !> - Call read_h2odata() to read stratospheric water vapor data need_h2odata: if(h2o_phys) then call read_h2odata (h2o_phys, me, master) @@ -263,7 +245,6 @@ subroutine GFS_phys_time_vary_init ( end if endif need_h2odata -!$OMP section !> - Call read_aerdata() to read aerosol climatology, Anning added coupled !> added coupled gocart and radiation option to initializing aer_nm if (iaerclm) then @@ -285,7 +266,6 @@ subroutine GFS_phys_time_vary_init ( ntrcaer = 1 endif -!$OMP section !> - Call read_cidata() to read IN and CCN data if (iccn == 1) then call read_cidata (me,master) @@ -293,7 +273,6 @@ subroutine GFS_phys_time_vary_init ( ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif -!$OMP section !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then myerrflg = 0 @@ -302,14 +281,12 @@ subroutine GFS_phys_time_vary_init ( call copy_error(myerrmsg, myerrflg, errmsg, errflg) endif -!$OMP section !> - Initialize soil vegetation (needed for sncovr calculation further down) myerrflg = 0 myerrmsg = 'set_soilveg failed without a message' call set_soilveg(me, isot, ivegsrc, nlunit, myerrmsg, myerrflg) call copy_error(myerrmsg, myerrflg, errmsg, errflg) -!$OMP section !> - read in NoahMP table (needed for NoahMP init) if(lsm == lsm_noahmp) then myerrflg = 0 @@ -318,25 +295,19 @@ subroutine GFS_phys_time_vary_init ( call copy_error(myerrmsg, myerrflg, errmsg, errflg) endif -!$OMP end sections ! Need an OpenMP barrier here (implicit in "end sections") -!$OMP sections - -!$OMP section !> - Setup spatial interpolation indices for ozone physics. if (ntoz > 0) then call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif -!$OMP section !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) endif -!$OMP section !> - Call setindxaer() to initialize aerosols data if (iaerclm) then call setindxaer (im, xlat_d, jindx1_aer, & @@ -349,7 +320,6 @@ subroutine GFS_phys_time_vary_init ( jamax = max(maxval(jindx2_aer), jamax) endif -!$OMP section !> - Call setindxci() to initialize IN and CCN data if (iccn == 1) then call setindxci (im, xlat_d, jindx1_ci, & @@ -357,14 +327,12 @@ subroutine GFS_phys_time_vary_init ( iindx1_ci, iindx2_ci, ddx_ci) endif -!$OMP section !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs if (do_ugwp_v1) then call cires_indx_ugwp (im, me, master, xlat_d, jindx1_tau, jindx2_tau, & ddy_j1tau, ddy_j2tau) endif -!$OMP section !--- initial calculation of maps local ix -> global i and j ix = 0 do j = 1,ny @@ -375,7 +343,6 @@ subroutine GFS_phys_time_vary_init ( enddo enddo -!$OMP section !--- if sncovr does not exist in the restart, need to create it if (all(sncovr < zero)) then if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' @@ -404,10 +371,6 @@ subroutine GFS_phys_time_vary_init ( endif endif -!$OMP end sections - -!$OMP end parallel - if (errflg/=0) return if (iaerclm) then From 929b716834927b0b832335ef189dad6a4470042b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 15 Dec 2023 16:55:14 +0000 Subject: [PATCH 112/132] pressure is not density --- physics/clm_lake.f90 | 20 +++++++++++--------- physics/clm_lake.meta | 32 ++++++++++++++++++++++++-------- 2 files changed, 35 insertions(+), 17 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 620f79a96..f9341c87b 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -238,7 +238,7 @@ subroutine calculate_z_dz_lake(i,input_lakedepth,clm_lakedepth,z_lake,dz_lake) real(kind_lake) :: dz_lake(nlevlake) ! layer thickness for lake (m) real(kind_lake) :: depthratio - if (input_lakedepth(i) == spval) then + if (input_lakedepth(i) == spval .or. input_lakedepth(i) < 0.1) then clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake) z_lake(1:nlevlake) = zlak(1:nlevlake) dz_lake(1:nlevlake) = dzlak(1:nlevlake) @@ -267,7 +267,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & - ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & + ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, tsfc, & flag_iter, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: @@ -283,7 +283,7 @@ SUBROUTINE clm_lake_run( & salty, savedtke12d, snowdp2d, h2osno2d, snl2d, t_grnd2d, t_lake3d, & lake_icefrac3d, t_soisno3d, h2osoi_ice3d, h2osoi_liq3d, h2osoi_vol3d, & - z3d, dz3d, zi3d, & + z3d, dz3d, zi3d, t1, qv1, prsl1, & input_lakedepth, clm_lakedepth, cannot_freeze, & ! Error reporting: @@ -321,8 +321,8 @@ SUBROUTINE clm_lake_run( & ! REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: & tg3, pgr, zlvl, qvcurr, xlat_d, xlon_d, ch, cm, & - dlwsfci, dswsfci, oro_lakedepth, wind, rho0, & - rainncprv, raincprv + dlwsfci, dswsfci, oro_lakedepth, wind, & + rainncprv, raincprv, t1, qv1, prsl1 REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP @@ -450,6 +450,7 @@ SUBROUTINE clm_lake_run( & logical, parameter :: feedback_to_atmosphere = .true. ! FIXME: REMOVE real(kind_lake) :: to_radians, lat_d, lon_d, qss, tkm, bd + real(kind_lake) :: rho0 ! lowest model level air density integer :: month,num1,num2,day_of_month,isl real(kind_lake) :: wght1,wght2,Tclim,depthratio @@ -693,12 +694,13 @@ SUBROUTINE clm_lake_run( & !-- The CLM output is combined for fractional ice and water if( t_grnd(c) >= tfrz ) then - qfx = eflx_lh_tot(c)*invhvap + qfx = eflx_lh_tot(c)*invhvap else - qfx = eflx_lh_tot(c)*invhsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) + qfx = eflx_lh_tot(c)*invhsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) endif - evap_wat(i) = qfx/rho0(i) ! kinematic_surface_upward_latent_heat_flux_over_water - hflx_wat(i)=eflx_sh_tot(c)/(rho0(i)*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water + rho0 = prsl1(i) / (rair*t1(i)*(1.0 + con_fvirt*qv1(i))) + evap_wat(i) = qfx/rho0 ! kinematic_surface_upward_latent_heat_flux_over_water + hflx_wat(i) = eflx_sh_tot(c)/(rho0*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water gflx_wat(I) = eflx_gnet(c) ![W/m/m] upward_heat_flux_in_soil_over_water ep1d_water(i) = eflx_lh_tot(c) ![W/m/m] surface_upward_potential_latent_heat_flux_over_water tsurf_water(I) = t_grnd(c) ![K] surface skin temperature after iteration over water diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 11a44286a..345f535ee 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -305,14 +305,6 @@ type = real kind = kind_phys intent = in -[rho0] - standard_name = air_pressure_at_surface_adjacent_layer - long_name = mean pressure at lowest model layer - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -732,6 +724,30 @@ type = real kind = kind_phys intent = in +[t1] + standard_name = air_temperature_at_surface_adjacent_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[qv1] + standard_name = specific_humidity_at_surface_adjacent_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[prsl1] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 0889de1446e11f26a0570baa056ceb0bfb65512e Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 18 Dec 2023 15:12:33 +0000 Subject: [PATCH 113/132] revisions to slowfall accumulation from @tanyasmirnova --- physics/module_sf_ruclsm.F90 | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 52fbc8123..9ac4493f7 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1703,7 +1703,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia IF (NEWSN > zero .and. snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN ! new snow KEEP_SNOW_ALBEDO = one - !snow_mosaic=0. ! ??? + snow_mosaic=0. ! ??? ENDIF IF (debug_print ) THEN @@ -2076,7 +2076,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia hfx = hfxs*(one-snowfrac) + hfx*snowfrac s = ss*(one-snowfrac) + s*snowfrac evapl = evapls*(one-snowfrac) - sublim = sublim*snowfrac prcpl = prcpls*(one-snowfrac) + prcpl*snowfrac fltot = fltots*(one-snowfrac) + fltot*snowfrac ALB = MAX(keep_snow_albedo*alb, & @@ -2088,10 +2087,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia runoff1 = runoff1s*(one-snowfrac) + runoff1*snowfrac runoff2 = runoff2s*(one-snowfrac) + runoff2*snowfrac - smelt = smelt * snowfrac - snoh = snoh * snowfrac - snflx = snflx * snowfrac - snom = snom * snowfrac mavail = mavails*(one-snowfrac) + one*snowfrac infiltr = infiltrs*(one-snowfrac) + infiltr*snowfrac @@ -2115,7 +2110,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia qvg = qvgs*(one-snowfrac) + qvg*snowfrac qsg = qsgs*(one-snowfrac) + qsg*snowfrac qcg = qcgs*(one-snowfrac) + qcg*snowfrac - sublim = eeta*snowfrac + sublim = eeta eeta = eetas*(one-snowfrac) + eeta*snowfrac qfx = qfxs*(one-snowfrac) + qfx*snowfrac hfx = hfxs*(one-snowfrac) + hfx*snowfrac @@ -2129,10 +2124,6 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia (emissn - emiss_snowfree) * snowfrac), emissn)) runoff1 = runoff1s*(one-snowfrac) + runoff1*snowfrac runoff2 = runoff2s*(one-snowfrac) + runoff2*snowfrac - smelt = smelt * snowfrac - snoh = snoh * snowfrac - snflx = snflx * snowfrac - snom = snom * snowfrac IF (debug_print ) THEN print *,'SOILT combined on ice', soilt ENDIF @@ -2215,15 +2206,13 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia IF (debug_print ) then !if (abs(xlat-testptlat).lt.0.2 .and. abs(xlon-testptlon).lt.0.2)then print *,'Snowfallac xlat, xlon',xlat,xlon - print *,'newsn,rhonewsn,newsnowratio=',newsn,rhonewsn,newsnowratio + print *,'newsn [m],rhonewsn,newsnowratio=',newsn,rhonewsn,newsnowratio print *,'Time-step newsn depth [m], swe [m]',newsn,newsn*rhonewsn print *,'Time-step smelt: swe [m]' ,smelt*delt print *,'Time-step sublim: swe,[kg m-2]',sublim*delt endif - snowfallac = snowfallac + max(zero,(newsn*rhonewsn - & ! source of snow (swe) [m] - (smelt+sublim*1.e-3_kind_phys)*delt*newsnowratio) & ! sink: melting and sublimation, (swe) [m] - /rhonewsn)*rhowater ! snow accumulation in snow depth [mm] + snowfallac = snowfallac + newsn * 1.e3_kind_phys ! accumulated snow depth [mm], using variable snow density IF (debug_print ) THEN !if (abs(xlat-testptlat).lt.0.2 .and. abs(xlon-testptlon).lt.0.2)then @@ -5596,7 +5585,7 @@ SUBROUTINE SNOWTEMP( debug_print,xlat,xlon, & nmelt = 1 soiltfrac=snowfrac*tfrz+(one-snowfrac)*SOILT QSG=min(QSG, QSN(soiltfrac,TBQ)/PP) - qvg=qsg + qvg=snowfrac*qsg+(one-snowfrac)*qvg T3 = STBOLT*TN*TN*TN UPFLUX = T3 * 0.5_kind_phys*(TN + SOILTfrac) XINET = EMISS*(GLW-UPFLUX) From 8f54257bb79106320d6d366fe62f67b4f0640f01 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 15:48:05 +0000 Subject: [PATCH 114/132] add new flag to track new clm lake freezing grid and let gfs sfclay update stibility variables --- physics/GFS_surface_composites_pre.F90 | 4 +++- physics/clm_lake.f90 | 9 ++++++++- physics/clm_lake.meta | 7 +++++++ physics/sfc_diff.f | 4 +++- physics/sfc_diff.meta | 7 +++++++ 5 files changed, 28 insertions(+), 3 deletions(-) diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/GFS_surface_composites_pre.F90 index 98b9fecd2..fd16dea59 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/GFS_surface_composites_pre.F90 @@ -241,8 +241,10 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l !mjz tsfcl(i) = huge endif + if (icy(i) .or. wet(i)) then ! init uustar_ice for all water/ice grids + uustar_ice(i) = uustar(i) + endif if (icy(i)) then ! Ice - uustar_ice(i) = uustar(i) is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 if(lsm /= lsm_ruc .and. .not.is_clm) then weasd_ice(i) = weasd(i) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 620f79a96..64c458a36 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, ISLTYP, rainncprv, raincprv, & + flag_iter, lake_freeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & @@ -325,6 +325,8 @@ SUBROUTINE clm_lake_run( & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter + LOGICAL, DIMENSION(:), INTENT(INOUT) :: lake_freeze + INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP ! @@ -754,6 +756,11 @@ SUBROUTINE clm_lake_run( & weasd(i) = weasdi(i) snowd(i) = snodi(c) ! surface_snow_thickness_water_equivalent_over_ice + + if (icy(i) .eq. .false.) then + lake_freeze(i)=.true. + end if + ! Ice points are icy: icy(i)=.true. ! flag_nonzero_sea_ice_surface_fraction ice_points = ice_points+1 diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 11a44286a..31d0bdb6e 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -328,6 +328,13 @@ dimensions = (horizontal_loop_extent) type = logical intent = in +[lake_freeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout [isltyp] standard_name = soil_type_classification long_name = soil type at each grid cell diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 6e834537a..0607748b6 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -60,6 +60,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) + & lake_freeze, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) @@ -90,6 +91,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy + logical, dimension(:), intent(in) :: lake_freeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation @@ -168,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i)) then + if(flag_iter(i) .or. lake_freeze(i) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index eb30b8c50..7abb703cd 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -194,6 +194,13 @@ dimensions = () type = logical intent = in +[lake_freeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout [u10m] standard_name = x_wind_at_10m long_name = 10 meter u wind speed From b1bb75a8fca26ef8f790eb091c6f9db62809a94b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 18 Dec 2023 16:50:27 +0000 Subject: [PATCH 115/132] explain lakedepth corruption safeguards --- physics/clm_lake.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index f9341c87b..bc640e1e2 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -239,6 +239,9 @@ subroutine calculate_z_dz_lake(i,input_lakedepth,clm_lakedepth,z_lake,dz_lake) real(kind_lake) :: depthratio if (input_lakedepth(i) == spval .or. input_lakedepth(i) < 0.1) then + ! This is a safeguard against: + ! 1. missing in the lakedepth database (== spval) + ! 2. errors in model cycling or unexpected changes in the orography database (< 0.1) clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake) z_lake(1:nlevlake) = zlak(1:nlevlake) dz_lake(1:nlevlake) = dzlak(1:nlevlake) From c6e09641f25767d0008c7c555c2f10b53cb2d0aa Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 18 Dec 2023 18:10:48 +0000 Subject: [PATCH 116/132] explain the snow_mosaic=0 line --- physics/module_sf_ruclsm.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 9ac4493f7..b15592052 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -1703,6 +1703,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia IF (NEWSN > zero .and. snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN ! new snow KEEP_SNOW_ALBEDO = one + ! turn off separate treatment of snow covered and snow-free portions of the grid cell snow_mosaic=0. ! ??? ENDIF From 99997c677be9f60768a467996fb99ff993f51b0f Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 18:23:19 +0000 Subject: [PATCH 117/132] change lake_freeze intent to input only in sfc_diff meta --- physics/sfc_diff.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 7abb703cd..d10a29d29 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -200,7 +200,7 @@ units = flag dimensions = (horizontal_loop_extent) type = logical - intent = inout + intent = in [u10m] standard_name = x_wind_at_10m long_name = 10 meter u wind speed From 2ceb88bb7c32f37e80c63deba174c8ebb1240a85 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 18:49:05 +0000 Subject: [PATCH 118/132] add missing parentheses --- physics/sfc_diff.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 0607748b6..bf2e8cde0 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -170,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i) .or. lake_freeze(i) then + if(flag_iter(i) .or. lake_freeze(i)) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 From 8941516ed69145557a90794a2fb1253e373c3661 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 00:31:25 +0000 Subject: [PATCH 119/132] fix compiling error for gnu --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 64c458a36..f58da2fa3 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -757,7 +757,7 @@ SUBROUTINE clm_lake_run( & snowd(i) = snodi(c) ! surface_snow_thickness_water_equivalent_over_ice - if (icy(i) .eq. .false.) then + if (.not. icy(i)) then lake_freeze(i)=.true. end if From 0fbcc9f62ad182ded98fcde2e4c2287ee3334738 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 15:22:38 +0000 Subject: [PATCH 120/132] change name of lake_freeze to flag_lakefreeze --- physics/clm_lake.f90 | 6 +++--- physics/clm_lake.meta | 2 +- physics/sfc_diff.f | 6 +++--- physics/sfc_diff.meta | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index f58da2fa3..77d647812 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, lake_freeze, ISLTYP, rainncprv, raincprv, & + flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & @@ -325,7 +325,7 @@ SUBROUTINE clm_lake_run( & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter - LOGICAL, DIMENSION(:), INTENT(INOUT) :: lake_freeze + LOGICAL, DIMENSION(:), INTENT(INOUT) :: flag_lakefreeze INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP @@ -758,7 +758,7 @@ SUBROUTINE clm_lake_run( & if (.not. icy(i)) then - lake_freeze(i)=.true. + flag_lakefreeze(i)=.true. end if ! Ice points are icy: diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 31d0bdb6e..5c454dd11 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -328,7 +328,7 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[lake_freeze] +[flag_lakefreeze] standard_name = flag_for_lake_water_freeze long_name = flag for lake water freeze units = flag diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index bf2e8cde0..c5ed8bfa6 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -60,7 +60,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) - & lake_freeze, & !intent(in) + & flag_lakefreeze, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) @@ -91,7 +91,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy - logical, dimension(:), intent(in) :: lake_freeze + logical, dimension(:), intent(in) :: flag_lakefreeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation @@ -170,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i) .or. lake_freeze(i)) then + if(flag_iter(i) .or. flag_lakefreeze(i)) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index d10a29d29..1aaad7239 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -194,7 +194,7 @@ dimensions = () type = logical intent = in -[lake_freeze] +[flag_lakefreeze] standard_name = flag_for_lake_water_freeze long_name = flag for lake water freeze units = flag From a9208405adffd6b1b6389ac3f1331097b05069ad Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 16:45:32 +0000 Subject: [PATCH 121/132] remove excess whitespace --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 77d647812..607c0b2df 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & + flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & From 65358b905b40f16f4c5ee312025fb9cfc37dce89 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Tue, 19 Dec 2023 19:23:49 +0000 Subject: [PATCH 122/132] "update to address code reviewers' comments" --- physics/cu_gf_deep.F90 | 25 +- physics/cu_gf_driver.F90 | 7 +- physics/cu_gf_driver.meta | 2 +- physics/cu_gf_driver_post.F90 | 4 +- physics/cu_gf_driver_post.meta | 2 +- physics/cu_gf_driver_pre.F90 | 4 +- physics/cu_gf_driver_pre.meta | 2 +- physics/smoke_dust/coarsepm_settling_mod.F90 | 1 - physics/smoke_dust/dep_dry_mod_emerson.F90 | 104 ++------ physics/smoke_dust/dep_dry_simple_mod.F90 | 5 - physics/smoke_dust/dust_fengsha_mod.F90 | 3 - physics/smoke_dust/module_add_emiss_burn.F90 | 84 +++---- physics/smoke_dust/module_plumerise.F90 | 172 +++++++++++++ physics/smoke_dust/module_plumerise1.F90 | 225 ------------------ physics/smoke_dust/module_smoke_plumerise.F90 | 4 +- physics/smoke_dust/module_wetdep_ls.F90 | 3 + physics/smoke_dust/plume_data_mod.F90 | 1 - physics/smoke_dust/rrfs_smoke_config.F90 | 3 +- physics/smoke_dust/rrfs_smoke_postpbl.meta | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 156 ++++++------ physics/smoke_dust/rrfs_smoke_wrapper.meta | 17 +- physics/smoke_dust/seas_mod.F90 | 1 - 22 files changed, 354 insertions(+), 473 deletions(-) create mode 100755 physics/smoke_dust/module_plumerise.F90 delete mode 100755 physics/smoke_dust/module_plumerise1.F90 diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index ab72c662c..b45452000 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -223,6 +223,7 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (its:ite,nchem) & , intent (out) :: wetdpc_deep real(kind=kind_phys), intent (in) :: fscav(:) +!$acc declare copy(chem3d) copyout(wetdpc_deep) copyin(fscav) real(kind=kind_phys) & ,intent (in ) :: & @@ -314,6 +315,8 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (kts:kte) :: trac,trcflx_in,trcflx_out,trc,trco real(kind=kind_phys), dimension (its:ite,kts:kte) :: pwdper, massflx integer :: nv +!$acc declare create(chem,chem_cup,chem_up,chem_down,dellac,dellac2,chem_c,chem_pw,chem_pwd, & +!$acc chem_pwav,chem_psum,pwdper,massflux) real(kind=kind_phys), dimension (its:ite,kts:kte) :: & entr_rate_2d,mentrd_rate_2d,he,hes,qes,z, heo,heso,qeso,zo, & @@ -424,7 +427,7 @@ subroutine cu_gf_deep_run( & integer, dimension (its:ite,kts:kte) :: k_inv_layers real(kind=kind_phys), dimension (its:ite) :: c0 ! HCB real(kind=kind_phys), dimension (its:ite,kts:kte) :: c0t3d ! hli for smoke/dust wet scavenging -!$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0) +!$acc declare create(pmin_lev,start_level,ktopkeep,dtempdz,k_inv_layers,c0,c0t3d) ! rainevap from sas real(kind=kind_phys) zuh2(40) @@ -2046,6 +2049,7 @@ subroutine cu_gf_deep_run( & ! initialize tracers if they exist ! chem (:,:,:) = 0. +!$acc kernels do nv = 1,nchem do k = 1, ktf do i = 1, itf @@ -2069,7 +2073,7 @@ subroutine cu_gf_deep_run( & do i=its,itf if(ierr(i).eq.0)then do k=kts,jmin(i) - pwdper(i,k)=-edtc(i,1)*pwdo(i,k)/pwavo(i) + if(pwavo(i).ne.0.) pwdper(i,k)=-edtc(i,1)*pwdo(i,k)/pwavo(i) enddo pwdper(i,:)=0. do nv=1,nchem @@ -2094,8 +2098,6 @@ subroutine cu_gf_deep_run( & trash=chem_c(i,k,nv)/(1.+c0t3d(i,k)*dz) chem_pw=c0t3d(i,k)*dz*trash*zuo(i,k) chem_up(i,k,nv)=trash2+trash -! chem_pw(i,k,nv)=min(chem_up(i,k,nv),chem_c(i,k,nv)*pwo(i,k)/zuo(i,k)/(1.e-8+qrco(i,k))) -! chem_up(i,k,nv)=chem_up(i,k,nv)-chem_pw(i,k,nv) chem_pwav(i,nv)=chem_pwav(i,nv)+chem_pw(i,k,nv)! *g/dp enddo do k=ktop(i)+1,ktf @@ -2109,11 +2111,11 @@ subroutine cu_gf_deep_run( & do ki=jmin(i),2,-1 dp=100.*(po_cup(i,ki)-po_cup(i,ki+1)) chem_down(i,ki,nv)=(chem_down(i,ki+1,nv)*zdo(i,ki+1) & - -.5*dd_massdetro(i,ki)*chem_down(i,ki+1,nv)+ & + -.5_kind_phys*dd_massdetro(i,ki)*chem_down(i,ki+1,nv)+ & dd_massentro(i,ki)*chem(i,ki,nv)) / & - (zdo(i,ki+1)-.5*dd_massdetro(i,ki)+dd_massentro(i,ki)) + (zdo(i,ki+1)-.5_kind_phys*dd_massdetro(i,ki)+dd_massentro(i,ki)) chem_down(i,ki,nv)=chem_down(i,ki,nv)+pwdper(i,ki)*chem_pwav(i,nv) - chem_pwd(i,ki,nv)=max(0.,pwdper(i,ki)*chem_pwav(i,nv)) + chem_pwd(i,ki,nv)=max(0._kind_phys,pwdper(i,ki)*chem_pwav(i,nv)) enddo ! total wet deposition do k=1,ktf-1 @@ -2167,6 +2169,7 @@ subroutine cu_gf_deep_run( & dellac2(:,:,:)=0. massflx(:,:)=0. do nv=1,nchem +!$acc loop private(trcflx_in) do i=its,itf if(ierr(i).eq.0)then trcflx_in(:)=0. @@ -2174,8 +2177,8 @@ subroutine cu_gf_deep_run( & ! initialize fct routine do k=kts,ktop(i) - dp=100.*(po_cup(i,k)-po_cup(i,k+1)) - dtime_max=min(dtime_max,.5*dp) + dp=100._kind_phys*(po_cup(i,k)-po_cup(i,k+1)) + dtime_max=min(dtime_max,.5_kind_phys*dp) massflx(i,k)=-xmb(i)*(zuo(i,k)-edto(i)*zdo(i,k)) trcflx_in(k)=massflx(i,k)*chem_cup(i,k,nv) enddo @@ -2212,6 +2215,7 @@ subroutine cu_gf_deep_run( & wetdpc_deep(i,nv)=max(wetdpc_deep(i,nv),qamin) enddo enddo +!$acc end kernels endif ! nchem > 0 @@ -4345,6 +4349,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ,intent (in ) :: & kbcon,ktop,k22,xland1 !$acc declare copyin(p_cup,rho,q,zu,gamma_cup,qe_cup,up_massentr,up_massdetr,dby,qes_cup,z_cup,zqexec,c0,kbcon,ktop,k22,xland1) +!$acc declare copy(c0t3d) real(kind=kind_phys), intent (in ) :: & ! HCB ccnclean ! @@ -4421,7 +4426,9 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & c0_iceconv=0.01 c1d_b=c1d bdsp(:)=bdispm +!$acc kernels c0t3d = 0. +!$acc end kernels ! !--- no precip for small clouds diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index d8bc11629..e4a78b030 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -155,9 +155,10 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in ) :: imfshalcnv integer, dimension(:), intent(inout) :: cactiv,cactiv_m real(kind_phys), dimension(:), intent(in) :: fscav +!$acc declare copyin(fscav) real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d real(kind_phys), dimension(:,:), intent(inout) :: wetdpc_deep -!$acc declare copy(cactiv,cactiv_m) +!$acc declare copy(cactiv,cactiv_m,chem3d,wetdpc_deep) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -188,14 +189,14 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, dimension (im) :: k22s,kbcons,ktops,k22,jmin,jminm integer, dimension (im) :: kbconm,ktopm,k22m !$acc declare create(k22_shallow,kbcon_shallow,ktop_shallow,rand_mom,rand_vmas, & -!$acc rand_clos,gdc,gdc2,ht,ccn_gf,ccn_m,dx,frhm,frhd, & +!$acc rand_clos,gdc,gdc2,ht,ccn_gf,ccn_m,dx,frhm,frhd,wetdpc_mid, & !$acc outt,outq,outqc,phh,subm,cupclw,cupclws, & !$acc dhdt,zu,zus,zd,phf,zum,zdm,outum,outvm, & !$acc outts,outqs,outqcs,outu,outv,outus,outvs, & !$acc outtm,outqm,outqcm,submm,cupclwm, & !$acc cnvwt,cnvwts,cnvwtm,hco,hcdo,zdo,zdd,hcom,hcdom,zdom, & !$acc tau_ecmwf,edt,edtm,edtd,ter11,aa0,xlandi, & -!$acc pret,prets,pretm,hexec,forcing,forcing2, & +!$acc pret,prets,pretm,hexec,forcing,forcing2,wetdpc_mid, & !$acc kbcon, ktop,ierr,ierrs,ierrm,kpbli, & !$acc k22s,kbcons,ktops,k22,jmin,jminm,kbconm,ktopm,k22m) diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index d6d874f7e..dce20064a 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -614,7 +614,7 @@ intent = in [nchem] standard_name = number_of_chemical_species_vertically_mixed - long_name = number of chemical vertically mixed + long_name = number of chemical species vertically mixed units = count dimensions = () type = integer diff --git a/physics/cu_gf_driver_post.F90 b/physics/cu_gf_driver_post.F90 index 1700fbde9..6ed1321bc 100644 --- a/physics/cu_gf_driver_post.F90 +++ b/physics/cu_gf_driver_post.F90 @@ -35,7 +35,7 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) character(len=*), intent(out) :: errmsg -!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) +!$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m,chem3d,gq0) integer, intent(out) :: errflg ! Local variables @@ -61,13 +61,13 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m conv_act_m(i)=0.0 endif enddo -!$acc end kernels if (rrfs_sd) then gq0(:,:,ntsmoke ) = chem3d(:,:,1) gq0(:,:,ntdust ) = chem3d(:,:,2) gq0(:,:,ntcoarsepm) = chem3d(:,:,3) endif +!$acc end kernels end subroutine cu_gf_driver_post_run diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 4c04224dc..f8320d5c9 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -85,7 +85,7 @@ intent = out [rrfs_sd] standard_name = do_smoke_coupling - long_name = flag controlling rrfs_sd collection (default off) + long_name = flag controlling rrfs_sd collection units = flag dimensions = () type = logical diff --git a/physics/cu_gf_driver_pre.F90 b/physics/cu_gf_driver_pre.F90 index 6be7b8aec..7ff66be21 100644 --- a/physics/cu_gf_driver_pre.F90 +++ b/physics/cu_gf_driver_pre.F90 @@ -44,7 +44,7 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, real(kind_phys), intent(in) :: conv_act(:) real(kind_phys), intent(in) :: conv_act_m(:) real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) -!$acc declare copyin(conv_act,conv_act_m) +!$acc declare copyin(conv_act,conv_act_m) copy(chem3d,gq0) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -81,13 +81,13 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, kdt, fhour, dtp, t, q, !$acc kernels cactiv(:)=nint(conv_act(:)) cactiv_m(:)=nint(conv_act_m(:)) -!$acc end kernels if (rrfs_sd) then chem3d(:,:,1) = gq0(:,:,ntsmoke) chem3d(:,:,2) = gq0(:,:,ntdust) chem3d(:,:,3) = gq0(:,:,ntcoarsepm) endif +!$acc end kernels end subroutine cu_gf_driver_pre_run diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta index 6d8787d06..49cc98148 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/cu_gf_driver_pre.meta @@ -124,7 +124,7 @@ intent = in [rrfs_sd] standard_name = do_smoke_coupling - long_name = flag controlling rrfs_sd collection (default off) + long_name = flag controlling rrfs_sd collection units = flag dimensions = () type = logical diff --git a/physics/smoke_dust/coarsepm_settling_mod.F90 b/physics/smoke_dust/coarsepm_settling_mod.F90 index 49f229453..b044edb67 100755 --- a/physics/smoke_dust/coarsepm_settling_mod.F90 +++ b/physics/smoke_dust/coarsepm_settling_mod.F90 @@ -64,7 +64,6 @@ SUBROUTINE coarsepm_settling_driver(dt,t_phy, & airmas(1,1,kk)=-(p8w(i,k+1,j)-p8w(i,k,j))*area(i,j)/g airden(1,1,kk)=rho_phy(i,k,j) tmp(1,1,kk)=t_phy(i,k,j) -! rh(1,1,kk) = rel_hum(i,k,j) ! hli do nv = 1, num_chem chem_before(i,j,k,nv) = chem(i,k,j,nv) enddo diff --git a/physics/smoke_dust/dep_dry_mod_emerson.F90 b/physics/smoke_dust/dep_dry_mod_emerson.F90 index d2d34bb4e..76fdc2411 100755 --- a/physics/smoke_dust/dep_dry_mod_emerson.F90 +++ b/physics/smoke_dust/dep_dry_mod_emerson.F90 @@ -9,7 +9,7 @@ module dep_dry_emerson_mod use machine , only : kind_phys use dep_data_mod ! JLS - use rrfs_smoke_config + use rrfs_smoke_config, only : num_chem, p_smoke, p_dust_1, p_coarse_pm implicit none @@ -20,7 +20,7 @@ module dep_dry_emerson_mod contains subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & chem,delz,snowh,t_phy,p_phy,rho_phy,ivgtyp,g0,dt, & - settling_flag,drydep_flux,settling_flux, & + settling_flag,drydep_flux,settling_flux,dbg_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) @@ -38,13 +38,14 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & - INTENT(INOUT) :: ustar, rmol, znt, snowh + INTENT(IN) :: ustar, rmol, znt, snowh REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & INTENT(IN ) :: t_phy, rho_phy, p_phy, delz INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: ivgtyp REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & INTENT(INOUT ) :: chem REAL(kind_phys), INTENT(IN) :: g0,dt + LOGICAL, INTENT(IN) :: dbg_opt ! ! Output arrays REAL(kind_phys), DIMENSION( ims:ime, jms:jme, ndvel ), INTENT(INOUT) :: ddvel @@ -73,6 +74,7 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & real(kind_phys) :: Rs ! Surface resistance real(kind_phys) :: vgpart real(kind_phys) :: growth_fac,vsettl,dtmax,conver,converi,dzmin + real(kind_phys) :: rmol_local real(kind_phys), dimension( kts:kte) :: rho_col, delz_col real(kind_phys), dimension(ndvel) :: dt_settl, chem_before, chem_after real(kind_phys), dimension( kts:kte, ndvel ) :: cblk_col, vg_col @@ -93,6 +95,7 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & do j = jts, jte do i = its, ite aer_res(i,j) = 0.0 + rmol_local = rmol(i,j) do k = kts, kte delz_col(k) = delz(i,k,j) rho_col(k) = rho_phy(i,k,j) @@ -108,14 +111,9 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ! where beta = 1.458e-6 [ kg sec^-1 K**-0.5 ], s = 110.4 [ K ]. amu = 1.458E-6 * t_phy(i,k,j) * sqrt(t_phy(i,k,j)) / ( t_phy(i,k,j) + 110.4 ) ! Aerodynamic resistance - call depvel( rmol(i,j), dep_ref_hgt, znt(i,j), ustar(i,j), vgpart, aer_res(i,j) ) + call depvel( rmol_local, dep_ref_hgt, znt(i,j), ustar(i,j), vgpart, aer_res(i,j) ) ! depvel uses meters, need to convert to s/cm - aer_res(i,j) = max(aer_res(i,j)/100.,0.) - ! Get the aerosol properties dp and aerodens and mean free path (xlm) - ! FOR RRFS-SD, diameters and densities are explicityly defined - !call modpar( cblk,t_phy(i,k,j),p_phy(i,k,j), amu, & - ! pmasssn,pmassa,pmassc,pdensn,pdensa,pdensc, & - ! dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm, ndvel ) + aer_res(i,j) = max(aer_res(i,j)/100._kind_phys,0._kind_phys) ! Air kinematic viscosity (cm^2/s) airkinvisc = ( 1.8325e-4 * ( 416.16 / ( t_phy(i,k,j) + 120.0 ) ) * & ( ( t_phy(i,k,j) / 296.16 )**1.5 ) ) / ( rho_phy(i,k,j) / 28.966e3 ) ! Convert density to mol/cm^3 @@ -182,6 +180,10 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ! Compute final ddvel = aer_res + RS, set max at max_dep_vel in dep_data_mod.F[ m/s] ! The /100. term converts from cm/s to m/s, required for MYNN. ddvel(i,j,nv) = min( (1. / (aer_res(i,j) + Rs ))/100., max_dep_vel) + if ( dbg_opt ) then + WRITE(6,*) 'dry_dep_mod_emerson: i,j,nv',i,j,nv + WRITE(6,*) 'dry_dep_mod_emerson: deposition velocity (m/s) ',ddvel(i,j,nv) + endif drydep_flux(i,j,nv) = chem(i,kts,j,chem_pointers(nv))*p_phy(i,kts,j) / & (RSI*t_phy(i,kts,j))*ddvel(i,j,nv)*dt*1.E-6 endif ! k == kts @@ -216,9 +218,10 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ndt_settl(nv) = MAX( 1, INT( ntdt /dtmax) ) ! Limit maximum number of iterations IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12 - dt_settl(nv) = REAL(ntdt) / REAL(ndt_settl(nv)) + dt_settl(nv) = REAL(ntdt,kind=kind_phys) /REAL(ndt_settl(nv),kind=kind_phys) enddo do nv = 1, ndvel + chem_before(nv) = 0._kind_phys do k = kts, kte chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 enddo @@ -229,6 +232,8 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & endif ! Put cblk back into chem array do nv= 1, ndvel + chem_after(nv) = 0._kind_phys + settling_flux(i,j,nv) = 0._kind_phys do k = kts, kte chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv) chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 @@ -302,7 +307,7 @@ subroutine depvel( rmol, zr, z0, ustar, vgpart, aer_res ) ELSE IF (rmol==0.) THEN polint = 0.74*alog(zr/z0) ELSE - polint = 0.74*alog(zr/z0) + 4.7*rmol*(zr-z0) + polint = 0.74_kind_phys*alog(zr/z0) + 4.7_kind_phys*rmol*(zr-z0) END IF vgpart = ustar*vk/polint aer_res = polint/(karman*max(ustar,1.0e-4)) @@ -310,81 +315,6 @@ end subroutine depvel ! !-------------------------------------------------------------------------------- ! -subroutine modpar( cblk, blkta, blkprs, amu, & - pmassn,pmassa,pmassc, pdensn,pdensa,pdensc, & - dgnuc,dgacc,dgcor,knnuc,knacc,kncor, xlm,ndvel ) - IMPLICIT NONE - - INTEGER, INTENT(IN) :: ndvel - REAL(kind_phys), DIMENSION(ndvel), INTENT( IN) :: cblk - REAL(kind_phys), INTENT(IN ) :: blkta, blkprs, amu - REAL(kind_phys), INTENT(OUT) :: pmassn,pmassa,pmassc,pdensn,pdensa,pdensc, & - dgnuc,dgacc,dgcor,knnuc,knacc,kncor,xlm -! -! Local - REAL(kind_phys) :: xxlsgn,xxlsga,xxlsgc,l2sginin,l2sginia,l2sginic, & - en1,ea1,ec1,esn04,esa04,esc04, & - esn08,esa08,esc08,esn16,esa16,esc16, & - esn20,esa20,esc20,esn36,esa36,esc36 - REAL(kind_phys), DIMENSION( 6 ) :: nblk ! number densities -! Pointers - INTEGER, PARAMETER :: vnu0 = 1 - INTEGER, PARAMETER :: vac0 = 2 - INTEGER, PARAMETER :: vcorn = 3 - INTEGER, PARAMETER :: vnu3 = 4 - INTEGER, PARAMETER :: vac3 = 5 - INTEGER, PARAMETER :: vcor3 = 6 -! - xxlsgn = log(sginin) - xxlsga = log(sginia) - xxlsgc = log(sginic) - l2sginin = xxlsgn**2 - l2sginia = xxlsga**2 - l2sginic = xxlsgc**2 - en1 = exp(0.125*l2sginin) - ea1 = exp(0.125*l2sginia) - ec1 = exp(0.125*l2sginic) - esn04 = en1**4 - esa04 = ea1**4 - esc04 = ec1**4 - esn08 = esn04*esn04 - esa08 = esa04*esa04 - esc08 = esc04*esc04 - esn16 = esn08*esn08 - esa16 = esa08*esa08 - esc16 = esc08*esc08 - esn20 = esn16*esn04 - esa20 = esa16*esa04 - esc20 = esc16*esc04 - esn36 = esn16*esn20 - esa36 = esa16*esa20 - esc36 = esc16*esc20 -! First step in WRF-Chem is to add together the aitken, accumulation, and coarse modes -! Calculate number densities - nblk(vnu0) = max(conmin,0.0) - nblk(vnu3) = max(conmin,0.0) - nblk(vac0) = max(conmin, (cblk(1)/rhosmoke + cblk(2)/rhodust)*fact_wfa) - nblk(vcorn) = max(conmin, cblk(3)/rhodust*fact_wfa) - nblk(vac3) = max(conmin,smokefac*cblk(2) + dustfac*cblk(1)) ! Accumulation is smoke + fine dust - nblk(vcor3) = max(conmin,dustfac*cblk(3)) -! Dust in coarse - pmassn = max(conmin,0.0) - pmassa = max(conmin,cblk(1) + cblk(2)) - pmassc = max(conmin,cblk(3)) - pdensn = max(conmin,0.0) - pdensa = max(densmin,(f6dpim9*pmassa/nblk(vac3))) - pdensc = max(densmin,(f6dpim9*pmassc/nblk(vcor3))) -! Calculate mean free path - xlm = 6.6328E-8*pss0*blkta/(tss0*blkprs*1.e3) -! Calculate diameters - dgnuc = max(dgmin,0.0) - dgacc = max(dgmin,(nblk(vac3)/(nblk(vac0)*esa36))**one3) - dgcor = max(dgmin,(nblk(vcor3)/(nblk(vcorn)*esc36))**one3) -! Calculate Knudsen numbers - knnuc = 2.0*xlm/dgnuc - knacc = 2.0*xlm/dgacc - kncor = 2.0*xlm/dgcor -end subroutine modpar ! !-------------------------------------------------------------------------------- ! diff --git a/physics/smoke_dust/dep_dry_simple_mod.F90 b/physics/smoke_dust/dep_dry_simple_mod.F90 index 91e2997c5..e47d3d974 100755 --- a/physics/smoke_dust/dep_dry_simple_mod.F90 +++ b/physics/smoke_dust/dep_dry_simple_mod.F90 @@ -26,8 +26,6 @@ subroutine dry_dep_driver_simple(rmol,ust,ndvel,ddvel, & its,ite, jts,jte, kts,kte REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & INTENT(INOUT) :: ust, rmol -! REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & -! INTENT(IN ) :: rel_hum REAL(kind_phys), PARAMETER :: kpart=500. REAL(kind_phys) :: dvpart @@ -56,9 +54,6 @@ subroutine dry_dep_driver_simple(rmol,ust,ndvel,ddvel, & dvpart = dvpart*(1.+(-300.*rmol(i,j))**0.66667) ENDIF -! IF (rel_hum(i,1,j)>0.8) THEN ! HIGH RELATIVE HUMIDITY CORRECTION -! dvpart = dvpart*(1.+0.37*exp((rel_hum(i,1,j)-0.8)/0.2)) -! END IF ddvel(i,j,nv) = MIN(0.50,dvpart) ! m/s enddo enddo diff --git a/physics/smoke_dust/dust_fengsha_mod.F90 b/physics/smoke_dust/dust_fengsha_mod.F90 index 3902d6508..54e66712d 100755 --- a/physics/smoke_dust/dust_fengsha_mod.F90 +++ b/physics/smoke_dust/dust_fengsha_mod.F90 @@ -140,9 +140,6 @@ subroutine gocart_dust_fengsha_driver(dt, & endif ! limit where there is lots of vegetation - !if (sum(vegfra(i,:,j)) .gt. .17) then - ! ilwi = 0 - !endif ! limit where there is snow on the ground if (snowh(i,j) .gt. 0) then diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index 70c14c54c..95005b973 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -17,9 +17,9 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & IMPLICIT NONE - INTEGER, INTENT(IN ) :: julday, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & + INTEGER, INTENT(IN ) :: julday, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte real(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & @@ -49,14 +49,14 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & ! bx_bburn = 20.041288 * 3600., RAR: this depends on the vegetation class, location (local time) etc. real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation ! For Gaussian diurnal cycle - REAL, PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later - REAL, PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., & - coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. + real(kind_phys), PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later + real(kind_phys), PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., & + coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. !>-- Fire parameters - real(kind=kind_phys), dimension(1:5), parameter :: avg_fire_dur = (/8.9, 4.2, 3.3, 3.0, 1.4/) - real(kind=kind_phys), dimension(1:5), parameter :: sigma_fire_dur = (/8.7, 6.0, 5.5, 5.2, 2.4/) + real(kind_phys), dimension(1:5), parameter :: avg_fire_dur = (/8.9, 4.2, 3.3, 3.0, 1.4/) + real(kind_phys), dimension(1:5), parameter :: sigma_fire_dur = (/8.7, 6.0, 5.5, 5.2, 2.4/) - timeq= gmt*3600. + real(time_int,4) + timeq= gmt*3600._kind_phys + real(time_int,4) timeq= mod(timeq,timeq_max) @@ -94,28 +94,26 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. CASE (1) - ! these fires will have exponentially decreasing diurnal cycle, - ! these fires decrease 55% in 2 hours, end in 5 hours - ! r_q(i,j) = rinti* ax1 * exp(- (time_int**2)/(cx1**2) ) - ! We assume 1hr latency in ingesting the sat. data - coef_bb_dc(i,j) = 1./((2*pi)**0.5 * sigma_fire_dur(1) *fire_age) * & + ! these fires will have exponentially decreasing diurnal cycle, + ! We assume 1hr latency in ingesting the sat. data + coef_bb_dc(i,j) = 1._kind_phys/((2*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2*sigma_fire_dur(1)**2 )) CASE (3) - age_hr= fire_age/3600. + age_hr= fire_age/3600._kind_phys IF (swdown(i,j)<.1 .AND. age_hr> 12. .AND. fhist(i,j)>0.75) THEN - fhist(i,j)= 0.75 + fhist(i,j)= 0.75_kind_phys ENDIF IF (swdown(i,j)<.1 .AND. age_hr> 24. .AND. fhist(i,j)>0.5) THEN - fhist(i,j)= 0.5 + fhist(i,j)= 0.5_kind_phys ENDIF IF (swdown(i,j)<.1 .AND. age_hr> 48. .AND. fhist(i,j)>0.25) THEN - fhist(i,j)= 0.25 + fhist(i,j)= 0.25_kind_phys ENDIF ! this is based on hwp, hourly or instantenous TBD - dc_hwp= ebu_in(i,j)* hwp(i,j)/ MAX(1.,hwp_prevd(i,j)) - dc_hwp= MAX(0.,dc_hwp) + dc_hwp= ebu_in(i,j)* hwp(i,j)/ MAX(1._kind_phys,hwp_prevd(i,j)) + dc_hwp= MAX(0._kind_phys,dc_hwp) !coef_bb_dc(i,j)= sc_factor* fhist(i,j)* rate_ebb2(i,j)* (1. + log( !hwp_(i,j)/ hwp_day_avg(i,j))) @@ -124,33 +122,39 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & dt1= abs(timeq - peak_hr(i,j)) dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400. dtm= MIN(dt1,dt2) - dc_gp = rinti*( ax2 * exp(- dtm**2/(2.*cx2**2) ) + const2 - coef2*timeq ) - dc_gp = MAX(0.,dc_gp) + dc_gp = rinti*( ax2 * exp(- dtm**2/(2._kind_phys*cx2**2) ) + const2 - coef2*timeq ) + dc_gp = MAX(0._kind_phys,dc_gp) - dc_fn = MAX(dc_hwp/dc_gp,3.) - coef_bb_dc(i,j) = sc_factor* fhist(i,j)* dc_fn - - do k=kts,kfire_max - conv= coef_bb_dc(i,j)*dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) - - dm_smoke= conv*ebu(i,k,j) - ! print*,'hli dm_smoke',dm_smoke,conv,ebu(i,k,j,p_ebu_smoke) - - chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke - chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) - - if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then - WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k - WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv ',rho_phy(i,k,j),dz8w(i,k,j),conv - WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke - endif - enddo + dc_fn = MAX(dc_hwp/dc_gp,3._kind_phys) + coef_bb_dc(i,j) = fhist(i,j)* dc_fn CASE DEFAULT END SELECT enddo enddo endif + do j=jts,jte + do i=its,ite + do k=kts,kfire_max + if (ebb_dcycle==1) then + conv= dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) + elseif (ebb_dcycle==2) then + conv= sc_factor*coef_bb_dc(i,j)*dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) + endif + dm_smoke= conv*ebu(i,k,j) + chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke + chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) + + if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then + WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k + WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv',rho_phy(i,k,j),dz8w(i,k,j),conv + WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke + endif + enddo + enddo + enddo + + END subroutine add_emis_burn END module module_add_emiss_burn diff --git a/physics/smoke_dust/module_plumerise.F90 b/physics/smoke_dust/module_plumerise.F90 new file mode 100755 index 000000000..8a1d6ab25 --- /dev/null +++ b/physics/smoke_dust/module_plumerise.F90 @@ -0,0 +1,172 @@ +!>\file module_plumerise.F90 +!! This file is the fire plume rise driver. + + module module_plumerise + + use machine , only : kind_phys +! real(kind=kind_phys),parameter :: p1000mb = 100000. ! p at 1000mb (pascals) +!- Implementing the fire radiative power (FRP) methodology for biomass burning +!- emissions and convective energy estimation. +!- Saulo Freitas, Gabriel Pereira (INPE/UFJS, Brazil) +!- Ravan Ahmadov, Georg Grell (NOAA, USA) +!- The flag "plumerise_flag" defines the method: +!- =1 => original method +!- =2 => FRP based + +CONTAINS +subroutine ebu_driver ( flam_frac,ebu_in,ebu, & + theta_phy,q_vap, & ! RAR: moist is replaced with q_vap, SRB: t_phy is repalced by theta_phy + rho_phy,vvel,u_phy,v_phy,pi_phy, & ! SRB: p_phy is replaced by pi_phy + wind_phy, & ! SRB: added wind_phy + z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags + frp_inst, k_min, k_max, & ! RAR: + wind_eff_opt, & + kpbl_thetav, & ! SRB: added kpbl_thetav + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, errmsg, errflg) + + use rrfs_smoke_config + use plume_data_mod + USE module_zero_plumegen_coms + USE module_smoke_plumerise + IMPLICIT NONE + + REAL(kind_phys), PARAMETER :: frp_threshold= 1.e+7 ! Minimum FRP (Watts) to distribute smoke in PBL + + REAL(kind_phys), PARAMETER :: zpbl_threshold = 2000. ! SRB: Minimum PBL depth to have plume rise + REAL(kind_phys), PARAMETER :: uspd_threshold = 5. ! SRB: Wind speed averaged across PBL depth to control smoke release levels + REAL(kind_phys), PARAMETER :: frp_threshold500 = 500.e+6 ! SRB: Minimum FRP (Watts) to have plume rise + + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: frp_inst ! RAR: FRP array + + real(kind_phys), DIMENSION(ims:ime, jms:jme), INTENT(IN) :: kpbl_thetav ! SRB + + character(*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + INTEGER, INTENT(IN ) :: wind_eff_opt + real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: ebu + real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebu_in + real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac + real(kind=kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: z,z_at_w,vvel,u_phy,v_phy,rho_phy,pi_phy,q_vap,theta_phy,wind_phy ! RAR, SRB + +! Local variables... + INTEGER :: nv, i, j, k, kp1, kp2 + INTEGER, DIMENSION(ims:ime, jms:jme), INTENT (OUT) :: k_min, k_max ! Min and max ver. levels for BB injection spread + real(kind_phys), dimension (kte) :: u_in ,v_in ,w_in ,theta_in ,pi_in, rho_phyin ,qv_in ,zmid, z_lev, uspd ! SRB + real(kind=kind_phys) :: dz_plume, cpor, con_rocp, uspdavg ! SRB + + cpor =con_cp/con_rd + con_rocp=con_rd/con_cp + + IF ( dbg_opt ) then + WRITE(*,*) 'module_plumerise: its,ite,jts,jte ', its,ite,jts,jte + WRITE(*,*) 'module_plumerise: ims,ime,jms,jme ', ims,ime,jms,jme + WRITE(*,*) 'module_plumerise: maxval(ebu(:,kts,:)) ', maxval(ebu(:,kts,:)) + END IF + +! RAR: setting to zero the ebu emissions at the levels k>1, this is necessary when the plumerise is called, so the emissions at k>1 are updated + !do nv=1,num_ebu + do j=jts,jte + do k=kts+1,kte + do i=its,ite + ebu(i,k,j)=0. + enddo + enddo + enddo + !enddo + +! For now the flammable fraction is constant, based on the namelist. The next +! step to use LU index and meteorology to parameterize it + do j=jts,jte + do i=its,ite + flam_frac(i,j)= 0. + if (frp_inst(i,j) > frp_threshold) then + flam_frac(i,j)= 0.9 + end if + enddo + enddo + + +! RAR: new FRP based approach +! Haiqin: do_plumerise is added to the namelist options +check_pl: IF (do_plumerise) THEN ! if the namelist option is set for plumerise + do j=jts,jte + do i=its,ite + + do k=kts,kte + u_in(k)= u_phy(i,k,j) + v_in(k)= v_phy(i,k,j) + w_in(k)= vvel(i,k,j) + qv_in(k)= q_vap(i,k,j) + pi_in(k)= pi_phy(i,k,j) + zmid(k)= z(i,k,j)-z_at_w(i,kts,j) + z_lev(k)= z_at_w(i,k,j)-z_at_w(i,kts,j) + rho_phyin(k)= rho_phy(i,k,j) + theta_in(k)= theta_phy(i,k,j) + uspd(k)= wind_phy(i,k,j) ! SRB + enddo + + IF (dbg_opt) then + WRITE(*,*) 'module_plumerise: i,j ',i,j + WRITE(*,*) 'module_plumerise: frp_inst(i,j) ',frp_inst(i,j) + WRITE(*,*) 'module_plumerise: ebu(i,kts,j) ',ebu(i,kts,j) + WRITE(*,*) 'module_plumerise: u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) ',u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) + WRITE(*,*) 'module_plumerise: zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) ',zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) + END IF + +! RAR: the plume rise calculation step: + CALL plumerise(kte,1,1,1,1,1,1, & + u_in, v_in, w_in, theta_in ,pi_in, & + rho_phyin, qv_in, zmid, z_lev, & + wind_eff_opt, & + frp_inst(i,j), k_min(i,j), & + k_max(i,j), dbg_opt, g, con_cp, & + con_rd, cpor, errmsg, errflg ) + if(errflg/=0) return + + kp1= k_min(i,j) + kp2= k_max(i,j) + dz_plume= z_at_w(i,kp2,j) - z_at_w(i,kp1,j) + +! SRB: Adding condition for overwriting plumerise levels + uspdavg=SUM(uspd(kts:kpbl_thetav(i,j)))/kpbl_thetav(i,j) !Average wind speed within the boundary layer + + IF ((frp_inst(i,j) .gt. frp_threshold) .AND. (frp_inst(i,j) .le. frp_threshold500) .AND. & + (z_at_w(i,kpbl_thetav(i,j),j) .gt. zpbl_threshold) .AND. (wind_eff_opt .eq. 1)) THEN + kp1=1 + IF (uspdavg .ge. uspd_threshold) THEN ! Too windy + kp2=kpbl_thetav(i,j)/3 + ELSE + kp2=kpbl_thetav(i,j) + END IF + dz_plume= z_at_w(i,kp2,j) - z_at_w(i,kp1,j) + do k=kp1,kp2-1 + ebu(i,k,j)= ebu_in(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume + enddo + ELSE + do k=kp1,kp2-1 + ebu(i,k,j)= flam_frac(i,j)* ebu_in(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume + enddo + ebu(i,kts,j)= (1.-flam_frac(i,j))* ebu_in(i,j) + END IF +! SRB: End modification + + IF ( dbg_opt ) then + WRITE(*,*) 'module_plumerise: i,j ',i,j + WRITE(*,*) 'module_plumerise: k_min(i,j), k_max(i,j) ',kp1, kp2 ! SRB: replaced k_min, k_max with kp1, kp2 + END IF +! endif check_frp + enddo + enddo + + ENDIF check_pl + +end subroutine ebu_driver + +END module module_plumerise diff --git a/physics/smoke_dust/module_plumerise1.F90 b/physics/smoke_dust/module_plumerise1.F90 deleted file mode 100755 index f98350130..000000000 --- a/physics/smoke_dust/module_plumerise1.F90 +++ /dev/null @@ -1,225 +0,0 @@ -!>\file module_plumerise1.F90 -!! This file is the fire plume rise driver. - - module module_plumerise1 - - use machine , only : kind_phys - real(kind=kind_phys),parameter :: p1000mb = 100000. ! p at 1000mb (pascals) -!- Implementing the fire radiative power (FRP) methodology for biomass burning -!- emissions and convective energy estimation. -!- Saulo Freitas, Gabriel Pereira (INPE/UFJS, Brazil) -!- Ravan Ahmadov, Georg Grell (NOAA, USA) -!- The flag "plumerise_flag" defines the method: -!- =1 => original method -!- =2 => FRP based -!------------------------------------------------------------------------- -! -! use module_zero_plumegen_coms -! integer, parameter :: nveg_agreg = 4 -! integer, parameter :: tropical_forest = 1 -! integer, parameter :: boreal_forest = 2 -! integer, parameter :: savannah = 3 - -! integer, parameter :: grassland = 4 -! real(kind_phys), dimension(nveg_agreg) :: firesize,mean_fct -! character(len=20), parameter :: veg_name(nveg_agreg) = (/ & -! 'Tropical-Forest', & -! 'Boreal-Forest ', & -! 'Savanna ', & -! 'Grassland ' /) -! character(len=20), parameter :: spc_suf(nveg_agreg) = (/ & -! 'agtf' , & ! trop forest -! 'agef' , & ! extratrop forest -! 'agsv' , & ! savanna -! 'aggr' /) ! grassland - -CONTAINS -subroutine ebu_driver ( flam_frac,ebu_in,ebu,coef_bb_dc, & - t_phy,q_vap, & ! RAR: moist is replaced with q_vap - rho_phy,vvel,u_phy,v_phy,p_phy, & - z_at_w,z,g,con_cp,con_rd, & ! scale_fire_emiss is part of config_flags - frp_hr, k_min, k_max, & ! RAR: - wind_eff_opt, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, errmsg, errflg) - - use rrfs_smoke_config - use plume_data_mod - USE module_zero_plumegen_coms - USE module_smoke_plumerise - IMPLICIT NONE - - REAL(kind_phys), PARAMETER :: frp_threshold= 1.e+7 ! Minimum FRP (Watts) to have plume rise - - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: frp_hr ! RAR: FRP array - -! TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - character(*), intent(inout) :: errmsg - integer, intent(inout) :: errflg - INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte - INTEGER, INTENT(IN ) :: wind_eff_opt -! real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), & -! INTENT(IN ) :: moist - real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: ebu - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: coef_bb_dc ! RAR: - real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ebu_in - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), INTENT(OUT ) :: flam_frac - real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ) :: frp_hr_coef_bb_dc - -! real(kind=kind_phys), DIMENSION( ims:ime, 1, jms:jme ), & -! INTENT(IN ) :: ebu_in -! real(kind=kind_phys), DIMENSION( ims:ime, jms:jme ), & -! INTENT(IN ) :: & -! mean_fct_agtf,mean_fct_agef,& -! mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, & -! firesize_agsv,firesize_aggr - - real(kind=kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: t_phy,z,z_at_w,vvel,u_phy,v_phy,rho_phy,p_phy,q_vap ! RAR - ! real(kind=kind_phys), INTENT(IN ) :: dtstep - -! Local variables... - INTEGER :: nv, i, j, k, kp1, kp2 - INTEGER, DIMENSION(ims:ime, jms:jme), INTENT (OUT) :: k_min, k_max ! Min and max ver. levels for BB injection spread - !real(kind_phys), dimension (num_ebu) :: eburn_in - !real(kind_phys), dimension (kte,num_ebu) :: eburn_out - real(kind_phys), dimension (kte) :: u_in ,v_in ,w_in ,theta_in ,pi_in, rho_phyin ,qv_in ,zmid, z_lev - real(kind=kind_phys) :: dz_plume, cpor, con_rocp - - !INTEGER, PARAMETER :: kfire_max=30 -! real(kind_phys), dimension(nveg_agreg) :: firesize,mean_fct -! real(kind_phys) :: sum, ffirs, ratio -! real(kind_phys),save,dimension(its:ite,jts:jte) :: ffirs -! nspecies=num_ebu -! write(0,*)'plumerise' - -! RAR: -! do j=jts,jte: -! do i=its,ite -! ebu(i,kts,j,p_ebu_smoke)= ebb_smoke(i,j) -! ebu(i,kts,j,p_ebu_no) = ebu_in(i,1,j,p_ebu_in_no) -! ebu(i,kts,j,p_ebu_co) = ebu_in(i,1,j,p_ebu_in_co) -! ebu(i,kts,j,p_ebu_so2) = ebu_in(i,1,j,p_ebu_in_so2) -! ebu(i,kts,j,p_ebu_dms) = ebu_in(i,1,j,p_ebu_in_dms) -! ebu(i,kts,j,p_ebu_oc) = ebu_in(i,1,j,p_ebu_in_oc) -! ebu(i,kts,j,p_ebu_bc) = ebu_in(i,1,j,p_ebu_in_bc) -! ebu(i,kts,j,p_ebu_pm25) = ebu_in(i,1,j,p_ebu_in_pm25) -! ebu(i,kts,j,p_ebu_pm10) = ebu_in(i,1,j,p_ebu_in_pm10) -! enddo -! enddo - cpor =con_cp/con_rd - con_rocp=con_rd/con_cp - - IF ( dbg_opt ) then - WRITE(*,*) 'module_plumerise1: its,ite,jts,jte ', its,ite,jts,jte - WRITE(*,*) 'module_plumerise1: ims,ime,jms,jme ', ims,ime,jms,jme - !WRITE(*,*) 'module_plumerise1: p_ebu_smoke,num_ebu: ', p_ebu_smoke,num_ebu - WRITE(*,*) 'module_plumerise1: maxval(ebu(:,kts,:)) ', maxval(ebu(:,kts,:)) - END IF - !endif - -! RAR: setting to zero the ebu emissions at the levels k>1, this is necessary when the plumerise is called, so the emissions at k>1 are updated - !do nv=1,num_ebu - do j=jts,jte - do k=kts+1,kte - do i=its,ite - ebu(i,k,j)=0. - enddo - enddo - enddo - !enddo - -! Apply the diurnal cycle coefficient - do j=jts,jte - do i=its,ite - frp_hr_coef_bb_dc(i,j) = frp_hr(i,j)*coef_bb_dc(i,j) - enddo - enddo - -! For now the flammable fraction is constant, based on the namelist. The next -! step to use LU index and meteorology to parameterize it - do j=jts,jte - do i=its,ite - flam_frac(i,j)= 0. - if (frp_hr_coef_bb_dc(i,j) > frp_threshold) then - flam_frac(i,j)= 0.9 - end if - enddo - enddo - - -! RAR: new FRP based approach -!check_pl: IF (config_flags%plumerise_flag == 2 ) THEN ! if the namelist option is set for plumerise -! Haiqin: plumerise_flag is added to the namelist options -check_pl: IF (do_plumerise) THEN ! if the namelist option is set for plumerise - do j=jts,jte - do i=its,ite - ! k_min(i,j)=0 - ! k_max(i,j)=0 - -! check_frp: if (.NOT.do_plumerise) then ! namelist option -! ebu(i,kts,j)= ebb_smoke(i,j) -! else - - do k=kts,kte - u_in(k)= u_phy(i,k,j) - v_in(k)= v_phy(i,k,j) - w_in(k)= vvel(i,k,j) - qv_in(k)= q_vap(i,k,j) ! RAR: moist(i,k,j,p_qv) - !pi_in(k)= cp*(p_phy(i,k,j)/p1000mb)**rcp - pi_in(k)= con_cp*(p_phy(i,k,j)/p1000mb)**con_rocp - zmid(k)= z(i,k,j)-z_at_w(i,kts,j) - z_lev(k)= z_at_w(i,k,j)-z_at_w(i,kts,j) - rho_phyin(k)= rho_phy(i,k,j) - theta_in(k)= t_phy(i,k,j)/pi_in(k)*con_cp - !theta_in(k)= t_phy(i,k,j)/pi_in(k)*cp - enddo - - IF (dbg_opt) then - WRITE(*,*) 'module_plumerise1: i,j ',i,j - WRITE(*,*) 'module_plumerise1: frp_hr(i,j) ',frp_hr_coef_bb_dc(i,j) - WRITE(*,*) 'module_plumerise1: ebu(i,kts,j) ',ebu(i,kts,j) - WRITE(*,*) 'module_plumerise1: u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) ',u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) - WRITE(*,*) 'module_plumerise1: zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) ',zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) - WRITE(*,*) 'module_plumerise1: t_phy(i,kte,j),pi_in(kte)',t_phy(i,kte,j),pi_in(kte) - END IF - -! RAR: the plume rise calculation step: - CALL plumerise(kte,1,1,1,1,1,1, & - !firesize,mean_fct, & - !num_ebu, eburn_in, eburn_out, & - u_in, v_in, w_in, theta_in ,pi_in, & - rho_phyin, qv_in, zmid, z_lev, & - wind_eff_opt, & - frp_hr_coef_bb_dc(i,j), k_min(i,j), & - k_max(i,j), dbg_opt, g, con_cp, & - con_rd, cpor, errmsg, errflg ) - !k_max(i,j), config_flags%debug_chem ) - if(errflg/=0) return - - kp1= k_min(i,j) - kp2= k_max(i,j) - dz_plume= z_at_w(i,kp2,j) - z_at_w(i,kp1,j) - - do k=kp1,kp2-1 - ebu(i,k,j)= flam_frac(i,j)* ebu_in(i,j)* (z_at_w(i,k+1,j)-z_at_w(i,k,j))/dz_plume - enddo - ebu(i,kts,j)= (1.-flam_frac(i,j))* ebu_in(i,j) - - IF ( dbg_opt ) then - WRITE(*,*) 'module_plumerise1: i,j ',i,j - WRITE(*,*) 'module_plumerise1: k_min(i,j), k_max(i,j) ',k_min(i,j), k_max(i,j) - END IF -! endif check_frp - enddo - enddo - - ENDIF check_pl - -end subroutine ebu_driver - -END module module_plumerise1 diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index d80eaeb62..0fca91de4 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -24,9 +24,7 @@ module module_smoke_plumerise CONTAINS ! RAR: - subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & -! firesize,mean_fct, & - ! nspecies,eburn_in,eburn_out, & + subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & wind_eff_opt, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & diff --git a/physics/smoke_dust/module_wetdep_ls.F90 b/physics/smoke_dust/module_wetdep_ls.F90 index b9d52cb49..8ba8f67d9 100755 --- a/physics/smoke_dust/module_wetdep_ls.F90 +++ b/physics/smoke_dust/module_wetdep_ls.F90 @@ -32,6 +32,9 @@ subroutine wetdep_ls(dt,var,rain,moist, integer :: nv,i,j,k,km,kb,kbeg !real(kind_phys), parameter :: alpha = .5 ! scavenging factor + wetdpr_smoke =0. + wetdpr_dust =0. + wetdpr_coarsepm=0. do nv=1,nchem do i=its,ite diff --git a/physics/smoke_dust/plume_data_mod.F90 b/physics/smoke_dust/plume_data_mod.F90 index 2bf91dbfa..3f0bcdecd 100755 --- a/physics/smoke_dust/plume_data_mod.F90 +++ b/physics/smoke_dust/plume_data_mod.F90 @@ -45,7 +45,6 @@ module plume_data_mod integer, parameter :: savannah = 3 integer, parameter :: grassland = 4 integer, parameter :: nveg_agreg = 4 -! integer, parameter :: wind_eff = 1 public diff --git a/physics/smoke_dust/rrfs_smoke_config.F90 b/physics/smoke_dust/rrfs_smoke_config.F90 index 5f8f02e7b..d7478986b 100755 --- a/physics/smoke_dust/rrfs_smoke_config.F90 +++ b/physics/smoke_dust/rrfs_smoke_config.F90 @@ -31,6 +31,7 @@ module rrfs_smoke_config integer :: ebb_dcycle = 2 ! 1: read in ebb_smoke(i,24), 2: daily logical :: dbg_opt = .true. logical :: aero_ind_fdb = .false. + logical :: add_fire_heat_flux= .false. logical :: do_rrfs_sd = .true. ! integer :: wind_eff_opt = 1 logical :: extended_sd_diags = .false. @@ -40,8 +41,6 @@ module rrfs_smoke_config integer, parameter :: CHEM_OPT_GOCART= 1 integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5 - integer, parameter :: DUST_OPT_FENGSHA = 5 - ! -- hydrometeors integer, parameter :: p_qv=1 integer, parameter :: p_qc=2 diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 5f8ca2a8e..392a6ea6b 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] name = rrfs_smoke_postpbl_run diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index f4e28be3a..afd386595 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -9,9 +9,9 @@ module rrfs_smoke_wrapper addsmoke_flag, plumerisefire_frq, wetdep_ls_opt, & drydep_opt, pm_settling, aero_ind_fdb, ebb_dcycle, & dbg_opt,smoke_forecast,wetdep_ls_alpha,do_rrfs_sd, & - ebb_dcycle, extended_sd_diags, & + ebb_dcycle, extended_sd_diags,add_fire_heat_flux, & num_moist, num_chem, num_emis_seas, num_emis_dust, & - DUST_OPT_FENGSHA, p_qv, p_atm_shum, p_atm_cldq, & + p_qv, p_atm_shum, p_atm_cldq, & p_smoke, p_dust_1, p_coarse_pm, epsilc use dust_data_mod, only : dust_alpha, dust_gamma, dust_moist_opt, & dust_moist_correction, dust_drylimit_factor @@ -20,7 +20,7 @@ module rrfs_smoke_wrapper use dep_dry_simple_mod, only : dry_dep_driver_simple use dep_dry_emerson_mod, only : dry_dep_driver_emerson use module_wetdep_ls, only : wetdep_ls - use module_plumerise1, only : ebu_driver + use module_plumerise, only : ebu_driver use module_add_emiss_burn, only : add_emis_burn use coarsepm_settling_mod, only : coarsepm_settling_driver @@ -30,7 +30,7 @@ module rrfs_smoke_wrapper public :: rrfs_smoke_wrapper_run, rrfs_smoke_wrapper_init - integer :: wind_eff_opt + integer :: plume_wind_eff contains @@ -45,7 +45,7 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, drydep_opt_in, pm_settling_in, & ! Dry Dep namelist wetdep_ls_opt_in,wetdep_ls_alpha_in, & ! Wet dep namelist rrfs_sd, do_plumerise_in, plumerisefire_frq_in, & ! smoke namelist - wind_eff_opt_in, & ! smoke namelist + plume_wind_eff_in,add_fire_heat_flux_in, & ! smoke namelist addsmoke_flag_in, ebb_dcycle_in, smoke_forecast_in, & ! Smoke namelist dust_opt_in, dust_alpha_in, dust_gamma_in, & ! Dust namelist dust_moist_opt_in, & ! Dust namelist @@ -61,8 +61,8 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, real(kind_phys), intent(in) :: dust_drylimit_factor_in integer, intent(in) :: dust_opt_in,dust_moist_opt_in, wetdep_ls_opt_in, pm_settling_in, seas_opt_in integer, intent(in) :: drydep_opt_in - logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in, extended_sd_diags_in - integer, intent(in) :: smoke_forecast_in, wind_eff_opt_in, plumerisefire_frq_in + logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in, extended_sd_diags_in, add_fire_heat_flux_in + integer, intent(in) :: smoke_forecast_in, plume_wind_eff_in, plumerisefire_frq_in integer, intent(in) :: addsmoke_flag_in, ebb_dcycle_in logical, intent(in) :: do_plumerise_in, rrfs_sd character(len=*),intent(out):: errmsg @@ -93,7 +93,8 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, plumerisefire_frq = plumerisefire_frq_in addsmoke_flag = addsmoke_flag_in smoke_forecast = smoke_forecast_in - wind_eff_opt = wind_eff_opt_in + plume_wind_eff = plume_wind_eff_in + add_fire_heat_flux = add_fire_heat_flux_in !>-Feedback aero_ind_fdb = aero_ind_fdb_in !>-Other @@ -110,14 +111,14 @@ end subroutine rrfs_smoke_wrapper_init subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, & u10m, v10m, ustar, rlat, rlon, tskin, pb2d, t2m, dpt2m, & pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w, & - nsoil, smc, vegtype_dom, vegtype_frac,soiltyp,nlcat, & + nsoil, smc, vegtype_dom, vegtype_frac, soiltyp, nlcat, & dswsfc, zorl, snow, julian,recmol, & idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv, & dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS, & ntrac, qgrs, gq0, chem3d, tile_num, & ntsmoke, ntdust, ntcoarsepm, imp_physics, imp_physics_thompson, & nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & - ebb_smoke_in, frp_input, coef_bb, ebu_smoke,fhist,min_fplume, & + ebb_smoke_in, frp_output, coef_bb, ebu_smoke,fhist,min_fplume, & max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, & fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & errmsg,errflg ) @@ -148,7 +149,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(:,:,:), intent(inout) :: qgrs, gq0 real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc - real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_input, fhist + real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_output, fhist real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke real(kind_phys), dimension(:,:), intent(inout) :: fire_in real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out @@ -169,8 +170,9 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !>-- Local Variables real(kind_phys), dimension(ims:im, kms:kme, jms:jme) :: ebu real(kind_phys), dimension(1:im, 1:kme,jms:jme) :: rri, t_phy, u_phy, v_phy, & - p_phy, z_at_w, dz8w, p8w, t8w, rho_phy, vvel, zmid - real(kind_phys), dimension(ims:im, jms:jme) :: u10, v10, ust, tsk, & + p_phy,pi_phy,wind_phy,theta_phy,z_at_w, dz8w, p8w, t8w, & + rho_phy, vvel, zmid + real(kind_phys), dimension(ims:im, jms:jme) :: frp_inst, u10, v10, ust, tsk, & xland, xlat, xlong, dxy, pbl, hfx, rnav, hwp_local, & wetdpr_smoke_local, wetdpr_dust_local, wetdpr_coarsepm_local !>- sea salt & chemistry variables @@ -183,8 +185,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys) :: gmt !>- dust & chemistry variables real(kind_phys), dimension(ims:im, jms:jme) :: ssm, rdrag, uthr, snowh ! fengsha dust - real(kind_phys), dimension(ims:im, nlcat, jms:jme) :: vegfrac real(kind_phys), dimension(ims:im, jms:jme) :: rmol, swdown, znt, clayf, sandf + real(kind_phys), dimension(ims:im, nlcat, jms:jme) :: vegfrac real(kind_phys), dimension(ims:im, nsoil, jms:jme) :: smois real(kind_phys), dimension(ims:im, 1:1, jms:jme, 1:num_emis_dust) :: emis_dust integer, dimension(ims:im, jms:jme) :: isltyp, ivgtyp @@ -192,9 +194,9 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ! -- buffers real(kind_phys), dimension(ims:im, jms:jme ) :: coef_bb_dc, flam_frac, frp_in, & fire_hist, peak_hr, lu_nofire, lu_qfire, ebu_in, & - fire_end_hr, hwp_day_avg + fire_end_hr, hwp_day_avg, kpbl_thetav integer, dimension(ims:im, jms:jme ) :: min_fplume2, max_fplume2, fire_type - logical :: call_fire, reset_hwp_ave + logical :: call_plume, reset_hwp_ave !>- optical variables real(kind_phys), dimension(ims:im, jms:jme, ndvel) :: ddvel, settling_flux, drydep_flux_local real(kind_phys), dimension(ims:im, kms:kme, jms:jme, ndvel) :: vgrav @@ -204,8 +206,6 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !> -- parameter to caluclate wfa&ifa (m) real(kind_phys), parameter :: mean_diameter1= 4.E-8, sigma1=1.8 real(kind_phys), parameter :: mean_diameter2= 1.E-6, sigma2=1.8 - ! real(kind_phys), parameter :: kappa_oc = 0.2 - ! real(kind_phys), parameter :: kappa_dust = 0.04 real(kind_phys) :: fact_wfa, fact_ifa !> -- aerosol density (kg/m3) real(kind_phys), parameter :: density_dust= 2.6e+3, density_sulfate=1.8e+3 @@ -247,7 +247,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, curr_secs = ktau * dt current_month=jdate(2) ! needed for the dust input data current_hour =jdate(5)+1 ! =1 at 00Z - hour_int=ktau*dt/3600. ! hours since the simulation start + hour_int=floor(ktau*dt/3600.) ! hours since the simulation start gmt = real(mod(idat(5)+hour_int,24)) julday = int(julian) @@ -268,25 +268,25 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, reset_hwp_ave = mod(int(curr_secs-dt),3600) == 0 ! plumerise frequency in minutes set up by the namelist input - call_fire = (do_plumerise .and. (plumerisefire_frq > 0)) - if (call_fire) call_fire = (mod(int(curr_secs), max(1, 60*plumerisefire_frq)) == 0) .or. (ktau == 2) + call_plume = (do_plumerise .and. (plumerisefire_frq > 0)) + if (call_plume) call_plume = (mod(int(curr_secs), max(1, 60*plumerisefire_frq)) == 0) .or. (ktau == 2) !>- get ready for chemistry run call rrfs_smoke_prep( & - ktau,current_month, current_hour, gmt, con_rd, con_fv, & + ktau,current_month, current_hour, gmt, con_rd, con_fv, con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,tskin, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & snow,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & - rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & - t8w,recmol, & + rri,t_phy,u_phy,v_phy,p_phy,pi_phy,wind_phy,theta_phy, & + rho_phy,dz8w,p8w,t8w,recmol, & z_at_w,vvel,zmid, & ntrac,gq0, & num_chem,num_moist, & ntsmoke, ntdust,ntcoarsepm, & - moist,chem,ebu_in,ebb_smoke_in, & + moist,chem,ebu_in,kpbl_thetav,ebb_smoke_in, & fhist,frp_in, hwp_day_avg, fire_end_hr, & emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & snowh,clayf,rdrag,sandf,ssm,uthr,oro, hwp_local, & @@ -315,15 +315,16 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !RAR: change this to the fractional LU type; fire_type: 0- no fires, 1- Ag ! or urban fires, 2- prescribed fires in wooded area, 3- wildfires + if (ebb_dcycle==2) then do j=jts,jte do i=its,ite if (ebu_in(i,j)<0.01) then fire_type(i,j) = 0 else ! Permanent wetlands, snow/ice, water, barren tundra - lu_nofire(i,j) = vegfrac(i,11,j) + vegfrac(i,15,j) + vegfrac(i,17,j) + vegfrac(i,20,j) + lu_nofire(i,j) = vegfrac(i,11,j) + vegfrac(i,15,j) + vegfrac(i,17,j) + vegfrac(i,20,j) ! cropland, urban, cropland/natural mosaic, barren and sparsely vegetated - lu_qfire(i,j) = vegfrac(i,12,j) + vegfrac(i,13,j) + vegfrac(i,14,j) + vegfrac(i,16,j) + lu_qfire(i,j) = vegfrac(i,12,j) + vegfrac(i,13,j) + vegfrac(i,14,j) + vegfrac(i,16,j) if (lu_nofire(i,j)>0.95) then fire_type(i,j) = 0 else if (lu_qfire(i,j)>0.95) then @@ -334,6 +335,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, end if end do end do + endif !>- compute sea-salt ! -- compute sea salt (opt=1) @@ -348,7 +350,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, endif !-- compute dust (opt=5) - if (dust_opt==DUST_OPT_FENGSHA) then + if (dust_opt==5) then call gocart_dust_fengsha_driver(dt,chem,rho_phy,smois,p8w,ssm, & isltyp,snowh,xland,dxy,g,emis_dust,ust,znt, & clayf,sandf,rdrag,uthr, & @@ -364,9 +366,9 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !-- /scratch2/BMC/ap-fc/Ravan/rapid-refresh/WRFV3.9/smoke ! Every hour (per namelist) the ebu_driver is called to calculate ebu, but ! the plumerise is controlled by the namelist option of plumerise_flag - !if (add_fire_heat_flux) then - do i = its,ite - if ( frp_in(i,1) .ge. 1.E7 ) then + if (add_fire_heat_flux) then + do i = its,ite + if ( coef_bb_dc(i,1)*frp_in(i,1) .ge. 1.E7 ) then fire_heat_flux_out(i) = min(max(0.,0.88*coef_bb_dc(i,1)*frp_in(i,1) / & 0.55/dxy(i,1)) ,5000.) ! JLS - W m-2 [0 - 10,000] frac_grid_burned_out(i) = min(max(0., 1.3*0.0006*coef_bb_dc(i,1)*frp_in(i,1)/dxy(i,1) ),1.) @@ -374,17 +376,24 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, fire_heat_flux_out(i) = 0.0 frac_grid_burned_out(i) = 0.0 endif - enddo - !endif - if (call_fire) then + enddo + endif + if (call_plume) then + ! Apply the diurnal cycle coefficient to frp_inst () + do j=jts,jte + do i=its,ite + frp_inst(i,j) = frp_in(i,j)*coef_bb_dc(i,j) + enddo + enddo + call ebu_driver ( & flam_frac,ebu_in,ebu, & - coef_bb_dc, & - t_phy,moist(:,:,:,p_qv), & - rho_phy,vvel,u_phy,v_phy,p_phy, & + theta_phy,moist(:,:,:,p_qv), & + rho_phy,vvel,u_phy,v_phy,pi_phy,wind_phy, & z_at_w,zmid,g,con_cp,con_rd, & - frp_in, min_fplume2, max_fplume2, & ! new approach - wind_eff_opt, & + frp_inst, min_fplume2, max_fplume2, & + plume_wind_eff, & + kpbl_thetav, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, errmsg, errflg ) @@ -419,7 +428,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, if (drydep_opt == 1) then call dry_dep_driver_emerson(rmol,ust,znt,ndvel,ddvel, & vgrav,chem,dz8w,snowh,t_phy,p_phy,rho_phy,ivgtyp,g,dt, & - pm_settling,drydep_flux_local,settling_flux, & + pm_settling,drydep_flux_local,settling_flux,dbg_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) @@ -452,7 +461,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) - if ( extended_sd_diags ) then + if ( extended_sd_diags .or. dbg_opt) then do i = its, ite wetdpr(i,1) = wetdpr(i,1) + wetdpr_smoke_local (i,1) wetdpr(i,2) = wetdpr(i,2) + wetdpr_dust_local (i,1) @@ -479,7 +488,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, enddo !---- diagnostic output of dry deposition & gravitational settling fluxes - if ( drydep_opt == 1 .and. extended_sd_diags ) then + if ( drydep_opt == 1 .and. (extended_sd_diags .or. dbg_opt) ) then do nv = 1, ndvel do i=its,ite drydep_flux_out(i,nv) = drydep_flux_out(i,nv) + & @@ -511,12 +520,12 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !------------------------------------- !-- to output for diagnostics do i = 1, im - !emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s - !emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s + emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s + emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s emdust (i) = emis_dust(i,1,1,1) + emis_dust(i,1,1,2) + & emis_dust(i,1,1,3) + emis_dust(i,1,1,4) ! dust emission: ug/m2/s coef_bb (i) = coef_bb_dc(i,1) - frp_input (i) = coef_bb_dc(i,1)*frp_in(i,1) + frp_output (i) = coef_bb_dc(i,1)*frp_in(i,1) fhist (i) = fire_hist (i,1) min_fplume (i) = real(min_fplume2(i,1)) max_fplume (i) = real(max_fplume2(i,1)) @@ -556,20 +565,20 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, end subroutine rrfs_smoke_wrapper_run subroutine rrfs_smoke_prep( & - ktau,current_month,current_hour,gmt,con_rd,con_fv, & + ktau,current_month,current_hour,gmt,con_rd,con_fv,con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & snow_cpl,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & - rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, & - t8w,recmol, & + rri,t_phy,u_phy,v_phy,p_phy,pi_phy,wind_phy,theta_phy, & + rho_phy,dz8w,p8w,t8w,recmol, & z_at_w,vvel,zmid, & ntrac,gq0, & num_chem, num_moist, & ntsmoke, ntdust, ntcoarsepm, & - moist,chem,ebu_in,ebb_smoke_in, & + moist,chem,ebu_in,kpbl_thetav,ebb_smoke_in, & fhist,frp_in, hwp_day_avg, fire_end_hr, & emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & snowh,clayf,rdrag,sandf,ssm,uthr,oro,hwp_local, & @@ -585,7 +594,7 @@ subroutine rrfs_smoke_prep( & integer, intent(in) :: nsoil, ktau integer, dimension(ims:ime), intent(in) :: land, vegtype_dom, soiltyp, kpbl integer, intent(in) :: ntrac - real(kind=kind_phys), intent(in) :: g, pi, gmt, con_rd, con_fv + real(kind=kind_phys), intent(in) :: g, pi, gmt, con_rd, con_fv, con_cp real(kind=kind_phys), dimension(ims:ime), intent(in) :: & u10m, v10m, ustar, garea, rlat, rlon, ts2d, dswsfc, & zorl, snow_cpl, pb2d, hf2d, oro, t2m, dpt2m, wetness, recmol @@ -596,7 +605,7 @@ subroutine rrfs_smoke_prep( & ! This is a place holder for ebb_dcycle == 2, currently set to hold a single ! value, which is the previous day's average of hwp, frp, ebb, fire_end real(kind=kind_phys), dimension(ims:ime, 4), intent(in) :: smoke2d_RRFS - real(kind=kind_phys), dimension(ims:ime, 4), intent(in) :: emi_ant_in + real(kind=kind_phys), dimension(ims:ime, 1), intent(in) :: emi_ant_in real(kind=kind_phys), dimension(ims:ime, kms:kme), intent(in) :: pr3d,ph3d real(kind=kind_phys), dimension(ims:ime, kts:kte), intent(in) :: & phl3d,tk3d,prl3d,us3d,vs3d,spechum,w @@ -611,12 +620,11 @@ subroutine rrfs_smoke_prep( & real(kind_phys), dimension(ims:ime, jms:jme),intent(out) :: ebu_in - ! real(kind_phys), dimension(ims:ime, jms:jme, num_frp_plume), intent(out) :: plume_frp integer,dimension(ims:ime, jms:jme), intent(out) :: isltyp, ivgtyp real(kind_phys), dimension(ims:ime, kms:kme, jms:jme), intent(out) :: & rri, t_phy, u_phy, v_phy, p_phy, rho_phy, dz8w, p8w, t8w, vvel, & - zmid + zmid, pi_phy, theta_phy, wind_phy real(kind_phys), dimension(ims:ime, jms:jme), intent(out) :: & u10, v10, ust, tsk, xland, xlat, xlong, dxy, rmol, swdown, znt, & pbl, hfx, snowh, clayf, rdrag, sandf, ssm, uthr, hwp_local @@ -629,16 +637,17 @@ subroutine rrfs_smoke_prep( & real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: frp_in, fire_end_hr, fhist, coef_bb_dc real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: hwp_day_avg, peak_hr real(kind_phys), dimension(ims:ime), intent(inout) :: emis_anoc,ebb_smoke_in - ! real(kind_phys), dimension(ims:ime, jms:jme, num_plume_data) :: plume real(kind_phys), parameter :: conv_frp = 1.e+06_kind_phys ! FRP conversion factor, MW to W - real(kind_phys), parameter :: frpc = 1._kind_phys ! FRP conversion factor (Regional) + real(kind_phys), parameter :: frpc = 1._kind_phys ! FRP conversion factor (Regional) ! -- local variables integer i,ip,j,k,k1,kp,kk,kkp,nv,l,ll,n,nl - real(kind_phys) :: SFCWIND,WIND,DELWIND,DZ,wdgust,snoweq,THETA,ZSF + real(kind_phys) :: SFCWIND,WIND,DELWIND,DZ,wdgust,snoweq,THETA real(kind_phys), dimension(ims:ime, kms:kme, jms:jme) :: THETAV - real(kind_phys), dimension(ims:ime, jms:jme) :: windgustpot,kpbl_thetav + real(kind_phys), dimension(ims:ime, jms:jme) :: windgustpot + real(kind_phys), dimension(ims:ime, jms:jme), intent(out) :: kpbl_thetav real(kind_phys), parameter :: delta_theta4gust = 0.5 + real(kind=kind_phys),parameter :: p1000mb = 100000. ! -- initialize fire emissions ebu_in = 0._kind_phys @@ -653,9 +662,12 @@ subroutine rrfs_smoke_prep( & ivgtyp = 0._kind_phys rri = 0._kind_phys t_phy = 0._kind_phys + theta_phy = 0._kind_phys u_phy = 0._kind_phys v_phy = 0._kind_phys + wind_phy = 0._kind_phys p_phy = 0._kind_phys + pi_phy = 0._kind_phys rho_phy = 0._kind_phys dz8w = 0._kind_phys p8w = 0._kind_phys @@ -755,6 +767,9 @@ subroutine rrfs_smoke_prep( & p_phy(i,k,j)=prl3d(i,kkp) u_phy(i,k,j)=us3d(i,kkp) v_phy(i,k,j)=vs3d(i,kkp) + pi_phy(i,k,j) = con_cp*(p_phy(i,k,j)/p1000mb)**(con_rd/con_cp) + theta_phy(i,k,j) = t_phy(i,k,j)/pi_phy(i,k,j)*con_cp + wind_phy(i,k,j) = sqrt(u_phy(i,k,j)**2 + v_phy(i,k,j)**2) ! from mp_thompson.F90 ; rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) ! from mynnd rho_phy(i,k,j)=p_phy(i,k,j)/(con_rd*t_phy(i,k,j)) !*(1.+con_fv*spechum(i,kkp))) @@ -764,14 +779,9 @@ subroutine rrfs_smoke_prep( & moist(i,k,j,1)=gq0(i,kkp,p_atm_shum) if (t_phy(i,k,j) > 265.) then moist(i,k,j,2)=gq0(i,kkp,p_atm_cldq) - !moist(i,k,j,3)=0. - ! TODO -- should we keep these limits? if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. else moist(i,k,j,2)=0. - ! moist(i,k,j,3)=gq0(i,kkp,p_atm_cldq) - ! TODO -- should we keep these limits? - ! if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. endif !-- zmid(i,k,j)=phl3d(i,kkp)/g @@ -813,7 +823,6 @@ subroutine rrfs_smoke_prep( & do i = its, ite do j = jts, jte if ( THETAV(i,kts+1,j) .lt. ( THETAV(i,kts,j) + delta_theta4gust) ) then - ZSF = oro(i) do k = kts+1, kte k1 = k !--- give theta-v at the sfc a 0.5K boost in the PBLH definition @@ -822,12 +831,7 @@ subroutine rrfs_smoke_prep( & endif enddo kpbl_thetav(i,j) = k1 - !pblh_thetav(i,j) = zmid(i,k+k1-1,j) * & - ! ((THETAV(i,kts,j)+delta_theta4gust) - THETAV(i,kts+k1-1,j)) & - ! * (zmid(i,kts+k1-1,j) - zmid(i,kts+k1-2,j)) & - ! / (THETAV(i,kts+k1-1,j) - THETAV(i,kts+k1-2,j)) - ZSF else - !pblh_thetav(i,j) = 0.0 kpbl_thetav(i,j) = kts + 1 endif enddo @@ -838,7 +842,7 @@ subroutine rrfs_smoke_prep( & SFCWIND = sqrt(u10m(i)**2+v10m(i)**2) windgustpot(i,1) = SFCWIND if (kpbl_thetav(i,1)+1 .ge. kts+1 ) then - do k=kts+1,kpbl_thetav(i,1)+1 + do k=kts+1,int(kpbl_thetav(i,1))+1 WIND = sqrt(us3d(i,k)**2+vs3d(i,k)**2) DELWIND = WIND - SFCWIND DZ = zmid(i,k,1) - oro(i) @@ -851,7 +855,6 @@ subroutine rrfs_smoke_prep( & do i=its,ite wdgust=max(windgustpot(i,1),3.) snoweq=max((25.-snow_cpl(i))/25.,0.) - ! hwp_local(i,1)=0.237*wdgust**1.11*max(t2m(i)-dpt2m(i),15.)**0.92*((1.-wetness(i))**6.95)*snoweq ! Eric original 08/2022 hwp_local(i,1)=0.177*wdgust**0.97*max(t2m(i)-dpt2m(i),15.)**1.03*((1.-wetness(i))**0.4)*snoweq ! Eric update 11/2023 enddo ! Set paramters for ebb_dcycle option @@ -865,10 +868,6 @@ subroutine rrfs_smoke_prep( & fire_end_hr(i,j) = 0.0 hwp_day_avg(i,j) = 0.0 ebb_smoke_in (i) = ebu_in(i,j) - if (ktau == 1) then - fhist (i,j) = 1. - coef_bb_dc (i,j) = 1. - endif enddo enddo endif @@ -876,7 +875,7 @@ subroutine rrfs_smoke_prep( & ! RAR: here we need to initialize various arrays in order to apply HWP to ! diurnal cycle ! if ebb_dcycle/=2 then those arrays=0, we need to read in temporal - if (ebb_dcycle == 2) then + if (ebb_dcycle == 2 .and. ktau == 1) then do i=its, ite do j=jts, jte ebu_in (i,j) = smoke2d_RRFS(i,1)!/86400. @@ -884,11 +883,6 @@ subroutine rrfs_smoke_prep( & fire_end_hr (i,j) = smoke2d_RRFS(i,3) hwp_day_avg (i,j) = smoke2d_RRFS(i,4) ebb_smoke_in(i ) = ebu_in(i,j) - ! Initialize to 1 on first time step, modified by add_emiss_burn thereafter - if (ktau == 1) then - fhist (i,j) = 1. - coef_bb_dc (i,j) = 1. - endif enddo enddo end if @@ -896,6 +890,8 @@ subroutine rrfs_smoke_prep( & if (ktau==1) then do j=jts,jte do i=its,ite + fhist (i,j) = 1. + coef_bb_dc (i,j) = 1. if (xlong(i,j)<230.) then peak_hr(i,j)= 0.0* 3600. ! peak at 24 UTC, fires in Alaska elseif(xlong(i,j)<245.) then diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index fe664d31d..393c5d3d8 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise1.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] @@ -50,6 +50,13 @@ dimensions = () type = logical intent = in +[add_fire_heat_flux_in] + standard_name = flag_for_fire_heat_flux + long_name = flag to add fire heat flux to LSM + units = flag + dimensions = () + type = logical + intent = in [do_plumerise_in] standard_name = do_smoke_plumerise long_name = rrfs smoke plumerise option @@ -64,7 +71,7 @@ dimensions = () type = integer intent = in -[wind_eff_opt_in] +[plume_wind_eff_in] standard_name = option_for_wind_effects_on_smoke_plumerise long_name = wind effect plumerise option units = index @@ -551,7 +558,7 @@ standard_name = anthropogenic_background_input long_name = anthropogenic background input units = various - dimensions = (horizontal_loop_extent,4) + dimensions = (horizontal_loop_extent,1) type = real kind = kind_phys intent = in @@ -567,7 +574,7 @@ standard_name = emission_smoke_prvd_RRFS long_name = emission fire RRFS daily units = various - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -692,7 +699,7 @@ type = real kind = kind_phys intent = inout -[frp_input] +[frp_output] standard_name = frp_hourly long_name = hourly fire radiative power units = MW diff --git a/physics/smoke_dust/seas_mod.F90 b/physics/smoke_dust/seas_mod.F90 index 1d18046ad..e5e63e909 100755 --- a/physics/smoke_dust/seas_mod.F90 +++ b/physics/smoke_dust/seas_mod.F90 @@ -185,7 +185,6 @@ subroutine gocart_seasalt_driver(dt,alt,t_phy,u_phy, & chem(i,kts,j,p_seas_3) = chem(i,kts,j,p_seas_3) + tc(3)*converi chem(i,kts,j,p_seas_4) = chem(i,kts,j,p_seas_4) + tc(4)*converi chem(i,kts,j,p_seas_5) = chem(i,kts,j,p_seas_5) + tc(5)*converi - !print*,'hli tc(2),chem(i,kts,j,p_seas_2)',tc(2),chem(i,kts,j,p_seas_2) ! for output diagnostics emis_seas(i,1,j,p_eseas1) = bems(1) From 846ec8e0075e9e330401e03d5e0880963926d9d7 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 20 Dec 2023 03:08:53 +0000 Subject: [PATCH 123/132] remove extra rho0 --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index a035928f4..91e8c71b7 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -270,7 +270,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & - ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & + ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, tsfc, & flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: From bf99b986d1a35c24e6fee2a518196ac65788a4c6 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Wed, 20 Dec 2023 17:40:11 +0000 Subject: [PATCH 124/132] "declare nchem as intent in" --- physics/cu_gf_driver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index e4a78b030..92f8760b0 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -94,8 +94,8 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, parameter :: dicycle_m=0 !- diurnal cycle flag integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- - integer :: its,ite, jts,jte, kts,kte, nchem - integer, intent(in ) :: im,km,ntracer + integer :: its,ite, jts,jte, kts,kte + integer, intent(in ) :: im,km,ntracer, nchem integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend From 37d512f55b425ef7f1ff069c89d23d85c7f9bb8e Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Fri, 22 Dec 2023 21:17:51 +0000 Subject: [PATCH 125/132] "update the dimension of chem3d in GF for hercules/gnu rap cases" --- physics/cu_gf_deep.F90 | 4 ++-- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/cu_gf_deep.F90 b/physics/cu_gf_deep.F90 index b45452000..a1bca36c9 100644 --- a/physics/cu_gf_deep.F90 +++ b/physics/cu_gf_deep.F90 @@ -216,11 +216,11 @@ subroutine cu_gf_deep_run( & ,intent (inout ) :: & mconv,ccn !$acc declare copy(mconv,ccn) - real(kind=kind_phys), dimension (its:ite,kts:kte,nchem) & + real(kind=kind_phys), dimension (:,:,:) & ,intent (inout) :: & chem3d logical, intent (in) :: do_smoke_transport - real(kind=kind_phys), dimension (its:ite,nchem) & + real(kind=kind_phys), dimension (:,:) & , intent (out) :: wetdpc_deep real(kind=kind_phys), intent (in) :: fscav(:) !$acc declare copy(chem3d) copyout(wetdpc_deep) copyin(fscav) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index afd386595..eb7f83af6 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -875,7 +875,7 @@ subroutine rrfs_smoke_prep( & ! RAR: here we need to initialize various arrays in order to apply HWP to ! diurnal cycle ! if ebb_dcycle/=2 then those arrays=0, we need to read in temporal - if (ebb_dcycle == 2 .and. ktau == 1) then + if (ebb_dcycle == 2) then do i=its, ite do j=jts, jte ebu_in (i,j) = smoke2d_RRFS(i,1)!/86400. From fe77e06ab907accb3b860857d050f990ba88662d Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 8 Jan 2024 11:54:41 -0600 Subject: [PATCH 126/132] move sfc_land to new location --- physics/{ => SFC_Models/Land}/sfc_land.F90 | 0 physics/{ => SFC_Models/Land}/sfc_land.meta | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename physics/{ => SFC_Models/Land}/sfc_land.F90 (100%) rename physics/{ => SFC_Models/Land}/sfc_land.meta (100%) diff --git a/physics/sfc_land.F90 b/physics/SFC_Models/Land/sfc_land.F90 similarity index 100% rename from physics/sfc_land.F90 rename to physics/SFC_Models/Land/sfc_land.F90 diff --git a/physics/sfc_land.meta b/physics/SFC_Models/Land/sfc_land.meta similarity index 100% rename from physics/sfc_land.meta rename to physics/SFC_Models/Land/sfc_land.meta From 09b02350a7526f1eddc0885f8bcb26e9cac5c72d Mon Sep 17 00:00:00 2001 From: Ufuk Turuncoglu Date: Mon, 8 Jan 2024 11:55:57 -0600 Subject: [PATCH 127/132] fix meta file --- physics/SFC_Models/Land/sfc_land.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/SFC_Models/Land/sfc_land.meta b/physics/SFC_Models/Land/sfc_land.meta index 493d2a70b..6a4bd8fbe 100644 --- a/physics/SFC_Models/Land/sfc_land.meta +++ b/physics/SFC_Models/Land/sfc_land.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_land type = scheme - dependencies = machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] From 18616d4344cda61f313086b483ccdc350bf1005e Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 8 Jan 2024 17:06:43 -0500 Subject: [PATCH 128/132] established a branch for q MERRA2 bug fixed from RRFS --- physics/MP/Morrison_Gettelman/aerinterp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/MP/Morrison_Gettelman/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 index 4e2dc9047..fcfe29607 100644 --- a/physics/MP/Morrison_Gettelman/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -426,7 +426,7 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, ENDDO else DO k=1, levsaer-1 !! from sfc to toa - IF(prsl(j,L) < aerpres(j,k) .and. prsl(j,L)>aerpres(j,k+1)) then + IF(prsl(j,L) <= aerpres(j,k) .and. prsl(j,L)>aerpres(j,k+1)) then i1 = k i2 = min(k+1,levsaer) exit From 97e3b1ce4e9721ae6cc361733842de53a061d7ed Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Thu, 18 Jan 2024 12:24:03 -0500 Subject: [PATCH 129/132] update surface physics z0 from waves --- physics/SFC_Layer/UFS/sfc_diff.f | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index e1bf3c756..5dd6525f9 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -437,6 +437,18 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0rl_wat(i) = 1.0e-4_kp endif + elseif (z0rl_wav(i) <= 1.0e-7_kp .or. + & z0rl_wav(i) > 1.0_kp) then +! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + + if (redrag) then + z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) + else + z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) + endif + endif endif ! end of if(open ocean) From 02b3440378e5bb04ddc4ba50b44f2532eb7cab08 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Fri, 19 Jan 2024 18:24:37 +0000 Subject: [PATCH 130/132] "Supplementary physics updates for RRFS code freeze" --- physics/CONV/Grell_Freitas/cu_gf_deep.F90 | 5 +- physics/CONV/Grell_Freitas/cu_gf_driver.F90 | 8 +- physics/CONV/Grell_Freitas/cu_gf_driver.meta | 7 + physics/PBL/MYNN_EDMF/module_bl_mynn.F90 | 146 ++++++++---------- .../SFC_Models/Land/RUC/module_sf_ruclsm.F90 | 6 +- physics/smoke_dust/dep_dry_mod_emerson.F90 | 58 ++++--- physics/smoke_dust/dust_fengsha_mod.F90 | 11 +- physics/smoke_dust/module_add_emiss_burn.F90 | 75 +++++---- physics/smoke_dust/module_plumerise.F90 | 61 +++++--- physics/smoke_dust/module_smoke_plumerise.F90 | 40 ++--- physics/smoke_dust/module_wetdep_ls.F90 | 13 +- physics/smoke_dust/plume_data_mod.F90 | 51 ------ physics/smoke_dust/rrfs_smoke_config.F90 | 3 +- physics/smoke_dust/rrfs_smoke_postpbl.meta | 3 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 145 ++++++++++------- physics/smoke_dust/rrfs_smoke_wrapper.meta | 85 +++++++++- 16 files changed, 424 insertions(+), 293 deletions(-) delete mode 100755 physics/smoke_dust/plume_data_mod.F90 diff --git a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 index a1bca36c9..8a2c73600 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 @@ -142,13 +142,13 @@ subroutine cu_gf_deep_run( & !! betwee -1 and +1 ,do_capsuppress,cap_suppress_j & ! ,k22 & ! - ,jmin,tropics) ! + ,jmin,kdt,tropics) ! implicit none integer & ,intent (in ) :: & - nranflag,itf,ktf,its,ite, kts,kte,ipr,imid + nranflag,itf,ktf,its,ite, kts,kte,ipr,imid,kdt integer, intent (in ) :: & ichoice,nchem real(kind=kind_phys), dimension (its:ite,4) & @@ -591,6 +591,7 @@ subroutine cu_gf_deep_run( & sig(i)=(1.-frh)**2 !frh_out(i) = frh if(forcing(i,7).eq.0.)sig(i)=1. + if(kdt.le.(3600./dtime))sig(i)=1. frh_out(i) = frh*sig(i) enddo !$acc end kernels diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 index 92f8760b0..54a23ca74 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.F90 @@ -68,7 +68,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& dfi_radar_max_intervals,ldiag3d,qci_conv,do_cap_suppress, & maxupmf,maxMF,do_mynnedmf,ichoice_in,ichoicem_in,ichoice_s_in, & spp_cu_deep,spp_wts_cu_deep,nchem,chem3d,fscav,wetdpc_deep, & - do_smoke_transport,errmsg,errflg) + do_smoke_transport,kdt,errmsg,errflg) !------------------------------------------------------------- implicit none integer, parameter :: maxiens=1 @@ -95,7 +95,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer :: ishallow_g3 ! depend on imfshalcnv !------------------------------------------------------------- integer :: its,ite, jts,jte, kts,kte - integer, intent(in ) :: im,km,ntracer, nchem + integer, intent(in ) :: im,km,ntracer,nchem,kdt integer, intent(in ) :: ichoice_in,ichoicem_in,ichoice_s_in logical, intent(in ) :: flag_init, flag_restart, do_mynnedmf logical, intent(in ) :: flag_for_scnv_generic_tend,flag_for_dcnv_generic_tend @@ -766,7 +766,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22m & - ,jminm,tropics) + ,jminm,kdt,tropics) !$acc kernels do i=its,itf do k=kts,ktf @@ -853,7 +853,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22 & - ,jmin,tropics) + ,jmin,kdt,tropics) jpr=0 ipr=0 !$acc kernels diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta index fe9b4c375..d0b661fd8 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -651,6 +651,13 @@ type = real kind = kind_phys intent = inout +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 index 6840f80bf..cc7a47ce6 100644 --- a/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 +++ b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 @@ -2001,9 +2001,9 @@ SUBROUTINE mym_length ( & uonset= 15. wt_u = (1.0 - min(max(ugrid - uonset, 0.0)/30.0, 0.5)) cns = 2.7 !was 3.5 - alp1 = 0.22 + alp1 = 0.23 alp2 = 0.3 - alp3 = 2.0 * wt_u !taper off bouyancy enhancement in shear-driven pbls + alp3 = 2.5 * wt_u !taper off bouyancy enhancement in shear-driven pbls alp4 = 5.0 alp5 = 0.3 alp6 = 50. @@ -2059,12 +2059,12 @@ SUBROUTINE mym_length ( & ! ** Length scale limited by the buoyancy effect ** IF ( dtv(k) .GT. 0.0 ) THEN - bv = max( sqrt( gtr*dtv(k) ), 0.001) + bv = max( sqrt( gtr*dtv(k) ), 0.0001) elb = MAX(alp2*qkw(k), & & alp6*edmf_a1(k-1)*edmf_w1(k-1)) / bv & & *( 1.0 + alp3*SQRT( vsc/(bv*elt) ) ) elb = MIN(elb, zwk) - elf = 0.80 * qkw(k)/bv + elf = 1.0 * qkw(k)/bv elBLavg(k) = MAX(elBLavg(k), alp6*edmf_a1(k-1)*edmf_w1(k-1)/bv) ELSE elb = 1.0e10 @@ -2084,8 +2084,10 @@ SUBROUTINE mym_length ( & !add blending to use BouLac mixing length in free atmos; !defined relative to the PBLH (zi) + transition layer (h1) !el(k) = MIN(elb/( elb/elt+elb/els+1.0 ),elf) - !try squared-blending - el(k) = SQRT( els**2/(1. + (els**2/elt**2) +(els**2/elb**2))) + !try squared-blending - but take out elb (makes it underdiffusive) + !el(k) = SQRT( els**2/(1. + (els**2/elt**2) +(els**2/elb**2))) + el(k) = sqrt( els**2/(1. + (els**2/elt**2))) + el(k) = min(el(k), elb) el(k) = MIN (el(k), elf) el(k) = el(k)*(1.-wt) + alp5*elBLavg(k)*wt @@ -3633,13 +3635,13 @@ SUBROUTINE mym_condensation (kts,kte, & real(kind_phys):: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll, & &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb, & - &ls,wt,qpct,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & + &ls,wt,wt2,qpct,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & &qmq,qsat_tk,q1_rh,rh_hack,dzm1,zsl,maxqc real(kind_phys), parameter :: qpct_sfc=0.025 real(kind_phys), parameter :: qpct_pbl=0.030 real(kind_phys), parameter :: qpct_trp=0.040 real(kind_phys), parameter :: rhcrit =0.83 !for cloudpdf = 2 - real(kind_phys), parameter :: rhmax =1.01 !for cloudpdf = 2 + real(kind_phys), parameter :: rhmax =1.02 !for cloudpdf = 2 integer :: i,j,k real(kind_phys):: erf @@ -3864,25 +3866,18 @@ SUBROUTINE mym_condensation (kts,kte, & !Add condition for falling/settling into low-RH layers, so at least !some cloud fraction is applied for all qc, qs, and qi. rh_hack= rh(k) + wt2 = min(max( zagl - pblh2, 0.0 )/300., 1.0) !ensure adequate RH & q1 when qi is at least 1e-9 (above the PBLH) - if (qi(k)>1.e-9 .and. zagl .gt. pblh2) then - rh_hack =min(rhmax, rhcrit + 0.07*(9.0 + log10(qi(k)))) + if ((qi(k)+qs(k))>1.e-9 .and. (zagl .gt. pblh2)) then + rh_hack =min(rhmax, rhcrit + wt2*0.045*(9.0 + log10(qi(k)+qs(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) q1(k) =max(q1_rh, q1(k) ) endif - !ensure adequate RH & q1 when qc is at least 1e-6 - if (qc(k)>1.e-6) then - rh_hack =min(rhmax, rhcrit + 0.09*(6.0 + log10(qc(k)))) - rh(k) =max(rh(k), rh_hack) - !add rh-based q1 - q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) - q1(k) =max(q1_rh, q1(k) ) - endif - !ensure adequate RH & q1 when qs is at least 1e-8 (above the PBLH) - if (qs(k)>1.e-8 .and. zagl .gt. pblh2) then - rh_hack =min(rhmax, rhcrit + 0.07*(8.0 + log10(qs(k)))) + !ensure adequate rh & q1 when qc is at least 1e-6 (above the PBLH) + if (qc(k)>1.e-6 .and. (zagl .gt. pblh2)) then + rh_hack =min(rhmax, rhcrit + wt2*0.08*(6.0 + log10(qc(k)))) rh(k) =max(rh(k), rh_hack) !add rh-based q1 q1_rh =-3. + 3.*(rh(k)-rhcrit)/(1.-rhcrit) @@ -3994,7 +3989,7 @@ SUBROUTINE mym_condensation (kts,kte, & fac_damp = min(zagl * 0.0025, 1.0) !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 !HRRRv4 !cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.25 )**2, 0.3) - cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.35) + cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.37) cldfra_bl1D(K) = min( 1., cld_factor*cldfra_bl1D(K) ) enddo @@ -4181,38 +4176,33 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & k=kts -!original approach (drag in b-vector): -! a(1)=0. -! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff -! c(1)=-dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(1)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff + & -! sub_u(k)*delt + det_u(k)*delt - !rho-weighted (drag in b-vector): a(k)= -dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(kmdz(k+1)+rhosfc*ust**2/wspd)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + b(k)=1.+dtz(k)*(kmdz(k+1)+rhosfc*ust**2/wspd)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*uoce*ust**2/wspd - dtz(k)*s_awu(k+1)*onoff - & - & dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff + sub_u(k)*delt + det_u(k)*delt - -!rho-weighted with drag term moved out of b-array -! a(k)= -dtz(k)*kmdz(k)*rhoinv(k) -! b(k)=1.+dtz(k)*(kmdz(k+1))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! d(k)=u(k)*(1.-ust**2/wspd*dtz(k)*rhosfc/rho(k)) + dtz(k)*uoce*ust**2/wspd - & -! !!!d(k)=u(k)*(1.-ust**2/wspd*dtz(k)) + dtz(k)*uoce*ust**2/wspd - & -! & dtz(k)*rhoinv(k)*s_awu(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff + sub_u(k)*delt + det_u(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff - b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=u(k) + dtz(k)*rhoinv(k)*(s_awu(k)-s_awu(k+1))*onoff + dtz(k)*rhoinv(k)*(sd_awu(k)-sd_awu(k+1))*onoff + & - & sub_u(k)*delt + det_u(k)*delt - ENDDO + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=u(k) + dtz(k)*uoce*ust**2/wspd & + & - dtz(k)*rhoinv(k)*s_awu(k+1)*onoff & + & + dtz(k)*rhoinv(k)*sd_awu(k+1)*onoff & + & + sub_u(k)*delt + det_u(k)*delt + + do k=kts+1,kte-1 + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff & + & + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff + b(k)=1.+ dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff & + & + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff + c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=u(k) + dtz(k)*rhoinv(k)*(s_awu(k)-s_awu(k+1))*onoff & + & - dtz(k)*rhoinv(k)*(sd_awu(k)-sd_awu(k+1))*onoff & + & + sub_u(k)*delt + det_u(k)*delt + enddo !! no flux at the top ! a(kte)=-1. @@ -4247,37 +4237,33 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & k=kts -!original approach (drag in b-vector): -! a(1)=0. -! b(1)=1. + dtz(k)*(dfm(k+1)+ust**2/wspd) - 0.5*dtz(k)*s_aw(k+1)*onoff -! c(1)= - dtz(k)*dfm(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(1)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff + & -! sub_v(k)*delt + det_v(k)*delt - !rho-weighted (drag in b-vector): a(k)= -dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(kmdz(k+1) + rhosfc*ust**2/wspd)*rhoinv(k) & - & - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*voce*ust**2/wspd - dtz(k)*s_awv(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff + & - & sub_v(k)*delt + det_v(k)*delt - -!rho-weighted with drag term moved out of b-array -! a(k)= -dtz(k)*kmdz(k)*rhoinv(k) -! b(k)=1.+dtz(k)*(kmdz(k+1))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff -! d(k)=v(k)*(1.-ust**2/wspd*dtz(k)*rhosfc/rho(k)) + dtz(k)*voce*ust**2/wspd - & -! !!!d(k)=v(k)*(1.-ust**2/wspd*dtz(k)) + dtz(k)*voce*ust**2/wspd - & -! & dtz(k)*rhoinv(k)*s_awv(k+1)*onoff - dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff + sub_v(k)*delt + det_v(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*kmdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff - b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff - c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff - d(k)=v(k) + dtz(k)*rhoinv(k)*(s_awv(k)-s_awv(k+1))*onoff + dtz(k)*rhoinv(k)*(sd_awv(k)-sd_awv(k+1))*onoff + & - & sub_v(k)*delt + det_v(k)*delt - ENDDO + b(k)=1.+dtz(k)*(kmdz(k+1) + rhosfc*ust**2/wspd)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=v(k) + dtz(k)*voce*ust**2/wspd & + & - dtz(k)*rhoinv(k)*s_awv(k+1)*onoff & + & + dtz(k)*rhoinv(k)*sd_awv(k+1)*onoff & + & + sub_v(k)*delt + det_v(k)*delt + + do k=kts+1,kte-1 + a(k)= -dtz(k)*kmdz(k)*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff & + & + 0.5*dtz(k)*rhoinv(k)*sd_aw(k)*onoff + b(k)=1.+dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) & + & + 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff & + & + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1))*onoff + c(k)= -dtz(k)*kmdz(k+1)*rhoinv(k) & + & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff & + & - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1)*onoff + d(k)=v(k) + dtz(k)*rhoinv(k)*(s_awv(k)-s_awv(k+1))*onoff & + & - dtz(k)*rhoinv(k)*(sd_awv(k)-sd_awv(k+1))*onoff & + & + sub_v(k)*delt + det_v(k)*delt + enddo !! no flux at the top ! a(kte)=-1. diff --git a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 index b15592052..2d01f96c9 100644 --- a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 +++ b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 @@ -1687,7 +1687,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia endif if(newsn > zero ) then - SNOWFRACnewsn=MIN(one,SNHEI/SNHEI_CRIT_newsn) + SNOWFRACnewsn=MIN(one,snowfallac*1.e-3_kind_phys/SNHEI_CRIT_newsn) endif !-- due to steep slopes and blown snow, limit snow fraction in the @@ -1700,7 +1700,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia if(snowfrac < 0.75_kind_phys) snow_mosaic = one KEEP_SNOW_ALBEDO = zero - IF (NEWSN > zero .and. snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN + IF (snowfracnewsn > 0.99_kind_phys .and. rhosnfall < 450._kind_phys) THEN ! new snow KEEP_SNOW_ALBEDO = one ! turn off separate treatment of snow covered and snow-free portions of the grid cell @@ -1735,7 +1735,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ! hwlps with these biases.. if( snow_mosaic == one) then ALBsn=alb_snow - if(newsn > zero .and. KEEP_SNOW_ALBEDO > 0.9_kind_phys .and. albsn < 0.4_kind_phys) then + if(KEEP_SNOW_ALBEDO > 0.9_kind_phys .and. albsn < 0.4_kind_phys) then !-- Albedo correction with fresh snow and deep snow pack !-- will reduce warm bias in western Canada !-- and US West coast, where max snow albedo is low (0.3-0.5). diff --git a/physics/smoke_dust/dep_dry_mod_emerson.F90 b/physics/smoke_dust/dep_dry_mod_emerson.F90 index 76fdc2411..771801c44 100755 --- a/physics/smoke_dust/dep_dry_mod_emerson.F90 +++ b/physics/smoke_dust/dep_dry_mod_emerson.F90 @@ -9,7 +9,7 @@ module dep_dry_emerson_mod use machine , only : kind_phys use dep_data_mod ! JLS - use rrfs_smoke_config, only : num_chem, p_smoke, p_dust_1, p_coarse_pm + use rrfs_smoke_config, only : num_chem, p_smoke, p_dust_1, p_coarse_pm, n_dbg_lines implicit none @@ -23,7 +23,7 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & settling_flag,drydep_flux,settling_flux,dbg_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + its,ite, jts,jte, kts,kte, curr_secs, mpiid, xlat, xlong ) ! ! compute dry deposition velocity for aerosol particles ! Based on Emerson et al. (2020), PNAS, @@ -37,6 +37,9 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + + REAL(kind_phys) :: curr_secs + REAL(kind_phys), DIMENSION( ims:ime , jms:jme ) , & INTENT(IN) :: ustar, rmol, znt, snowh REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), & @@ -80,6 +83,9 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & real(kind_phys), dimension( kts:kte, ndvel ) :: cblk_col, vg_col integer, dimension(ndvel) :: ndt_settl integer :: i, j, k, ntdt, nv + integer :: icall=0 + integer, INTENT(IN) :: mpiid + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong ! chem pointers (p_*) are not sequentially numbered, need to define so nv loops work integer, dimension(ndvel) :: chem_pointers !> -- Gas constant @@ -87,11 +93,15 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & chem_pointers(1) = p_smoke chem_pointers(2) = p_dust_1 chem_pointers(3) = p_coarse_pm - + growth_fac = 1.0 conver=1.e-9 converi=1.e9 + if (mod(int(curr_secs),1800) .eq. 0) then + icall = 0 + endif + do j = jts, jte do i = its, ite aer_res(i,j) = 0.0 @@ -116,7 +126,7 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & aer_res(i,j) = max(aer_res(i,j)/100._kind_phys,0._kind_phys) ! Air kinematic viscosity (cm^2/s) airkinvisc = ( 1.8325e-4 * ( 416.16 / ( t_phy(i,k,j) + 120.0 ) ) * & - ( ( t_phy(i,k,j) / 296.16 )**1.5 ) ) / ( rho_phy(i,k,j) / 28.966e3 ) ! Convert density to mol/cm^3 + ( ( t_phy(i,k,j) / 296.16 )**1.5 ) ) / ( rho_phy(i,k,j) / 1.e3 ) ! Convert density to mol/cm^3 ! Air molecular freepath (cm) ! Check against XLM from above freepath = 7.39758e-4 * airkinvisc / sqrt( t_phy(i,k,j) ) do nv = 1, ndvel @@ -141,11 +151,11 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & amu_corrected = amu / Cc ! Gravitational Settling vg = aerodens * dp * dp * gravity * 100. * Cc / & ! Convert gravity to cm/s^2 - ( 18. * airkinvisc * ( rho_phy(i,k,j) / 28.966e3 ) ) ! Convert density to mol/cm^3 + ( 18. * airkinvisc * ( rho_phy(i,k,j) / 1.e3 ) ) ! Convert density to mol/cm^3 ! -- Rest of loop for the surface when deposition velocity needs to be cacluated if ( k == kts ) then ! Brownian Diffusion - DDp = ( boltzmann * t_phy(i,k,j) ) * Cc / (3. * pi * airkinvisc * ( rho_phy(i,k,j) / 28.966e3 ) * dp) ! Convert density to mol/cm^3 + DDp = ( boltzmann * t_phy(i,k,j) ) * Cc / (3. * pi * airkinvisc * ( rho_phy(i,k,j) / 1.e3 ) * dp) ! Convert density to mol/cm^3 ! Schmit number Sc = airkinvisc / DDp ! Brownian Diffusion @@ -179,13 +189,17 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & Rs = 1. / ( ( ustar(i,j) * 100.) * ( Eb + Eim + Ein) * eps0 ) ! Convert ustar to cm/s ! Compute final ddvel = aer_res + RS, set max at max_dep_vel in dep_data_mod.F[ m/s] ! The /100. term converts from cm/s to m/s, required for MYNN. - ddvel(i,j,nv) = min( (1. / (aer_res(i,j) + Rs ))/100., max_dep_vel) - if ( dbg_opt ) then - WRITE(6,*) 'dry_dep_mod_emerson: i,j,nv',i,j,nv - WRITE(6,*) 'dry_dep_mod_emerson: deposition velocity (m/s) ',ddvel(i,j,nv) + if ( settling_flag == 1 ) then + ddvel(i,j,nv) = max(min( ( vg + 1./(aer_res(i,j)+Rs) )/100., max_dep_vel),0._kind_phys) + else + ddvel(i,j,nv) = max(min( ( 1./(aer_res(i,j)+Rs) )/100., max_dep_vel),0._kind_phys) endif - drydep_flux(i,j,nv) = chem(i,kts,j,chem_pointers(nv))*p_phy(i,kts,j) / & - (RSI*t_phy(i,kts,j))*ddvel(i,j,nv)*dt*1.E-6 + if ( dbg_opt .and. (icall .le. n_dbg_lines) ) then + WRITE(1000+mpiid,*) 'dry_dep_mod_emer:xlat,xlong,curr_secs,nv',xlat(i,j),xlong(i,j),int(curr_secs),nv + WRITE(1000+mpiid,*) 'dry_dep_mod_emer:xlat,xlong,curr_secs,deposition velocity (m/s)',xlat(i,j),xlong(i,j),int(curr_secs),ddvel(i,j,nv) + icall = icall + 1 + endif + drydep_flux(i,j,nv) = chem(i,kts,j,chem_pointers(nv))*rho_phy(i,k,j)*ddvel(i,j,nv)/100.0*dt endif ! k == kts vgrav(i,k,j,nv) = vg ! Fill column variables @@ -220,25 +234,25 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12 dt_settl(nv) = REAL(ntdt,kind=kind_phys) /REAL(ndt_settl(nv),kind=kind_phys) enddo - do nv = 1, ndvel - chem_before(nv) = 0._kind_phys - do k = kts, kte - chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 - enddo - enddo + !do nv = 1, ndvel + ! chem_before(nv) = 0._kind_phys + ! do k = kts, kte + ! chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 + ! enddo + !enddo ! Perform gravitational settling if desired if ( settling_flag == 1 ) then call particle_settling(cblk_col,rho_col,delz_col,vg_col,dt_settl,ndt_settl,ndvel,kts,kte) endif ! Put cblk back into chem array do nv= 1, ndvel - chem_after(nv) = 0._kind_phys - settling_flux(i,j,nv) = 0._kind_phys + !chem_after(nv) = 0._kind_phys + !settling_flux(i,j,nv) = 0._kind_phys do k = kts, kte chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv) - chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 + !chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 enddo ! k - settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2 + !settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2 enddo ! nv end do ! j end do ! i diff --git a/physics/smoke_dust/dust_fengsha_mod.F90 b/physics/smoke_dust/dust_fengsha_mod.F90 index 54e66712d..6ec8f8d4a 100755 --- a/physics/smoke_dust/dust_fengsha_mod.F90 +++ b/physics/smoke_dust/dust_fengsha_mod.F90 @@ -21,8 +21,8 @@ module dust_fengsha_mod contains subroutine gocart_dust_fengsha_driver(dt, & - chem,rho_phy,smois,p8w,ssm, & - isltyp,snowh,xland,area,g,emis_dust, & + chem,rho_phy,smois,stemp,p8w,ssm, & + isltyp,snowh,xland,area,g,emis_dust, & ust,znt,clay,sand,rdrag,uthr, & num_emis_dust,num_chem,num_soil_layers, & ids,ide, jds,jde, kds,kde, & @@ -54,7 +54,7 @@ subroutine gocart_dust_fengsha_driver(dt, & REAL(kind_phys), DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN) :: rho_phy REAL(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), INTENT(INOUT) :: chem REAL(kind_phys), DIMENSION( ims:ime, 1, jms:jme,num_emis_dust),OPTIONAL, INTENT(INOUT) :: emis_dust - REAL(kind_phys), DIMENSION( ims:ime, num_soil_layers, jms:jme ), INTENT(IN) :: smois + REAL(kind_phys), DIMENSION( ims:ime, num_soil_layers, jms:jme ), INTENT(IN) :: smois, stemp !0d input variables REAL(kind_phys), INTENT(IN) :: dt ! time step @@ -146,6 +146,11 @@ subroutine gocart_dust_fengsha_driver(dt, & ilwi = 0 endif + ! Don't emit over frozen soil + if (stemp(i,1,j) < 268.0) then ! -5C + ilwi = 0 + endif + ! Do not allow areas with bedrock, lava, or land-ice to loft IF (isltyp(i,j) .eq. 15 .or. isltyp(i,j) .eq. 16. .or. & diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index 95005b973..0a22fcfd7 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -9,11 +9,11 @@ module module_add_emiss_burn subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & chem,julday,gmt,xlat,xlong, & fire_end_hr, peak_hr,time_int, & - coef_bb_dc, fhist, hwp, hwp_prevd, & + coef_bb_dc, fire_hist, hwp, hwp_prevd, & swdown,ebb_dcycle, ebu_in, ebu,fire_type,& ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + its,ite, jts,jte, kts,kte,mpiid ) IMPLICIT NONE @@ -22,6 +22,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + INTEGER, INTENT(IN) :: mpiid real(kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & INTENT(INOUT ) :: chem ! shall we set num_chem=1 here? @@ -29,7 +30,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & INTENT(INOUT ) :: ebu real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong, swdown - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp, peak_hr, fire_end_hr, ebu_in !, vfrac + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp, peak_hr, fire_end_hr, ebu_in !RAR: Shall we make fire_end integer? real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: coef_bb_dc ! RAR: real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: hwp_prevd @@ -38,17 +39,17 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & real(kind_phys), INTENT(IN) :: time_int,pi ! RAR: time in seconds since start of simulation INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: fire_type integer, INTENT(IN) :: ebb_dcycle ! RAR: this is going to be namelist dependent, ebb_dcycle=means - real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fhist + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: fire_hist !>--local integer :: i,j,k,n,m + integer :: icall=0 real(kind_phys) :: conv_rho, conv, dm_smoke, dc_hwp, dc_gp, dc_fn !daero_num_wfa, daero_num_ifa !, lu_sum1_5, lu_sum12_14 INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise - ! real, parameter :: cx = 2.184936 * 3600., rinti = 2.1813936e-8 , ax = 2000.6038 - ! bx_bburn = 20.041288 * 3600., RAR: this depends on the vegetation class, location (local time) etc. real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation - ! For Gaussian diurnal cycle + +! For Gaussian diurnal cycle real(kind_phys), PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later real(kind_phys), PARAMETER :: rinti=2.1813936e-8, ax2=3400., const2=130., & coef2=10.6712963e-4, cx2=7200., timeq_max=3600.*24. @@ -90,32 +91,39 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & ! Constants for the fire diurnal cycle calculation do j=jts,jte do i=its,ite - fire_age= time_int + (fire_end_hr(i,j))*3600. + fire_age= time_int + (fire_end_hr(i,j)-1._kind_phys)*3600._kind_phys !One hour delay is due to the latency of the RAVE files + fire_age= MAX(0._kind_phys,fire_age) SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. CASE (1) ! these fires will have exponentially decreasing diurnal cycle, - ! We assume 1hr latency in ingesting the sat. data - coef_bb_dc(i,j) = 1._kind_phys/((2*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & - exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2*sigma_fire_dur(1)**2 )) + coef_bb_dc(i,j) = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & + exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) + + ! IF ( dbg_opt .AND. time_int<5000.) then + ! WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j) + ! WRITE(6,*) 'coef_bb_dc(i,j) ',coef_bb_dc(i,j) + ! END IF + CASE (3) age_hr= fire_age/3600._kind_phys - IF (swdown(i,j)<.1 .AND. age_hr> 12. .AND. fhist(i,j)>0.75) THEN - fhist(i,j)= 0.75_kind_phys + IF (swdown(i,j)<.1 .AND. age_hr> 12. .AND. fire_hist(i,j)>0.75) THEN + fire_hist(i,j)= 0.75_kind_phys ENDIF - IF (swdown(i,j)<.1 .AND. age_hr> 24. .AND. fhist(i,j)>0.5) THEN - fhist(i,j)= 0.5_kind_phys + IF (swdown(i,j)<.1 .AND. age_hr> 24. .AND. fire_hist(i,j)>0.5) THEN + fire_hist(i,j)= 0.5_kind_phys ENDIF - IF (swdown(i,j)<.1 .AND. age_hr> 48. .AND. fhist(i,j)>0.25) THEN - fhist(i,j)= 0.25_kind_phys + IF (swdown(i,j)<.1 .AND. age_hr> 48. .AND. fire_hist(i,j)>0.25) THEN + fire_hist(i,j)= 0.25_kind_phys ENDIF ! this is based on hwp, hourly or instantenous TBD - dc_hwp= ebu_in(i,j)* hwp(i,j)/ MAX(1._kind_phys,hwp_prevd(i,j)) + dc_hwp= hwp(i,j)/ MAX(5._kind_phys,hwp_prevd(i,j)) dc_hwp= MAX(0._kind_phys,dc_hwp) + dc_hwp= MIN(25._kind_phys,dc_hwp) - !coef_bb_dc(i,j)= sc_factor* fhist(i,j)* rate_ebb2(i,j)* (1. + log( + !coef_bb_dc(i,j)= sc_factor* fire_hist(i,j)* rate_ebb2(i,j)* (1. + log( !hwp_(i,j)/ hwp_day_avg(i,j))) ! RAR: Gaussian profile for wildfires @@ -125,17 +133,30 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & dc_gp = rinti*( ax2 * exp(- dtm**2/(2._kind_phys*cx2**2) ) + const2 - coef2*timeq ) dc_gp = MAX(0._kind_phys,dc_gp) - dc_fn = MAX(dc_hwp/dc_gp,3._kind_phys) - coef_bb_dc(i,j) = fhist(i,j)* dc_fn + dc_fn = MIN(dc_hwp/dc_gp,3._kind_phys) + !coef_bb_dc(i,j) = fire_hist(i,j)* dc_fn + coef_bb_dc(i,j) = fire_hist(i,j)* dc_hwp + + ! IF ( dbg_opt .AND. time_int<5000.) then + ! WRITE(6,*) 'i,j,fire_hist(i,j),peak_hr(i,j) ', i,j,fire_hist(i,j),peak_hr(i,j) + ! WRITE(6,*) 'dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) ',dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) + ! END IF + CASE DEFAULT END SELECT enddo enddo endif + if (mod(int(time_int),1800) .eq. 0) then + icall = 0 + endif + do j=jts,jte do i=its,ite do k=kts,kfire_max + if (ebu(i,k,j)<0.001_kind_phys) cycle + if (ebb_dcycle==1) then conv= dtstep/(rho_phy(i,k,j)* dz8w(i,k,j)) elseif (ebb_dcycle==2) then @@ -143,14 +164,14 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & endif dm_smoke= conv*ebu(i,k,j) chem(i,k,j,p_smoke) = chem(i,k,j,p_smoke) + dm_smoke - chem(i,k,j,p_smoke) = MIN(chem(i,k,j,p_smoke),5.e+3) + chem(i,k,j,p_smoke) = MIN(MAX(chem(i,k,j,p_smoke),0._kind_phys),5.e+3_kind_phys) - if ( dbg_opt .and. (k==kts .OR. k==kfire_max) ) then - WRITE(6,*) 'add_emiss_burn: i,j,k ',i,j,k - WRITE(6,*) 'add_emiss_burn: rho_phy(i,k,j),dz8w(i,k,j),conv',rho_phy(i,k,j),dz8w(i,k,j),conv - WRITE(6,*) 'add_emiss_burn: ebu(i,k,j),dm_smoke ', ebu(i,k,j),dm_smoke - endif + if ( dbg_opt .and. (k==kts .OR. k==kfire_max) .and. (icall .le. n_dbg_lines) ) then + WRITE(1000+mpiid,*) 'add_emiss_burn:xlat,xlong,curr_secs,fire_type,fire_hist,peak_hr', xlat(i,j),xlong(i,j),int(time_int),fire_type(i,j),fire_hist(i,j),peak_hr(i,j) + WRITE(1000+mpiid,*) 'add_emiss_burn:xlat,xlong,curr_secs,coef_bb_dc,ebu',xlat(i,j),xlong(i,j),int(time_int),coef_bb_dc(i,j),ebu(i,k,j) + endif enddo + icall = icall + 1 enddo enddo diff --git a/physics/smoke_dust/module_plumerise.F90 b/physics/smoke_dust/module_plumerise.F90 index 8a1d6ab25..5f7ef2a0e 100755 --- a/physics/smoke_dust/module_plumerise.F90 +++ b/physics/smoke_dust/module_plumerise.F90 @@ -24,10 +24,11 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & kpbl_thetav, & ! SRB: added kpbl_thetav ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, errmsg, errflg) + its,ite, jts,jte, kts,kte, errmsg, errflg,curr_secs, & + xlat, xlong , uspdavg2, hpbl_thetav2, mpiid) use rrfs_smoke_config - use plume_data_mod + !use plume_data_mod USE module_zero_plumegen_coms USE module_smoke_plumerise IMPLICIT NONE @@ -40,6 +41,8 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & real(kind=kind_phys), DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: frp_inst ! RAR: FRP array + real(kind_phys), DIMENSION(ims:ime,jms:jme), INTENT(IN) :: xlat,xlong ! SRB + real(kind_phys), DIMENSION(ims:ime, jms:jme), INTENT(IN) :: kpbl_thetav ! SRB character(*), intent(inout) :: errmsg @@ -47,6 +50,7 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte + real(kind_phys) :: curr_secs INTEGER, INTENT(IN ) :: wind_eff_opt real(kind=kind_phys), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: ebu real(kind=kind_phys), INTENT(IN ) :: g, con_cp, con_rd @@ -57,23 +61,32 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & ! Local variables... INTEGER :: nv, i, j, k, kp1, kp2 + INTEGER :: icall=0 INTEGER, DIMENSION(ims:ime, jms:jme), INTENT (OUT) :: k_min, k_max ! Min and max ver. levels for BB injection spread + REAL, DIMENSION(ims:ime, jms:jme), INTENT (OUT) :: uspdavg2, hpbl_thetav2 ! SRB real(kind_phys), dimension (kte) :: u_in ,v_in ,w_in ,theta_in ,pi_in, rho_phyin ,qv_in ,zmid, z_lev, uspd ! SRB real(kind=kind_phys) :: dz_plume, cpor, con_rocp, uspdavg ! SRB +! MPI variables + INTEGER, INTENT(IN) :: mpiid + cpor =con_cp/con_rd con_rocp=con_rd/con_cp - IF ( dbg_opt ) then - WRITE(*,*) 'module_plumerise: its,ite,jts,jte ', its,ite,jts,jte - WRITE(*,*) 'module_plumerise: ims,ime,jms,jme ', ims,ime,jms,jme - WRITE(*,*) 'module_plumerise: maxval(ebu(:,kts,:)) ', maxval(ebu(:,kts,:)) + if (mod(int(curr_secs),1800) .eq. 0) then + icall = 0 + endif + + IF ( dbg_opt .and. icall .le. n_dbg_lines) then + WRITE(1000+mpiid,*) 'module_plumerise: its,ite,jts,jte ', its,ite,jts,jte + WRITE(1000+mpiid,*) 'module_plumerise: ims,ime,jms,jme ', ims,ime,jms,jme + WRITE(1000+mpiid,*) 'module_plumerise: maxval(ebu(:,kts,:)) ', maxval(ebu(:,kts,:)) END IF ! RAR: setting to zero the ebu emissions at the levels k>1, this is necessary when the plumerise is called, so the emissions at k>1 are updated !do nv=1,num_ebu do j=jts,jte - do k=kts+1,kte + do k=kts,kte do i=its,ite ebu(i,k,j)=0. enddo @@ -112,12 +125,10 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & uspd(k)= wind_phy(i,k,j) ! SRB enddo - IF (dbg_opt) then - WRITE(*,*) 'module_plumerise: i,j ',i,j - WRITE(*,*) 'module_plumerise: frp_inst(i,j) ',frp_inst(i,j) - WRITE(*,*) 'module_plumerise: ebu(i,kts,j) ',ebu(i,kts,j) - WRITE(*,*) 'module_plumerise: u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) ',u_in(10),v_in(10),w_in(kte),qv_in(10),pi_in(10) - WRITE(*,*) 'module_plumerise: zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) ',zmid(kte),z_lev(kte),rho_phyin(kte),theta_in(kte) + + IF (dbg_opt .and. (icall .le. n_dbg_lines) .and. (frp_inst(i,j) .ge. frp_threshold) ) then + WRITE(1000+mpiid,*) 'module_plumerise_before:xlat,xlong,curr_secs,ebu(kts),frp_inst',xlat(i,j), xlong(i,j), int(curr_secs),ebu(i,kts,j),frp_inst(i,j) + WRITE(1000+mpiid,*) 'module_plumerise_before:xlat,xlong,curr_secs,u(10),v(10),w(10),qv(10)',xlat(i,j), xlong(i,j),int(curr_secs), u_in(10),v_in(10),w_in(kte),qv_in(10) END IF ! RAR: the plume rise calculation step: @@ -127,7 +138,8 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & wind_eff_opt, & frp_inst(i,j), k_min(i,j), & k_max(i,j), dbg_opt, g, con_cp, & - con_rd, cpor, errmsg, errflg ) + con_rd, cpor, errmsg, errflg, & + icall, mpiid, xlat(i,j), xlong(i,j), curr_secs ) if(errflg/=0) return kp1= k_min(i,j) @@ -136,9 +148,13 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & ! SRB: Adding condition for overwriting plumerise levels uspdavg=SUM(uspd(kts:kpbl_thetav(i,j)))/kpbl_thetav(i,j) !Average wind speed within the boundary layer + +! SRB: Adding output + uspdavg2(i,j) = uspdavg + hpbl_thetav2(i,j) = z_lev(kpbl_thetav(i,j)) IF ((frp_inst(i,j) .gt. frp_threshold) .AND. (frp_inst(i,j) .le. frp_threshold500) .AND. & - (z_at_w(i,kpbl_thetav(i,j),j) .gt. zpbl_threshold) .AND. (wind_eff_opt .eq. 1)) THEN + (z_lev(kpbl_thetav(i,j)) .gt. zpbl_threshold) .AND. (wind_eff_opt .eq. 1)) THEN kp1=1 IF (uspdavg .ge. uspd_threshold) THEN ! Too windy kp2=kpbl_thetav(i,j)/3 @@ -157,11 +173,18 @@ subroutine ebu_driver ( flam_frac,ebu_in,ebu, & END IF ! SRB: End modification - IF ( dbg_opt ) then - WRITE(*,*) 'module_plumerise: i,j ',i,j - WRITE(*,*) 'module_plumerise: k_min(i,j), k_max(i,j) ',kp1, kp2 ! SRB: replaced k_min, k_max with kp1, kp2 + IF ( dbg_opt .and. (icall .le. n_dbg_lines) .and. (frp_inst(i,j) .ge. frp_threshold) ) then + WRITE(1000+mpiid,*) 'mod_plumerise_after:xlat,xlong,curr_secs,k_min(i,j), k_max(i,j) ',xlat(i,j),xlong(i,j),int(curr_secs),kp1,kp2 + WRITE(1000+mpiid,*) 'mod_plumerise_after:xlat,xlong,curr_secs,ebu(kts),frp_inst',xlat(i,j),xlong(i,j),int(curr_secs),ebu(i,kts,j),frp_inst(i,j) + WRITE(1000+mpiid,*) 'mod_plumerise_after:xlat,xlong,curr_secs,u(10),v(10),w(10),qv(10)',xlat(i,j),xlong(i,j),int(curr_secs),u_in(10),v_in(10),w_in(kte),qv_in(10) + WRITE(1000+mpiid,*) 'mod_plumerise_after:xlat,xlong,curr_secs,uspdavg,kpbl_thetav',xlat(i,j),xlong(i,j),int(curr_secs),uspdavg,kpbl_thetav(i,j) + IF ( frp_inst(i,j) .ge. 3.e+9 ) then + WRITE(1000+mpiid,*) 'mod_plumerise_after:High FRP at : xlat,xlong,curr_secs,frp_inst',xlat(i,j),xlong(i,j),int(curr_secs),frp_inst(i,j) + END IF + icall = icall + 1 END IF -! endif check_frp +! endif check_frp +! icall = icall + 1 enddo enddo diff --git a/physics/smoke_dust/module_smoke_plumerise.F90 b/physics/smoke_dust/module_smoke_plumerise.F90 index 0fca91de4..aa45890f4 100755 --- a/physics/smoke_dust/module_smoke_plumerise.F90 +++ b/physics/smoke_dust/module_smoke_plumerise.F90 @@ -14,10 +14,11 @@ module module_smoke_plumerise use machine , only : kind_phys - use plume_data_mod, only : num_frp_plume, p_frp_hr, p_frp_std + !use plume_data_mod, only : num_frp_plume, p_frp_hr, p_frp_std !tropical_forest, boreal_forest, savannah, grassland, & ! wind_eff USE module_zero_plumegen_coms + USE rrfs_smoke_config, only : n_dbg_lines !real(kind=kind_phys),parameter :: rgas=r_d !real(kind=kind_phys),parameter :: cpor=cp/r_d @@ -28,12 +29,13 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & up,vp,wp,theta,pp,dn0,rv,zt_rams,zm_rams, & wind_eff_opt, & frp_inst,k1,k2, dbg_opt, g, cp, rgas, & - cpor, errmsg, errflg ) + cpor, errmsg, errflg, icall, mpiid, lat, long, curr_secs ) implicit none LOGICAL, INTENT (IN) :: dbg_opt - INTEGER, INTENT (IN) :: wind_eff_opt + INTEGER, INTENT (IN) :: wind_eff_opt, mpiid + real(kind_phys), INTENT(IN) :: lat,long, curr_secs ! SRB ! INTEGER, PARAMETER :: ihr_frp=1, istd_frp=2!, imean_fsize=3, istd_fsize=4 ! RAR: @@ -70,7 +72,7 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! real(kind=kind_phys), dimension(nveg_agreg) :: firesize,mean_fct INTEGER :: wind_eff - + INTEGER, INTENT(IN) :: icall type(plumegen_coms), pointer :: coms ! Set wind effect from namelist @@ -162,19 +164,11 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & endif burnt_area= max(1.0e4,burnt_area) - IF (dbg_opt) THEN - WRITE(*,*) 'plumerise: m1 ', m1 - WRITE(*,*) 'plumerise: imm, FRP,burnt_area ', imm, FRP,burnt_area - ! WRITE(*,*) 'convert_smold_to_flam ',convert_smold_to_flam - WRITE(*,*) 'plumerise: zcon ', coms%zcon - WRITE(*,*) 'plumerise: zzcon ', coms%zzcon - END IF - - IF (dbg_opt) then - WRITE(*,*) 'plumerise: imm ', imm - WRITE(*,*) 'plumerise: burnt_area ',burnt_area - END IF - + IF ( dbg_opt .and. (icall .le. n_dbg_lines) .and. (frp_inst .ge. frp_threshold) ) THEN + WRITE(1000+mpiid,*) 'inside plumerise: xlat,xlong,curr_secs, m1 ', lat,long, int(curr_secs), m1 + WRITE(1000+mpiid,*) 'inside plumerise: xlat,xlong,curr_secs,imm,FRP,burnt_area ', lat, long, int(curr_secs), imm, FRP,burnt_area + END IF + !- get fire properties (burned area, plume radius, heating rates ...) call get_fire_properties(coms,imm,iveg_ag,burnt_area,FRP,errmsg,errflg) if(errflg/=0) return @@ -182,8 +176,8 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & !------ generates the plume rise ------ call makeplume (coms,kmt,ztopmax(imm),ixx,imm) - IF (dbg_opt) then - WRITE(*,*) 'plumerise after makeplume: imm,kmt,ztopmax(imm) ',imm,kmt,ztopmax(imm) + IF ( dbg_opt .and. (icall .le. n_dbg_lines) .and. (frp_inst .ge. frp_threshold) ) then + WRITE(1000+mpiid,*) 'inside plumerise after makeplume:xlat,xlong,curr_secs,imm,kmt,ztopmax(imm) ', lat, long, int(curr_secs), imm,kmt, ztopmax(imm) END IF enddo lp_minmax @@ -203,12 +197,12 @@ subroutine plumerise(m1,m2,m3,ia,iz,ja,jz, & ! enddo !enddo - IF (dbg_opt) then - WRITE(*,*) 'plumerise after set_flam_vert: nkp,k1,k2, ', nkp,k1,k2 - WRITE(*,*) 'plumerise after set_flam_vert: dzi ', dzi + !IF (dbg_opt) then + ! WRITE(*,*) 'plumerise after set_flam_vert: nkp,k1,k2, ', nkp,k1,k2 + ! WRITE(*,*) 'plumerise after set_flam_vert: dzi ', dzi !WRITE(*,*) 'plumerise after set_flam_vert: eburn_in(2) ', eburn_in(2) !WRITE(*,*) 'plumerise after set_flam_vert: eburn_out(:,2) ',eburn_out(:,2) - END IF + !END IF ! enddo lp_veg ! sub-grid vegetation, currently it's aggregated diff --git a/physics/smoke_dust/module_wetdep_ls.F90 b/physics/smoke_dust/module_wetdep_ls.F90 index 8ba8f67d9..2ef07e38c 100755 --- a/physics/smoke_dust/module_wetdep_ls.F90 +++ b/physics/smoke_dust/module_wetdep_ls.F90 @@ -31,11 +31,18 @@ subroutine wetdep_ls(dt,var,rain,moist, real(kind_phys) :: dvar,factor,clsum integer :: nv,i,j,k,km,kb,kbeg !real(kind_phys), parameter :: alpha = .5 ! scavenging factor + integer, save :: print_alpha = 0 wetdpr_smoke =0. wetdpr_dust =0. wetdpr_coarsepm=0. + !if ( print_alpha == 0 ) then + ! write(*,*) 'wetdep_ls, alpha = ',alpha + ! print_alpha = print_alpha + 1 + !endif + + do nv=1,nchem do i=its,ite do j=jts,jte @@ -76,11 +83,11 @@ subroutine wetdep_ls(dt,var,rain,moist, dvar=alpha*factor/(1+factor)*var(i,k,j,nv) ! Accumulate diags if (nv .eq. p_smoke ) then - wetdpr_smoke(i,j) = wetdpr_smoke(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + wetdpr_smoke(i,j) = wetdpr_smoke(i,j) + dvar * rho(i,k,j) / dt elseif (nv .eq. p_dust_1 ) then - wetdpr_dust(i,j) = wetdpr_dust(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + wetdpr_dust(i,j) = wetdpr_dust(i,j) + dvar * rho(i,k,j) / dt elseif (nv .eq. p_coarse_pm ) then - wetdpr_coarsepm(i,j) = wetdpr_coarsepm(i,j) + dvar * rho(i,k,j) * dt * 1.E-6 + wetdpr_coarsepm(i,j) = wetdpr_coarsepm(i,j) + dvar * rho(i,k,j) / dt endif var(i,k,j,nv)=max(1.e-16,var(i,k,j,nv)-dvar) endif diff --git a/physics/smoke_dust/plume_data_mod.F90 b/physics/smoke_dust/plume_data_mod.F90 deleted file mode 100755 index 3f0bcdecd..000000000 --- a/physics/smoke_dust/plume_data_mod.F90 +++ /dev/null @@ -1,51 +0,0 @@ -!>\file plume_data_mod.F90 -!! This file contains data for the fire plume rise module. - -module plume_data_mod - - use machine , only : kind_phys - - implicit none - - ! -- FRP parameters - integer, dimension(0:20), parameter :: & - catb = (/ & - 0, & - 2, 1, 2, 1, & !floresta tropical 2 and 4 / extra trop fores 1,3,5 - 2, 3, 3, 3, 3, & !cerrado/woody savanna :6 a 9 - 4, 4, 4, 4, 4, 0, 4, 0, 0, 0, 0 & !pastagem/lavouras: 10 ... - /) - - real(kind=kind_phys), dimension(0:4), parameter :: & - flaming = (/ & - 0.00, & ! - 0.45, & ! % biomass burned at flaming phase : tropical forest igbp 2 and 4 - 0.45, & ! % biomass burned at flaming phase : extratropical forest igbp 1 , 3 and 5 - 0.75, & ! % biomass burned at flaming phase : cerrado/woody savanna igbp 6 to 9 - 0.00 & ! % biomass burned at flaming phase : pastagem/lavoura: igbp 10 a 17 - /) - - real(kind=kind_phys), dimension(0:20), parameter :: & - msize= (/ & - 0.00021, & !0near water,1Evergreen needleleaf,2EvergreenBroadleaf,!3Deciduous Needleleaf,4Deciduous Broadleaf - 0.00021, 0.00021, 0.00021, 0.00021, & !5Mixed forest,6Closed shrublands,7Open shrublands,8Woody savannas,9Savannas, - 0.00023, 0.00022, 0.00022, 0.00022, 0.00029, &! 10Grassland,11Permanent wetlands,12cropland,13'Urban and Built-Up' - 0.00029, 0.00021, 0.00026, 0.00021, 0.00026, &!14cropland/natural vegetation mosaic,15Snow and ice,16Barren or sparsely vegetated - 0.00021, 0.00021, 0.00021, 0.00021, 0.00021, 0.00021 & !17Water,18Wooded Tundra,19Mixed Tundra,20Bare Ground Tundra - /) - - ! -- FRP buffer indices - integer, parameter :: p_frp_hr = 1 - integer, parameter :: p_frp_std = 2 - integer, parameter :: num_frp_plume = 2 - - ! -- plumerise parameters - integer, parameter :: tropical_forest = 1 - integer, parameter :: boreal_forest = 2 - integer, parameter :: savannah = 3 - integer, parameter :: grassland = 4 - integer, parameter :: nveg_agreg = 4 - - public - -end module plume_data_mod diff --git a/physics/smoke_dust/rrfs_smoke_config.F90 b/physics/smoke_dust/rrfs_smoke_config.F90 index d7478986b..dae4338bb 100755 --- a/physics/smoke_dust/rrfs_smoke_config.F90 +++ b/physics/smoke_dust/rrfs_smoke_config.F90 @@ -24,6 +24,7 @@ module rrfs_smoke_config integer :: addsmoke_flag = 1 integer :: smoke_forecast = 1 integer :: plumerisefire_frq=60 + integer :: n_dbg_lines = 3 integer :: wetdep_ls_opt = 1 integer :: drydep_opt = 1 integer :: pm_settling = 1 @@ -39,7 +40,7 @@ module rrfs_smoke_config ! -- integer, parameter :: CHEM_OPT_GOCART= 1 - integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5 + integer, parameter :: num_moist=3, num_chem=20, num_emis_seas=5, num_emis_dust=5 ! -- hydrometeors integer, parameter :: p_qv=1 diff --git a/physics/smoke_dust/rrfs_smoke_postpbl.meta b/physics/smoke_dust/rrfs_smoke_postpbl.meta index 50fbb4e03..8d7481ec4 100755 --- a/physics/smoke_dust/rrfs_smoke_postpbl.meta +++ b/physics/smoke_dust/rrfs_smoke_postpbl.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_postpbl type = scheme - dependencies = ../hooks/machine.F,dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 - + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] name = rrfs_smoke_postpbl_run diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index eb7f83af6..4daad7168 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -12,7 +12,7 @@ module rrfs_smoke_wrapper ebb_dcycle, extended_sd_diags,add_fire_heat_flux, & num_moist, num_chem, num_emis_seas, num_emis_dust, & p_qv, p_atm_shum, p_atm_cldq, & - p_smoke, p_dust_1, p_coarse_pm, epsilc + p_smoke, p_dust_1, p_coarse_pm, epsilc, n_dbg_lines use dust_data_mod, only : dust_alpha, dust_gamma, dust_moist_opt, & dust_moist_correction, dust_drylimit_factor use seas_mod, only : gocart_seasalt_driver @@ -52,7 +52,7 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, dust_moist_correction_in, dust_drylimit_factor_in, & ! Dust namelist aero_ind_fdb_in, & ! Feedback namelist extended_sd_diags_in,dbg_opt_in, & ! Other namelist - errmsg, errflg ) + errmsg, errflg, n_dbg_lines_in ) !>-- Namelist @@ -62,7 +62,7 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, integer, intent(in) :: dust_opt_in,dust_moist_opt_in, wetdep_ls_opt_in, pm_settling_in, seas_opt_in integer, intent(in) :: drydep_opt_in logical, intent(in) :: aero_ind_fdb_in,dbg_opt_in, extended_sd_diags_in, add_fire_heat_flux_in - integer, intent(in) :: smoke_forecast_in, plume_wind_eff_in, plumerisefire_frq_in + integer, intent(in) :: smoke_forecast_in, plume_wind_eff_in, plumerisefire_frq_in, n_dbg_lines_in integer, intent(in) :: addsmoke_flag_in, ebb_dcycle_in logical, intent(in) :: do_plumerise_in, rrfs_sd character(len=*),intent(out):: errmsg @@ -100,6 +100,7 @@ subroutine rrfs_smoke_wrapper_init( seas_opt_in, !>-Other extended_sd_diags = extended_sd_diags_in dbg_opt = dbg_opt_in + n_dbg_lines = n_dbg_lines_in end subroutine rrfs_smoke_wrapper_init @@ -111,17 +112,19 @@ end subroutine rrfs_smoke_wrapper_init subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, & u10m, v10m, ustar, rlat, rlon, tskin, pb2d, t2m, dpt2m, & pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w, & - nsoil, smc, vegtype_dom, vegtype_frac, soiltyp, nlcat, & + nsoil, smc, tslb, vegtype_dom, vegtype_frac, soiltyp, nlcat, & dswsfc, zorl, snow, julian,recmol, & idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv, & dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS, & ntrac, qgrs, gq0, chem3d, tile_num, & ntsmoke, ntdust, ntcoarsepm, imp_physics, imp_physics_thompson, & nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & - ebb_smoke_in, frp_output, coef_bb, ebu_smoke,fhist,min_fplume, & + ebb_smoke_in, frp_output, coef_bb, fire_type_out, & + ebu_smoke,fhist,min_fplume, & max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, & + peak_hr_out,lu_nofire_out,lu_qfire_out, & fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & - errmsg,errflg ) + uspdavg, hpbl_thetav, mpicomm, mpirank, mpiroot, errmsg,errflg ) implicit none @@ -135,7 +138,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, integer, parameter :: its=1,jts=1,jte=1, kts=1 integer, dimension(:), intent(in) :: land, vegtype_dom, soiltyp - real(kind_phys), dimension(:,:), intent(in) :: smc + real(kind_phys), dimension(:,:), intent(in) :: smc, tslb real(kind_phys), dimension(:,:,:), intent(in) :: dust12m_in real(kind_phys), dimension(:,:,:), intent(in) :: smoke_RRFS real(kind_phys), dimension(:,:), intent(in) :: smoke2d_RRFS @@ -153,14 +156,16 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke real(kind_phys), dimension(:,:), intent(inout) :: fire_in real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out - real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume - real(kind_phys), dimension(:), intent( out) :: hwp + real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume, uspdavg, hpbl_thetav + real(kind_phys), dimension(:), intent(inout) :: hwp, peak_hr_out real(kind_phys), dimension(:), intent(inout) :: hwp_ave real(kind_phys), dimension(:,:), intent(inout) :: nwfa, nifa real(kind_phys), dimension(:,:), intent(inout) :: ddvel_inout real(kind_phys), dimension(:,:), intent(inout) :: drydep_flux_out real(kind_phys), dimension(:,:), intent(inout) :: wetdpr real(kind_phys), dimension(:), intent(in) :: wetness + real(kind_phys), dimension(:), intent(out) :: lu_nofire_out,lu_qfire_out + integer, dimension(:), intent(out) :: fire_type_out integer, intent(in) :: imp_physics, imp_physics_thompson integer, dimension(:), intent(in) :: kpbl real(kind_phys), dimension(:), intent(in) :: oro @@ -187,16 +192,17 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(ims:im, jms:jme) :: ssm, rdrag, uthr, snowh ! fengsha dust real(kind_phys), dimension(ims:im, jms:jme) :: rmol, swdown, znt, clayf, sandf real(kind_phys), dimension(ims:im, nlcat, jms:jme) :: vegfrac - real(kind_phys), dimension(ims:im, nsoil, jms:jme) :: smois + real(kind_phys), dimension(ims:im, nsoil, jms:jme) :: smois, stemp real(kind_phys), dimension(ims:im, 1:1, jms:jme, 1:num_emis_dust) :: emis_dust integer, dimension(ims:im, jms:jme) :: isltyp, ivgtyp !>- plume variables ! -- buffers real(kind_phys), dimension(ims:im, jms:jme ) :: coef_bb_dc, flam_frac, frp_in, & fire_hist, peak_hr, lu_nofire, lu_qfire, ebu_in, & - fire_end_hr, hwp_day_avg, kpbl_thetav + fire_end_hr, hwp_day_avg, kpbl_thetav,& + uspdavg2, hpbl_thetav2 integer, dimension(ims:im, jms:jme ) :: min_fplume2, max_fplume2, fire_type - logical :: call_plume, reset_hwp_ave + logical :: call_plume, reset_hwp_ave, avg_hwp_ave !>- optical variables real(kind_phys), dimension(ims:im, jms:jme, ndvel) :: ddvel, settling_flux, drydep_flux_local real(kind_phys), dimension(ims:im, kms:kme, jms:jme, ndvel) :: vgrav @@ -218,6 +224,13 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys) :: factor, factor2, factor3 integer :: nbegin, nv integer :: i, j, k, kp, n +! MPI variables + integer :: mpiid + integer, intent(in) :: mpicomm + integer, intent(in) :: mpirank + integer, intent(in) :: mpiroot + + mpiid = mpirank errmsg = '' errflg = 0 @@ -232,6 +245,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, min_fplume2 = 0 max_fplume2 = 0 + uspdavg2 = 0. + hpbl_thetav2 = 0. emis_seas = 0. emis_dust = 0. peak_hr = 0. @@ -260,12 +275,17 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ! -- compute incremental convective and large-scale rainfall do i=its,ite rnav(i,1)=max((rain_cpl(i)-rainc_cpl(i))*1000., 0.) ! meter to mm +! coef_bb initializes as clear_val (from GFS_typedefs.F90) +! at ktau = 1, coef_bb_dc is set = 1.0 coef_bb_dc(i,1) = coef_bb(i) +! fhist initializes as 1. (from GFS_typedefs.F90) fire_hist (i,1) = fhist (i) + peak_hr (i,1) = peak_hr_out(i) enddo ! Is this a reset timestep (00:00 + dt)? reset_hwp_ave = mod(int(curr_secs-dt),3600) == 0 + avg_hwp_ave = mod(int(curr_secs),3600) == 0 ! plumerise frequency in minutes set up by the namelist input call_plume = (do_plumerise .and. (plumerisefire_frq > 0)) @@ -276,7 +296,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ktau,current_month, current_hour, gmt, con_rd, con_fv, con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,tskin, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & - nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & + nsoil,smc,tslb,vegtype_dom,soiltyp, & + nlcat,vegtype_frac,dswsfc,zorl, & snow,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & @@ -287,20 +308,14 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, num_chem,num_moist, & ntsmoke, ntdust,ntcoarsepm, & moist,chem,ebu_in,kpbl_thetav,ebb_smoke_in, & - fhist,frp_in, hwp_day_avg, fire_end_hr, & - emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & - snowh,clayf,rdrag,sandf,ssm,uthr,oro, hwp_local, & + fire_hist,frp_in, hwp_day_avg, fire_end_hr, & + emis_anoc,smois,stemp,ivgtyp,isltyp,vegfrac,rmol,swdown,znt, & + hfx,pbl,snowh,clayf,rdrag,sandf,ssm,uthr,oro, hwp_local, & t2m,dpt2m,wetness,kpbl, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) - do j=jts,jte - do i=its,ite - peak_hr(i,j)= fire_in(i,1) - enddo - enddo - IF (ktau==1) THEN ebu = 0. do j=jts,jte @@ -311,6 +326,13 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, enddo enddo enddo + ELSE + do k=kts,kte + do i=its,ite + ! ebu is divided by coef_bb_dc since it is applied in the output + ebu(i,k,1)=ebu_smoke(i,k) / coef_bb_dc(i,1) + enddo + enddo ENDIF !RAR: change this to the fractional LU type; fire_type: 0- no fires, 1- Ag @@ -320,6 +342,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, do i=its,ite if (ebu_in(i,j)<0.01) then fire_type(i,j) = 0 + lu_nofire(i,j) = 1.0 else ! Permanent wetlands, snow/ice, water, barren tundra lu_nofire(i,j) = vegfrac(i,11,j) + vegfrac(i,15,j) + vegfrac(i,17,j) + vegfrac(i,20,j) @@ -350,9 +373,10 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, endif !-- compute dust (opt=5) - if (dust_opt==5) then - call gocart_dust_fengsha_driver(dt,chem,rho_phy,smois,p8w,ssm, & - isltyp,snowh,xland,dxy,g,emis_dust,ust,znt, & + if (dust_opt==1) then + call gocart_dust_fengsha_driver(dt,chem,rho_phy, & + smois,stemp,p8w,ssm, & + isltyp,snowh,xland,dxy,g,emis_dust,ust,znt, & clayf,sandf,rdrag,uthr, & num_emis_dust,num_chem,nsoil, & ids,ide, jds,jde, kds,kde, & @@ -367,6 +391,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, ! Every hour (per namelist) the ebu_driver is called to calculate ebu, but ! the plumerise is controlled by the namelist option of plumerise_flag if (add_fire_heat_flux) then + WRITE(1000+mpiid,*) 'Entered add_fire_heat_flux at timestep:',ktau do i = its,ite if ( coef_bb_dc(i,1)*frp_in(i,1) .ge. 1.E7 ) then fire_heat_flux_out(i) = min(max(0.,0.88*coef_bb_dc(i,1)*frp_in(i,1) / & @@ -396,7 +421,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, kpbl_thetav, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte, errmsg, errflg ) + its,ite, jts,jte, kts,kte, errmsg, errflg, curr_secs, & + xlat, xlong, uspdavg2, hpbl_thetav2, mpiid ) if(errflg/=0) return end if @@ -409,7 +435,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, swdown,ebb_dcycle,ebu_in,ebu,fire_type, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + its,ite, jts,jte, kts,kte , mpiid ) endif !>-- compute coarsepm setting if using simple dry dep option and @@ -431,7 +457,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, pm_settling,drydep_flux_local,settling_flux,dbg_opt, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) + its,ite, jts,jte, kts,kte, curr_secs, mpiid, xlat, xlong ) do nv=1,ndvel do i=its,ite ddvel_inout(i,nv)=ddvel(i,1,nv) @@ -470,10 +496,12 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, endif endif -! Smoke emisisons diagnostic +! Smoke emisisons diagnostic, RAR: let's multiply by coef_bb_dc before output +! Since ebu_smoke includes coef_bb_dc, we need to divide by coef_bb_dc when it +! comes back into the wrapper. do k=kts,kte do i=its,ite - ebu_smoke(i,k)=ebu(i,k,1) + ebu_smoke(i,k)=ebu(i,k,1) * coef_bb_dc(i,1) enddo enddo @@ -485,15 +513,21 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, do i=its,ite hwp(i)=hwp_local(i,1) hwp_ave(i) = hwp_ave(i) + hwp(i)*dt + if ( ktau == 1) then + hwp_ave(i) = hwp_ave(i) / dt + elseif ( avg_hwp_ave ) then + hwp_ave(i) = hwp_ave(i) / 3600._kind_phys + endif enddo - + + !---- diagnostic output of dry deposition & gravitational settling fluxes if ( drydep_opt == 1 .and. (extended_sd_diags .or. dbg_opt) ) then do nv = 1, ndvel do i=its,ite drydep_flux_out(i,nv) = drydep_flux_out(i,nv) + & - drydep_flux_local(i,1,nv) + & - settling_flux(i,1,nv) + drydep_flux_local(i,1,nv) !+ & + !settling_flux(i,1,nv) enddo enddo endif @@ -520,6 +554,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, !------------------------------------- !-- to output for diagnostics do i = 1, im +! RAR: let's remove the seas and ant. OC emseas (i) = emis_seas(i,1,1,1)*1.e+9 ! size bin 1 sea salt emission: ug/m2/s emanoc (i) = emis_anoc (i) ! anthropogenic organic carbon: ug/m2/s emdust (i) = emis_dust(i,1,1,1) + emis_dust(i,1,1,2) + & @@ -529,10 +564,13 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, fhist (i) = fire_hist (i,1) min_fplume (i) = real(min_fplume2(i,1)) max_fplume (i) = real(max_fplume2(i,1)) + fire_type_out(i)=fire_type(i,1) + lu_nofire_out(i)=lu_nofire(i,1) + lu_qfire_out (i)=lu_qfire(i,1) enddo do i = 1, im - fire_in(i,1) = peak_hr(i,1) + peak_hr_out(i) = peak_hr(i,1) enddo !-- to provide real aerosol emission for Thompson MP @@ -568,7 +606,7 @@ subroutine rrfs_smoke_prep( & ktau,current_month,current_hour,gmt,con_rd,con_fv,con_cp, & u10m,v10m,ustar,land,garea,rlat,rlon,ts2d, & pr3d,ph3d,phl3d,tk3d,prl3d,us3d,vs3d,spechum,w, & - nsoil,smc,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & + nsoil,smc,tslb,vegtype_dom,soiltyp,nlcat,vegtype_frac,dswsfc,zorl, & snow_cpl,dust12m_in,emi_ant_in,smoke_RRFS,smoke2d_RRFS,coef_bb_dc, & hf2d, pb2d, g, pi, hour_int, peak_hr, & u10,v10,ust,tsk,xland,xlat,xlong,dxy, & @@ -579,9 +617,9 @@ subroutine rrfs_smoke_prep( & num_chem, num_moist, & ntsmoke, ntdust, ntcoarsepm, & moist,chem,ebu_in,kpbl_thetav,ebb_smoke_in, & - fhist,frp_in, hwp_day_avg, fire_end_hr, & - emis_anoc,smois,ivgtyp,isltyp,vegfrac,rmol,swdown,znt,hfx,pbl, & - snowh,clayf,rdrag,sandf,ssm,uthr,oro,hwp_local, & + fire_hist,frp_in, hwp_day_avg, fire_end_hr, & + emis_anoc,smois,stemp,ivgtyp,isltyp,vegfrac,rmol,swdown, & + znt,hfx,pbl,snowh,clayf,rdrag,sandf,ssm,uthr,oro,hwp_local, & t2m,dpt2m,wetness,kpbl, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & @@ -599,7 +637,7 @@ subroutine rrfs_smoke_prep( & u10m, v10m, ustar, garea, rlat, rlon, ts2d, dswsfc, & zorl, snow_cpl, pb2d, hf2d, oro, t2m, dpt2m, wetness, recmol real(kind=kind_phys), dimension(ims:ime, nlcat), intent(in) :: vegtype_frac - real(kind=kind_phys), dimension(ims:ime, nsoil), intent(in) :: smc + real(kind=kind_phys), dimension(ims:ime, nsoil), intent(in) :: smc,tslb real(kind=kind_phys), dimension(ims:ime, 12, 5), intent(in) :: dust12m_in real(kind=kind_phys), dimension(ims:ime, 24, 2), intent(in) :: smoke_RRFS ! This is a place holder for ebb_dcycle == 2, currently set to hold a single @@ -633,8 +671,8 @@ subroutine rrfs_smoke_prep( & real(kind_phys), dimension(ims:ime, kms:kme, jms:jme, num_chem), intent(out) :: chem real(kind_phys), dimension(ims:ime, kms:kme, jms:jme), intent(out) :: z_at_w - real(kind_phys), dimension(ims:ime, nsoil, jms:jme), intent(out) :: smois - real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: frp_in, fire_end_hr, fhist, coef_bb_dc + real(kind_phys), dimension(ims:ime, nsoil, jms:jme), intent(out) :: smois,stemp + real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: frp_in, fire_end_hr, fire_hist, coef_bb_dc real(kind_phys), dimension(ims:ime,jms:jme), intent(inout) :: hwp_day_avg, peak_hr real(kind_phys), dimension(ims:ime), intent(inout) :: emis_anoc,ebb_smoke_in real(kind_phys), parameter :: conv_frp = 1.e+06_kind_phys ! FRP conversion factor, MW to W @@ -730,6 +768,7 @@ subroutine rrfs_smoke_prep( & do j=jts,jte do i=its,ite smois(i,k,j)=smc(i,k) + stemp(i,k,j)=tslb(i,k) enddo enddo enddo @@ -776,13 +815,14 @@ subroutine rrfs_smoke_prep( & rri(i,k,j)=1./rho_phy(i,k,j) vvel(i,k,j)=-w(i,kkp)*rri(i,k,j)/g moist(i,k,j,:)=0. - moist(i,k,j,1)=gq0(i,kkp,p_atm_shum) - if (t_phy(i,k,j) > 265.) then - moist(i,k,j,2)=gq0(i,kkp,p_atm_cldq) + moist(i,k,j,1)=gq0(i,kkp,1) + !if (t_phy(i,k,j) > 265.) then + moist(i,k,j,2)=gq0(i,kkp,2) if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. - else - moist(i,k,j,2)=0. - endif + !else + ! moist(i,k,j,2)=0. + if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. + !endif !-- zmid(i,k,j)=phl3d(i,kkp)/g enddo @@ -862,11 +902,11 @@ subroutine rrfs_smoke_prep( & if (hour_int .le. 24) then do j=jts,jte do i=its,ite - ebu_in (i,j) = smoke_RRFS(i,hour_int+1,1) ! smoke frp_in (i,j) = smoke_RRFS(i,hour_int+1,2)*conv_frp ! frp - fire_end_hr(i,j) = 0.0 - hwp_day_avg(i,j) = 0.0 + ! These 2 arrays aren't needed for this option + ! fire_end_hr(i,j) = 0.0 + ! hwp_day_avg(i,j) = 0.0 ebb_smoke_in (i) = ebu_in(i,j) enddo enddo @@ -890,7 +930,8 @@ subroutine rrfs_smoke_prep( & if (ktau==1) then do j=jts,jte do i=its,ite - fhist (i,j) = 1. + ! GFS_typedefs.F90 initializes this = 1, but should be OK to duplicate, RAR?? + fire_hist (i,j) = 1. coef_bb_dc (i,j) = 1. if (xlong(i,j)<230.) then peak_hr(i,j)= 0.0* 3600. ! peak at 24 UTC, fires in Alaska @@ -909,7 +950,7 @@ subroutine rrfs_smoke_prep( & enddo endif - ! We will add a namelist variable, real :: flam_frac_global + ! We will add a namelist variable, real :: flam_frac_global, RAR?? do k=kms,kte do i=ims,ime chem(i,k,jts,p_smoke )=max(epsilc,gq0(i,k,ntsmoke )) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index af61ac05e..fc3aa9fe6 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrfs_smoke_wrapper type = scheme - dependencies = ../hooks/machine.F,dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,plume_data_mod.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 + dependencies = dep_dry_simple_mod.F90,module_wetdep_ls.F90,dust_data_mod.F90,dust_fengsha_mod.F90,module_add_emiss_burn.F90,module_plumerise.F90,module_smoke_plumerise.F90,module_zero_plumegen_coms.F90,rrfs_smoke_config.F90,seas_data_mod.F90,seas_mod.F90,seas_ngac_mod.F90,coarsepm_settling_mod.F90, dep_dry_mod_emerson.F90,dep_data_mod.F90 ######################################################################## [ccpp-arg-table] @@ -71,6 +71,13 @@ dimensions = () type = integer intent = in +[n_dbg_lines_in] + standard_name = smoke_debug_lines + long_name = rrfs smoke add smoke option + units = index + dimensions = () + type = integer + intent = in [plume_wind_eff_in] standard_name = option_for_wind_effects_on_smoke_plumerise long_name = wind effect plumerise option @@ -406,6 +413,14 @@ type = real kind = kind_phys intent = inout +[tslb] + standard_name = soil_temperature_for_land_surface_model + long_name = soil temperature for land surface model + units = K + dimensions = (horizontal_loop_extent,vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = in [vegtype_dom] standard_name = vegetation_type_classification long_name = vegetation type at each grid cell @@ -715,6 +730,13 @@ type = real kind = kind_phys intent = inout +[fire_type_out] + standard_name = fire_type_out + long_name = type of fire + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = out [ebu_smoke] standard_name = ebu_smoke long_name = buffer of vertical fire emission @@ -747,6 +769,43 @@ type = real kind = kind_phys intent = inout +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[uspdavg] + standard_name = bl_averaged_wind_speed + long_name = average wind speed within the boundary layer + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[hpbl_thetav] + standard_name = pbl_height_thetav + long_name = pbl height based on modified parcel method + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [drydep_flux_out] standard_name = dry_deposition_flux long_name = rrfs dry deposition flux @@ -810,6 +869,30 @@ type = real kind = kind_phys intent = inout +[peak_hr_out] + standard_name = peak_hr_fire + long_name = hour of peak fire emissions + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[lu_nofire_out] + standard_name = lu_nofire_out + long_name = land use of no fire pixels for type + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[lu_qfire_out] + standard_name = lu_qfire_out + long_name = land use of fire pixels for type + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [fire_heat_flux_out] standard_name = surface_fire_heat_flux long_name = heat flux of fire at the surface From c0544c218776d4a94169d45cb7dae102800594a1 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Tue, 23 Jan 2024 16:13:19 +0000 Subject: [PATCH 131/132] "update to address code reviewer's comments" --- physics/smoke_dust/dep_dry_mod_emerson.F90 | 14 ---------- physics/smoke_dust/module_add_emiss_burn.F90 | 27 +++++++++---------- physics/smoke_dust/rrfs_smoke_config.F90 | 2 +- physics/smoke_dust/rrfs_smoke_wrapper.F90 | 14 +++------- physics/smoke_dust/rrfs_smoke_wrapper.meta | 28 +++++++------------- 5 files changed, 27 insertions(+), 58 deletions(-) diff --git a/physics/smoke_dust/dep_dry_mod_emerson.F90 b/physics/smoke_dust/dep_dry_mod_emerson.F90 index 771801c44..e69d6bc3f 100755 --- a/physics/smoke_dust/dep_dry_mod_emerson.F90 +++ b/physics/smoke_dust/dep_dry_mod_emerson.F90 @@ -179,10 +179,6 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & eps0 = eps0_grs end if ! Set if snow greater than 1 cm -! if ( snowh(i,j) .gt. 0.01 ) then ! snow -! A = A_wat -! eps0 = eps0_wat -! endif ! Interception Ein = Cin * ( dp / A )**vv ! Surface resistance @@ -234,25 +230,15 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, & IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12 dt_settl(nv) = REAL(ntdt,kind=kind_phys) /REAL(ndt_settl(nv),kind=kind_phys) enddo - !do nv = 1, ndvel - ! chem_before(nv) = 0._kind_phys - ! do k = kts, kte - ! chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 - ! enddo - !enddo ! Perform gravitational settling if desired if ( settling_flag == 1 ) then call particle_settling(cblk_col,rho_col,delz_col,vg_col,dt_settl,ndt_settl,ndvel,kts,kte) endif ! Put cblk back into chem array do nv= 1, ndvel - !chem_after(nv) = 0._kind_phys - !settling_flux(i,j,nv) = 0._kind_phys do k = kts, kte chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv) - !chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2 enddo ! k - !settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2 enddo ! nv end do ! j end do ! i diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index 0a22fcfd7..f1bbaeee9 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -47,7 +47,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise - real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation + real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm, coef_con ! For BB emis. diurnal cycle calculation ! For Gaussian diurnal cycle real(kind_phys), PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later @@ -89,6 +89,8 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & if (ebb_dcycle==2) then ! Constants for the fire diurnal cycle calculation + coef_con = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & + exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) do j=jts,jte do i=its,ite fire_age= time_int + (fire_end_hr(i,j)-1._kind_phys)*3600._kind_phys !One hour delay is due to the latency of the RAVE files @@ -97,13 +99,12 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. CASE (1) ! these fires will have exponentially decreasing diurnal cycle, - coef_bb_dc(i,j) = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & - exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) + coef_bb_dc(i,j) = coef_con - ! IF ( dbg_opt .AND. time_int<5000.) then - ! WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j) - ! WRITE(6,*) 'coef_bb_dc(i,j) ',coef_bb_dc(i,j) - ! END IF + IF ( dbg_opt .AND. time_int<5000.) then + WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j) + WRITE(6,*) 'coef_bb_dc(i,j) ',coef_bb_dc(i,j) + END IF CASE (3) age_hr= fire_age/3600._kind_phys @@ -123,9 +124,6 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & dc_hwp= MAX(0._kind_phys,dc_hwp) dc_hwp= MIN(25._kind_phys,dc_hwp) - !coef_bb_dc(i,j)= sc_factor* fire_hist(i,j)* rate_ebb2(i,j)* (1. + log( - !hwp_(i,j)/ hwp_day_avg(i,j))) - ! RAR: Gaussian profile for wildfires dt1= abs(timeq - peak_hr(i,j)) dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400. @@ -134,13 +132,12 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & dc_gp = MAX(0._kind_phys,dc_gp) dc_fn = MIN(dc_hwp/dc_gp,3._kind_phys) - !coef_bb_dc(i,j) = fire_hist(i,j)* dc_fn coef_bb_dc(i,j) = fire_hist(i,j)* dc_hwp - ! IF ( dbg_opt .AND. time_int<5000.) then - ! WRITE(6,*) 'i,j,fire_hist(i,j),peak_hr(i,j) ', i,j,fire_hist(i,j),peak_hr(i,j) - ! WRITE(6,*) 'dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) ',dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) - ! END IF + IF ( dbg_opt .AND. time_int<5000.) then + WRITE(6,*) 'i,j,fire_hist(i,j),peak_hr(i,j) ', i,j,fire_hist(i,j),peak_hr(i,j) + WRITE(6,*) 'dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) ',dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) + END IF CASE DEFAULT END SELECT diff --git a/physics/smoke_dust/rrfs_smoke_config.F90 b/physics/smoke_dust/rrfs_smoke_config.F90 index dae4338bb..c20d6e2db 100755 --- a/physics/smoke_dust/rrfs_smoke_config.F90 +++ b/physics/smoke_dust/rrfs_smoke_config.F90 @@ -40,7 +40,7 @@ module rrfs_smoke_config ! -- integer, parameter :: CHEM_OPT_GOCART= 1 - integer, parameter :: num_moist=3, num_chem=20, num_emis_seas=5, num_emis_dust=5 + integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5 ! -- hydrometeors integer, parameter :: p_qv=1 diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index 4daad7168..3842cba54 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -121,7 +121,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & ebb_smoke_in, frp_output, coef_bb, fire_type_out, & ebu_smoke,fhist,min_fplume, & - max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, & + max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout, & peak_hr_out,lu_nofire_out,lu_qfire_out, & fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & uspdavg, hpbl_thetav, mpicomm, mpirank, mpiroot, errmsg,errflg ) @@ -154,8 +154,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_output, fhist real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke - real(kind_phys), dimension(:,:), intent(inout) :: fire_in - real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out + real(kind_phys), dimension(:), intent(out ) :: fire_heat_flux_out, frac_grid_burned_out real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume, uspdavg, hpbl_thetav real(kind_phys), dimension(:), intent(inout) :: hwp, peak_hr_out real(kind_phys), dimension(:), intent(inout) :: hwp_ave @@ -816,13 +815,8 @@ subroutine rrfs_smoke_prep( & vvel(i,k,j)=-w(i,kkp)*rri(i,k,j)/g moist(i,k,j,:)=0. moist(i,k,j,1)=gq0(i,kkp,1) - !if (t_phy(i,k,j) > 265.) then - moist(i,k,j,2)=gq0(i,kkp,2) - if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. - !else - ! moist(i,k,j,2)=0. - if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0. - !endif + moist(i,k,j,2)=gq0(i,kkp,2) + if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0. !-- zmid(i,k,j)=phl3d(i,kkp)/g enddo diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index fc3aa9fe6..e00781ec1 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -731,9 +731,9 @@ kind = kind_phys intent = inout [fire_type_out] - standard_name = fire_type_out + standard_name = fire_type long_name = type of fire - units = none + units = 1 dimensions = (horizontal_loop_extent) type = integer intent = out @@ -791,17 +791,17 @@ type = integer intent = in [uspdavg] - standard_name = bl_averaged_wind_speed + standard_name = mean_wind_speed_in_boundary_layer long_name = average wind speed within the boundary layer - units = none + units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout [hpbl_thetav] - standard_name = pbl_height_thetav + standard_name = atmosphere_boundary_layer_thickness_from_modified_parcel long_name = pbl height based on modified parcel method - units = none + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -861,24 +861,16 @@ type = real kind = kind_phys intent = inout -[fire_in] - standard_name = smoke_fire_auxiliary_input - long_name = smoke fire auxiliary input variables - units = various - dimensions = (horizontal_loop_extent,fire_auxiliary_data_extent) - type = real - kind = kind_phys - intent = inout [peak_hr_out] standard_name = peak_hr_fire - long_name = hour of peak fire emissions - units = none + long_name = time_of_peak_fire_emissions + units = s dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out [lu_nofire_out] - standard_name = lu_nofire_out + standard_name = sum_of_land_use_fractions_for_no_fire_pixels long_name = land use of no fire pixels for type units = frac dimensions = (horizontal_loop_extent) @@ -886,7 +878,7 @@ kind = kind_phys intent = out [lu_qfire_out] - standard_name = lu_qfire_out + standard_name = sum_of_land_use_fractions_for_cropland_fire_pixels long_name = land use of fire pixels for type units = frac dimensions = (horizontal_loop_extent) From a0acaedeb7512f9c3cc062922b83466ffdfc2478 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Wed, 24 Jan 2024 16:35:59 +0000 Subject: [PATCH 132/132] "update to resolve code managers' comments" --- physics/smoke_dust/module_add_emiss_burn.F90 | 6 +++--- physics/smoke_dust/rrfs_smoke_wrapper.meta | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/smoke_dust/module_add_emiss_burn.F90 b/physics/smoke_dust/module_add_emiss_burn.F90 index f1bbaeee9..80d91bb0e 100755 --- a/physics/smoke_dust/module_add_emiss_burn.F90 +++ b/physics/smoke_dust/module_add_emiss_burn.F90 @@ -89,8 +89,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & if (ebb_dcycle==2) then ! Constants for the fire diurnal cycle calculation - coef_con = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * & - exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) + coef_con=1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys) do j=jts,jte do i=its,ite fire_age= time_int + (fire_end_hr(i,j)-1._kind_phys)*3600._kind_phys !One hour delay is due to the latency of the RAVE files @@ -99,7 +98,8 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, & SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc. CASE (1) ! these fires will have exponentially decreasing diurnal cycle, - coef_bb_dc(i,j) = coef_con + coef_bb_dc(i,j) = coef_con*1._kind_phys/(sigma_fire_dur(1) *fire_age) * & + exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 )) IF ( dbg_opt .AND. time_int<5000.) then WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j) diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index e00781ec1..271d2dd36 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -872,7 +872,7 @@ [lu_nofire_out] standard_name = sum_of_land_use_fractions_for_no_fire_pixels long_name = land use of no fire pixels for type - units = frac + units = 1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -880,7 +880,7 @@ [lu_qfire_out] standard_name = sum_of_land_use_fractions_for_cropland_fire_pixels long_name = land use of fire pixels for type - units = frac + units = 1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys