diff --git a/INFO b/INFO index 604ce5092c..14c9bcff04 100644 --- a/INFO +++ b/INFO @@ -1,5 +1,9 @@ -18 Jan 2022 +27 Feb 2022 + - update FV3 to 24feb22 gsl/develop branch, a2a6a22, tag global-24Feb2022 + effective 00Z 28Feb22 +20 Jan 2022 - change from ugwpv1 SDF to unified_ugwp SDF + effective 00Z 21Jan22 11 Jan 2022 - added NCL images in realtime 10 Jan 2022 @@ -13,7 +17,7 @@ - changed default values in field_table_gsd to 0.0 for ice_nc, rain_nc, water_nc, sgs_tke variables 21 Dec 2021 - - update to 15dec21 gsl/develop branch, dbdb629 + - update FV3 to 15dec21 gsl/develop branch, dbdb629 add updated MYNN routines turn off GF shallow scheme 14 Dec 2021 diff --git a/sorc/build_fv3.sh b/sorc/build_fv3.sh index 2f7ddc2125..1648dd78c2 100755 --- a/sorc/build_fv3.sh +++ b/sorc/build_fv3.sh @@ -30,6 +30,6 @@ if [ ${RUN_CCPP:-${1:-"NO"}} = "NO" ]; then else #JKH./compile.sh "$target" "-DAPP=ATM -D32BIT=Y -DCCPP_SUITES=FV3_GFS_v16,FV3_GSD_noah,FV3_GSD_v0,FV3_GSD_noah_unified_ugwp" 2 NO NO ./compile.sh "$target" "-DAPP=ATM -D32BIT=Y -DCCPP_SUITES=FV3_GFS_v16,FV3_GSD_noah_unified_ugwp" 2 YES NO - mkdir ../NEMS/exe + mkdir -p ../NEMS/exe mv -f fv3_2.exe ../NEMS/exe/global_fv3gfs.x fi diff --git a/sorc/build_ufswm_24feb22.sh b/sorc/build_ufswm_24feb22.sh new file mode 100755 index 0000000000..e0db4c53c6 --- /dev/null +++ b/sorc/build_ufswm_24feb22.sh @@ -0,0 +1,28 @@ +#! /usr/bin/env bash +set -eux + +source ./machine-setup.sh > /dev/null 2>&1 +cwd=`pwd` + +USE_PREINST_LIBS=${USE_PREINST_LIBS:-"true"} +if [ $USE_PREINST_LIBS = true ]; then + export MOD_PATH=/lfs4/HFIP/hfv3gfs/nwprod/NCEPLIBS/modulefiles +else + export MOD_PATH=${cwd}/lib/modulefiles +fi + +# Check final exec folder exists +if [ ! -d "../exec" ]; then + mkdir ../exec +fi + +if [ $target = hera ]; then target=hera.intel ; fi +if [ $target = jet ]; then target=jet.intel ; fi +if [ $target = orion ]; then target=orion.intel ; fi + +cd ufs-weather-model_24feb22_a2a6a22 +FV3=$( pwd -P )/FV3 +cd tests/ +./compile.sh "$target" "-DAPP=ATM -D32BIT=Y -DCCPP_SUITES=FV3_GFS_v16,FV3_GSD_noah_unified_ugwp" 2 YES NO +mkdir -p ../NEMS/exe +mv -f fv3_2.exe ../NEMS/exe/global_fv3gfs.x diff --git a/sorc/checkout.sh b/sorc/checkout.sh index e1c3d098a1..9d7807a7ca 100755 --- a/sorc/checkout.sh +++ b/sorc/checkout.sh @@ -34,20 +34,20 @@ if [[ ! -d fv3gfs.fd ]] ; then cd fv3gfs.fd git checkout GFS.v16.0.16 else - echo ufs-weather-model_15dec_gsldev.fd checkout ... - if [[ ! -d ufs-weather-model_15dec_dbdb629 ]] ; then - rm -f ${topdir}/checkout-15dec.log - git clone --recursive -b gsl/develop https://github.com/NOAA-GSL/ufs-weather-model ufs-weather-model_15dec_dbdb629 >> ${topdir}/checkout-fv3gfs.log 2>&1 - cd ufs-weather-model_15dec_dbdb629 - git checkout dbdb629ec64a8312c9a4a58649f366ac0757c04b + echo ufs-weather-model_24feb22_gsldev.fd checkout ... + if [[ ! -d ufs-weather-model_24feb22_a2a6a22 ]] ; then + rm -f ${topdir}/checkout-24feb22.log + git clone --recursive -b gsl/develop https://github.com/NOAA-GSL/ufs-weather-model ufs-weather-model_24feb22_a2a6a22 >> ${topdir}/checkout-fv3gfs.log 2>&1 + cd ufs-weather-model_24feb22_a2a6a22 + git checkout global-24Feb2022 else - echo 'Skip. Directory ufs-weather-model_15dec_gsldev.fd already exists.' + echo 'Skip. Directory ufs-weather-model_24feb22_gsldev.fd already exists.' fi fi git submodule update --init --recursive cd ${topdir} if [ ${run_ccpp:-"NO"} = "YES" ]; then - ln -fs ufs-weather-model_15dec_dbdb629 fv3gfs.fd + ln -fs ufs-weather-model_24feb22_a2a6a22 fv3gfs.fd rsync -avx fv3gfs.fd_gsl/FV3/ fv3gfs.fd/FV3/ ## copy over changes not in FV3 repository fi else diff --git a/sorc/checkout_gsldev_24feb22.sh b/sorc/checkout_gsldev_24feb22.sh new file mode 100755 index 0000000000..c878d0506a --- /dev/null +++ b/sorc/checkout_gsldev_24feb22.sh @@ -0,0 +1,22 @@ +#!/bin/sh +#set -xue +set -x + +topdir=$(pwd) +echo $topdir + +echo ufs-weather-model_24feb22_gsldev.fd checkout ... +if [[ ! -d ufs-weather-model_24feb22_a2a6a22 ]] ; then + rm -f ${topdir}/checkout-24feb22.log + git clone --recursive -b gsl/develop https://github.com/NOAA-GSL/ufs-weather-model ufs-weather-model_24feb22_a2a6a22 >> ${topdir}/checkout-24feb22.log 2>&1 + cd ufs-weather-model_24feb22_a2a6a22 + git checkout a2a6a22b865d471a2814712ea80bef946d30bd2d + git submodule update --init --recursive + cd ${topdir} + ln -fs ufs-weather-model_24feb22_a2a6a22 fv3gfs.fd + rsync -avx fv3gfs.fd_gsl/FV3/ fv3gfs.fd/FV3/ ## copy over changes not in FV3 repository +else + echo 'Skip. Directory ufs-weather-model_24feb22_gsldev.fd already exists.' +fi + +exit 0 diff --git a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/drag_suite.F90 b/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/drag_suite.F90 deleted file mode 100644 index 21d15de276..0000000000 --- a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/drag_suite.F90 +++ /dev/null @@ -1,1366 +0,0 @@ -!> \File drag_suite.F90 -!! This file is the parameterization of orographic gravity wave -!! drag, mountain blocking, and form drag. - -!> This module contains the CCPP-compliant orographic gravity wave dray scheme. - module drag_suite - - contains - - subroutine drag_suite_init(gwd_opt, errmsg, errflg) - - integer, intent(in) :: gwd_opt - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Consistency checks - if (gwd_opt/=3 .and. gwd_opt/=33) then - write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & - & drag is different from drag_suite scheme" - errflg = 1 - return - end if - end subroutine drag_suite_init - -! \defgroup GFS_ogwd GFS Orographic Gravity Wave Drag -!> \defgroup gfs_drag_suite GFS drag_suite Main -!! \brief This subroutine includes orographic gravity wave drag, mountain -!! blocking, and form drag. -!! -!> The time tendencies of zonal and meridional wind are altered to -!! include the effect of mountain induced gravity wave drag from -!! subgrid scale orography including convective breaking, shear -!! breaking and the presence of critical levels. -!! -!> \section arg_table_drag_suite_run Argument Table -!! \htmlinclude drag_suite_run.html -!! -!> \section gen_drag_suite GFS Orographic GWD Scheme General Algorithm -!! -# Calculate subgrid mountain blocking -!! -# Calculate orographic wave drag -!! -!! The NWP model gravity wave drag (GWD) scheme in the GFS has two -!! main components: how the surface stress is computed, and then how -!! that stress is distributed over a vertical column where it may -!! interact with the models momentum. Each of these depends on the -!! large scale environmental atmospheric state and assumptions about -!! the sub-grid scale processes. In Alpert GWD (1987) based on linear, -!! two-dimensional non-rotating, stably stratified flow over a mountain ridge, -!! sub-grid scale gravity wave motions are assumed which propagate away -!! from the mountain. Described in Alpert (1987), the flux measured over -!! a "low level" vertically averaged layer, in the atmosphere defines a base -!! level flux. "Low level" was taken to be the first 1/3 of the troposphere -!! in the 1987 implementation. This choice was meant to encompass a thick -!! low layer for vertical averages of the environmental (large scale) flow -!! quantities. The vertical momentum flux or gravity wave stress in a -!! grid box due to a single mountain is given as in Pierrehumbert, (1987) (PH): -!! -!! \f$ \tau = \frac {\rho \: U^{3}\: G(F_{r})} {\Delta X \; N } \f$ -!! -!! emetic \f$ \Delta X \f$ is a grid increment, N is the Brunt Viasala frequency -!! -!! -!! \f$ N(\sigma) = \frac{-g \: \sigma \: -!! \frac{\partial\Theta}{\partial\sigma}}{\Theta \:R \:T} \f$ -!! -!! The environmental variables are calculated from a mass weighted vertical -!! average over a base layer. G(Fr) is a monotonically increasing -!! function of Froude number, -!! -!! \f$ F_{r} = \frac{N h^{'}}{U} \f$ -!! -!! where U is the wind speed calculated as a mass weighted vertical average in -!! the base layer, and h', is the vertical displacement caused by the orography -!! variance. An effective mountain length for the gravity wave processes, -!! -!! \f$ l^{*} = \frac{\Delta X}{m} \f$ -!! -!! where m is the number of mountains in a grid box, can then -!! be defined to obtain the form of the base level stress -!! -!! -!! \f$ \tau = \frac {\rho \: U^{3} \: G(F_{r})} {N \;l^{*}} \f$ -!! -!! giving the stress induced from the surface in a model grid box. -!! PH gives the form for the function G(Fr) as -!! -!! -!! \f$ G(F_{r}) = \bar{G}\frac{F^{2}_{r}}{F^{2}_{r}\: + \:a^{2}} \f$ -!! -!! Where \f$ \bar{G} \f$ is an order unity non-dimensional saturation -!! flux set to 1 and 'a' is a function of the mountain aspect ratio also -!!set to 1 in the 1987 implementation of the GFS GWD. Typical values of -!! U=10m/s, N=0.01 1/s, l*=100km, and a=1, gives a flux of 1 Pascal and -!! if this flux is made to go to zero linearly with height then the -!! decelerations would be about 10/m/s/day which is consistent with -!! observations in PH. -!! -!! -!! In Kim, Moorthi, Alpert's (1998, 2001) GWD currently in GFS operations, -!! the GWD scheme has the same physical basis as in Alpert (1987) with the addition -!! of enhancement factors for the amplitude, G, and mountain shape details -!! in G(Fr) to account for effects from the mountain blocking. A factor, -!! E m', is an enhancement factor on the stress in the Alpert '87 scheme. -!! The E ranges from no enhancement to an upper limit of 3, E=E(OA)[1-3], -!! and is a function of OA, the Orographic Asymmetry defined in KA (1995) as -!! -!! Orographic Asymmetry (OA) = \f$ \frac{ \bar{x} \; - \; -!! \sum\limits_{j=1}^{N_{b}} x_{j} \; n_{j} }{\sigma_{x}} \f$ -!! -!! where Nb is the total number of bottom blocks in the mountain barrier, -!! \f$ \sigma_{x} \f$ is the standard deviation of the horizontal distance defined by -!! -!! \f$ \sigma_{x} = \sqrt{ \frac{\sum\limits_{j=1}^{N_{b}} -!! \; (x_{j} \; - \; \bar{x} )^2}{N_{x}} } \f$ -!! -!! -!! where Nx is the number of grid intervals for the large scale domain being -!! considered. So the term, E(OA)m'/ \f$ \Delta X \f$ in Kim's scheme represents -!! a multiplier on G shown in Alpert's eq (1), where m' is the number of mountains -!! in a sub-grid scale box. Kim increased the complexity of m' making it a -!! function of the fractional area of the sub-grid mountain and the asymmetry -!! and convexity statistics which are found from running a gravity wave -!! model for a large number of cases: -!! -!! \f$ m^{'} = C_{m} \Delta X \left[ \frac{1 \; + \; -!! \sum\limits_{x} L_{h} }{\Delta X} \right]^{OA+1} \f$ -!! -!! Where, according to Kim, \f$ \sum \frac{L_{h}}{\Delta X} \f$ is -!! the fractional area covered by the subgrid-scale orography higher than -!! a critical height \f$ h_{c} = Fr_{c} U_{0}/N_{0} \f$ , over the -!! "low level" vertically averaged layer, for a grid box with the interval -!! \f$ \Delta X \f$. Each \f$ L_{n}\f$ is the width of a segment of -!! orography intersection at the critical height: -!! -!! \f$ Fr_{0} = \frac{N_{0} \; h^{'}}{U_{0}} \f$ -!! -!! \f$ G^{'}(OC,Fr_{0}) = \frac{Fr_{0}^{2}}{Fr_{0}^{2} \; + \; a^{2}} \f$ -!! -!! \f$ a^{2} = \frac{C_{G}}{OC} \f$ -!! -!! \f$ E(OA, Fr_{0}) = (OA \; + \; 2)^{\delta} \f$ and \f$ \delta -!! \; = \; \frac{C_{E} \; Fr_{0}}{Fr_{c}} \f$ where \f$ Fr_{c} \f$ -!! is as in Alpert. -!! -!! -!! This represents a closed scheme, somewhat empirical adjustments -!! to the original scheme to calculate the surface stress. -!! -!! Momentum is deposited by the sub-grid scale gravity waves break due -!! to the presence of convective mixing assumed to occur when the -!! minimum Richardson number: -!! -!! Orographic Convexity (OC) = \f$ \frac{ \sum\limits_{j=1}^{N_{x}} -!! \; (h_{j} \; - \; \bar{h})^4 }{N_{x} \;\sigma_{h}^4} \f$ , -!! and where \f$ \sigma_{h} = \sqrt{ \frac{\sum\limits_{j=1}^{N_{x}} -!! \; (h_{j} \; - \; \bar{h} )^2}{N_{x}} } \f$ -!! -!! This represents a closed scheme, somewhat empirical adjustments -!! to the original scheme to calculate the surface stress. -!! -!! Momentum is deposited by the sub-grid scale gravity waves break due -!! to the presence of convective mixing assumed to occur when -!! the minimum Richardson number: -!! -!! \f$ Ri_{m} = \frac{Ri(1 \; - \; Fr)}{(1 \; + \; \sqrt{Ri}Fr)^2} \f$ -!! -!! Is less than 1/4 Or if critical layers are encountered in a layer -!! the the momentum flux will vanish. The critical layer is defined -!! when the base layer wind becomes perpendicular to the environmental -!! wind. Otherwise, wave breaking occurs at a level where the amplification -!! of the wave causes the local Froude number or similarly a truncated -!! (first term of the) Scorer parameter, to be reduced below a critical -!! value by the saturation hypothesis (Lindzen,). This is done through -!! eq 1 which can be written as -!! -!! \f$ \tau = \rho U N k h^{'2} \f$ -!! -!! For small Froude number this is discretized in the vertical so at each -!! level the stress is reduced by ratio of the Froude or truncated Scorer -!! parameter, \f$ \frac{U^{2}}{N^{2}} = \frac{N \tau_{l-1}}{\rho U^{3} k} \f$ , -!! where the stress is from the layer below beginning with that found near -!! the surface. The respective change in momentum is applied in -!! that layer building up from below. -!! -!! An amplitude factor is part of the calibration of this scheme which is -!! a function of the model resolution and the vertical diffusion. This -!! is because the vertical diffusion and the GWD account encompass -!! similar physical processes. Thus, one needs to run the model over -!! and over for various amplitude factors for GWD and vertical diffusion. -!! -!! In addition, there is also mountain blocking from lift and frictional -!! forces. Improved integration between how the GWD is calculated and -!! the mountain blocking of wind flow around sub-grid scale orography -!! is underway at NCEP. The GFS already has convectively forced GWD -!! an independent process. The next step is to test -!! -!> \section det_drag_suite GFS Orographic GWD Scheme Detailed Algorithm -!> @{ - subroutine drag_suite_run( & - & IM,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & - & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & - & var,oc1,oa4,ol4, & - & varss,oc1ss,oa4ss,ol4ss, & - & THETA,SIGMA,GAMMA,ELVMAX, & - & dtaux2d_ls,dtauy2d_ls,dtaux2d_bl,dtauy2d_bl, & - & dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd, & - & dusfc,dvsfc, & - & dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & - & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & - & slmsk,br1,hpbl, & - & g, cp, rd, rv, fv, pi, imx, cdmbgwd, me, master, & - & lprnt, ipr, rdxzb, dx, gwd_opt, & - & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & - & dtend, dtidx, index_of_process_orographic_gwd, & - & index_of_temperature, index_of_x_wind, & - & index_of_y_wind, ldiag3d, errmsg, errflg) - -! ******************************************************************** -! -----> I M P L E M E N T A T I O N V E R S I O N <---------- -! -! ----- This code ----- -!begin WRF code - -! this code handles the time tendencies of u v due to the effect of mountain -! induced gravity wave drag from sub-grid scale orography. this routine -! not only treats the traditional upper-level wave breaking due to mountain -! variance (alpert 1988), but also the enhanced lower-tropospheric wave -! breaking due to mountain convexity and asymmetry (kim and arakawa 1995). -! thus, in addition to the terrain height data in a model grid box, -! additional 10-2d topographic statistics files are needed, including -! orographic standard deviation (var), convexity (oc1), asymmetry (oa4) -! and ol (ol4). these data sets are prepared based on the 30 sec usgs orography -! hong (1999). the current scheme was implmented as in hong et al.(2008) -! -! Originally coded by song-you hong and young-joon kim and implemented by song-you hong -! -! program history log: -! 2014-10-01 Hyun-Joo Choi (from KIAPS) flow-blocking drag of kim and doyle -! with blocked height by dividing streamline theory -! 2017-04-06 Joseph Olson (from Gert-Jan Steeneveld) added small-scale -! orographic grabity wave drag: -! 2017-09-15 Joseph Olson, with some bug fixes from Michael Toy: added the -! topographic form drag of Beljaars et al. (2004, QJRMS) -! Activation of each component is done by specifying the integer-parameters -! (defined below) to 0: inactive or 1: active -! gwd_opt_ls = 0 or 1: large-scale -! gwd_opt_bl = 0 or 1: blocking drag -! gwd_opt_ss = 0 or 1: small-scale gravity wave drag -! gwd_opt_fd = 0 or 1: topographic form drag -! 2017-09-25 Michael Toy (from NCEP GFS model) added dissipation heating -! gsd_diss_ht_opt = 0: dissipation heating off -! gsd_diss_ht_opt = 1: dissipation heating on -! 2020-08-25 Michael Toy changed logic control for drag component selection -! for CCPP. -! Namelist options: -! do_gsl_drag_ls_bl - logical flag for large-scale GWD + blocking -! do_gsl_drag_ss - logical flag for small-scale GWD -! do_gsl_drag_tofd - logical flag for turbulent form drag -! Compile-time options (same as before): -! gwd_opt_ls = 0 or 1: large-scale GWD -! gwd_opt_bl = 0 or 1: blocking drag -! -! References: -! Hong et al. (2008), wea. and forecasting -! Kim and Doyle (2005), Q. J. R. Meteor. Soc. -! Kim and Arakawa (1995), j. atmos. sci. -! Alpert et al. (1988), NWP conference. -! Hong (1999), NCEP office note 424. -! Steeneveld et al (2008), JAMC -! Tsiringakis et al. (2017), Q. J. R. Meteor. Soc. -! Beljaars et al. (2004), Q. J. R. Meteor. Soc. -! -! notice : comparible or lower resolution orography files than model resolution -! are desirable in preprocess (wps) to prevent weakening of the drag -!------------------------------------------------------------------------------- -! -! input -! dudt (im,km) non-lin tendency for u wind component -! dvdt (im,km) non-lin tendency for v wind component -! u1(im,km) zonal wind / sqrt(rcl) m/sec at t0-dt -! v1(im,km) meridional wind / sqrt(rcl) m/sec at t0-dt -! t1(im,km) temperature deg k at t0-dt -! q1(im,km) specific humidity at t0-dt -! deltim time step secs -! del(km) positive increment of pressure across layer (pa) -! KPBL(IM) is the index of the top layer of the PBL -! ipr & lprnt for diagnostics -! -! output -! dudt, dvdt wind tendency due to gwdo -! dTdt -! -!------------------------------------------------------------------------------- - -!end wrf code -!----------------------------------------------------------------------C -! USE -! ROUTINE IS CALLED FROM CCPP (AFTER CALLING PBL SCHEMES) -! -! PURPOSE -! USING THE GWD PARAMETERIZATIONS OF PS-GLAS AND PH- -! GFDL TECHNIQUE. THE TIME TENDENCIES OF U V -! ARE ALTERED TO INCLUDE THE EFFECT OF MOUNTAIN INDUCED -! GRAVITY WAVE DRAG FROM SUB-GRID SCALE OROGRAPHY INCLUDING -! CONVECTIVE BREAKING, SHEAR BREAKING AND THE PRESENCE OF -! CRITICAL LEVELS -! -! -! ******************************************************************** - USE MACHINE , ONLY : kind_phys - implicit none - - ! Interface variables - integer, intent(in) :: im, km, imx, kdt, ipr, me, master - integer, intent(in) :: gwd_opt - logical, intent(in) :: lprnt - integer, intent(in) :: KPBL(:) - real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, cdmbgwd(:) - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - logical, intent(in) :: ldiag3d - integer, intent(in) :: dtidx(:,:), index_of_temperature, & - & index_of_process_orographic_gwd, index_of_x_wind, index_of_y_wind - - integer :: kpblmax - integer, parameter :: ims=1, kms=1, its=1, kts=1 - real(kind=kind_phys), intent(in) :: fv, pi - real(kind=kind_phys) :: rcl, cdmb - real(kind=kind_phys) :: g_inv - - real(kind=kind_phys), intent(inout) :: & - & dudt(:,:),dvdt(:,:), & - & dtdt(:,:) - real(kind=kind_phys), intent(out) :: rdxzb(:) - real(kind=kind_phys), intent(in) :: & - & u1(:,:),v1(:,:), & - & t1(:,:),q1(:,:), & - & PHII(:,:),prsl(:,:), & - & prslk(:,:),PHIL(:,:) - real(kind=kind_phys), intent(in) :: prsi(:,:), & - & del(:,:) - real(kind=kind_phys), intent(in) :: var(:),oc1(:), & - & oa4(:,:),ol4(:,:), & - & dx(:) - real(kind=kind_phys), intent(in) :: varss(:),oc1ss(:), & - & oa4ss(:,:),ol4ss(:,:) - real(kind=kind_phys), intent(in) :: THETA(:),SIGMA(:), & - & GAMMA(:),ELVMAX(:) - -! added for small-scale orographic wave drag - real(kind=kind_phys), dimension(im,km) :: utendwave,vtendwave,thx,thvx - real(kind=kind_phys), intent(in) :: br1(:), & - & hpbl(:), & - & slmsk(:) - real(kind=kind_phys), dimension(im) :: govrth,xland - !real(kind=kind_phys), dimension(im,km) :: dz2 - real(kind=kind_phys) :: tauwavex0,tauwavey0, & - & XNBV,density,tvcon,hpbl2 - integer :: kpbl2,kvar - !real(kind=kind_phys), dimension(im,km+1) :: zq ! = PHII/g - real(kind=kind_phys), dimension(im,km) :: zl ! = PHIL/g - -!SPP - real(kind=kind_phys), dimension(im) :: rstoch - -!Output: - real(kind=kind_phys), intent(out) :: & - & dusfc(:), dvsfc(:) -!Output (optional): - real(kind=kind_phys), intent(out) :: & - & dusfc_ls(:),dvsfc_ls(:), & - & dusfc_bl(:),dvsfc_bl(:), & - & dusfc_ss(:),dvsfc_ss(:), & - & dusfc_fd(:),dvsfc_fd(:) - real(kind=kind_phys), intent(out) :: & - & dtaux2d_ls(:,:),dtauy2d_ls(:,:), & - & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & - & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & - & dtaux2d_fd(:,:),dtauy2d_fd(:,:) - -!Misc arrays - real(kind=kind_phys), dimension(im,km) :: dtaux2d, dtauy2d - -!------------------------------------------------------------------------- -! Flags to regulate the activation of specific components of drag suite: -! Each component is tapered off automatically as a function of dx, so best to -! keep them activated (.true.). - logical, intent(in) :: & - do_gsl_drag_ls_bl, & ! large-scale gravity wave drag and blocking - do_gsl_drag_ss, & ! small-scale gravity wave drag (Steeneveld et al. 2008) - do_gsl_drag_tofd ! form drag (Beljaars et al. 2004, QJRMS) - -! Additional flags - integer, parameter :: & - gwd_opt_ls = 1, & ! large-scale gravity wave drag - gwd_opt_bl = 1, & ! blocking drag - gsd_diss_ht_opt = 0 - -! Parameters for bounding the scale-adaptive variability: -! Small-scale GWD + turbulent form drag - real(kind=kind_phys), parameter :: dxmin_ss = 1000., & - & dxmax_ss = 12000. ! min,max range of tapering (m) -! Large-scale GWD + blocking - real(kind=kind_phys), parameter :: dxmin_ls = 3000., & - & dxmax_ls = 13000. ! min,max range of tapering (m) - real(kind=kind_phys), dimension(im) :: ss_taper, ls_taper ! small- and large-scale tapering factors (-) -! -! Variables for limiting topographic standard deviation (var) - real(kind=kind_phys), parameter :: varmax_ss = 50., & - varmax_fd = 150., & - beta_ss = 0.1, & - beta_fd = 0.2 - real(kind=kind_phys) :: var_temp, var_temp2 - -! added Beljaars orographic form drag - real(kind=kind_phys), dimension(im,km) :: utendform,vtendform - real(kind=kind_phys) :: a1,a2,wsp - real(kind=kind_phys) :: H_efold - -! critical richardson number for wave breaking : ! larger drag with larger value - real(kind=kind_phys), parameter :: ric = 0.25 - real(kind=kind_phys), parameter :: dw2min = 1. - real(kind=kind_phys), parameter :: rimin = -100. - real(kind=kind_phys), parameter :: bnv2min = 1.0e-5 - real(kind=kind_phys), parameter :: efmin = 0.0 - real(kind=kind_phys), parameter :: efmax = 10.0 - real(kind=kind_phys), parameter :: xl = 4.0e4 - real(kind=kind_phys), parameter :: critac = 1.0e-5 - real(kind=kind_phys), parameter :: gmax = 1. - real(kind=kind_phys), parameter :: veleps = 1.0 - real(kind=kind_phys), parameter :: factop = 0.5 - real(kind=kind_phys), parameter :: frc = 1.0 - real(kind=kind_phys), parameter :: ce = 0.8 - real(kind=kind_phys), parameter :: cg = 0.5 - integer,parameter :: kpblmin = 2 - -! -! local variables -! - integer :: i,j,k,lcap,lcapp1,nwd,idir, & - klcap,kp1 -! - real(kind=kind_phys) :: rcs,csg,fdir,cleff,cleff_ss,cs, & - 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 -! - logical :: ldrag(im),icrilv(im), & - flag(im),kloop1(im) -! - real(kind=kind_phys) :: taub(im),taup(im,km+1), & - xn(im),yn(im), & - ubar(im),vbar(im), & - fr(im),ulow(im), & - rulow(im),bnv(im), & - oa(im),ol(im), & - oass(im),olss(im), & - roll(im),dtfac(im), & - brvf(im),xlinv(im), & - delks(im),delks1(im), & - bnv2(im,km),usqj(im,km), & - taud_ls(im,km),taud_bl(im,km), & - ro(im,km), & - vtk(im,km),vtj(im,km), & - zlowtop(im),velco(im,km-1), & - coefm(im),coefm_ss(im) -! - integer :: kbl(im),klowtop(im) - integer,parameter :: mdir=8 - !integer :: nwdir(mdir) - !data nwdir/6,7,5,8,2,3,1,4/ - integer, parameter :: nwdir(8) = (/6,7,5,8,2,3,1,4/) -! -! variables for flow-blocking drag -! - real(kind=kind_phys),parameter :: frmax = 10. - real(kind=kind_phys),parameter :: olmin = 1.0e-5 - real(kind=kind_phys),parameter :: odmin = 0.1 - real(kind=kind_phys),parameter :: odmax = 10. - real(kind=kind_phys),parameter :: erad = 6371.315e+3 - integer :: komax(im) - integer :: kblk - real(kind=kind_phys) :: cd - real(kind=kind_phys) :: zblk,tautem - real(kind=kind_phys) :: pe,ke - real(kind=kind_phys) :: delx,dely - real(kind=kind_phys) :: dxy4(im,4),dxy4p(im,4) - real(kind=kind_phys) :: dxy(im),dxyp(im) - real(kind=kind_phys) :: ol4p(4),olp(im),od(im) - real(kind=kind_phys) :: taufb(im,km+1) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: udtend, vdtend, Tdtend - - ! Calculate inverse of gravitational acceleration - g_inv = 1./G - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Initialize local variables - var_temp2 = 0. - udtend = -1 - vdtend = -1 - Tdtend = -1 - - if(ldiag3d) then - udtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) - vdtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) - Tdtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) - endif - -!-------------------------------------------------------------------- -! SCALE-ADPTIVE PARAMETER FROM GFS GWD SCHEME -!-------------------------------------------------------------------- -! parameter (cdmb = 1.0) ! non-dim sub grid mtn drag Amp (*j*) -! non-dim sub grid mtn drag Amp (*j*) -! cdmb = 1.0/float(IMX/192) -! cdmb = 192.0/float(IMX) - cdmb = 4.0 * 192.0/float(IMX) - if (cdmbgwd(1) >= 0.0) cdmb = cdmb * cdmbgwd(1) - -!>-# Orographic Gravity Wave Drag Section - kpblmax = km / 2 ! maximum pbl height : # of vertical levels / 2 -! -! Scale cleff between IM=384*2 and 192*2 for T126/T170 and T62 -! - if (imx > 0) then -! cleff = 1.0E-5 * SQRT(FLOAT(IMX)/384.0) -! cleff = 1.0E-5 * SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! -! cleff = 0.5E-5 * SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! -! cleff = 1.0E-5 * SQRT(FLOAT(IMX)/192)/float(IMX/192) -! cleff = 1.0E-5 / SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! - cleff = 0.5E-5 / SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! -! hmhj for ndsl -! jw cleff = 0.1E-5 / SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! -! cleff = 2.0E-5 * SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! -! cleff = 2.5E-5 * SQRT(FLOAT(IMX)/192.0) ! this is inverse of CLEFF! - endif - if (cdmbgwd(2) >= 0.0) cleff = cleff * cdmbgwd(2) -!-------------------------------------------------------------------- -! END SCALE-ADPTIVE PARAMETER SECTION -!-------------------------------------------------------------------- -! -!---- constants -! - rcl = 1. - rcs = sqrt(rcl) - cs = 1. / sqrt(rcl) - csg = cs * g - lcap = km - lcapp1 = lcap + 1 - fdir = mdir / (2.0*pi) - - do i=1,im - if (slmsk(i)==1. .or. slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 - xland(i)=1.0 !but land/water = (1/2) in this module - else - xland(i)=2.0 - endif - RDXZB(i) = 0.0 - enddo - -!--- calculate scale-aware tapering factors -do i=1,im - if ( dx(i) .ge. dxmax_ls ) then - ls_taper(i) = 1. - else - if ( dx(i) .le. dxmin_ls) then - ls_taper(i) = 0. - else - ls_taper(i) = 0.5 * ( SIN(pi*(dx(i)-0.5*(dxmax_ls+dxmin_ls))/ & - (dxmax_ls-dxmin_ls)) + 1. ) - endif - endif -enddo - -do i=1,im - if ( dx(i) .ge. dxmax_ss ) then - ss_taper(i) = 1. - else - if ( dx(i) .le. dxmin_ss) then - ss_taper(i) = 0. - else - ss_taper(i) = dxmax_ss * (1. - dxmin_ss/dx(i))/(dxmax_ss-dxmin_ss) - endif - endif -enddo - -!--- calculate length of grid for flow-blocking drag -! -do i=1,im - delx = dx(i) - dely = dx(i) - dxy4(i,1) = delx - dxy4(i,2) = dely - dxy4(i,3) = sqrt(delx*delx + dely*dely) - dxy4(i,4) = dxy4(i,3) - dxy4p(i,1) = dxy4(i,2) - dxy4p(i,2) = dxy4(i,1) - dxy4p(i,3) = dxy4(i,4) - dxy4p(i,4) = dxy4(i,3) -enddo -! -!-----initialize arrays -! - dtaux = 0.0 - dtauy = 0.0 - do i = its,im - klowtop(i) = 0 - kbl(i) = 0 - enddo -! - do i = its,im - xn(i) = 0.0 - yn(i) = 0.0 - ubar (i) = 0.0 - vbar (i) = 0.0 - roll (i) = 0.0 - taub (i) = 0.0 - oa(i) = 0.0 - ol(i) = 0.0 - oass(i) = 0.0 - olss(i) = 0.0 - ulow (i) = 0.0 - dtfac(i) = 1.0 - rstoch(i) = 0.0 - ldrag(i) = .false. - icrilv(i) = .false. - flag(i) = .true. - enddo - - do k = kts,km - do i = its,im - usqj(i,k) = 0.0 - bnv2(i,k) = 0.0 - vtj(i,k) = 0.0 - vtk(i,k) = 0.0 - taup(i,k) = 0.0 - taud_ls(i,k) = 0.0 - taud_bl(i,k) = 0.0 - dtaux2d(i,k) = 0.0 - dtauy2d(i,k) = 0.0 - enddo - enddo -! - if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then - do i = its,im - dusfc_ls(i) = 0.0 - dvsfc_ls(i) = 0.0 - dusfc_bl(i) = 0.0 - dvsfc_bl(i) = 0.0 - dusfc_ss(i) = 0.0 - dvsfc_ss(i) = 0.0 - dusfc_fd(i) = 0.0 - dvsfc_fd(i) = 0.0 - enddo - do k = kts,km - do i = its,im - dtaux2d_ls(i,k)= 0.0 - dtauy2d_ls(i,k)= 0.0 - dtaux2d_bl(i,k)= 0.0 - dtauy2d_bl(i,k)= 0.0 - dtaux2d_ss(i,k)= 0.0 - dtauy2d_ss(i,k)= 0.0 - dtaux2d_fd(i,k)= 0.0 - dtauy2d_fd(i,k)= 0.0 - enddo - enddo - endif - - do i = its,im - taup(i,km+1) = 0.0 - xlinv(i) = 1.0/xl - dusfc(i) = 0.0 - dvsfc(i) = 0.0 - enddo -! -! initialize array for flow-blocking drag -! - taufb(1:im,1:km+1) = 0.0 - komax(1:im) = 0 -! - do k = kts,km - do i = its,im - vtj(i,k) = t1(i,k) * (1.+fv*q1(i,k)) - vtk(i,k) = vtj(i,k) / prslk(i,k) - ro(i,k) = 1./rd * prsl(i,k) / vtj(i,k) ! density kg/m**3 - enddo - enddo -! -! calculate mid-layer height (zl), interface height (zq), and layer depth (dz2). -! - !zq=0. - do k = kts,km - do i = its,im - !zq(i,k+1) = PHII(i,k+1)*g_inv - !dz2(i,k) = (PHII(i,k+1)-PHII(i,k))*g_inv - zl(i,k) = PHIL(i,k)*g_inv - enddo - enddo -! -! determine reference level: maximum of 2*var and pbl heights -! - do i = its,im - zlowtop(i) = 2. * var(i) - enddo -! - do i = its,im - kloop1(i) = .true. - enddo -! - do k = kts+1,km - do i = its,im - if(kloop1(i).and.zl(i,k)-zl(i,1).ge.zlowtop(i)) then - klowtop(i) = k+1 - kloop1(i) = .false. - endif - enddo - enddo -! - do i = its,im - kbl(i) = max(kpbl(i), klowtop(i)) - kbl(i) = max(min(kbl(i),kpblmax),kpblmin) - enddo -! -! determine the level of maximum orographic height -! - ! komax(:) = kbl(:) - komax(:) = klowtop(:) - 1 ! modification by NOAA/GSD March 2018 -! - do i = its,im - delks(i) = 1.0 / (prsi(i,1) - prsi(i,kbl(i))) - delks1(i) = 1.0 / (prsl(i,1) - prsl(i,kbl(i))) - enddo -! -! compute low level averages within pbl -! - do k = kts,kpblmax - do i = its,im - if (k.lt.kbl(i)) then - rcsks = rcs * del(i,k) * delks(i) - rdelks = del(i,k) * delks(i) - ubar(i) = ubar(i) + rcsks * u1(i,k) ! pbl u mean - vbar(i) = vbar(i) + rcsks * v1(i,k) ! pbl v mean - roll(i) = roll(i) + rdelks * ro(i,k) ! ro mean - endif - enddo - enddo -! -! figure out low-level horizontal wind direction -! -! nwd 1 2 3 4 5 6 7 8 -! wd w s sw nw e n ne se -! - do i = its,im - wdir = atan2(ubar(i),vbar(i)) + pi - idir = mod(nint(fdir*wdir),mdir) + 1 - nwd = nwdir(idir) - oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1) - ol(i) = ol4(i,mod(nwd-1,4)+1) - ! Repeat for small-scale gwd - oass(i) = (1-2*int( (nwd-1)/4 )) * oa4ss(i,mod(nwd-1,4)+1) - olss(i) = ol4ss(i,mod(nwd-1,4)+1) - -! -!----- compute orographic width along (ol) and perpendicular (olp) -!----- the direction of wind -! - ol4p(1) = ol4(i,2) - ol4p(2) = ol4(i,1) - ol4p(3) = ol4(i,4) - ol4p(4) = ol4(i,3) - olp(i) = ol4p(mod(nwd-1,4)+1) -! -!----- compute orographic direction (horizontal orographic aspect ratio) -! - od(i) = olp(i)/max(ol(i),olmin) - od(i) = min(od(i),odmax) - od(i) = max(od(i),odmin) -! -!----- compute length of grid in the along(dxy) and cross(dxyp) wind directions -! - dxy(i) = dxy4(i,MOD(nwd-1,4)+1) - dxyp(i) = dxy4p(i,MOD(nwd-1,4)+1) - enddo -! -! END INITIALIZATION; BEGIN GWD CALCULATIONS: -! -IF ( (do_gsl_drag_ls_bl).and. & - ((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)) ) then - - do i=its,im - - if ( ls_taper(i).GT.1.E-02 ) then - -! -!--- saving richardson number in usqj for migwdi -! - do k = kts,km-1 - ti = 2.0 / (t1(i,k)+t1(i,k+1)) - rdz = 1./(zl(i,k+1) - zl(i,k)) - tem1 = u1(i,k) - u1(i,k+1) - tem2 = v1(i,k) - v1(i,k+1) - dw2 = rcl*(tem1*tem1 + tem2*tem2) - shr2 = max(dw2,dw2min) * rdz * rdz - bvf2 = g*(g/cp+rdz*(vtj(i,k+1)-vtj(i,k))) * ti - usqj(i,k) = max(bvf2/shr2,rimin) - bnv2(i,k) = 2.0*g*rdz*(vtk(i,k+1)-vtk(i,k))/(vtk(i,k+1)+vtk(i,k)) - bnv2(i,k) = max( bnv2(i,k), bnv2min ) - enddo -! -!----compute the "low level" or 1/3 wind magnitude (m/s) -! - ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0) - rulow(i) = 1./ulow(i) -! - do k = kts,km-1 - velco(i,k) = (0.5*rcs) * ((u1(i,k)+u1(i,k+1)) * ubar(i) & - + (v1(i,k)+v1(i,k+1)) * vbar(i)) - velco(i,k) = velco(i,k) * rulow(i) - if ((velco(i,k).lt.veleps) .and. (velco(i,k).gt.0.)) then - velco(i,k) = veleps - endif - enddo -! -! no drag when critical level in the base layer -! - ldrag(i) = velco(i,1).le.0. -! -! no drag when velco.lt.0 -! - do k = kpblmin,kpblmax - if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. velco(i,k).le.0. - enddo -! -! no drag when bnv2.lt.0 -! - do k = kts,kpblmax - if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. bnv2(i,k).lt.0. - enddo -! -!-----the low level weighted average ri is stored in usqj(1,1; im) -!-----the low level weighted average n**2 is stored in bnv2(1,1; im) -!---- this is called bnvl2 in phys_gwd_alpert_sub not bnv2 -!---- rdelks (del(k)/delks) vert ave factor so we can * instead of / -! - wtkbj = (prsl(i,1)-prsl(i,2)) * delks1(i) - bnv2(i,1) = wtkbj * bnv2(i,1) - usqj(i,1) = wtkbj * usqj(i,1) -! - do k = kpblmin,kpblmax - if (k .lt. kbl(i)) then - rdelks = (prsl(i,k)-prsl(i,k+1)) * delks1(i) - bnv2(i,1) = bnv2(i,1) + bnv2(i,k) * rdelks - usqj(i,1) = usqj(i,1) + usqj(i,k) * rdelks - endif - enddo -! - 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(i) .le. 0.0 -! -! set all ri low level values to the low level value -! - do k = kpblmin,kpblmax - if (k .lt. kbl(i)) usqj(i,k) = usqj(i,1) - enddo -! - if (.not.ldrag(i)) then - bnv(i) = sqrt( bnv2(i,1) ) - fr(i) = bnv(i) * rulow(i) * 2. * var(i) * od(i) - fr(i) = min(fr(i),frmax) - xn(i) = ubar(i) * rulow(i) - yn(i) = vbar(i) * rulow(i) - endif -! -! compute the base level stress and store it in taub -! calculate enhancement factor, number of mountains & aspect -! ratio const. use simplified relationship between standard -! deviation & critical hgt - - if (.not. ldrag(i)) then - efact = (oa(i) + 2.) ** (ce*fr(i)/frc) - efact = min( max(efact,efmin), efmax ) -!!!!!!! cleff (effective grid length) is highly tunable parameter -!!!!!!! the bigger (smaller) value produce weaker (stronger) wave drag -!WRF cleff = sqrt(dxy(i)**2. + dxyp(i)**2.) -!WRF cleff = 3. * max(dx(i),cleff) - coefm(i) = (1. + ol(i)) ** (oa(i)+1.) -!WRF xlinv(i) = coefm(i) / cleff - xlinv(i) = coefm(i) * cleff - tem = fr(i) * fr(i) * oc1(i) - gfobnv = gmax * tem / ((tem + cg)*bnv(i)) - if ( gwd_opt_ls .NE. 0 ) then - taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & - * ulow(i) * gfobnv * efact - else ! We've gotten what we need for the blocking scheme - taub(i) = 0.0 - end if - else - taub(i) = 0.0 - xn(i) = 0.0 - yn(i) = 0.0 - endif - - endif ! (ls_taper(i).GT.1.E-02) - - enddo ! do i=its,im - -ENDIF ! (do_gsl_drag_ls_bl).and.((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)) - -!========================================================= -! add small-scale wavedrag for stable boundary layer -!========================================================= - XNBV=0. - tauwavex0=0. - tauwavey0=0. - density=1.2 - utendwave=0. - vtendwave=0. -! -IF ( do_gsl_drag_ss ) THEN - - do i=its,im - - if ( ss_taper(i).GT.1.E-02 ) then - ! - ! calculating potential temperature - ! - do k = kts,km - thx(i,k) = t1(i,k)/prslk(i,k) - enddo - ! - do k = kts,km - tvcon = (1.+fv*q1(i,k)) - thvx(i,k) = thx(i,k)*tvcon - enddo - - hpbl2 = hpbl(i)+10. - kpbl2 = kpbl(i) - !kvar = MIN(kpbl, k-level of var) - kvar = 1 - do k=kts+1,MAX(kpbl(i),kts+1) -! IF (zl(i,k)>2.*var(i) .or. zl(i,k)>2*varmax) then - IF (zl(i,k)>300.) then - kpbl2 = k - IF (k == kpbl(i)) then - hpbl2 = hpbl(i)+10. - ELSE - hpbl2 = zl(i,k)+10. - ENDIF - exit - ENDIF - enddo - if((xland(i)-1.5).le.0. .and. 2.*varss(i).le.hpbl(i))then - if(br1(i).gt.0. .and. thvx(i,kpbl2)-thvx(i,kts) > 0.)then - cleff_ss = sqrt(dxy(i)**2 + dxyp(i)**2) ! WRF -! cleff_ss = 3. * max(dx(i),cleff_ss) -! cleff_ss = 10. * max(dxmax_ss,cleff_ss) - cleff_ss = 0.1 * max(dxmax_ss,cleff_ss) ! WRF -! cleff_ss = 0.1 * 12000. - coefm_ss(i) = (1. + olss(i)) ** (oass(i)+1.) - xlinv(i) = coefm_ss(i) / cleff_ss - !govrth(i)=g/(0.5*(thvx(i,kpbl(i))+thvx(i,kts))) - govrth(i)=g/(0.5*(thvx(i,kpbl2)+thvx(i,kts))) - !XNBV=sqrt(govrth(i)*(thvx(i,kpbl(i))-thvx(i,kts))/hpbl(i)) - XNBV=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) -! - if (abs(u1(i,kpbl2)) > 0.01) then - !if(abs(XNBV/u1(i,kpbl(i))).gt.xlinv(i))then - if(abs(XNBV/u1(i,kpbl2)).gt.xlinv(i))then - !tauwavex0=0.5*XNBV*xlinv(i)*(2*MIN(varss(i),75.))**2*ro(i,kts)*u1(i,kpbl(i)) - !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,kpbl2) - !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,3) - var_temp = MIN(varss(i),varmax_ss) + & - MAX(0.,beta_ss*(varss(i)-varmax_ss)) - ! Note: This is a semi-implicit treatment of the time differencing - var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero - tauwavex0=var_temp2*u1(i,kvar)/(1.+var_temp2*deltim) - tauwavex0=tauwavex0*ss_taper(i) - else - tauwavex0=0. - endif - else - tauwavex0=0. - endif -! - if (abs(v1(i,kpbl2)) > 0.01) then - !if(abs(XNBV/v1(i,kpbl(i))).gt.xlinv(i))then - if(abs(XNBV/v1(i,kpbl2)).gt.xlinv(i))then - !tauwavey0=0.5*XNBV*xlinv(i)*(2*MIN(varss(i),75.))**2*ro(i,kts)*v1(i,kpbl(i)) - !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,kpbl2) - !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,3) - var_temp = MIN(varss(i),varmax_ss) + & - MAX(0.,beta_ss*(varss(i)-varmax_ss)) - ! Note: This is a semi-implicit treatment of the time differencing - var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero - tauwavey0=var_temp2*v1(i,kvar)/(1.+var_temp2*deltim) - tauwavey0=tauwavey0*ss_taper(i) - else - tauwavey0=0. - endif - else - tauwavey0=0. - endif - - do k=kts,kpbl(i) !MIN(kpbl2+1,km-1) -!original - !utendwave(i,k)=-1.*tauwavex0*2.*max((1.-zl(i,k)/hpbl(i)),0.)/hpbl(i) - !vtendwave(i,k)=-1.*tauwavey0*2.*max((1.-zl(i,k)/hpbl(i)),0.)/hpbl(i) -!new - utendwave(i,k)=-1.*tauwavex0*2.*max((1.-zl(i,k)/hpbl2),0.)/hpbl2 - vtendwave(i,k)=-1.*tauwavey0*2.*max((1.-zl(i,k)/hpbl2),0.)/hpbl2 -!mod-to be used in HRRRv3/RAPv4 - !utendwave(i,k)=-1.*tauwavex0 * max((1.-zl(i,k)/hpbl2),0.)**2 - !vtendwave(i,k)=-1.*tauwavey0 * max((1.-zl(i,k)/hpbl2),0.)**2 - enddo - endif - endif - - do k = kts,km - dudt(i,k) = dudt(i,k) + utendwave(i,k) - dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) - dusfc(i) = dusfc(i) + utendwave(i,k) * del(i,k) - dvsfc(i) = dvsfc(i) + vtendwave(i,k) * del(i,k) - enddo - if(udtend>0) then - dtend(i,kts:km,udtend) = dtend(i,kts:km,udtend) + utendwave(i,kts:km)*deltim - endif - if(vdtend>0) then - dtend(i,kts:km,vdtend) = dtend(i,kts:km,vdtend) + vtendwave(i,kts:km)*deltim - endif - if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then - do k = kts,km - dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) - dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) - dtaux2d_ss(i,k) = utendwave(i,k) - dtauy2d_ss(i,k) = vtendwave(i,k) - enddo - endif - - endif ! if (ss_taper(i).GT.1.E-02) - - enddo ! i=its,im - -ENDIF ! if (do_gsl_drag_ss) - -!================================================================ -! Topographic Form Drag from Beljaars et al. (2004, QJRMS, equ. 16): -!================================================================ -IF ( do_gsl_drag_tofd ) THEN - - do i=its,im - - if ( ss_taper(i).GT.1.E-02 ) then - - utendform=0. - vtendform=0. - - IF ((xland(i)-1.5) .le. 0.) then - !(IH*kflt**n1)**-1 = (0.00102*0.00035**-1.9)**-1 = 0.00026615161 - var_temp = MIN(varss(i),varmax_fd) + & - MAX(0.,beta_fd*(varss(i)-varmax_fd)) - var_temp = MIN(var_temp, 250.) - a1=0.00026615161*var_temp**2 -! a1=0.00026615161*MIN(varss(i),varmax)**2 -! a1=0.00026615161*(0.5*varss(i))**2 - ! k1**(n1-n2) = 0.003**(-1.9 - -2.8) = 0.003**0.9 = 0.005363 - a2=a1*0.005363 - ! Revise e-folding height based on PBL height and topographic std. dev. -- M. Toy 3/12/2018 - H_efold = max(2*varss(i),hpbl(i)) - H_efold = min(H_efold,1500.) - DO k=kts,km - wsp=SQRT(u1(i,k)**2 + v1(i,k)**2) - ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - var_temp = 0.0759*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & - zl(i,k)**(-1.2)*ss_taper(i) ! this is greater than zero - ! Note: This is a semi-implicit treatment of the time differencing - ! per Beljaars et al. (2004, QJRMS) - utendform(i,k) = - var_temp*wsp*u1(i,k)/(1. + var_temp*deltim*wsp) - vtendform(i,k) = - var_temp*wsp*v1(i,k)/(1. + var_temp*deltim*wsp) - !IF(zl(i,k) > 4000.) exit - ENDDO - ENDIF - - do k = kts,km - dudt(i,k) = dudt(i,k) + utendform(i,k) - dvdt(i,k) = dvdt(i,k) + vtendform(i,k) - dusfc(i) = dusfc(i) + utendform(i,k) * del(i,k) - dvsfc(i) = dvsfc(i) + vtendform(i,k) * del(i,k) - enddo - if(udtend>0) then - dtend(i,kts:km,udtend) = dtend(i,kts:km,udtend) + utendform(i,kts:km)*deltim - endif - if(vdtend>0) then - dtend(i,kts:km,vdtend) = dtend(i,kts:km,vdtend) + vtendform(i,kts:km)*deltim - endif - if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then - do k = kts,km - dtaux2d_fd(i,k) = utendform(i,k) - dtauy2d_fd(i,k) = vtendform(i,k) - dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) - dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) - enddo - endif - - endif ! if (ss_taper(i).GT.1.E-02) - - enddo ! i=its,im - -ENDIF ! if (do_gsl_drag_tofd) -!======================================================= -! More for the large-scale gwd component -IF ( (do_gsl_drag_ls_bl).and.(gwd_opt_ls .EQ. 1) ) THEN - - do i=its,im - - if ( ls_taper(i).GT.1.E-02 ) then - -! -! now compute vertical structure of the stress. - do k = kts,kpblmax - if (k .le. kbl(i)) taup(i,k) = taub(i) - enddo -! - do k = kpblmin, km-1 ! vertical level k loop! - kp1 = k + 1 -! -! unstablelayer if ri < ric -! unstable layer if upper air vel comp along surf vel <=0 (crit lay) -! at (u-c)=0. crit layer exists and bit vector should be set (.le.) -! - if (k .ge. kbl(i)) then - icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric) & - .or. (velco(i,k) .le. 0.0) - brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared - brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency - endif -! - if (k .ge. kbl(i) .and. (.not. ldrag(i))) then - if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0 ) then - temv = 1.0 / velco(i,k) - tem1 = coefm(i)/dxy(i)*(ro(i,kp1)+ro(i,k))*brvf(i)* & - velco(i,k)*0.5 - hd = sqrt(taup(i,k) / tem1) - fro = brvf(i) * hd * temv -! -! rim is the minimum-richardson number by shutts (1985) - tem2 = sqrt(usqj(i,k)) - tem = 1. + tem2 * fro - rim = usqj(i,k) * (1.-fro) / (tem * tem) -! -! check stability to employ the 'saturation hypothesis' -! of lindzen (1981) except at tropospheric downstream regions -! - if (rim .le. ric) then ! saturation hypothesis! - if ((oa(i) .le. 0.).or.(kp1 .ge. kpblmin )) then - temc = 2.0 + 1.0 / tem2 - hd = velco(i,k) * (2.*sqrt(temc)-temc) / brvf(i) - taup(i,kp1) = tem1 * hd * hd - endif - else ! no wavebreaking! - taup(i,kp1) = taup(i,k) - endif - endif - endif - enddo -! - if(lcap.lt.km) then - do klcap = lcapp1,km - taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) - enddo - endif - - endif ! if ( ls_taper(i).GT.1.E-02 ) - - enddo ! do i=its,im - -ENDIF ! (do_gsl_drag_ls_bl).and.(gwd_opt_ls .EQ. 1) -!=============================================================== -!COMPUTE BLOCKING COMPONENT -!=============================================================== -IF ( (do_gsl_drag_ls_bl) .and. (gwd_opt_bl .EQ. 1) ) THEN - - do i=its,im - - if ( ls_taper(i).GT.1.E-02 ) then - - if (.not.ldrag(i)) then -! -!------- determine the height of flow-blocking layer -! - kblk = 0 - pe = 0.0 - do k = km, kpblmin, -1 - if(kblk.eq.0 .and. k.le.komax(i)) then - pe = pe + bnv2(i,k)*(zl(i,komax(i))-zl(i,k))* & - del(i,k)/g/ro(i,k) - ke = 0.5*((rcs*u1(i,k))**2.+(rcs*v1(i,k))**2.) -! -!---------- apply flow-blocking drag when pe >= ke -! - if(pe.ge.ke) then - kblk = k - kblk = min(kblk,kbl(i)) - zblk = zl(i,kblk)-zl(i,kts) - RDXZB(i) = real(k,kind=kind_phys) - endif - endif - enddo - if(kblk.ne.0) then -! -!--------- compute flow-blocking stress -! - cd = max(2.0-1.0/od(i),0.0) - taufb(i,kts) = 0.5 * roll(i) * coefm(i) / & - max(dxmax_ls,dxy(i))**2 * cd * dxyp(i) * & - olp(i) * zblk * ulow(i)**2 - tautem = taufb(i,kts)/float(kblk-kts) - do k = kts+1, kblk - taufb(i,k) = taufb(i,k-1) - tautem - enddo -! -!----------sum orographic GW stress and flow-blocking stress -! - ! taup(i,:) = taup(i,:) + taufb(i,:) ! Keep taup and taufb separate for now - endif - - endif ! if (.not.ldrag(i)) - - endif ! if ( ls_taper(i).GT.1.E-02 ) - - enddo ! do i=its,im - -ENDIF ! IF ( (do_gsl_drag_ls_bl) .and. (gwd_opt_bl .EQ. 1) ) -!=========================================================== -IF ( (do_gsl_drag_ls_bl) .and. & - (gwd_opt_ls .EQ. 1 .OR. gwd_opt_bl .EQ. 1) ) THEN - - do i=its,im - - if ( ls_taper(i) .GT. 1.E-02 ) then - -! -! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy -! - do k = kts,km - taud_ls(i,k) = 1. * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) - taud_bl(i,k) = 1. * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) - enddo -! -! limit de-acceleration (momentum deposition ) at top to 1/2 value -! the idea is some stuff must go out the 'top' - do klcap = lcap,km - taud_ls(i,klcap) = taud_ls(i,klcap) * factop - taud_bl(i,klcap) = taud_bl(i,klcap) * factop - enddo -! -! if the gravity wave drag would force a critical line -! in the lower ksmm1 layers during the next deltim timestep, -! then only apply drag until that critical line is reached. -! - do k = kts,kpblmax-1 - if (k .le. kbl(i)) then - if ((taud_ls(i,k)+taud_bl(i,k)).ne.0.) & - dtfac(i) = min(dtfac(i),abs(velco(i,k) & - /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) - endif - enddo -! - do k = kts,km - taud_ls(i,k) = taud_ls(i,k)*dtfac(i)* ls_taper(i) *(1.-rstoch(i)) - taud_bl(i,k) = taud_bl(i,k)*dtfac(i)* ls_taper(i) *(1.-rstoch(i)) - - dtaux = taud_ls(i,k) * xn(i) - dtauy = taud_ls(i,k) * yn(i) - dtauxb = taud_bl(i,k) * xn(i) - dtauyb = taud_bl(i,k) * yn(i) - - !add blocking and large-scale contributions to tendencies - dudt(i,k) = dtaux + dtauxb + dudt(i,k) - dvdt(i,k) = dtauy + dtauyb + dvdt(i,k) - - if ( gsd_diss_ht_opt .EQ. 1 ) then - ! Calculate dissipation heating - ! Initial kinetic energy (at t0-dt) - eng0 = 0.5*( (rcs*u1(i,k))**2. + (rcs*v1(i,k))**2. ) - ! Kinetic energy after wave-breaking/flow-blocking - eng1 = 0.5*( (rcs*(u1(i,k)+(dtaux+dtauxb)*deltim))**2 + & - (rcs*(v1(i,k)+(dtauy+dtauyb)*deltim))**2 ) - ! Modify theta tendency - dtdt(i,k) = dtdt(i,k) + max((eng0-eng1),0.0)/cp/deltim - if ( Tdtend>0 ) then - dtend(i,k,Tdtend) = dtend(i,k,Tdtend) + max((eng0-eng1),0.0)/cp - endif - endif - - dusfc(i) = dusfc(i) + taud_ls(i,k)*xn(i)*del(i,k) + & - taud_bl(i,k)*xn(i)*del(i,k) - dvsfc(i) = dvsfc(i) + taud_ls(i,k)*yn(i)*del(i,k) + & - taud_bl(i,k)*yn(i)*del(i,k) - if(udtend>0) then - dtend(i,k,udtend) = dtend(i,k,udtend) + (taud_ls(i,k) * & - xn(i) + taud_bl(i,k) * xn(i)) * deltim - endif - if(vdtend>0) then - dtend(i,k,vdtend) = dtend(i,k,vdtend) + (taud_ls(i,k) * & - yn(i) + taud_bl(i,k) * yn(i)) * deltim - endif - - enddo - - ! Finalize dusfc and dvsfc diagnostics - dusfc(i) = (-1./g*rcs) * dusfc(i) - dvsfc(i) = (-1./g*rcs) * dvsfc(i) - - if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then - do k = kts,km - dtaux2d_ls(i,k) = taud_ls(i,k) * xn(i) - dtauy2d_ls(i,k) = taud_ls(i,k) * yn(i) - dtaux2d_bl(i,k) = taud_bl(i,k) * xn(i) - dtauy2d_bl(i,k) = taud_bl(i,k) * yn(i) - dusfc_ls(i) = dusfc_ls(i) + dtaux2d_ls(i,k) * del(i,k) - dvsfc_ls(i) = dvsfc_ls(i) + dtauy2d_ls(i,k) * del(i,k) - dusfc_bl(i) = dusfc_bl(i) + dtaux2d_bl(i,k) * del(i,k) - dvsfc_bl(i) = dvsfc_bl(i) + dtauy2d_bl(i,k) * del(i,k) - enddo - endif - - endif ! if ( ls_taper(i) .GT. 1.E-02 ) - - enddo ! do i=its,im - -ENDIF ! (do_gsl_drag_ls_bl).and.(gwd_opt_ls.EQ.1 .OR. gwd_opt_bl.EQ.1) - -if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then - ! Finalize dusfc and dvsfc diagnostics - do i = its,im - dusfc_ls(i) = (-1./g*rcs) * dusfc_ls(i) - dvsfc_ls(i) = (-1./g*rcs) * dvsfc_ls(i) - dusfc_bl(i) = (-1./g*rcs) * dusfc_bl(i) - dvsfc_bl(i) = (-1./g*rcs) * dvsfc_bl(i) - dusfc_ss(i) = (-1./g*rcs) * dusfc_ss(i) - dvsfc_ss(i) = (-1./g*rcs) * dvsfc_ss(i) - dusfc_fd(i) = (-1./g*rcs) * dusfc_fd(i) - dvsfc_fd(i) = (-1./g*rcs) * dvsfc_fd(i) - enddo -endif -! - return - end subroutine drag_suite_run -!------------------------------------------------------------------- -! - subroutine drag_suite_finalize() - end subroutine drag_suite_finalize - - end module drag_suite diff --git a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.F90 b/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.F90 deleted file mode 100644 index db31228d3b..0000000000 --- a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.F90 +++ /dev/null @@ -1,1073 +0,0 @@ -!> \file module_MYNNPBL_wrapper.F90 -!! This file contains all of the code related to running the MYNN -!! eddy-diffusivity mass-flux scheme. - -!>\ingroup gsd_mynn_edmf -!> The following references best describe the code within -!! Olson et al. (2019, NOAA Technical Memorandum) -!! Nakanishi and Niino (2009) \cite NAKANISHI_2009 - MODULE mynnedmf_wrapper - - contains - -!> \section arg_table_mynnedmf_wrapper_init Argument Table -!! \htmlinclude mynnedmf_wrapper_init.html -!! - subroutine mynnedmf_wrapper_init ( & - & con_cp, con_grav, con_rd, con_rv, & - & con_cpv, con_cliq, con_cice, con_rcp, & - & con_XLV, con_XLF, con_p608, con_ep2, & - & con_karman, do_mynnedmf, lheatstrg, & - & errmsg, errflg ) - - use machine, only : kind_phys - use bl_mynn_common - - implicit none - - logical, intent(in) :: do_mynnedmf - logical, intent(in) :: lheatstrg - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - real(kind=kind_phys),intent(in):: con_xlv - real(kind=kind_phys),intent(in):: con_xlf - real(kind=kind_phys),intent(in):: con_rv - real(kind=kind_phys),intent(in):: con_rd - real(kind=kind_phys),intent(in):: con_ep2 - real(kind=kind_phys),intent(in):: con_grav - real(kind=kind_phys),intent(in):: con_cp - real(kind=kind_phys),intent(in):: con_cpv - real(kind=kind_phys),intent(in):: con_rcp - real(kind=kind_phys),intent(in):: con_p608 - real(kind=kind_phys),intent(in):: con_cliq - real(kind=kind_phys),intent(in):: con_cice - real(kind=kind_phys),intent(in):: con_karman - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - xlv = con_xlv - xlf = con_xlf - r_v = con_rv - r_d = con_rd - ep_2 = con_ep2 - grav = con_grav - cp = con_cp - cpv = con_cpv - rcp = con_rcp - p608 = con_p608 - cliq = con_cliq - cice = con_cice - karman = con_karman - - xls = xlv+xlf != 2.85E6 (J/kg) sublimation - rvovrd = r_v/r_d != 1.608 - ep_3 = 1.-ep_2 != 0.378 - gtr = grav/tref - rk = cp/r_d - tv0 = p608*tref - tv1 = (1.+p608)*tref - xlscp = (xlv+xlf)/cp - xlvcp = xlv/cp - g_inv = 1./grav - - ! Consistency checks - if (.not. do_mynnedmf) then - errmsg = 'Logic error: do_mynnedmf = .false.' - errflg = 1 - return - end if - - if (lheatstrg) then - errmsg = 'Logic error: lheatstrg not implemented for MYNN PBL' - errflg = 1 - return - end if - - end subroutine mynnedmf_wrapper_init - - subroutine mynnedmf_wrapper_finalize () - end subroutine mynnedmf_wrapper_finalize - -! \brief This scheme (1) performs pre-mynnedmf work, (2) runs the mynnedmf, and (3) performs post-mynnedmf work -!> \section arg_table_mynnedmf_wrapper_run Argument Table -!! \htmlinclude mynnedmf_wrapper_run.html -!! -SUBROUTINE mynnedmf_wrapper_run( & - & im,levs, & - & flag_init,flag_restart, & - & lssav, ldiag3d, qdiag3d, & - & lsidea, cplflx, & - & delt,dtf,dx,zorl, & - & phii,u,v,omega,t3d, & - & qgrs_water_vapor, & - & qgrs_liquid_cloud, & - & qgrs_ice_cloud, & - & qgrs_cloud_droplet_num_conc, & - & qgrs_cloud_ice_num_conc, & - & qgrs_ozone, & - & qgrs_water_aer_num_conc, & - & qgrs_ice_aer_num_conc, & - & prsl,exner, & - & slmsk,tsurf,qsfc,ps, & - & ust,ch,hflx,qflx,wspd,rb, & - & dtsfc1,dqsfc1, & - & dusfc1,dvsfc1, & - & dusfci_diag,dvsfci_diag, & - & dtsfci_diag,dqsfci_diag, & - & dusfc_diag,dvsfc_diag, & - & dtsfc_diag,dqsfc_diag, & - & dusfc_cice,dvsfc_cice, & - & dtsfc_cice,dqsfc_cice, & - & hflx_wat,qflx_wat,stress_wat, & - & oceanfrac,fice,wet,icy,dry, & - & dusfci_cpl,dvsfci_cpl, & - & dtsfci_cpl,dqsfci_cpl, & - & dusfc_cpl,dvsfc_cpl, & - & dtsfc_cpl,dqsfc_cpl, & - & recmol, & - & qke,qke_adv,Tsq,Qsq,Cov, & - & el_pbl,sh3d,exch_h,exch_m, & - & Pblh,kpbl, & - & qc_bl,qi_bl,cldfra_bl, & - & edmf_a,edmf_w,edmf_qt, & - & edmf_thl,edmf_ent,edmf_qc, & - & sub_thl,sub_sqv,det_thl,det_sqv,& - & nupdraft,maxMF,ktop_plume, & - & dudt, dvdt, dtdt, & - & dqdt_water_vapor, dqdt_liquid_cloud, & ! <=== ntqv, ntcw - & dqdt_ice_cloud, dqdt_ozone, & ! <=== ntiw, ntoz - & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & ! <=== ntlnc, ntinc - & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc,& ! <=== ntwa, ntia - & flag_for_pbl_generic_tend, & - & dtend, dtidx, index_of_temperature, & - & index_of_x_wind, index_of_y_wind, ntke, & - & ntqv, ntcw, ntiw, ntoz, ntlnc, ntinc, ntwa, ntia, & - & index_of_process_pbl, htrsw, htrlw, xmu, & - & bl_mynn_tkebudget, bl_mynn_tkeadvect, & - & bl_mynn_cloudpdf, bl_mynn_mixlength, & - & bl_mynn_edmf, & - & bl_mynn_edmf_mom, bl_mynn_edmf_tke, & - & bl_mynn_cloudmix, bl_mynn_mixqt, & - & bl_mynn_output, & - & icloud_bl, do_mynnsfclay, & - & imp_physics, imp_physics_gfdl, & - & imp_physics_thompson, imp_physics_wsm6, & - & ltaerosol, lprnt, huge, errmsg, errflg ) - -! should be moved to inside the mynn: - use machine, only : kind_phys - use bl_mynn_common, only: cp, r_d, grav, g_inv, zero, & - xlv, xlvcp, xlscp - use module_bl_mynn, only : mynn_bl_driver - -!------------------------------------------------------------------- - implicit none -!------------------------------------------------------------------- - - real(kind=kind_phys) :: huge - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea, qdiag3d - LOGICAL, INTENT(IN) :: cplflx - - !smoke/chem - !LOGICAL, INTENT(IN) :: rrfs_smoke, rrfs_smoke, fire_turb - !INTEGER, INTENT(IN) ::nchem, ndvel, kdvel - !for testing only: - LOGICAL, parameter :: rrfs_smoke=.false., mix_chem=.false., fire_turb=.false. - INTEGER, PARAMETER :: nchem=2, ndvel=2, kdvel=1 - -! NAMELIST OPTIONS (INPUT): - LOGICAL, INTENT(IN) :: & - & bl_mynn_tkeadvect, & - & ltaerosol, & - & lprnt, & - & do_mynnsfclay, & - & flag_for_pbl_generic_tend - INTEGER, INTENT(IN) :: & - & bl_mynn_cloudpdf, & - & bl_mynn_mixlength, & - & icloud_bl, & - & bl_mynn_edmf, & - & bl_mynn_edmf_mom, & - & bl_mynn_edmf_tke, & - & bl_mynn_cloudmix, & - & bl_mynn_mixqt, & - & bl_mynn_tkebudget, & - & bl_mynn_output, & - & imp_physics, imp_physics_wsm6, & - & imp_physics_thompson, imp_physics_gfdl - -!TENDENCY DIAGNOSTICS - real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:) - integer, intent(in) :: index_of_temperature, index_of_x_wind - integer, intent(in) :: index_of_y_wind, index_of_process_pbl - integer, intent(in) :: ntoz, ntqv, ntcw, ntiw, ntlnc - integer, intent(in) :: ntinc, ntwa, ntia, ntke - -!MISC CONFIGURATION OPTIONS - INTEGER, PARAMETER :: & - & spp_pbl=0, & - & bl_mynn_mixscalars=1 - REAL, PARAMETER :: & - & closure=2.6 !2.5, 2.6 or 3.0 - LOGICAL :: & - & FLAG_QI, FLAG_QNI, FLAG_QC, FLAG_QNC, & - & FLAG_QNWFA, FLAG_QNIFA - ! Define locally until needed from CCPP - LOGICAL, PARAMETER :: cycling = .false. - INTEGER, PARAMETER :: param_first_scalar = 1 - INTEGER :: & - & p_qc, p_qr, p_qi, p_qs, p_qg, p_qnc, p_qni - -!MYNN-1D - REAL(kind=kind_phys), intent(in) :: delt, dtf - INTEGER, intent(in) :: im, levs - LOGICAL, intent(in) :: flag_init, flag_restart - INTEGER :: initflag, k, i - INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & - & IMS,IME,JMS,JME,KMS,KME, & - & ITS,ITE,JTS,JTE,KTS,KTE - - REAL(kind=kind_phys) :: tem - -!MYNN-3D - real(kind=kind_phys), dimension(:,:), intent(in) :: phii - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - & dtdt, dudt, dvdt, & - & dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice_cloud, & - & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & - & dqdt_ozone, dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - & qke, qke_adv, EL_PBL, Sh3D, & - & qc_bl, qi_bl, cldfra_bl - !These 10 arrays are only allocated when bl_mynn_output > 0 - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - & edmf_a,edmf_w,edmf_qt, & - & edmf_thl,edmf_ent,edmf_qc, & - & sub_thl,sub_sqv,det_thl,det_sqv - - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - & t3d,qgrs_water_vapor,qgrs_liquid_cloud,qgrs_ice_cloud - - real(kind=kind_phys), dimension(:,:), intent(in) :: & - & u,v,omega, & - & exner,prsl, & - & qgrs_cloud_droplet_num_conc, & - & qgrs_cloud_ice_num_conc, & - & qgrs_ozone, & - & qgrs_water_aer_num_conc, & - & qgrs_ice_aer_num_conc - real(kind=kind_phys), dimension(:,:), intent(out) :: & - & Tsq, Qsq, Cov, exch_h, exch_m - real(kind=kind_phys), dimension(:), intent(in) :: xmu - real(kind=kind_phys), dimension(:,:), intent(in) :: htrsw, htrlw - !LOCAL - real(kind=kind_phys), dimension(im,levs) :: & - & sqv,sqc,sqi,qnc,qni,ozone,qnwfa,qnifa, & - & dz, w, p, rho, th, qv, delp, & - & RUBLTEN, RVBLTEN, RTHBLTEN, RQVBLTEN, & - & RQCBLTEN, RQNCBLTEN, RQIBLTEN, RQNIBLTEN, & - & RQNWFABLTEN, RQNIFABLTEN, & - & dqke,qWT,qSHEAR,qBUOY,qDISS, & - & pattern_spp_pbl - real(kind=kind_phys), allocatable :: old_ozone(:,:) - -!smoke/chem arrays - ! real(kind=kind_phys), dimension(:,:), intent(inout), optional :: & - ! & qgrs_smoke_conc, qgrs_dust_conc - ! real(kind=kind_phys), allocatable, dimension(:,:,:) :: chem3d - ! real(kind=kind_phys), dimension(:,:), intent(in), optional :: vdep - ! real(kind=kind_phys), dimension(:), intent(in), optional :: frp, emis_ant_no -!for testing only - real(kind=kind_phys), dimension(im,levs) :: & - & qgrs_smoke_conc, qgrs_dust_conc - real(kind=kind_phys), allocatable, dimension(:,:,:) :: chem3d - real(kind=kind_phys), dimension(im,ndvel) :: vdep !not passed in yet??? - real(kind=kind_phys), dimension(im) :: frp, emis_ant_no - -!MYNN-2D - real(kind=kind_phys), dimension(:), intent(in) :: & - & dx,zorl,slmsk,tsurf,qsfc,ps, & - & hflx,qflx,ust,wspd,rb,recmol - - real(kind=kind_phys), dimension(:), intent(in) :: & - & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice, & - & stress_wat,hflx_wat,qflx_wat, & - & oceanfrac,fice - - logical, dimension(:), intent(in) :: & - & wet, dry, icy - - real(kind=kind_phys), dimension(:), intent(inout) :: & - & pblh,dusfc_diag,dvsfc_diag,dtsfc_diag,dqsfc_diag - real(kind=kind_phys), dimension(:), intent(out) :: & - & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, & - & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag, & - & maxMF - integer, dimension(:), intent(inout) :: & - & kpbl,nupdraft,ktop_plume - - real(kind=kind_phys), dimension(:), intent(inout) :: & - & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind=kind_phys), dimension(:), intent(inout) :: & - & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl - - !LOCAL - real, dimension(im) :: & - & hfx,qfx,rmol,xland,uoce,voce,vdfg,znt,ts - integer :: idtend - real, dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 - real(kind=kind_phys), allocatable :: save_qke_adv(:,:) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (lprnt) then - write(0,*)"==============================================" - write(0,*)"in mynn wrapper..." - write(0,*)"flag_init=",flag_init - write(0,*)"flag_restart=",flag_restart - endif - - if (.not. flag_for_pbl_generic_tend .and. ldiag3d) then - idtend = dtidx(ntke+100,index_of_process_pbl) - if (idtend>=1) then - allocate(save_qke_adv(im,levs)) - save_qke_adv=qke_adv - endif - endif - - ! DH* TODO: Use flag_restart to distinguish which fields need - ! to be initialized and which are read from restart files - if (flag_init) then - initflag=1 - !print*,"in MYNN, initflag=",initflag - else - initflag=0 - !print*,"in MYNN, initflag=",initflag - endif - - !initialize arrays for test - qgrs_smoke_conc = 1.0 - qgrs_dust_conc = 1.0 - FRP = 0. - EMIS_ANT_NO = 0. - vdep = 0. ! hli for chem dry deposition, 0 temporarily - if (rrfs_smoke) then - allocate ( chem3d(im,levs,nchem) ) - do k=1,levs - do i=1,im - chem3d(i,k,1)=qgrs_smoke_conc(i,k) - chem3d(i,k,2)=qgrs_dust_conc (i,k) - enddo - enddo - endif - - ! Check incoming moist species to ensure non-negative values - ! First, create height (dz) and pressure differences (delp) - ! across model layers - do k=1,levs - do i=1,im - dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv - enddo - enddo - - do i=1,im - delp(i,1) = ps(i) - (prsl(i,2)*dz(i,1) + prsl(i,1)*dz(i,2))/(dz(i,1)+dz(i,2)) - do k=2,levs-1 - delp(i,k) = (prsl(i,k)*dz(i,k-1) + prsl(i,k-1)*dz(i,k))/(dz(i,k)+dz(i,k-1)) - & - (prsl(i,k+1)*dz(i,k) + prsl(i,k)*dz(i,k+1))/(dz(i,k)+dz(i,k+1)) - enddo - delp(i,levs) = delp(i,levs-1) - enddo - - do i=1,im - call moisture_check2(levs, delt, & - delp(i,:), exner(i,:), & - qgrs_water_vapor(i,:), & - qgrs_liquid_cloud(i,:),& - qgrs_ice_cloud(i,:), & - t3d(i,:) ) - enddo - - ! Assign variables for each microphysics scheme - if (imp_physics == imp_physics_wsm6) then - ! WSM6 - FLAG_QI = .true. - FLAG_QNI= .false. - FLAG_QC = .true. - FLAG_QNC= .false. - FLAG_QNWFA= .false. - FLAG_QNIFA= .false. - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 - do k=1,levs - do i=1,im - sqv(i,k) = qgrs_water_vapor(i,k) - sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) - ozone(i,k) = qgrs_ozone(i,k) - qnc(i,k) = 0. - qni(i,k) = 0. - qnwfa(i,k) = 0. - qnifa(i,k) = 0. - enddo - enddo - elseif (imp_physics == imp_physics_thompson) then - ! Thompson - if(ltaerosol) then - FLAG_QI = .true. - FLAG_QNI= .true. - FLAG_QC = .true. - FLAG_QNC= .true. - FLAG_QNWFA= .true. - FLAG_QNIFA= .true. - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 - do k=1,levs - do i=1,im - sqv(i,k) = qgrs_water_vapor(i,k) - sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) - qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) - qni(i,k) = qgrs_cloud_ice_num_conc(i,k) - ozone(i,k) = qgrs_ozone(i,k) - qnwfa(i,k) = qgrs_water_aer_num_conc(i,k) - qnifa(i,k) = qgrs_ice_aer_num_conc(i,k) - enddo - enddo - else - FLAG_QI = .true. - FLAG_QNI= .true. - FLAG_QC = .true. - FLAG_QNC= .false. - FLAG_QNWFA= .false. - FLAG_QNIFA= .false. - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 - do k=1,levs - do i=1,im - sqv(i,k) = qgrs_water_vapor(i,k) - sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) - qnc(i,k) = 0. - qni(i,k) = qgrs_cloud_ice_num_conc(i,k) - ozone(i,k) = qgrs_ozone(i,k) - qnwfa(i,k) = 0. - qnifa(i,k) = 0. - enddo - enddo - endif - elseif (imp_physics == imp_physics_gfdl) then - ! GFDL MP - FLAG_QI = .true. - FLAG_QNI= .false. - FLAG_QC = .true. - FLAG_QNC= .false. - FLAG_QNWFA= .false. - FLAG_QNIFA= .false. - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 - do k=1,levs - do i=1,im - sqv(i,k) = qgrs_water_vapor(i,k) - sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) - qnc(i,k) = 0. - qni(i,k) = 0. - qnwfa(i,k) = 0. - qnifa(i,k) = 0. - ozone(i,k) = qgrs_ozone(i,k) - enddo - enddo - else - print*,"In MYNN wrapper. Unknown microphysics scheme, imp_physics=",imp_physics - print*,"Defaulting to qc and qv species only..." - FLAG_QI = .false. - FLAG_QNI= .false. - FLAG_QC = .true. - FLAG_QNC= .false. - FLAG_QNWFA= .false. - FLAG_QNIFA= .false. - p_qc = 2 - p_qr = 0 - p_qi = 0 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 - do k=1,levs - do i=1,im - sqv(i,k) = qgrs_water_vapor(i,k) - sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = 0. - qnc(i,k) = 0. - qni(i,k) = 0. - qnwfa(i,k) = 0. - qnifa(i,k) = 0. - ozone(i,k) = qgrs_ozone(i,k) - enddo - enddo - endif - if(ldiag3d .and. dtidx(100+ntoz,index_of_process_pbl)>1) then - allocate(old_ozone(im,levs)) - old_ozone = ozone - endif - if (lprnt)write(0,*)"prepping MYNN-EDMF variables..." - - do k=1,levs - do i=1,im - ! dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv - th(i,k)=t3d(i,k)/exner(i,k) - ! keep as specific humidity - ! qv(i,k)=qvsh(i,k)/(1.0 - qvsh(i,k)) - ! qc(i,k)=qc(i,k)/(1.0 - qvsh(i,k)) - ! qi(i,k)=qi(i,k)/(1.0 - qvsh(i,k)) - rho(i,k)=prsl(i,k)/(r_d*t3d(i,k)) - w(i,k) = -omega(i,k)/(rho(i,k)*grav) - pattern_spp_pbl(i,k)=0.0 - enddo - enddo - do i=1,im - if (slmsk(i)==1. .or. slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 - xland(i)=1.0 !but land/water = (1/2) in SFCLAY_mynn - else - xland(i)=2.0 - endif - uoce(i)=0.0 - voce(i)=0.0 - vdfg(i)=0.0 - !ust(i) = sqrt(stress(i)) - ch(i)=0.0 - hfx(i)=hflx(i)*rho(i,1)*cp - qfx(i)=qflx(i)*rho(i,1) - - dtsfc1(i) = hfx(i) - dqsfc1(i) = qfx(i)*XLV - dusfc1(i) = -1.*rho(i,1)*ust(i)*ust(i)*u(i,1)/wspd(i) - dvsfc1(i) = -1.*rho(i,1)*ust(i)*ust(i)*v(i,1)/wspd(i) - - !BWG: diagnostic surface fluxes for scalars & momentum - dtsfci_diag(i) = dtsfc1(i) - dqsfci_diag(i) = dqsfc1(i) - dtsfc_diag(i) = dtsfc_diag(i) + dtsfc1(i)*delt - dqsfc_diag(i) = dqsfc_diag(i) + dqsfc1(i)*delt - dusfci_diag(i) = dusfc1(i) - dvsfci_diag(i) = dvsfc1(i) - dusfc_diag(i) = dusfc_diag(i) + dusfci_diag(i)*delt - dvsfc_diag(i) = dvsfc_diag(i) + dvsfci_diag(i)*delt - - znt(i)=zorl(i)*0.01 !cm -> m? - if (do_mynnsfclay) then - rmol(i)=recmol(i) - else - if (hfx(i) .ge. 0.)then - rmol(i)=-hfx(i)/(200.*dz(i,1)*0.5) - else - rmol(i)=ABS(rb(i))*1./(dz(i,1)*0.5) - endif - endif - ts(i)=tsurf(i)/exner(i,1) !theta -! qsfc(i)=qss(i) -! ps(i)=pgr(i) -! wspd(i)=wind(i) - enddo - - ! BWG: Coupling insertion - if (cplflx) then - do i=1,im - if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES - if ( .not. wet(i)) then ! no open water, use results from CICE - dusfci_cpl(i) = dusfc_cice(i) - dvsfci_cpl(i) = dvsfc_cice(i) - dtsfci_cpl(i) = dtsfc_cice(i) - dqsfci_cpl(i) = dqsfc_cice(i) - elseif (icy(i) .or. dry(i)) then ! use stress_ocean for opw component at mixed point - if (wspd(i) > zero) then - dusfci_cpl(i) = -1.*rho(i,1)*stress_wat(i)*u(i,1)/wspd(i) ! U-momentum flux - dvsfci_cpl(i) = -1.*rho(i,1)*stress_wat(i)*v(i,1)/wspd(i) ! V-momentum flux - else - dusfci_cpl(i) = zero - dvsfci_cpl(i) = zero - endif - dtsfci_cpl(i) = cp*rho(i,1)*hflx_wat(i) ! sensible heat flux over open ocean - dqsfci_cpl(i) = XLV*rho(i,1)*qflx_wat(i) ! latent heat flux over open ocean - else ! use results from this scheme for 100% open ocean - dusfci_cpl(i) = dusfci_diag(i) - dvsfci_cpl(i) = dvsfci_diag(i) - dtsfci_cpl(i) = dtsfci_diag(i) - dqsfci_cpl(i) = dqsfci_diag(i) - endif -! - dusfc_cpl (i) = dusfc_cpl(i) + dusfci_cpl(i) * delt - dvsfc_cpl (i) = dvsfc_cpl(i) + dvsfci_cpl(i) * delt - dtsfc_cpl (i) = dtsfc_cpl(i) + dtsfci_cpl(i) * delt - dqsfc_cpl (i) = dqsfc_cpl(i) + dqsfci_cpl(i) * delt - else ! If no ocean - dusfc_cpl(i) = huge - dvsfc_cpl(i) = huge - dtsfc_cpl(i) = huge - dqsfc_cpl(i) = huge - endif ! Ocean only, NO LAKES - enddo - endif ! End coupling insertion - - if (lprnt) then - print* - write(0,*)"===CALLING mynn_bl_driver; input:" - print*,"bl_mynn_tkebudget=",bl_mynn_tkebudget," bl_mynn_tkeadvect=",bl_mynn_tkeadvect - print*,"bl_mynn_cloudpdf=",bl_mynn_cloudpdf," bl_mynn_mixlength=",bl_mynn_mixlength - print*,"bl_mynn_edmf=",bl_mynn_edmf," bl_mynn_edmf_mom=",bl_mynn_edmf_mom - print*,"bl_mynn_edmf_tke=",bl_mynn_edmf_tke - print*,"bl_mynn_cloudmix=",bl_mynn_cloudmix," bl_mynn_mixqt=",bl_mynn_mixqt - print*,"icloud_bl=",icloud_bl - print*,"T:",t3d(1,1),t3d(1,2),t3d(1,levs) - print*,"TH:",th(1,1),th(1,2),th(1,levs) - print*,"rho:",rho(1,1),rho(1,2),rho(1,levs) - print*,"exner:",exner(1,1),exner(1,2),exner(1,levs) - print*,"prsl:",prsl(1,1),prsl(1,2),prsl(1,levs) - print*,"dz:",dz(1,1),dz(1,2),dz(1,levs) - print*,"u:",u(1,1),u(1,2),u(1,levs) - print*,"v:",v(1,1),v(1,2),v(1,levs) - print*,"sqv:",sqv(1,1),sqv(1,2),sqv(1,levs) - print*,"sqc:",sqc(1,1),sqc(1,2),sqc(1,levs) - print*,"sqi:",sqi(1,1),sqi(1,2),sqi(1,levs) - print*,"rmol:",rmol(1)," ust:",ust(1) - print*," dx=",dx(1),"initflag=",initflag - print*,"Tsurf:",tsurf(1)," Thetasurf:",ts(1) - print*,"HFX:",hfx(1)," qfx",qfx(1) - print*,"qsfc:",qsfc(1)," ps:",ps(1) - print*,"wspd:",wspd(1)," rb=",rb(1) - print*,"znt:",znt(1)," delt=",delt - print*,"im=",im," levs=",levs - print*,"PBLH=",pblh(1)," KPBL=",KPBL(1)," xland=",xland(1) - print*,"vdfg=",vdfg(1)," ch=",ch(1) - !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) - print*,"qke:",qke(1,1),qke(1,2),qke(1,levs) - print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs) - print*,"Sh3d:",Sh3d(1,1),sh3d(1,2),sh3d(1,levs) - !print*,"exch_h:",exch_h(1,1),exch_h(1,2),exch_h(1,levs) ! - intent(out) - !print*,"exch_m:",exch_m(1,1),exch_m(1,2),exch_m(1,levs) ! - intent(out) - print*,"max cf_bl:",maxval(cldfra_bl(1,:)) - endif - - - CALL mynn_bl_driver( & - & initflag=initflag,restart=flag_restart, & - & cycling=cycling, & - & delt=delt,dz=dz,dx=dx,znt=znt, & - & u=u,v=v,w=w,th=th,sqv3D=sqv,sqc3D=sqc, & - & sqi3D=sqi,qnc=qnc,qni=qni, & - & qnwfa=qnwfa,qnifa=qnifa,ozone=ozone, & - & p=prsl,exner=exner,rho=rho,T3D=t3d, & - & xland=xland,ts=ts,qsfc=qsfc,ps=ps, & - & ust=ust,ch=ch,hfx=hfx,qfx=qfx,rmol=rmol, & - & wspd=wspd,uoce=uoce,voce=voce,vdfg=vdfg, & !input - & qke=QKE,qke_adv=qke_adv, & !output - & bl_mynn_tkeadvect=bl_mynn_tkeadvect,sh3d=Sh3d, & -!chem/smoke - & nchem=nchem,kdvel=kdvel,ndvel=ndvel, & - & Chem3d=chem3d,Vdep=vdep, & - & rrfs_smoke=rrfs_smoke, & - & FRP=frp,EMIS_ANT_NO=emis_ant_no, & - & mix_chem=mix_chem,fire_turb=fire_turb, & -!----- - & Tsq=tsq,Qsq=qsq,Cov=cov, & !output - & RUBLTEN=RUBLTEN,RVBLTEN=RVBLTEN,RTHBLTEN=RTHBLTEN, & !output - & RQVBLTEN=RQVBLTEN,RQCBLTEN=rqcblten, & - & RQIBLTEN=rqiblten,RQNCBLTEN=rqncblten, & !output - & RQNIBLTEN=rqniblten,RQNWFABLTEN=RQNWFABLTEN, & !output - & RQNIFABLTEN=RQNIFABLTEN,dozone=dqdt_ozone, & !output - & EXCH_H=exch_h,EXCH_M=exch_m, & !output - & pblh=pblh,KPBL=KPBL & !output - & ,el_pbl=el_pbl & !output - & ,dqke=dqke & !output - & ,qWT=qWT,qSHEAR=qSHEAR,qBUOY=qBUOY,qDISS=qDISS & !output - & ,bl_mynn_tkebudget=bl_mynn_tkebudget & !input parameter - & ,bl_mynn_cloudpdf=bl_mynn_cloudpdf & !input parameter - & ,bl_mynn_mixlength=bl_mynn_mixlength & !input parameter - & ,icloud_bl=icloud_bl & !input parameter - & ,qc_bl=qc_bl,qi_bl=qi_bl,cldfra_bl=cldfra_bl & !output - & ,closure=closure,bl_mynn_edmf=bl_mynn_edmf & !input parameter - & ,bl_mynn_edmf_mom=bl_mynn_edmf_mom & !input parameter - & ,bl_mynn_edmf_tke=bl_mynn_edmf_tke & !input parameter - & ,bl_mynn_mixscalars=bl_mynn_mixscalars & !input parameter - & ,bl_mynn_output=bl_mynn_output & !input parameter - & ,bl_mynn_cloudmix=bl_mynn_cloudmix & !input parameter - & ,bl_mynn_mixqt=bl_mynn_mixqt & !input parameter - & ,edmf_a=edmf_a,edmf_w=edmf_w,edmf_qt=edmf_qt & !output - & ,edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc &!output - & ,sub_thl3D=sub_thl,sub_sqv3D=sub_sqv & - & ,det_thl3D=det_thl,det_sqv3D=det_sqv & - & ,nupdraft=nupdraft,maxMF=maxMF & !output - & ,ktop_plume=ktop_plume & !output - & ,spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl & !input - & ,RTHRATEN=htrlw & !input - & ,FLAG_QI=flag_qi,FLAG_QNI=flag_qni & !input - & ,FLAG_QC=flag_qc,FLAG_QNC=flag_qnc & !input - & ,FLAG_QNWFA=FLAG_QNWFA,FLAG_QNIFA=FLAG_QNIFA & !input - & ,IDS=1,IDE=im,JDS=1,JDE=1,KDS=1,KDE=levs & !input - & ,IMS=1,IME=im,JMS=1,JME=1,KMS=1,KME=levs & !input - & ,ITS=1,ITE=im,JTS=1,JTE=1,KTS=1,KTE=levs) !input - - - ! POST MYNN (INTERSTITIAL) WORK: - !update/save MYNN-only variables - !do k=1,levs - ! do i=1,im - ! gq0(i,k,4)=qke(i,k,1) !tke*2 - ! enddo - !enddo - !For MYNN, convert TH-tend to T-tend - do k = 1, levs - do i = 1, im - dtdt(i,k) = dtdt(i,k) + RTHBLTEN(i,k)*exner(i,k) - dudt(i,k) = dudt(i,k) + RUBLTEN(i,k) - dvdt(i,k) = dvdt(i,k) + RVBLTEN(i,k) - enddo - enddo - accum_duvt3dt: if(ldiag3d .or. lsidea) then - call dtend_helper(index_of_x_wind,RUBLTEN) - call dtend_helper(index_of_y_wind,RVBLTEN) - call dtend_helper(index_of_temperature,RTHBLTEN,exner) - if(ldiag3d) then - call dtend_helper(100+ntoz,dqdt_ozone) - ! idtend = dtidx(100+ntoz,index_of_process_pbl) - ! if(idtend>=1) then - ! dtend(:,:,idtend) = dtend(:,:,idtend) + (ozone-old_ozone) - ! deallocate(old_ozone) - ! endif - endif - endif accum_duvt3dt - !Update T, U and V: - !do k = 1, levs - ! do i = 1, im - ! T3D(i,k) = T3D(i,k) + RTHBLTEN(i,k)*exner(i,k)*delt - ! u(i,k) = u(i,k) + RUBLTEN(i,k)*delt - ! v(i,k) = v(i,k) + RVBLTEN(i,k)*delt - ! enddo - !enddo - - !DO moist/scalar/tracer tendencies: - if (imp_physics == imp_physics_wsm6) then - ! WSM6 - do k=1,levs - do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) - !dqdt_ozone(i,k) = 0.0 - enddo - enddo - if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then - call dtend_helper(100+ntqv,RQVBLTEN) - call dtend_helper(100+ntcw,RQCBLTEN) - call dtend_helper(100+ntiw,RQIBLTEN) - endif - !Update moist species: - !do k=1,levs - ! do i=1,im - ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt - ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt - ! qgrs_ice_cloud(i,k) = qgrs_ice_cloud(i,k) + RQIBLTEN(i,k)*delt - ! !dqdt_ozone(i,k) = 0.0 - ! enddo - !enddo - elseif (imp_physics == imp_physics_thompson) then - ! Thompson-Aerosol - if(ltaerosol) then - do k=1,levs - do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - !dqdt_ozone(i,k) = 0.0 - dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) - dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) - enddo - enddo - if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then - call dtend_helper(100+ntqv,RQVBLTEN) - call dtend_helper(100+ntcw,RQCBLTEN) - call dtend_helper(100+ntlnc,RQNCBLTEN) - call dtend_helper(100+ntiw,RQIBLTEN) - call dtend_helper(100+ntinc,RQNIBLTEN) - call dtend_helper(100+ntwa,RQNWFABLTEN) - call dtend_helper(100+ntia,RQNIFABLTEN) - endif - !do k=1,levs - ! do i=1,im - ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt - ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt - ! qgrs_ice_cloud(i,k) = qgrs_ice_cloud(i,k) + RQIBLTEN(i,k)*delt - ! qgrs_cloud_droplet_num_conc(i,k) = qgrs_cloud_droplet_num_conc(i,k) + RQNCBLTEN(i,k)*delt - ! qgrs_cloud_ice_num_conc(i,k) = qgrs_cloud_ice_num_conc(i,k) + RQNIBLTEN(i,k)*delt - ! !dqdt_ozone(i,k) = 0.0 - ! !qgrs_water_aer_num_conc(i,k) = qgrs_water_aer_num_conc(i,k) + RQNWFABLTEN(i,k)*delt - ! !qgrs_ice_aer_num_conc(i,k) = qgrs_ice_aer_num_conc(i,k) + RQNIFABLTEN(i,k)*delt - ! enddo - !enddo - else - !Thompson (2008) - do k=1,levs - do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) - !dqdt_ozone(i,k) = 0.0 - enddo - enddo - if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then - call dtend_helper(100+ntqv,RQVBLTEN) - call dtend_helper(100+ntcw,RQCBLTEN) - call dtend_helper(100+ntiw,RQIBLTEN) - call dtend_helper(100+ntinc,RQNIBLTEN) - endif - !do k=1,levs - ! do i=1,im - ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt - ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt - ! qgrs_ice_cloud(i,k) = qgrs_ice_cloud(i,k) + RQIBLTEN(i,k)*delt - ! qgrs_cloud_ice_num_conc(i,k) = qgrs_cloud_ice_num_conc(i,k) + RQNIBLTEN(i,k)*delt - ! !dqdt_ozone(i,k) = 0.0 - ! enddo - !enddo - endif !end thompson choice - elseif (imp_physics == imp_physics_gfdl) then - ! GFDL MP - do k=1,levs - do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) - !dqdt_rain(i,k) = 0.0 - !dqdt_snow(i,k) = 0.0 - !dqdt_graupel(i,k) = 0.0 - !dqdt_ozone(i,k) = 0.0 - enddo - enddo - if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then - call dtend_helper(100+ntqv,RQVBLTEN) - call dtend_helper(100+ntcw,RQCBLTEN) - call dtend_helper(100+ntiw,RQIBLTEN) - endif - !do k=1,levs - ! do i=1,im - ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt - ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt - ! qgrs_ice_cloud(i,k) = qgrs_ice_cloud(i,k) + RQIBLTEN(i,k)*delt - ! !dqdt_ozone(i,k) = 0.0 - ! enddo - !enddo - else -! print*,"In MYNN wrapper. Unknown microphysics scheme, imp_physics=",imp_physics - do k=1,levs - do i=1,im - dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = 0.0 - !dqdt_rain(i,k) = 0.0 - !dqdt_snow(i,k) = 0.0 - !dqdt_graupel(i,k) = 0.0 - !dqdt_ozone(i,k) = 0.0 - enddo - enddo - if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then - call dtend_helper(100+ntqv,RQVBLTEN) - call dtend_helper(100+ntcw,RQCBLTEN) - call dtend_helper(100+ntiw,RQIBLTEN) - endif - endif - - if (lprnt) then - print* - print*,"===Finished with mynn_bl_driver; output:" - print*,"T:",t3d(1,1),t3d(1,2),t3d(1,levs) - print*,"TH:",th(1,1),th(1,2),th(1,levs) - print*,"rho:",rho(1,1),rho(1,2),rho(1,levs) - print*,"exner:",exner(1,1),exner(1,2),exner(1,levs) - print*,"prsl:",prsl(1,1),prsl(1,2),prsl(1,levs) - print*,"dz:",dz(1,1),dz(1,2),dz(1,levs) - print*,"u:",u(1,1),u(1,2),u(1,levs) - print*,"v:",v(1,1),v(1,2),v(1,levs) - print*,"sqv:",sqv(1,1),sqv(1,2),sqv(1,levs) - print*,"sqc:",sqc(1,1),sqc(1,2),sqc(1,levs) - print*,"sqi:",sqi(1,1),sqi(1,2),sqi(1,levs) - print*,"rmol:",rmol(1)," ust:",ust(1) - print*,"dx(1)=",dx(1),"initflag=",initflag - print*,"Tsurf:",tsurf(1)," Thetasurf:",ts(1) - print*,"HFX:",hfx(1)," qfx",qfx(1) - print*,"qsfc:",qsfc(1)," ps:",ps(1) - print*,"wspd:",wspd(1)," rb=",rb(1) - print*,"znt:",znt(1)," delt=",delt - print*,"im=",im," levs=",levs - print*,"PBLH=",pblh(1)," KPBL=",KPBL(1)," xland=",xland(1) - print*,"vdfg=",vdfg(1)," ch=",ch(1) - !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) - print*,"qke:",qke(1,1),qke(1,2),qke(1,levs) - print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs) - print*,"Sh3d:",Sh3d(1,1),sh3d(1,2),sh3d(1,levs) - print*,"exch_h:",exch_h(1,1),exch_h(1,2),exch_h(1,levs) - print*,"exch_m:",exch_m(1,1),exch_m(1,2),exch_m(1,levs) - print*,"max cf_bl:",maxval(cldfra_bl(1,:)) - print*,"max qc_bl:",maxval(qc_bl(1,:)) - print*,"dtdt:",dtdt(1,1),dtdt(1,2),dtdt(1,levs) - 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* - endif - - if(allocated(save_qke_adv)) then - if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then - idtend = dtidx(100+ntke,index_of_process_pbl) - if(idtend>=1) then - dtend(:,:,idtend) = dtend(:,:,idtend) + qke_adv-save_qke_adv - endif - endif - deallocate(save_qke_adv) - endif - - if(allocated(chem3d))then - deallocate(chem3d) - endif - - CONTAINS - - SUBROUTINE dtend_helper(itracer,field,mult) - real(kind=kind_phys), intent(in) :: field(im,levs) - real(kind=kind_phys), intent(in), optional :: mult(im,levs) - integer, intent(in) :: itracer - integer :: idtend - - idtend=dtidx(itracer,index_of_process_pbl) - if(idtend>=1) then - if(present(mult)) then - dtend(:,:,idtend) = dtend(:,:,idtend) + field*dtf*mult - else - dtend(:,:,idtend) = dtend(:,:,idtend) + field*dtf - endif - endif - END SUBROUTINE dtend_helper - -! ================================================================== - SUBROUTINE moisture_check2(kte, delt, dp, exner, & - qv, qc, qi, th ) - ! - ! If qc < qcmin, qi < qimin, or qv < qvmin happens in any layer, - ! force them to be larger than minimum value by (1) condensating - ! water vapor into liquid or ice, and (2) by transporting water vapor - ! from the very lower layer. - ! - ! We then update the final state variables and tendencies associated - ! with this correction. If any condensation happens, update theta/temperature too. - ! Note that (qv,qc,qi,th) are the final state variables after - ! applying corresponding input tendencies and corrective tendencies. - - implicit none - integer, intent(in) :: kte - real, intent(in) :: delt - real, dimension(kte), intent(in) :: dp, exner - real, dimension(kte), intent(inout) :: qv, qc, qi, th - integer k - real :: dqc2, dqi2, dqv2, sum, aa, dum - real, parameter :: qvmin1= 1e-8, & !min at k=1 - qvmin = 1e-20, & !min above k=1 - qcmin = 0.0, & - qimin = 0.0 - - do k = kte, 1, -1 ! From the top to the surface - dqc2 = max(0.0, qcmin-qc(k)) !qc deficit (>=0) - dqi2 = max(0.0, qimin-qi(k)) !qi deficit (>=0) - - !update species - qc(k) = qc(k) + dqc2 - qi(k) = qi(k) + dqi2 - qv(k) = qv(k) - dqc2 - dqi2 - !for theta - !th(k) = th(k) + xlvcp/exner(k)*dqc2 + & - ! xlscp/exner(k)*dqi2 - !for temperature - th(k) = th(k) + xlvcp*dqc2 + & - xlscp*dqi2 - - !then fix qv if lending qv made it negative - if (k .eq. 1) then - dqv2 = max(0.0, qvmin1-qv(k)) !qv deficit (>=0) - qv(k) = qv(k) + dqv2 - qv(k) = max(qv(k),qvmin1) - dqv2 = 0.0 - else - dqv2 = max(0.0, qvmin-qv(k)) !qv deficit (>=0) - qv(k) = qv(k) + dqv2 - qv(k-1)= qv(k-1) - dqv2*dp(k)/dp(k-1) - qv(k) = max(qv(k),qvmin) - endif - qc(k) = max(qc(k),qcmin) - qi(k) = max(qi(k),qimin) - end do - - ! Extra moisture used to satisfy 'qv(1)>=qvmin' is proportionally - ! extracted from all the layers that has 'qv > 2*qvmin'. This fully - ! preserves column moisture. - if( dqv2 .gt. 1.e-20 ) then - sum = 0.0 - do k = 1, kte - if( qv(k) .gt. 2.0*qvmin ) sum = sum + qv(k)*dp(k) - enddo - aa = dqv2*dp(1)/max(1.e-20,sum) - if( aa .lt. 0.5 ) then - do k = 1, kte - if( qv(k) .gt. 2.0*qvmin ) then - dum = aa*qv(k) - qv(k) = qv(k) - dum - endif - enddo - else - ! For testing purposes only (not yet found in any output): - ! write(*,*) 'Full moisture conservation is impossible' - endif - endif - - return - - END SUBROUTINE moisture_check2 - - END SUBROUTINE mynnedmf_wrapper_run - -!###================================================================= - -END MODULE mynnedmf_wrapper diff --git a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.meta_15dec b/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.meta_15dec deleted file mode 100644 index 526aba8596..0000000000 --- a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.meta_15dec +++ /dev/null @@ -1,1289 +0,0 @@ -[ccpp-table-properties] - name = mynnedmf_wrapper - type = scheme - dependencies = machine.F,module_bl_mynn.F90,physcons.F90 - -######################################################################## -[ccpp-arg-table] - name = mynnedmf_wrapper_init - type = scheme -[con_cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat of dry air at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_grav] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_rd] - standard_name = gas_constant_of_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_rv] - standard_name = gas_constant_water_vapor - long_name = ideal gas constant for water vapor - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_cpv] - standard_name = specific_heat_of_water_vapor_at_constant_pressure - long_name = specific heat of water vapor at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_cliq] - standard_name = specific_heat_of_liquid_water_at_constant_pressure - long_name = specific heat of liquid water at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_cice] - standard_name = specific_heat_of_ice_at_constant_pressure - long_name = specific heat of ice at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_rcp] - standard_name = ratio_of_gas_constant_dry_air_to_specific_heat_of_dry_air_at_constant_pressure - long_name = (rd/cp) - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[con_xlv] - standard_name = latent_heat_of_vaporization_of_water_at_0C - long_name = latent heat of evaporation/sublimation - units = J kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_xlf] - standard_name = latent_heat_of_fusion_of_water_at_0C - long_name = latent heat of fusion - units = J kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_p608] - standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one - long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[con_ep2] - standard_name = ratio_of_dry_air_to_water_vapor_gas_constants - long_name = rd/rv - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[con_karman] - standard_name = von_karman_constant - long_name = von karman constant - units = none - dimensions = () - type = real - 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 -[lheatstrg] - standard_name = flag_for_canopy_heat_storage_in_land_surface_scheme - long_name = flag for canopy heat storage parameterization - units = flag - dimensions = () - type = logical - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - -##################################################################### -[ccpp-arg-table] - name = mynnedmf_wrapper_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 = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[flag_init] - standard_name = flag_for_first_timestep - long_name = flag signaling first time step for time integration loop - units = flag - dimensions = () - type = logical - intent = in -[flag_restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - units = flag - dimensions = () - type = logical - intent = in -[lssav] - standard_name = flag_for_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - 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 -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[lsidea] - standard_name = flag_for_integrated_dynamics_through_earths_atmosphere - long_name = flag for idealized physics - units = flag - dimensions = () - type = logical - intent = in -[cplflx] - standard_name = flag_for_surface_flux_coupling - long_name = flag controlling cplflx collection (default off) - units = flag - dimensions = () - type = logical - intent = in -[delt] - standard_name = timestep_for_physics - long_name = time step for physics - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[dtf] - standard_name = timestep_for_dynamics - long_name = dynamics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[dx] - standard_name = characteristic_grid_lengthscale - long_name = size of the grid cell - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length in cm - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[phii] - standard_name = geopotential_at_interface - long_name = geopotential at model layer interfaces - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[U] - standard_name = x_wind - long_name = x component of layer wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[V] - standard_name = y_wind - long_name = y component of layer wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[omega] - standard_name = lagrangian_tendency_of_air_pressure - long_name = layer mean vertical velocity - units = Pa s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[T3D] - standard_name = air_temperature - long_name = layer mean air temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgrs_water_vapor] - standard_name = specific_humidity - long_name = water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgrs_liquid_cloud] - standard_name = cloud_liquid_water_mixing_ratio - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgrs_ice_cloud] - standard_name = cloud_ice_mixing_ratio - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgrs_cloud_droplet_num_conc] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air - long_name = number concentration of cloud droplets (liquid) - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs_cloud_ice_num_conc] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air - long_name = number concentration of ice - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs_ozone] - standard_name = ozone_mixing_ratio - long_name = ozone mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs_water_aer_num_conc] - standard_name = mass_number_concentration_of_hygroscopic_aerosols - long_name = number concentration of water-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs_ice_aer_num_conc] - standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols - long_name = number concentration of ice-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[prsl] - standard_name = air_pressure - long_name = mean layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[exner] - standard_name = dimensionless_exner_function - long_name = Exner function at layers - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[slmsk] - standard_name = area_type - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[tsurf] - standard_name = surface_skin_temperature - long_name = surface temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[qsfc] - standard_name = surface_specific_humidity - long_name = surface air saturation specific humidity - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[ps] - standard_name = surface_air_pressure - long_name = surface pressure - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[ust] - standard_name = surface_friction_velocity - long_name = boundary layer parameter - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[ch] - standard_name = surface_drag_wind_speed_for_momentum_in_air - long_name = momentum exchange coefficient - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness_and_vegetation - long_name = kinematic surface upward sensible heat flux reduced by surface roughness and vegetation - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[qflx] - standard_name = surface_upward_specific_humidity_flux - long_name = kinematic surface upward latent heat flux - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[wspd] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[rb] - standard_name = bulk_richardson_number_at_lowest_model_level - long_name = bulk Richardson number at the surface - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dtsfc1] - standard_name = instantaneous_surface_upward_sensible_heat_flux - long_name = surface upward sensible heat flux valid for current call - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dqsfc1] - standard_name = instantaneous_surface_upward_latent_heat_flux - long_name = surface upward latent heat flux valid for current call - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dusfc1] - standard_name = instantaneous_surface_x_momentum_flux - long_name = surface momentum flux in the x-direction valid for current call - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dvsfc1] - standard_name = instantaneous_surface_y_momentum_flux - long_name = surface momentum flux in the y-direction valid for current call - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dusfci_diag] - standard_name = instantaneous_surface_x_momentum_flux_for_diag - long_name = instantaneous sfc x momentum flux multiplied by timestep - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dvsfci_diag] - standard_name = instantaneous_surface_y_momentum_flux_for_diag - long_name = instantaneous sfc y momentum flux multiplied by timestep - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dtsfci_diag] - standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag - long_name = instantaneous sfc sensible heat flux multiplied by timestep - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dqsfci_diag] - standard_name = instantaneous_surface_upward_latent_heat_flux_for_diag - long_name = instantaneous sfc latent heat flux multiplied by timestep - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dusfc_diag] - standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc x momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dvsfc_diag] - standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc y momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dtsfc_diag] - standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc sensible heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dqsfc_diag] - standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dusfc_cice] - standard_name = surface_x_momentum_flux_from_coupled_process - long_name = sfc x momentum flux for coupling - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dvsfc_cice] - standard_name = surface_y_momentum_flux_from_coupled_process - long_name = sfc y momentum flux for coupling - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dtsfc_cice] - standard_name = surface_upward_sensible_heat_flux_from_coupled_process - long_name = sfc sensible heat flux for coupling - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dqsfc_cice] - standard_name = surface_upward_latent_heat_flux_from_coupled_process - long_name = sfc latent heat flux for coupling - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[hflx_wat] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_water - long_name = kinematic surface upward sensible heat flux over water - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[qflx_wat] - standard_name = kinematic_surface_upward_latent_heat_flux_over_water - long_name = kinematic surface upward latent heat flux over water - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[stress_wat] - standard_name = surface_wind_stress_over_water - long_name = surface wind stress over water - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[oceanfrac] - standard_name = sea_area_fraction - long_name = fraction of horizontal grid area occupied by ocean - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[fice] - standard_name = sea_ice_area_fraction_of_sea_area_fraction - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[wet] - standard_name = flag_nonzero_wet_surface_fraction - long_name = flag indicating presence of some ocean or lake surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = in -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_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 -[dusfci_cpl] - standard_name = surface_x_momentum_flux_for_coupling - long_name = instantaneous sfc u momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dvsfci_cpl] - standard_name = surface_y_momentum_flux_for_coupling - long_name = instantaneous sfc v momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dtsfci_cpl] - standard_name = surface_upward_sensible_heat_flux_for_coupling - long_name = instantaneous sfc sensible heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dqsfci_cpl] - standard_name = surface_upward_latent_heat_flux_for_coupling - long_name = instantaneous sfc latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dusfc_cpl] - standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc u momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dvsfc_cpl] - standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc v momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dtsfc_cpl] - standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc sensible heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dqsfc_cpl] - standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[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 -[qke] - standard_name = nonadvected_turbulent_kinetic_energy_multiplied_by_2 - long_name = 2 x tke at mass points - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qke_adv] - standard_name = turbulent_kinetic_energy - long_name = turbulent kinetic energy - units = J - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tsq] - standard_name = variance_of_air_temperature - long_name = temperature fluctuation squared - units = K2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[qsq] - standard_name = variance_of_specific_humidity - long_name = water vapor fluctuation squared - units = kg2 kg-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[cov] - standard_name = covariance_of_air_temperature_and_specific_humidity - long_name = covariance of temperature and moisture - units = K kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[el_pbl] - standard_name = turbulent_mixing_length - long_name = mixing length in meters - units = m - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[Sh3D] - standard_name = stability_function_for_heat - long_name = stability function for heat - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[exch_h] - standard_name = atmosphere_heat_diffusivity_for_mynnpbl - long_name = diffusivity for heat for MYNN PBL (defined for all mass levels) - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[exch_m] - standard_name = atmosphere_momentum_diffusivity_for_mynnpbl - long_name = diffusivity for momentum for MYNN PBL (defined for all mass levels) - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[PBLH] - standard_name = atmosphere_boundary_layer_thickness - long_name = PBL thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[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 = inout -[QC_BL] - standard_name = subgrid_scale_cloud_liquid_water_mixing_ratio - long_name = subgrid cloud water mixing ratio from PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[QI_BL] - standard_name = subgrid_scale_cloud_ice_mixing_ratio - long_name = subgrid cloud ice mixing ratio from PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[CLDFRA_BL] - standard_name = subgrid_scale_cloud_area_fraction_in_atmosphere_layer - long_name = subgrid cloud fraction from PBL scheme - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_a] - standard_name = emdf_updraft_area - long_name = updraft area from mass flux scheme - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_w] - standard_name = emdf_updraft_vertical_velocity - long_name = updraft vertical velocity from mass flux scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_qt] - standard_name = emdf_updraft_total_water - long_name = updraft total water from mass flux scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_thl] - standard_name = emdf_updraft_theta_l - long_name = updraft theta-l from mass flux scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_ent] - standard_name = emdf_updraft_entrainment_rate - long_name = updraft entrainment rate from mass flux scheme - units = s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_qc] - standard_name = emdf_updraft_cloud_water - long_name = updraft cloud water from mass flux scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[sub_thl] - standard_name = theta_subsidence_tendency - long_name = updraft theta subsidence tendency - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[sub_sqv] - standard_name = water_vapor_subsidence_tendency - long_name = updraft water vapor subsidence tendency - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[det_thl] - standard_name = theta_detrainment_tendency - long_name = updraft theta detrainment tendency - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[det_sqv] - standard_name = water_vapor_detrainment_tendency - long_name = updraft water vapor detrainment tendency - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[nupdraft] - standard_name = number_of_plumes - long_name = number of plumes per grid column - units = count - dimensions = (horizontal_loop_extent) - type = integer - intent = inout -[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 = out -[ktop_plume] - standard_name = k_level_of_highest_plume - long_name = k-level of highest plume - units = count - dimensions = (horizontal_loop_extent) - type = integer - intent = inout -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_water_vapor] - standard_name = process_split_cumulative_tendency_of_specific_humidity - long_name = water vapor specific humidity tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_liquid_cloud] - standard_name = process_split_cumulative_tendency_of_cloud_liquid_water_mixing_ratio - long_name = cloud condensed water mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_ice_cloud] - standard_name = process_split_cumulative_tendency_of_cloud_ice_mixing_ratio - long_name = cloud condensed water mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_ozone] - standard_name = process_split_cumulative_tendency_of_ozone_mixing_ratio - long_name = ozone mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_cloud_droplet_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air - long_name = number conc. of cloud droplets (liquid) tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_ice_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air - long_name = number conc. of ice tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_water_aer_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_hygroscopic_aerosols - long_name = number conc. of water-friendly aerosols tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_ice_aer_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols - long_name = number conc. of ice-friendly aerosols tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[flag_for_pbl_generic_tend] - standard_name = flag_for_generic_tendency_due_to_planetary_boundary_layer - long_name = true if GFS_PBL_generic should calculate tendencies - 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 -[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 -[ntke] - standard_name = index_of_turbulent_kinetic_energy_in_tracer_concentration_array - long_name = tracer index for turbulent kinetic energy - units = index - 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 -[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 -[ntcw] - standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for cloud condensate (or liquid water) - units = index - dimensions = () - type = integer - intent = in -[ntiw] - standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ice water - units = index - dimensions = () - type = integer - intent = in -[ntlnc] - standard_name = index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array - long_name = tracer index for liquid number concentration - units = index - dimensions = () - type = integer - intent = in -[ntinc] - standard_name = index_of_mass_number_concentration_of_cloud_ice_in_tracer_concentration_array - long_name = tracer index for ice number concentration - units = index - dimensions = () - type = integer - intent = in -[ntwa] - standard_name = index_of_mass_number_concentration_of_hygroscopic_aerosols_in_tracer_concentration_array - long_name = tracer index for water friendly aerosol - units = index - dimensions = () - type = integer - intent = in -[ntia] - standard_name = index_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_in_tracer_concentration_array - long_name = tracer index for ice friendly aerosol - 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 -[htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep - long_name = total sky sw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep - long_name = total sky lw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[xmu] - standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes - long_name = zenith angle temporal adjustment factor for shortwave - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[bl_mynn_tkebudget] - standard_name = control_for_tke_budget_output - long_name = flag for activating TKE budget - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_tkeadvect] - standard_name = flag_for_tke_advection - long_name = flag for activating TKE advect - units = flag - dimensions = () - type = logical - intent = in -[bl_mynn_cloudpdf] - standard_name = control_for_cloud_pdf_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to determine which cloud PDF to use - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_mixlength] - standard_name = control_for_mixing_length_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to determine which mixing length form to use - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_edmf] - standard_name = control_for_edmf_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate the mass-flux scheme - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_edmf_mom] - standard_name = control_for_edmf_momentum_transport_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate the transport of momentum - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_edmf_tke] - standard_name = control_for_edmf_tke_transport_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate the transport of TKE - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_cloudmix] - standard_name = control_for_cloud_species_mixing_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate mixing of cloud species - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_mixqt] - standard_name = control_for_total_water_mixing_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to mix total water or individual species - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_output] - standard_name = control_for_additional_diagnostics_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag initialize and output extra 3D variables - units = flag - dimensions = () - type = integer - intent = in -[icloud_bl] - standard_name = control_for_sgs_cloud_radiation_coupling_in_mellor_yamamda_nakanishi_niino_pbl_scheme - long_name = flag for coupling sgs clouds to radiation - units = flag - dimensions = () - type = integer - intent = in -[do_mynnsfclay] - standard_name = flag_for_mellor_yamada_nakanishi_niino_surface_layer_scheme - long_name = flag to activate MYNN surface layer - units = flag - dimensions = () - type = logical - intent = in -[imp_physics] - standard_name = control_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[imp_physics_gfdl] - standard_name = identifier_for_gfdl_microphysics_scheme - long_name = choice of GFDL microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[imp_physics_thompson] - standard_name = identifier_for_thompson_microphysics_scheme - long_name = choice of Thompson microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[imp_physics_wsm6] - standard_name = identifier_for_wsm6_microphysics_scheme - long_name = choice of WSM6 microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[ltaerosol] - standard_name = flag_for_aerosol_physics - long_name = flag for aerosol physics - units = flag - dimensions = () - type = logical - intent = in -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in -[huge] - standard_name = netcdf_float_fillvalue - long_name = definition of NetCDF float FillValue - 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 - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out diff --git a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.meta_24nov b/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.meta_24nov deleted file mode 100644 index 5d70282046..0000000000 --- a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_MYNNPBL_wrapper.meta_24nov +++ /dev/null @@ -1,1289 +0,0 @@ -[ccpp-table-properties] - name = mynnedmf_wrapper - type = scheme - dependencies = machine.F,module_bl_mynn.F90,physcons.F90 - -######################################################################## -[ccpp-arg-table] - name = mynnedmf_wrapper_init - type = scheme -[con_cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat of dry air at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_grav] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_rd] - standard_name = gas_constant_of_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_rv] - standard_name = gas_constant_water_vapor - long_name = ideal gas constant for water vapor - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_cpv] - standard_name = specific_heat_of_water_vapor_at_constant_pressure - long_name = specific heat of water vapor at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_cliq] - standard_name = specific_heat_of_liquid_water_at_constant_pressure - long_name = specific heat of liquid water at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_cice] - standard_name = specific_heat_of_ice_at_constant_pressure - long_name = specific heat of ice at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_rcp] - standard_name = ratio_of_gas_constant_dry_air_to_specific_heat_of_dry_air_at_constant_pressure - long_name = (rd/cp) - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[con_xlv] - standard_name = latent_heat_of_vaporization_of_water_at_0C - long_name = latent heat of evaporation/sublimation - units = J kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_xlf] - standard_name = latent_heat_of_fusion_of_water_at_0C - long_name = latent heat of fusion - units = J kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_p608] - standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one - long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[con_ep2] - standard_name = ratio_of_dry_air_to_water_vapor_gas_constants - long_name = rd/rv - units = none - dimensions = () - type = real - kind = kind_phys - intent = in -[con_karman] - standard_name = von_karman_constant - long_name = von karman constant - units = none - dimensions = () - type = real - 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 -[lheatstrg] - standard_name = flag_for_canopy_heat_storage_in_land_surface_scheme - long_name = flag for canopy heat storage parameterization - units = flag - dimensions = () - type = logical - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - -##################################################################### -[ccpp-arg-table] - name = mynnedmf_wrapper_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 = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in -[flag_init] - standard_name = flag_for_first_timestep - long_name = flag signaling first time step for time integration loop - units = flag - dimensions = () - type = logical - intent = in -[flag_restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - units = flag - dimensions = () - type = logical - intent = in -[lssav] - standard_name = flag_for_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - 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 -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[lsidea] - standard_name = flag_for_integrated_dynamics_through_earths_atmosphere - long_name = flag for idealized physics - units = flag - dimensions = () - type = logical - intent = in -[cplflx] - standard_name = flag_for_surface_flux_coupling - long_name = flag controlling cplflx collection (default off) - units = flag - dimensions = () - type = logical - intent = in -[delt] - standard_name = timestep_for_physics - long_name = time step for physics - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[dtf] - standard_name = timestep_for_dynamics - long_name = dynamics timestep - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[dx] - standard_name = characteristic_grid_lengthscale - long_name = size of the grid cell - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length in cm - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[phii] - standard_name = geopotential_at_interface - long_name = geopotential at model layer interfaces - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[U] - standard_name = x_wind - long_name = x component of layer wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[V] - standard_name = y_wind - long_name = y component of layer wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[omega] - standard_name = lagrangian_tendency_of_air_pressure - long_name = layer mean vertical velocity - units = Pa s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[T3D] - standard_name = air_temperature - long_name = layer mean air temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgrs_water_vapor] - standard_name = specific_humidity - long_name = water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgrs_liquid_cloud] - standard_name = cloud_liquid_water_mixing_ratio - long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgrs_ice_cloud] - standard_name = cloud_ice_mixing_ratio - long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qgrs_cloud_droplet_num_conc] - standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air - long_name = number concentration of cloud droplets (liquid) - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs_cloud_ice_num_conc] - standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air - long_name = number concentration of ice - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs_ozone] - standard_name = ozone_mixing_ratio - long_name = ozone mixing ratio - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs_water_aer_num_conc] - standard_name = mass_number_concentration_of_hygroscopic_aerosols - long_name = number concentration of water-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[qgrs_ice_aer_num_conc] - standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols - long_name = number concentration of ice-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[prsl] - standard_name = air_pressure - long_name = mean layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[exner] - standard_name = dimensionless_exner_function - long_name = Exner function at layers - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[slmsk] - standard_name = area_type - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[tsurf] - standard_name = surface_skin_temperature - long_name = surface temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[qsfc] - standard_name = surface_specific_humidity - long_name = surface air saturation specific humidity - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[ps] - standard_name = surface_air_pressure - long_name = surface pressure - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[ust] - standard_name = surface_friction_velocity - long_name = boundary layer parameter - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[ch] - standard_name = surface_drag_wind_speed_for_momentum_in_air - long_name = momentum exchange coefficient - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness_and_vegetation - long_name = kinematic surface upward sensible heat flux reduced by surface roughness and vegetation - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[qflx] - standard_name = surface_upward_specific_humidity_flux - long_name = kinematic surface upward latent heat flux - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[wspd] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[rb] - standard_name = bulk_richardson_number_at_lowest_model_level - long_name = bulk Richardson number at the surface - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dtsfc1] - standard_name = instantaneous_surface_upward_sensible_heat_flux - long_name = surface upward sensible heat flux valid for current call - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dqsfc1] - standard_name = instantaneous_surface_upward_latent_heat_flux - long_name = surface upward latent heat flux valid for current call - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dusfc1] - standard_name = instantaneous_surface_x_momentum_flux - long_name = surface momentum flux in the x-direction valid for current call - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dvsfc1] - standard_name = instantaneous_surface_y_momentum_flux - long_name = surface momentum flux in the y-direction valid for current call - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dusfci_diag] - standard_name = instantaneous_surface_x_momentum_flux_for_diag - long_name = instantaneous sfc x momentum flux multiplied by timestep - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dvsfci_diag] - standard_name = instantaneous_surface_y_momentum_flux_for_diag - long_name = instantaneous sfc y momentum flux multiplied by timestep - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dtsfci_diag] - standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag - long_name = instantaneous sfc sensible heat flux multiplied by timestep - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dqsfci_diag] - standard_name = instantaneous_surface_upward_latent_heat_flux_for_diag - long_name = instantaneous sfc latent heat flux multiplied by timestep - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dusfc_diag] - standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc x momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dvsfc_diag] - standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc y momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dtsfc_diag] - standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc sensible heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dqsfc_diag] - standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep - long_name = cumulative sfc latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dusfc_cice] - standard_name = surface_x_momentum_flux_from_coupled_process - long_name = sfc x momentum flux for coupling - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dvsfc_cice] - standard_name = surface_y_momentum_flux_from_coupled_process - long_name = sfc y momentum flux for coupling - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dtsfc_cice] - standard_name = surface_upward_sensible_heat_flux_from_coupled_process - long_name = sfc sensible heat flux for coupling - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[dqsfc_cice] - standard_name = surface_upward_latent_heat_flux_from_coupled_process - long_name = sfc latent heat flux for coupling - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[hflx_wat] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_water - long_name = kinematic surface upward sensible heat flux over water - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[qflx_wat] - standard_name = kinematic_surface_upward_latent_heat_flux_over_water - long_name = kinematic surface upward latent heat flux over water - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[stress_wat] - standard_name = surface_wind_stress_over_water - long_name = surface wind stress over water - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[oceanfrac] - standard_name = sea_area_fraction - long_name = fraction of horizontal grid area occupied by ocean - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[fice] - standard_name = sea_ice_area_fraction_of_sea_area_fraction - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[wet] - standard_name = flag_nonzero_wet_surface_fraction - long_name = flag indicating presence of some ocean or lake surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = in -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_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 -[dusfci_cpl] - standard_name = surface_x_momentum_flux_for_coupling - long_name = instantaneous sfc u momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dvsfci_cpl] - standard_name = surface_y_momentum_flux_for_coupling - long_name = instantaneous sfc v momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dtsfci_cpl] - standard_name = surface_upward_sensible_heat_flux_for_coupling - long_name = instantaneous sfc sensible heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dqsfci_cpl] - standard_name = surface_upward_latent_heat_flux_for_coupling - long_name = instantaneous sfc latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dusfc_cpl] - standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc u momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dvsfc_cpl] - standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc v momentum flux multiplied by timestep - units = Pa s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dtsfc_cpl] - standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc sensible heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[dqsfc_cpl] - standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep - long_name = cumulative sfc latent heat flux multiplied by timestep - units = W m-2 s - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[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 -[qke] - standard_name = nonadvected_turbulent_kinetic_energy_multiplied_by_2 - long_name = 2 x tke at mass points - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[qke_adv] - standard_name = turbulent_kinetic_energy - long_name = turbulent kinetic energy - units = J - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[tsq] - standard_name = variance_of_air_temperature - long_name = temperature fluctuation squared - units = K2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[qsq] - standard_name = variance_of_specific_humidity - long_name = water vapor fluctuation squared - units = kg2 kg-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[cov] - standard_name = covariance_of_air_temperature_and_specific_humidity - long_name = covariance of temperature and moisture - units = K kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[el_pbl] - standard_name = turbulent_mixing_length - long_name = mixing length in meters - units = m - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[Sh3D] - standard_name = stability_function_for_heat - long_name = stability function for heat - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[exch_h] - standard_name = atmosphere_heat_diffusivity_for_mynnpbl - long_name = diffusivity for heat for MYNN PBL (defined for all mass levels) - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[exch_m] - standard_name = atmosphere_momentum_diffusivity_for_mynnpbl - long_name = diffusivity for momentum for MYNN PBL (defined for all mass levels) - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = out -[PBLH] - standard_name = atmosphere_boundary_layer_thickness - long_name = PBL thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[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 = inout -[QC_BL] - standard_name = subgrid_scale_cloud_liquid_water_mixing_ratio - long_name = subgrid cloud water mixing ratio from PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[QI_BL] - standard_name = subgrid_scale_cloud_ice_mixing_ratio - long_name = subgrid cloud ice mixing ratio from PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[CLDFRA_BL] - standard_name = subgrid_scale_cloud_area_fraction_in_atmosphere_layer - long_name = subgrid cloud fraction from PBL scheme - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_a] - standard_name = emdf_updraft_area - long_name = updraft area from mass flux scheme - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_w] - standard_name = emdf_updraft_vertical_velocity - long_name = updraft vertical velocity from mass flux scheme - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_qt] - standard_name = emdf_updraft_total_water - long_name = updraft total water from mass flux scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_thl] - standard_name = emdf_updraft_theta_l - long_name = updraft theta-l from mass flux scheme - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_ent] - standard_name = emdf_updraft_entrainment_rate - long_name = updraft entrainment rate from mass flux scheme - units = s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[edmf_qc] - standard_name = emdf_updraft_cloud_water - long_name = updraft cloud water from mass flux scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[sub_thl] - standard_name = theta_subsidence_tendency - long_name = updraft theta subsidence tendency - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[sub_sqv] - standard_name = water_vapor_subsidence_tendency - long_name = updraft water vapor subsidence tendency - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[det_thl] - standard_name = theta_detrainment_tendency - long_name = updraft theta detrainment tendency - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[det_sqv] - standard_name = water_vapor_detrainment_tendency - long_name = updraft water vapor detrainment tendency - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[nupdraft] - standard_name = number_of_plumes - long_name = number of plumes per grid column - units = count - dimensions = (horizontal_loop_extent) - type = integer - intent = inout -[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 = out -[ktop_plume] - standard_name = k_level_of_highest_plume - long_name = k-level of highest plume - units = count - dimensions = (horizontal_loop_extent) - type = integer - intent = inout -[dudt] - standard_name = process_split_cumulative_tendency_of_x_wind - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dvdt] - standard_name = process_split_cumulative_tendency_of_y_wind - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dtdt] - standard_name = process_split_cumulative_tendency_of_air_temperature - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_water_vapor] - standard_name = process_split_cumulative_tendency_of_specific_humidity - long_name = water vapor specific humidity tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_liquid_cloud] - standard_name = process_split_cumulative_tendency_of_cloud_liquid_water_mixing_ratio - long_name = cloud condensed water mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_ice_cloud] - standard_name = process_split_cumulative_tendency_of_cloud_ice_mixing_ratio - long_name = cloud condensed water mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_ozone] - standard_name = process_split_cumulative_tendency_of_ozone_mixing_ratio - long_name = ozone mixing ratio tendency due to model physics - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_cloud_droplet_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_liquid_water_particles_in_air - long_name = number conc. of cloud droplets (liquid) tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_ice_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air - long_name = number conc. of ice tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_water_aer_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_hygroscopic_aerosols - long_name = number conc. of water-friendly aerosols tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[dqdt_ice_aer_num_conc] - standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols - long_name = number conc. of ice-friendly aerosols tendency due to model physics - units = kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[flag_for_pbl_generic_tend] - standard_name = flag_for_generic_tendency_due_to_planetary_boundary_layer - long_name = true if GFS_PBL_generic should calculate tendencies - units = flag - dimensions = () - type = logical - intent = in -[dtend] - standard_name = cumulative_change_of_state_variables - long_name = diagnostic tendencies for state variables - units = various - 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 -[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 -[ntke] - standard_name = index_of_turbulent_kinetic_energy_in_tracer_concentration_array - long_name = tracer index for turbulent kinetic energy - units = index - 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 -[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 -[ntcw] - standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for cloud condensate (or liquid water) - units = index - dimensions = () - type = integer - intent = in -[ntiw] - standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array - long_name = tracer index for ice water - units = index - dimensions = () - type = integer - intent = in -[ntlnc] - standard_name = index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array - long_name = tracer index for liquid number concentration - units = index - dimensions = () - type = integer - intent = in -[ntinc] - standard_name = index_of_mass_number_concentration_of_cloud_ice_in_tracer_concentration_array - long_name = tracer index for ice number concentration - units = index - dimensions = () - type = integer - intent = in -[ntwa] - standard_name = index_of_mass_number_concentration_of_hygroscopic_aerosols_in_tracer_concentration_array - long_name = tracer index for water friendly aerosol - units = index - dimensions = () - type = integer - intent = in -[ntia] - standard_name = index_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_in_tracer_concentration_array - long_name = tracer index for ice friendly aerosol - 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 -[htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep - long_name = total sky sw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep - long_name = total sky lw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[xmu] - standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes - long_name = zenith angle temporal adjustment factor for shortwave - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[bl_mynn_tkebudget] - standard_name = control_for_tke_budget_output - long_name = flag for activating TKE budget - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_tkeadvect] - standard_name = flag_for_tke_advection - long_name = flag for activating TKE advect - units = flag - dimensions = () - type = logical - intent = in -[bl_mynn_cloudpdf] - standard_name = control_for_cloud_pdf_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to determine which cloud PDF to use - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_mixlength] - standard_name = control_for_mixing_length_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to determine which mixing length form to use - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_edmf] - standard_name = control_for_edmf_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate the mass-flux scheme - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_edmf_mom] - standard_name = control_for_edmf_momentum_transport_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate the transport of momentum - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_edmf_tke] - standard_name = control_for_edmf_tke_transport_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate the transport of TKE - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_cloudmix] - standard_name = control_for_cloud_species_mixing_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to activate mixing of cloud species - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_mixqt] - standard_name = control_for_total_water_mixing_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag to mix total water or individual species - units = flag - dimensions = () - type = integer - intent = in -[bl_mynn_output] - standard_name = control_for_additional_diagnostics_in_mellor_yamada_nakanishi_niino_pbl_scheme - long_name = flag initialize and output extra 3D variables - units = flag - dimensions = () - type = integer - intent = in -[icloud_bl] - standard_name = control_for_sgs_cloud_radiation_coupling_in_mellor_yamamda_nakanishi_niino_pbl_scheme - long_name = flag for coupling sgs clouds to radiation - units = flag - dimensions = () - type = integer - intent = in -[do_mynnsfclay] - standard_name = flag_for_mellor_yamada_nakanishi_niino_surface_layer_scheme - long_name = flag to activate MYNN surface layer - units = flag - dimensions = () - type = logical - intent = in -[imp_physics] - standard_name = control_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[imp_physics_gfdl] - standard_name = identifier_for_gfdl_microphysics_scheme - long_name = choice of GFDL microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[imp_physics_thompson] - standard_name = identifier_for_thompson_microphysics_scheme - long_name = choice of Thompson microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[imp_physics_wsm6] - standard_name = identifier_for_wsm6_microphysics_scheme - long_name = choice of WSM6 microphysics scheme - units = flag - dimensions = () - type = integer - intent = in -[ltaerosol] - standard_name = flag_for_aerosol_physics - long_name = flag for aerosol physics - units = flag - dimensions = () - type = logical - intent = in -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in -[huge] - standard_name = netcdf_float_fillvalue - long_name = definition of NetCDF float FillValue - 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 - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out diff --git a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_bl_mynn.F90 b/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_bl_mynn.F90 deleted file mode 100644 index e386ac8bb4..0000000000 --- a/sorc/fv3gfs.fd_gsl/FV3/ccpp/physics/physics/module_bl_mynn.F90 +++ /dev/null @@ -1,7934 +0,0 @@ -!>\file module_bl_mynn.F90 -!! This file contains the entity of MYNN-EDMF PBL scheme. -! ********************************************************************** -! * An improved Mellor-Yamada turbulence closure model * -! * * -! * Original author: M. Nakanishi (N.D.A), naka@nda.ac.jp * -! * Translated into F90 and implemented in WRF-ARW by: * -! * Mariusz Pagowski (NOAA-GSL) * -! * Subsequently developed by: * -! * Joseph Olson, Jaymes Kenyon (NOAA/GSL), * -! * Wayne Angevine (NOAA/CSL), Kay Suselj (NASA/JPL), * -! * Franciano Puhales (UFSM), Laura Fowler (NCAR), * -! * Elynn Wu (UCSD), and Jordan Schnell (NOAA/GSL) * -! * * -! * Contents: * -! * * -! * mynn_bl_driver - main subroutine which calls all other routines * -! * -------------- * -! * 1. mym_initialize (to be called once initially) * -! * gives the closure constants and initializes the turbulent * -! * quantities. * -! * 2. get_pblh * -! * Calculates the boundary layer height * -! * 3. scale_aware * -! * Calculates scale-adaptive tapering functions * -! * 4. mym_condensation * -! * determines the liquid water content and the cloud fraction * -! * diagnostically. * -! * 5. dmp_mf * -! * Calls the (nonlocal) mass-flux component * -! * 6. ddmf_jpl * -! * Calls the downdraft mass-flux component * -! * (-) mym_level2 (called in the other subroutines) * -! * calculates the stability functions at Level 2. * -! * (-) mym_length (called in the other subroutines) * -! * calculates the master length scale. * -! * 7. mym_turbulence * -! * calculates the vertical diffusivity coefficients and the * -! * production terms for the turbulent quantities. * -! * 8. mym_predict * -! * predicts the turbulent quantities at the next step. * -! * * -! * call mym_initialize * -! * | * -! * |<----------------+ * -! * | | * -! * call get_pblh | * -! * call scale_aware | * -! * call mym_condensation | * -! * call dmp_mf | * -! * call ddmf_jpl | * -! * call mym_turbulence | * -! * call mym_predict | * -! * | | * -! * |-----------------+ * -! * | * -! * end * -! * * -! * Variables worthy of special mention: * -! * tref : Reference temperature * -! * thl : Liquid water potential temperature * -! * qw : Total water (water vapor+liquid water) content * -! * ql : Liquid water content * -! * vt, vq : Functions for computing the buoyancy flux * -! * qke : 2 * TKE * -! * el : mixing length * -! * * -! * If the water contents are unnecessary, e.g., in the case of * -! * ocean models, thl is the potential temperature and qw, ql, vt * -! * and vq are all zero. * -! * * -! * Grid arrangement: * -! * k+1 +---------+ * -! * | | i = 1 - nx * -! * (k) | * | k = 1 - nz * -! * | | * -! * k +---------+ * -! * i (i) i+1 * -! * * -! * All the predicted variables are defined at the center (*) of * -! * the grid boxes. The diffusivity coefficients and two of their * -! * components (el and stability functions sh & sm) are, however, * -! * defined on the walls of the grid boxes. * -! * # Upper boundary values are given at k=nz. * -! * * -! * References: * -! * 1. Nakanishi, M., 2001: * -! * Boundary-Layer Meteor., 99, 349-378. * -! * 2. Nakanishi, M. and H. Niino, 2004: * -! * Boundary-Layer Meteor., 112, 1-31. * -! * 3. Nakanishi, M. and H. Niino, 2006: * -! * Boundary-Layer Meteor., 119, 397-407. * -! * 4. Nakanishi, M. and H. Niino, 2009: * -! * Jour. Meteor. Soc. Japan, 87, 895-912. * -! * 5. Olson J. and coauthors, 2019: A description of the * -! * MYNN-EDMF scheme and coupling to other components in * -! * WRF-ARW. NOAA Tech. Memo. OAR GSD, 61, 37 pp., * -! * https://doi.org/10.25923/n9wm-be49. * -! * 6. Puhales, Franciano S. and coauthors, 2020: Turbulent * -! * Kinetic Energy Budget for MYNN-EDMF PBL Scheme in WRF model.* -! * Universidade Federal de Santa Maria Technical Note. 9 pp. * -! ********************************************************************** -! ================================================================== -! Notes on original implementation into WRF-ARW -! changes to original code: -! 1. code is 1D (in z) -! 2. option to advect TKE, but not the covariances and variances -! 3. Cranck-Nicholson replaced with the implicit scheme -! 4. removed terrain-dependent grid since input in WRF in actual -! distances in z[m] -! 5. cosmetic changes to adhere to WRF standard (remove common blocks, -! intent etc) -!------------------------------------------------------------------- -! Further modifications post-implementation -! -! 1. Addition of BouLac mixing length in the free atmosphere. -! 2. Changed the turbulent mixing length to be integrated from the -! surface to the top of the BL + a transition layer depth. -! v3.4.1: Option to use Kitamura/Canuto modification which removes -! the critical Richardson number and negative TKE (default). -! Hybrid PBL height diagnostic, which blends a theta-v-based -! definition in neutral/convective BL and a TKE-based definition -! in stable conditions. -! TKE budget output option (bl_mynn_tkebudget) -! v3.5.0: TKE advection option (bl_mynn_tkeadvect) -! v3.5.1: Fog deposition related changes. -! v3.6.0: Removed fog deposition from the calculation of tendencies -! Added mixing of qc, qi, qni -! Added output for wstar, delta, TKE_PBL, & KPBL for correct -! coupling to shcu schemes -! v3.8.0: Added subgrid scale cloud output for coupling to radiation -! schemes (activated by setting icloud_bl =1 in phys namelist). -! Added WRF_DEBUG prints (at level 3000) -! Added Tripoli and Cotton (1981) correction. -! Added namelist option bl_mynn_cloudmix to test effect of mixing -! cloud species (default = 1: on). -! Added mass-flux option (bl_mynn_edmf, = 1 for DMP mass-flux, 0: off). -! Related options: -! bl_mynn_edmf_mom = 1 : activate momentum transport in MF scheme -! bl_mynn_edmf_tke = 1 : activate TKE transport in MF scheme -! Added mixing length option (bl_mynn_mixlength, see notes below) -! Added more sophisticated saturation checks, following Thompson scheme -! Added new cloud PDF option (bl_mynn_cloudpdf = 2) from Chaboureau -! and Bechtold (2002, JAS, with mods) -! Added capability to mix chemical species when env variable -! WRF_CHEM = 1, thanks to Wayne Angevine. -! Added scale-aware mixing length, following Junshi Ito's work -! Ito et al. (2015, BLM). -! v3.9.0 Improvement to the mass-flux scheme (dynamic number of plumes, -! better plume/cloud depth, significant speed up, better cloud -! fraction). -! Added Stochastic Parameter Perturbation (SPP) implementation. -! Many miscellaneous tweaks to the mixing lengths and stratus -! component of the subgrid clouds. -! v.4.0 Removed or added alternatives to WRF-specific functions/modules -! for the sake of portability to other models. -! the sake of portability to other models. -! Further refinement of mass-flux scheme from SCM experiments with -! Wayne Angevine: switch to linear entrainment and back to -! Simpson and Wiggert-type w-equation. -! Addition of TKE production due to radiation cooling at top of -! clouds (proto-version); not activated by default. -! Some code rewrites to move if-thens out of loops in an attempt to -! improve computational efficiency. -! New tridiagonal solver, which is supposedly 14% faster and more -! conservative. Impact seems very small. -! Many miscellaneous tweaks to the mixing lengths and stratus -! component of the subgrid-scale (SGS) clouds. -! v4.1 Big improvements in downward SW radiation due to revision of subgrid clouds -! - better cloud fraction and subgrid scale mixing ratios. -! - may experience a small cool bias during the daytime now that high -! SW-down bias is greatly reduced... -! Some tweaks to increase the turbulent mixing during the daytime for -! bl_mynn_mixlength option 2 to alleviate cool bias (very small impact). -! Improved ensemble spread from changes to SPP in MYNN -! - now perturbing eddy diffusivity and eddy viscosity directly -! - now perturbing background rh (in SGS cloud calc only) -! - now perturbing entrainment rates in mass-flux scheme -! Added IF checks (within IFDEFS) to protect mixchem code from being used -! when HRRR smoke is used (no impact on regular non-wrf chem use) -! Important bug fix for wrf chem when transporting chemical species in MF scheme -! Removed 2nd mass-flux scheme (no only bl_mynn_edmf = 1, no option 2) -! Removed unused stochastic code for mass-flux scheme -! Changed mass-flux scheme to be integrated on interface levels instead of -! mass levels - impact is small -! Added option to mix 2nd moments in MYNN as opposed to the scalar_pblmix option. -! - activated with bl_mynn_mixscalars = 1; this sets scalar_pblmix = 0 -! - added tridagonal solver used in scalar_pblmix option to duplicate tendencies -! - this alone changes the interface call considerably from v4.0. -! Slight revision to TKE production due to radiation cooling at top of clouds -! Added the non-Guassian buoyancy flux function of Bechtold and Siebesma (1998, JAS). -! - improves TKE in SGS clouds -! Added heating due to dissipation of TKE (small impact, maybe + 0.1 C daytime PBL temp) -! Misc changes made for FV3/MPAS compatibility -! v4.2 A series of small tweaks to help reduce a cold bias in the PBL: -! - slight increase in diffusion in convective conditions -! - relaxed criteria for mass-flux activation/strength -! - added capability to cycle TKE for continuity in hourly updating HRRR -! - added effects of compensational environmental subsidence in mass-flux scheme, -! which resulted in tweaks to detrainment rates. -! Bug fix for diagnostic-decay of SGS clouds - noticed by Greg Thompson. This has -! a very small, but primarily positive, impact on SW-down biases. -! Tweak to calculation of KPBL - urged by Laura Fowler - to make more intuitive. -! Tweak to temperature range of blending for saturation check (water to ice). This -! slightly reduces excessive SGS clouds in polar region. No impact warm clouds. -! Added namelist option bl_mynn_output (0 or 1) to suppress or activate the -! allocation and output of 10 3D variables. Most people will want this -! set to 0 (default) to save memory and disk space. -! Added new array qi_bl as opposed to using qc_bl for both SGS qc and qi. This -! gives us more control of the magnitudes which can be confounded by using -! a single array. As a results, many subroutines needed to be modified, -! especially mym_condensation. -! Added the blending of the stratus component of the SGS clouds to the mass-flux -! clouds to account for situations where stratus and cumulus may exist in the -! grid cell. -! Misc small-impact bugfixes: -! 1) dz was incorrectly indexed in mym_condensation -! 2) configurations with icloud_bl = 0 were using uninitialized arrays -! v4.3.2 / CCPP -! This version includes many modifications that proved valuable in the global -! framework and removes some key lingering bugs in the mixing of chemical species. -! TKE Budget output fixed (Puhales, 2020-12) -! New option for stability function: (Puhales, 2020-12) -! bl_mynn_stfunc = 0 (original, Kansas-type function, Paulson, 1970 ) -! bl_mynn_stfunc = 1 (expanded range, same as used for Jimenez et al (MWR) -! see the Technical Note for this implementation. -! Improved conservation of momentum and higher-order moments. -! Important bug fixes for mixing of chemical species. -! Addition of pressure-gradient effects on updraft momentum transport. -! Addition of bl_mynn_closure option = 2.5, 2.6, or 3.0 -! Addition of sig_order to regulate the use of higher-order moments -! for sigma when using bl_mynn_cloudpdf = 2 (Chab-Becht). This -! new option is set in the subroutine mym_condensation. -! Removed WRF_CHEM dependencies. -! Many miscellaneous tweaks. -! -! Many of these changes are now documented in references listed above. -!==================================================================== - - module bl_mynn_common - -!------------------------------------------ -!Define Model-specific constants/parameters. -!This module will be used at the initialization stage -!where all model-specific constants are read and saved into -!memory. This module is then used again in the MYNN-EDMF. All -!MYNN-specific constants are declared globally in the main -!module (module_bl_mynn) further below: -!------------------------------------------ - -! For MPAS: -! use mpas_kind_types,only: kind_phys => RKIND -! For CCPP: - use machine, only : kind_phys - - implicit none - save - -! To be specified from dycore - real(kind=kind_phys):: cp != 7.*r_d/2. (J/kg/K) - real(kind=kind_phys):: cpv != 4.*r_v (J/kg/K) Spec heat H2O gas - real(kind=kind_phys):: cice != 2106. (J/kg/K) Spec heat H2O ice - real(kind=kind_phys):: cliq != 4190. (J/kg/K) Spec heat H2O liq - real(kind=kind_phys):: p608 != R_v/R_d-1. - real(kind=kind_phys):: ep_2 != R_d/R_v - real(kind=kind_phys):: grav != accel due to gravity - real(kind=kind_phys):: karman != von Karman constant - real(kind=kind_phys):: rcp != r_d/cp - real(kind=kind_phys):: r_d != 287. (J/kg/K) gas const dry air - real(kind=kind_phys):: r_v != 461.6 (J/kg/K) gas const water - real(kind=kind_phys):: xlf != 0.35E6 (J/kg) fusion at 0 C - real(kind=kind_phys):: xlv != 2.50E6 (J/kg) vaporization at 0 C - real(kind=kind_phys):: xls != 2.85E6 (J/kg) sublimation - real(kind=kind_phys):: rvovrd != r_v/r_d != 1.608 - -! Specified locally - real(kind=kind_phys),parameter:: zero = 0.0 - real(kind=kind_phys),parameter:: half = 0.5 - real(kind=kind_phys),parameter:: one = 1.0 - real(kind=kind_phys),parameter:: two = 2.0 - real(kind=kind_phys),parameter:: onethird = 1./3. - real(kind=kind_phys),parameter:: twothirds = 2./3. - real(kind=kind_phys),parameter:: tref = 300.0 ! reference temperature (K) - real(kind=kind_phys),parameter:: TKmin = 253.0 ! for total water conversion, Tripoli and Cotton (1981) - real(kind=kind_phys),parameter:: p1000mb=100000.0 - real(kind=kind_phys),parameter:: svp1 = 0.6112 !(kPa) - real(kind=kind_phys),parameter:: svp2 = 17.67 !(dimensionless) - real(kind=kind_phys),parameter:: svp3 = 29.65 !(K) - -! To be derived in the init routine - real(kind=kind_phys):: ep_3 != 1.-ep_2 != 0.378 - real(kind=kind_phys):: gtr != grav/tref - real(kind=kind_phys):: rk != cp/r_d - real(kind=kind_phys):: tv0 != p608*tref - real(kind=kind_phys):: tv1 != (1.+p608)*tref - real(kind=kind_phys):: xlscp != (xlv+xlf)/cp - real(kind=kind_phys):: xlvcp != xlv/cp - real(kind=kind_phys):: g_inv != 1./grav - - end module bl_mynn_common - -!================================================================== - -MODULE module_bl_mynn - - use bl_mynn_common,only: & - cp , cpv , cliq , cice , & - p608 , ep_2 , ep_3 , gtr , & - grav , g_inv , karman , p1000mb , & - rcp , r_d , r_v , rk , & - rvovrd , svp1 , svp2 , svp3 , & - xlf , xlv , xls , xlscp , & - xlvcp , tv0 , tv1 , tref , & - zero , half , one , two , & - onethird , twothirds , tkmin - - - IMPLICIT NONE - - - INTEGER , PARAMETER :: param_first_scalar = 1, & - & p_qc = 2, & - & p_qr = 0, & - & p_qi = 2, & - & p_qs = 0, & - & p_qg = 0, & - & p_qnc= 0, & - & p_qni= 0 - -!END FV3 CONSTANTS -!==================================================================== -!WRF CONSTANTS -! USE module_model_constants, only: & -! &karman, grav, p1000mb, & -! &cp, r_d, r_v, rcp, xlv, xlf, xls, & -! &svp1, svp2, svp3, p608, ep_2, rvovrd, & -! &cpv, cliq, cice -! -! USE module_state_description, only: param_first_scalar, & -! &p_qc, p_qr, p_qi, p_qs, p_qg, p_qnc, p_qni -! -! IMPLICIT NONE -! -!END WRF CONSTANTS -!=================================================================== -! From here on, these are used for any model -! The parameters below depend on stability functions of module_sf_mynn. - REAL, PARAMETER :: cphm_st=5.0, cphm_unst=16.0, & - cphh_st=5.0, cphh_unst=16.0 - -! Closure constants - REAL, PARAMETER :: & - &pr = 0.74, & - &g1 = 0.235, & ! NN2009 = 0.235 - &b1 = 24.0, & - &b2 = 15.0, & ! CKmod NN2009 - &c2 = 0.729, & ! 0.729, & !0.75, & - &c3 = 0.340, & ! 0.340, & !0.352, & - &c4 = 0.0, & - &c5 = 0.2, & - &a1 = b1*( 1.0-3.0*g1 )/6.0, & -! &c1 = g1 -1.0/( 3.0*a1*b1**(1.0/3.0) ), & - &c1 = g1 -1.0/( 3.0*a1*2.88449914061481660), & - &a2 = a1*( g1-c1 )/( g1*pr ), & - &g2 = b2/b1*( 1.0-c3 ) +2.0*a1/b1*( 3.0-2.0*c2 ) - - REAL, PARAMETER :: & - &cc2 = 1.0-c2, & - &cc3 = 1.0-c3, & - &e1c = 3.0*a2*b2*cc3, & - &e2c = 9.0*a1*a2*cc2, & - &e3c = 9.0*a2*a2*cc2*( 1.0-c5 ), & - &e4c = 12.0*a1*a2*cc2, & - &e5c = 6.0*a1*a1 - -! 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, 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, PARAMETER :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 - -! Constants for cloud PDF (mym_condensation) - REAL, 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 - !!Meteorological Society of Japan, Vol. 88, No. 5, pp. 857-864, 2010). - !!Note that this change required further modification of other parameters - !!above (c2, c3). If you want to remove this option, set c2 and c3 constants - !!(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, 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, 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 - !>Option to activate downdrafts, from Elynn Wu (0: deactive, 1: active) - 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 - - !Option to activate environmental subsidence in mass-flux scheme - 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 - - !option to print out more stuff for debugging purposes - LOGICAL, PARAMETER :: debug_code = .false. - INTEGER, PARAMETER :: idbg = 23 !specific i-point to write out - -! JAYMES- -!> Constants used for empirical calculations of saturation -!! vapor pressures (in function "esat") and saturation mixing ratios -!! (in function "qsat"), reproduced from module_mp_thompson.F, -!! v3.6 - REAL, PARAMETER:: J0= .611583699E03 - REAL, PARAMETER:: J1= .444606896E02 - REAL, PARAMETER:: J2= .143177157E01 - REAL, PARAMETER:: J3= .264224321E-1 - REAL, PARAMETER:: J4= .299291081E-3 - REAL, PARAMETER:: J5= .203154182E-5 - REAL, PARAMETER:: J6= .702620698E-8 - REAL, PARAMETER:: J7= .379534310E-11 - REAL, PARAMETER:: J8=-.321582393E-13 - - REAL, PARAMETER:: K0= .609868993E03 - REAL, PARAMETER:: K1= .499320233E02 - REAL, PARAMETER:: K2= .184672631E01 - REAL, PARAMETER:: K3= .402737184E-1 - REAL, PARAMETER:: K4= .565392987E-3 - REAL, PARAMETER:: K5= .521693933E-5 - REAL, PARAMETER:: K6= .307839583E-7 - REAL, PARAMETER:: K7= .105785160E-9 - REAL, PARAMETER:: K8= .161444444E-12 -! end- - - ! Used in WRF-ARW module_physics_init.F - INTEGER :: mynn_level - - -CONTAINS - -! ================================================================== -!>\ingroup gsd_mynn_edmf -!! This subroutine is the GSD MYNN-EDNF PBL driver routine,which -!! encompassed the majority of the subroutines that comprise the -!! procedures that ultimately solve for tendencies of -!! \f$U, V, \theta, q_v, q_c, and q_i\f$. -!!\section gen_mynn_bl_driver GSD mynn_bl_driver General Algorithm -!> @{ - SUBROUTINE mynn_bl_driver( & - &initflag,restart,cycling, & - &delt,dz,dx,znt, & - &u,v,w,th,sqv3D,sqc3D,sqi3D, & - &qnc,qni, & - &qnwfa,qnifa,ozone, & - &p,exner,rho,T3D, & - &xland,ts,qsfc,ps, & - &ust,ch,hfx,qfx,rmol,wspd, & - &uoce,voce, & !ocean current - &vdfg, & !Katata-added for fog dep - &Qke,qke_adv, & - &bl_mynn_tkeadvect,sh3d, & - - &nchem,kdvel,ndvel, & !Smoke/Chem variables - &chem3d, vdep, & - &rrfs_smoke, & ! flag for Smoke - &frp,EMIS_ANT_NO, & ! JLS/RAR to adjust exchange coeffs - &mix_chem,fire_turb, & ! end smoke/chem variables - - &Tsq,Qsq,Cov, & - &RUBLTEN,RVBLTEN,RTHBLTEN, & - &RQVBLTEN,RQCBLTEN,RQIBLTEN, & - &RQNCBLTEN,RQNIBLTEN, & - &RQNWFABLTEN,RQNIFABLTEN,DOZONE, & - &exch_h,exch_m, & - &Pblh,kpbl, & - &el_pbl, & - &dqke,qWT,qSHEAR,qBUOY,qDISS, & !TKE BUDGET - &bl_mynn_tkebudget, & - &bl_mynn_cloudpdf, & - &bl_mynn_mixlength, & - &icloud_bl,qc_bl,qi_bl,cldfra_bl,& - &closure, & - &bl_mynn_edmf, & - &bl_mynn_edmf_mom, & - &bl_mynn_edmf_tke, & - &bl_mynn_mixscalars, & - &bl_mynn_output, & - &bl_mynn_cloudmix,bl_mynn_mixqt, & - &edmf_a,edmf_w,edmf_qt, & - &edmf_thl,edmf_ent,edmf_qc, & - &sub_thl3D,sub_sqv3D, & - &det_thl3D,det_sqv3D, & - &nupdraft,maxMF,ktop_plume, & - &spp_pbl,pattern_spp_pbl, & - &RTHRATEN, & - &FLAG_QC,FLAG_QI,FLAG_QNC, & - &FLAG_QNI,FLAG_QNWFA,FLAG_QNIFA & - &,IDS,IDE,JDS,JDE,KDS,KDE & - &,IMS,IME,JMS,JME,KMS,KME & - &,ITS,ITE,JTS,JTE,KTS,KTE) - -!------------------------------------------------------------------- - - INTEGER, INTENT(in) :: initflag - !INPUT NAMELIST OPTIONS: - LOGICAL, INTENT(IN) :: restart,cycling - INTEGER, INTENT(in) :: bl_mynn_tkebudget - INTEGER, INTENT(in) :: bl_mynn_cloudpdf - INTEGER, INTENT(in) :: bl_mynn_mixlength - INTEGER, INTENT(in) :: bl_mynn_edmf - LOGICAL, INTENT(in) :: bl_mynn_tkeadvect - 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, INTENT(in) :: closure - - LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& - FLAG_QNWFA,FLAG_QNIFA - - LOGICAL, INTENT(IN) :: mix_chem,fire_turb - - INTEGER,INTENT(in) :: & - & IDS,IDE,JDS,JDE,KDS,KDE & - &,IMS,IME,JMS,JME,KMS,KME & - &,ITS,ITE,JTS,JTE,KTS,KTE - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - -! initflag > 0 for TRUE -! else for FALSE -! closure : <= 2.5; Level 2.5 -! 2.5< and <3; Level 2.6 -! = 3; Level 3 - - REAL, INTENT(in) :: delt -!WRF -! REAL, INTENT(in) :: dx -!END WRF -!FV3 - REAL, DIMENSION(IMS:IME), INTENT(in) :: dx -!END FV3 - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(in) :: dz,& - &u,v,w,th,sqv3D,p,exner,rho,T3D - REAL, DIMENSION(IMS:IME,KMS:KME), OPTIONAL, INTENT(in)::& - &sqc3D,sqi3D,qni,qnc,qnwfa,qnifa - REAL, DIMENSION(IMS:IME,KMS:KME), OPTIONAL, INTENT(in):: ozone - REAL, DIMENSION(IMS:IME), INTENT(in) :: xland,ust,& - &ch,ts,qsfc,ps,hfx,qfx,wspd,uoce,voce,vdfg,znt - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & - &Qke,Tsq,Qsq,Cov,qke_adv !ACF for QKE advection - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & - &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,& - &RQIBLTEN,RQNIBLTEN,RQNCBLTEN, & - &RQNWFABLTEN,RQNIFABLTEN - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: DOZONE - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(in) :: RTHRATEN - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(out) :: & - &exch_h,exch_m - - !These 10 arrays are only allocated when bl_mynn_output > 0 - REAL, DIMENSION(:,:), OPTIONAL, INTENT(inout) :: & - & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & - & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D - -! REAL, DIMENSION(IMS:IME,KMS:KME) :: & -! & edmf_a_dd,edmf_w_dd,edmf_qt_dd,edmf_thl_dd,edmf_ent_dd,edmf_qc_dd - - REAL, DIMENSION(IMS:IME), INTENT(inout) :: Pblh,rmol - - REAL, DIMENSION(IMS:IME) :: Psig_bl,Psig_shcu - - INTEGER,DIMENSION(IMS:IME),INTENT(INOUT) :: & - &KPBL,nupdraft,ktop_plume - - REAL, DIMENSION(IMS:IME), INTENT(OUT) :: & - &maxmf - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & - &el_pbl - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(out) :: & - &qWT,qSHEAR,qBUOY,qDISS,dqke - ! 3D budget arrays are not allocated when bl_mynn_tkebudget == 0. - ! 1D (local) budget arrays are used for passing between subroutines. - REAL, DIMENSION(KTS:KTE) :: qWT1,qSHEAR1,qBUOY1,qDISS1,dqke1,diss_heat - - REAL, DIMENSION(IMS:IME,KMS:KME) :: Sh3D - - REAL, DIMENSION(IMS:IME,KMS:KME), INTENT(inout) :: & - &qc_bl,qi_bl,cldfra_bl - REAL, DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D,cldfra_bl1D,& - qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old - -! smoke/chemical arrays - INTEGER, INTENT(IN ) :: nchem, kdvel, ndvel - LOGICAL, OPTIONAL, INTENT(IN ) :: rrfs_smoke -! REAL, DIMENSION( ims:ime, kms:kme, nchem ), INTENT(INOUT), optional :: chem3d -! REAL, DIMENSION( ims:ime, kdvel, ndvel ), INTENT(IN), optional :: vdep - REAL, DIMENSION( :,:,: ), INTENT(INOUT), optional :: chem3d - REAL, DIMENSION( :,: ), INTENT(IN), optional :: vdep - REAL, DIMENSION( : ), INTENT(IN), optional :: frp,EMIS_ANT_NO - - REAL, DIMENSION(KTS:KTE ,nchem) :: chem1 - REAL, DIMENSION(KTS:KTE+1,nchem) :: s_awchem1 - REAL, DIMENSION(its:ite) :: vd1 - INTEGER :: ic - -!local vars - INTEGER :: ITF,JTF,KTF, IMD,JMD - INTEGER :: i,j,k - REAL, DIMENSION(KTS:KTE) :: thl,thvl,tl,qv1,qc1,qi1,sqw,& - &El, Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & - &Vt, Vq, sgm, thlsg, sqwsg - REAL, DIMENSION(KTS:KTE) :: thetav,sh,sm,u1,v1,w1,p1,ex1,dz1,th1,tk1,rho1,& - &qke1,tsq1,qsq1,cov1,sqv,sqi,sqc,du1,dv1,dth1,dqv1,dqc1,dqi1,ozone1, & - &k_m1,k_h1,qni1,dqni1,qnc1,dqnc1,qnwfa1,qnifa1,dqnwfa1,dqnifa1,dozone1 - - !mass-flux variables - REAL, DIMENSION(KTS:KTE) :: dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf - REAL, DIMENSION(KTS:KTE) :: edmf_a1,edmf_w1,edmf_qt1,edmf_thl1,& - edmf_ent1,edmf_qc1 - REAL, DIMENSION(KTS:KTE) :: edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1,edmf_thl_dd1,& - edmf_ent_dd1,edmf_qc_dd1 - REAL, DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & - det_thl,det_sqv,det_sqc,det_u,det_v - REAL,DIMENSION(KTS:KTE+1) :: s_aw1,s_awthl1,s_awqt1,& - s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1,& - s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1 - REAL,DIMENSION(KTS:KTE+1) :: sd_aw1,sd_awthl1,sd_awqt1,& - sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 - - REAL, DIMENSION(KTS:KTE+1) :: zw - REAL :: 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,sqc9,sqi9 - - !top-down diffusion - REAL, DIMENSION(ITS:ITE) :: maxKHtopdown - REAL,DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD - - LOGICAL :: INITIALIZE_QKE - - ! Stochastic fields - INTEGER, INTENT(IN) ::spp_pbl - REAL, DIMENSION( ims:ime, kms:kme), INTENT(IN),OPTIONAL ::pattern_spp_pbl - REAL, DIMENSION(KTS:KTE) ::rstoch_col - - ! Substepping TKE - INTEGER :: nsub - real :: delt2 - - IF ( debug_code ) THEN - if (idbg .lt. ime) then - print*,'in MYNN driver; at beginning' - print*," th(1:5)=",th(idbg,1:5) - print*," u(1:5)=",u(idbg,1:5) - print*," v(1:5)=",v(idbg,1:5) - print*," w(1:5)=",w(idbg,1:5) - print*," sqv(1:5)=",sqv3D(idbg,1:5) - print*," p(1:5)=",p(idbg,1:5) - print*," rho(1:5)=",rho(idbg,1:5) - print*," xland=",xland(idbg)," u*=",ust(idbg), & - &" ts=",ts(idbg)," qsfc=",qsfc(idbg), & - &" z/L=",0.5*dz(idbg,1)*rmol(idbg)," ps=",ps(idbg),& - &" hfx=",hfx(idbg)," qfx=",qfx(idbg), & - &" wspd=",wspd(idbg)," znt=",znt(idbg) - endif - ENDIF - -!*** Begin debugging - IMD=(IMS+IME)/2 - JMD=(JMS+JME)/2 -!*** End debugging - -!WRF -! JTF=MIN0(JTE,JDE-1) -! ITF=MIN0(ITE,IDE-1) -! KTF=MIN0(KTE,KDE-1) -!FV3 - JTF=JTE - ITF=ITE - KTF=KTE - - IF (bl_mynn_output > 0) THEN !research mode - edmf_a(its:ite,kts:kte)=0. - edmf_w(its:ite,kts:kte)=0. - edmf_qt(its:ite,kts:kte)=0. - edmf_thl(its:ite,kts:kte)=0. - edmf_ent(its:ite,kts:kte)=0. - edmf_qc(its:ite,kts:kte)=0. - sub_thl3D(its:ite,kts:kte)=0. - sub_sqv3D(its:ite,kts:kte)=0. - det_thl3D(its:ite,kts:kte)=0. - det_sqv3D(its:ite,kts:kte)=0. - - !edmf_a_dd(its:ite,kts:kte)=0. - !edmf_w_dd(its:ite,kts:kte)=0. - !edmf_qt_dd(its:ite,kts:kte)=0. - !edmf_thl_dd(its:ite,kts:kte)=0. - !edmf_ent_dd(its:ite,kts:kte)=0. - !edmf_qc_dd(its:ite,kts:kte)=0. - ENDIF - ktop_plume(its:ite)=0 !int - nupdraft(its:ite)=0 !int - maxmf(its:ite)=0. - maxKHtopdown(its:ite)=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, -!! If true, a three-dimensional initialization loop is entered. Within this loop, -!! several arrays are initialized and k-oriented (vertical) subroutines are called -!! at every i and j point, corresponding to the x- and y- directions, respectively. - IF (initflag > 0 .and. .not.restart) THEN - - !Test to see if we want to initialize qke - IF ( (restart .or. cycling)) THEN - IF (MAXVAL(QKE(its:ite,kts)) < 0.0002) THEN - INITIALIZE_QKE = .TRUE. - !print*,"QKE is too small, must initialize" - ELSE - INITIALIZE_QKE = .FALSE. - !print*,"Using background QKE, will not initialize" - ENDIF - ELSE ! not cycling or restarting: - INITIALIZE_QKE = .TRUE. - !print*,"not restart nor cycling, must initialize QKE" - ENDIF - - if (.not.restart .or. .not.cycling) THEN - Sh3D(its:ite,kts:kte)=0. - el_pbl(its:ite,kts:kte)=0. - tsq(its:ite,kts:kte)=0. - qsq(its:ite,kts:kte)=0. - cov(its:ite,kts:kte)=0. - cldfra_bl(its:ite,kts:kte)=0. - qc_bl(its:ite,kts:kte)=0. - qke(its:ite,kts:kte)=0. - else - qc_bl1D(kts:kte)=0.0 - qi_bl1D(kts:kte)=0.0 - cldfra_bl1D(kts:kte)=0.0 - end if - dqc1(kts:kte)=0.0 - dqi1(kts:kte)=0.0 - dqni1(kts:kte)=0.0 - dqnc1(kts:kte)=0.0 - dqnwfa1(kts:kte)=0.0 - dqnifa1(kts:kte)=0.0 - dozone1(kts:kte)=0.0 - qc_bl1D_old(kts:kte)=0.0 - cldfra_bl1D_old(kts:kte)=0.0 - edmf_a1(kts:kte)=0.0 - edmf_w1(kts:kte)=0.0 - edmf_qc1(kts:kte)=0.0 - edmf_a_dd1(kts:kte)=0.0 - edmf_w_dd1(kts:kte)=0.0 - edmf_qc_dd1(kts:kte)=0.0 - sgm(kts:kte)=0.0 - vt(kts:kte)=0.0 - vq(kts:kte)=0.0 - - DO k=KTS,KTE - DO i=ITS,ITF - exch_m(i,k)=0. - exch_h(i,k)=0. - ENDDO - ENDDO - - IF ( bl_mynn_tkebudget == 1) THEN - DO k=KTS,KTE - DO i=ITS,ITF - qWT(i,k)=0. - qSHEAR(i,k)=0. - qBUOY(i,k)=0. - qDISS(i,k)=0. - dqke(i,k)=0. - ENDDO - ENDDO - ENDIF - - DO i=ITS,ITF - DO k=KTS,KTE !KTF - dz1(k)=dz(i,k) - u1(k) = u(i,k) - v1(k) = v(i,k) - w1(k) = w(i,k) - th1(k)=th(i,k) - tk1(k)=T3D(i,k) - ex1(k)=exner(i,k) - rho1(k)=rho(i,k) - sqc(k)=sqc3D(i,k) !/(1.+qv(i,k)) - sqv(k)=sqv3D(i,k) !/(1.+qv(i,k)) - thetav(k)=th(i,k)*(1.+0.608*sqv(k)) - IF (icloud_bl > 0) THEN - CLDFRA_BL1D(k)=CLDFRA_BL(i,k) - QC_BL1D(k)=QC_BL(i,k) - QI_BL1D(k)=QI_BL(i,k) - ENDIF - IF (PRESENT(sqi3D) .AND. FLAG_QI ) THEN - sqi(k)=sqi3D(i,k) !/(1.+qv(i,k)) - sqw(k)=sqv(k)+sqc(k)+sqi(k) - thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*sqi(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) & - ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=sqi(k) - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ELSE - sqi(k)=0.0 - sqw(k)=sqv(k)+sqc(k) - thl(k)=th1(k)-xlvcp/ex1(k)*sqc(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)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=0.0 - ELSE - sqc9=sqc(k) - sqi9=0.0 - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ENDIF - thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) - - IF (k==kts) THEN - zw(k)=0. - ELSE - zw(k)=zw(k-1)+dz(i,k-1) - ENDIF - IF (INITIALIZE_QKE) THEN - !Initialize tke for initial PBLH calc only - using - !simple PBLH form of Koracin and Berkowicz (1988, BLM) - !to linearly taper off tke towards top of PBL. - qke1(k)=5.*ust(i) * MAX((ust(i)*700. - zw(k))/(MAX(ust(i),0.01)*700.), 0.01) - ELSE - qke1(k)=qke(i,k) - ENDIF - el(k)=el_pbl(i,k) - sh(k)=Sh3D(i,k) - tsq1(k)=tsq(i,k) - qsq1(k)=qsq(i,k) - cov1(k)=cov(i,k) - if (spp_pbl==1) then - rstoch_col(k)=pattern_spp_pbl(i,k) - else - rstoch_col(k)=0.0 - endif - - ENDDO - - zw(kte+1)=zw(kte)+dz(i,kte) - -!> - Call get_pblh() to calculate hybrid (\f$\theta_{vli}-TKE\f$) PBL height. -! CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& - CALL GET_PBLH(KTS,KTE,PBLH(i),thvl, & - & Qke1,zw,dz1,xland(i),KPBL(i)) - -!> - Call scale_aware() to calculate similarity functions for scale-adaptive control -!! (\f$P_{\sigma-PBL}\f$ and \f$P_{\sigma-shcu}\f$). - IF (scaleaware > 0.) THEN - CALL SCALE_AWARE(dx(i),PBLH(i),Psig_bl(i),Psig_shcu(i)) - ELSE - Psig_bl(i)=1.0 - Psig_shcu(i)=1.0 - ENDIF - - ! DH* CHECK IF WE CAN DO WITHOUT CALLING THIS ROUTINE FOR RESTARTS -!> - Call mym_initialize() to initializes the mixing length, TKE, \f$\theta^{'2}\f$, -!! \f$q^{'2}\f$, and \f$\theta^{'}q^{'}\f$. These variables are calculated after -!! obtaining prerequisite variables by calling the following subroutines from -!! within mym_initialize(): mym_level2() and mym_length(). - CALL mym_initialize ( & - &kts,kte, & - &dz1, dx(i), zw, & - &u1, v1, thl, sqv, & - &thlsg, sqwsg, & - &PBLH(i), th1, thetav, sh, sm, & - &ust(i), rmol(i), & - &el, Qke1, Tsq1, Qsq1, Cov1, & - &Psig_bl(i), cldfra_bl1D, & - &bl_mynn_mixlength, & - &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf,& - &INITIALIZE_QKE, & - &spp_pbl,rstoch_col ) - - IF (.not.restart) THEN - !UPDATE 3D VARIABLES - DO k=KTS,KTE !KTF - el_pbl(i,k)=el(k) - sh3d(i,k)=sh(k) - qke(i,k)=qke1(k) - tsq(i,k)=tsq1(k) - qsq(i,k)=qsq1(k) - cov(i,k)=cov1(k) - ENDDO - !initialize qke_adv array if using advection - IF (bl_mynn_tkeadvect) THEN - DO k=KTS,KTE - qke_adv(i,k)=qke1(k) - ENDDO - ENDIF - ENDIF - -!*** Begin debugging -! IF(I==IMD .AND. J==JMD)THEN -! PRINT*,"MYNN DRIVER INIT: k=",1," sh=",sh(k) -! PRINT*," sqw=",sqw(k)," thl=",thl(k)," k_m=",exch_m(i,k) -! PRINT*," xland=",xland(i)," rmol=",rmol(i)," ust=",ust(i) -! PRINT*," qke=",qke(i,k)," el=",el_pbl(i,k)," tsq=",Tsq(i,k) -! PRINT*," PBLH=",PBLH(i)," u=",u(i,k)," v=",v(i,k) -! ENDIF -!*** End debugging - - ENDDO !end i-loop - - ENDIF ! end initflag - -!> - After initializing all required variables, the regular procedures -!! performed at every time step are ready for execution. - !ACF- copy qke_adv array into qke if using advection - IF (bl_mynn_tkeadvect) THEN - qke=qke_adv - ENDIF - - DO i=ITS,ITF - DO k=KTS,KTE !KTF - !JOE-TKE BUDGET - IF ( bl_mynn_tkebudget == 1) THEN - dqke(i,k)=qke(i,k) - END IF - IF (icloud_bl > 0) THEN - CLDFRA_BL1D(k)=CLDFRA_BL(i,k) - QC_BL1D(k)=QC_BL(i,k) - QI_BL1D(k)=QI_BL(i,k) - cldfra_bl1D_old(k)=cldfra_bl(i,k) - qc_bl1D_old(k)=qc_bl(i,k) - qi_bl1D_old(k)=qi_bl(i,k) - else - CLDFRA_BL1D(k)=0.0 - QC_BL1D(k)=0.0 - QI_BL1D(k)=0.0 - cldfra_bl1D_old(k)=0.0 - qc_bl1D_old(k)=0.0 - qi_bl1D_old(k)=0.0 - ENDIF - dz1(k)= dz(i,k) - u1(k) = u(i,k) - v1(k) = v(i,k) - w1(k) = w(i,k) - th1(k)= th(i,k) - tk1(k)=T3D(i,k) - p1(k) = p(i,k) - ex1(k)= exner(i,k) - rho1(k)=rho(i,k) - sqv(k)= sqv3D(i,k) !/(1.+qv(i,k)) - sqc(k)= sqc3D(i,k) !/(1.+qv(i,k)) -!joe-test -! sqc(k)=MAX(sqc(k),0.0) -! sqv(k)=MAX(sqv(k),1e-15) - qv1(k)= sqv(k)/(1.-sqv(k)) - qc1(k)= sqc(k)/(1.-sqv(k)) - dqc1(k)=0.0 - dqi1(k)=0.0 - dqni1(k)=0.0 - dqnc1(k)=0.0 - dqnwfa1(k)=0.0 - dqnifa1(k)=0.0 - dozone1(k)=0.0 - IF(PRESENT(sqi3D) .AND. FLAG_QI)THEN - sqi(k)= sqi3D(i,k) !/(1.+qv(i,k)) - qi1(k)= sqi(k)/(1.-sqv(k)) - sqw(k)= sqv(k)+sqc(k)+sqi(k) - thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*sqi(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) & - ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=sqi(k) - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ELSE - qi1(k)=0.0 - sqi(k)=0.0 - sqw(k)= sqv(k)+sqc(k) - thl(k)= th1(k)-xlvcp/ex1(k)*sqc(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)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=0.0 - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - ENDIF - thetav(k)=th1(k)*(1.+0.608*sqv(k)) - thvl(k) =thlsg(k) *(1.+0.608*sqv(k)) - - IF (PRESENT(qni) .AND. FLAG_QNI ) THEN - qni1(k)=qni(i,k) - ELSE - qni1(k)=0.0 - ENDIF - IF (PRESENT(qnc) .AND. FLAG_QNC ) THEN - qnc1(k)=qnc(i,k) - ELSE - qnc1(k)=0.0 - ENDIF - IF (PRESENT(qnwfa) .AND. FLAG_QNWFA ) THEN - qnwfa1(k)=qnwfa(i,k) - ELSE - qnwfa1(k)=0.0 - ENDIF - IF (PRESENT(qnifa) .AND. FLAG_QNIFA ) THEN - qnifa1(k)=qnifa(i,k) - ELSE - qnifa1(k)=0.0 - ENDIF - IF (PRESENT(ozone)) THEN - ozone1(k)=ozone(i,k) - ELSE - ozone1(k)=0.0 - ENDIF - el(k) = el_pbl(i,k) - qke1(k)=qke(i,k) - sh(k) = sh3d(i,k) - tsq1(k)=tsq(i,k) - qsq1(k)=qsq(i,k) - cov1(k)=cov(i,k) - if (spp_pbl==1) then - rstoch_col(k)=pattern_spp_pbl(i,k) - else - rstoch_col(k)=0.0 - endif - - !edmf - edmf_a1(k)=0.0 - edmf_w1(k)=0.0 - edmf_qc1(k)=0.0 - s_aw1(k)=0. - s_awthl1(k)=0. - s_awqt1(k)=0. - s_awqv1(k)=0. - s_awqc1(k)=0. - s_awu1(k)=0. - s_awv1(k)=0. - s_awqke1(k)=0. - s_awqnc1(k)=0. - s_awqni1(k)=0. - s_awqnwfa1(k)=0. - s_awqnifa1(k)=0. - ![EWDD] - edmf_a_dd1(k)=0.0 - edmf_w_dd1(k)=0.0 - edmf_qc_dd1(k)=0.0 - sd_aw1(k)=0. - sd_awthl1(k)=0. - sd_awqt1(k)=0. - sd_awqv1(k)=0. - sd_awqc1(k)=0. - sd_awu1(k)=0. - sd_awv1(k)=0. - sd_awqke1(k)=0. - sub_thl(k)=0. - sub_sqv(k)=0. - sub_u(k)=0. - sub_v(k)=0. - det_thl(k)=0. - det_sqv(k)=0. - det_sqc(k)=0. - det_u(k)=0. - det_v(k)=0. - - IF (k==kts) THEN - zw(k)=0. - ELSE - zw(k)=zw(k-1)+dz(i,k-1) - ENDIF - ENDDO ! end k - - !initialize smoke/chem arrays (if used): - IF (rrfs_smoke .or. mix_chem) then - IF (mix_chem ) then - do ic = 1,ndvel - vd1(ic) = vdep(i,ic) !is this correct???? - chem1(kts,ic) = chem3d(i,kts,ic) - s_awchem1(kts,ic)=0. - enddo - do k = kts+1,kte - DO ic = 1,nchem - chem1(k,ic) = chem3d(i,k,ic) - s_awchem1(k,ic)=0. - ENDDO - enddo - ELSE - do ic = 1,ndvel - vd1(ic) = 0. !is this correct??? (ite) or (ndvel) - chem1(kts,ic) = 0. - s_awchem1(kts,ic)=0. - enddo - do k = kts+1,kte - do ic = 1,nchem - chem1(k,ic) = 0. - s_awchem1(k,ic)=0. - enddo - enddo - ENDIF - ENDIF - - zw(kte+1)=zw(kte)+dz(i,kte) - !EDMF - s_aw1(kte+1)=0. - s_awthl1(kte+1)=0. - s_awqt1(kte+1)=0. - s_awqv1(kte+1)=0. - s_awqc1(kte+1)=0. - s_awu1(kte+1)=0. - s_awv1(kte+1)=0. - s_awqke1(kte+1)=0. - s_awqnc1(kte+1)=0. - s_awqni1(kte+1)=0. - s_awqnwfa1(kte+1)=0. - s_awqnifa1(kte+1)=0. - sd_aw1(kte+1)=0. - sd_awthl1(kte+1)=0. - sd_awqt1(kte+1)=0. - sd_awqv1(kte+1)=0. - sd_awqc1(kte+1)=0. - sd_awu1(kte+1)=0. - sd_awv1(kte+1)=0. - sd_awqke1(kte+1)=0. - IF ( mix_chem ) THEN - DO ic = 1,nchem - s_awchem1(kte+1,ic)=0. - ENDDO - ENDIF - -!> - Call get_pblh() to calculate the hybrid \f$\theta_{vli}-TKE\f$ -!! PBL height diagnostic. -! CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& - CALL GET_PBLH(KTS,KTE,PBLH(i),thvl,& - & Qke1,zw,dz1,xland(i),KPBL(i)) - -!> - Call scale_aware() to calculate the similarity functions, -!! \f$P_{\sigma-PBL}\f$ and \f$P_{\sigma-shcu}\f$, to control -!! the scale-adaptive behaviour for the local and nonlocal -!! components, respectively. - IF (scaleaware > 0.) THEN - CALL SCALE_AWARE(dx(i),PBLH(i),Psig_bl(i),Psig_shcu(i)) - ELSE - Psig_bl(i)=1.0 - Psig_shcu(i)=1.0 - ENDIF - - sqcg= 0.0 !ill-defined variable; qcg has been removed - cpm=cp*(1.+0.84*qv1(kts)) - exnerg=(ps(i)/p1000mb)**rcp - - !----------------------------------------------------- - !ORIGINAL CODE - !flt = hfx(i)/( rho(i,kts)*cpm ) & - ! +xlvcp*ch(i)*(sqc(kts)/exner(i,kts) -sqcg/exnerg) - !flq = qfx(i)/ rho(i,kts) & - ! -ch(i)*(sqc(kts) -sqcg ) - !----------------------------------------------------- - ! Katata-added - The deposition velocity of cloud (fog) - ! water is used instead of CH. - !flt = hfx(i)/( rho(i,kts)*cpm ) & - ! & +xlvcp*vdfg(i)*(sqc(kts)/exner(i,kts)- sqcg/exnerg) - !flq = qfx(i)/ rho(i,kts) & - ! & -vdfg(i)*(sqc(kts) - sqcg ) - !----------------------------------------------------- - flqv = qfx(i)/rho1(kts) - flqc = -vdfg(i)*(sqc(kts) - sqcg ) - th_sfc = ts(i)/ex1(kts) - - ! TURBULENT FLUX FOR TKE BOUNDARY CONDITIONS - flq =flqv+flqc !! LATENT - flt =hfx(i)/(rho1(kts)*cpm )-xlvcp*flqc/ex1(kts) !! Temperature flux - fltv=flt + flqv*p608*th_sfc !! Virtual temperature flux - - ! Update 1/L using updated sfc heat flux and friction velocity - rmol(i) = -karman*gtr*fltv/max(ust(i)**3,1.0e-6) - zet = 0.5*dz(i,kts)*rmol(i) - zet = MAX(zet, -20.) - zet = MIN(zet, 20.) - !if(i.eq.idbg)print*,"updated z/L=",zet - if (bl_mynn_stfunc == 0) then - !Original Kansas-type stability functions - if ( zet >= 0.0 ) then - pmz = 1.0 + (cphm_st-1.0) * zet - phh = 1.0 + cphh_st * zet - else - pmz = 1.0/ (1.0-cphm_unst*zet)**0.25 - zet - phh = 1.0/SQRT(1.0-cphh_unst*zet) - end if - else - !Updated stability functions (Puhales, 2020) - phi_m = phim(zet) - pmz = phi_m - zet - phh = phih(zet) - end if - -!> - Call mym_condensation() to calculate the nonconvective component -!! of the subgrid cloud fraction and mixing ratio as well as the functions -!! used to calculate the buoyancy flux. Different cloud PDFs can be -!! selected by use of the namelist parameter \p bl_mynn_cloudpdf. - - CALL mym_condensation ( kts,kte, & - &dx(i),dz1,zw,thl,sqw,sqv,sqc,sqi,& - &p1,ex1,tsq1,qsq1,cov1, & - &Sh,el,bl_mynn_cloudpdf, & - &qc_bl1D,qi_bl1D,cldfra_bl1D, & - &PBLH(i),HFX(i), & - &Vt, Vq, th1, sgm, rmol(i), & - &spp_pbl, rstoch_col ) - -!> - Add TKE source driven by cloud top cooling -!! Calculate the buoyancy production of TKE from cloud-top cooling when -!! \p bl_mynn_topdown =1. - IF (bl_mynn_topdown.eq.1)then - CALL topdown_cloudrad(kts,kte,dz1,zw, & - &xland(i),kpbl(i),PBLH(i), & - &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & - &cldfra_bl1D,rthraten, & - &maxKHtopdown(i),KHtopdown,TKEprodTD ) - ELSE - maxKHtopdown(i) = 0.0 - KHtopdown(kts:kte) = 0.0 - TKEprodTD(kts:kte) = 0.0 - ENDIF - - IF (bl_mynn_edmf > 0) THEN - !PRINT*,"Calling DMP Mass-Flux: i= ",i - CALL DMP_mf( & - &kts,kte,delt,zw,dz1,p1,rho1, & - &bl_mynn_edmf_mom, & - &bl_mynn_edmf_tke, & - &bl_mynn_mixscalars, & - &u1,v1,w1,th1,thl,thetav,tk1, & - &sqw,sqv,sqc,qke1, & - &qnc1,qni1,qnwfa1,qnifa1, & - &ex1,Vt,Vq,sgm, & - &ust(i),flt,flq,flqv,flqc, & - &PBLH(i),KPBL(i),DX(i), & - &xland(i),th_sfc, & - ! now outputs - tendencies - ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & - ! outputs - updraft properties - & edmf_a1,edmf_w1,edmf_qt1, & - & edmf_thl1,edmf_ent1,edmf_qc1, & - ! for the solver - & s_aw1,s_awthl1,s_awqt1, & - & s_awqv1,s_awqc1, & - & s_awu1,s_awv1,s_awqke1, & - & s_awqnc1,s_awqni1, & - & s_awqnwfa1,s_awqnifa1, & - & sub_thl,sub_sqv, & - & sub_u,sub_v, & - & det_thl,det_sqv,det_sqc, & - & det_u,det_v, & - ! chem/smoke mixing - & nchem,chem1,s_awchem1, & - & mix_chem, & - & qc_bl1D,cldfra_bl1D, & - & qc_bl1D_old,cldfra_bl1D_old, & - & FLAG_QC,FLAG_QI, & - & FLAG_QNC,FLAG_QNI, & - & FLAG_QNWFA,FLAG_QNIFA, & - & Psig_shcu(i), & - & nupdraft(i),ktop_plume(i), & - & maxmf(i),ztop_plume, & - & spp_pbl,rstoch_col ) - ENDIF - - IF (bl_mynn_edmf_dd == 1) THEN - CALL DDMF_JPL(kts,kte,delt,zw,dz1,p1, & - &u1,v1,th1,thl,thetav,tk1, & - sqw,sqv,sqc,rho1,ex1, & - &ust(i),flt,flq, & - &PBLH(i),KPBL(i), & - &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1, & - &edmf_thl_dd1,edmf_ent_dd1, & - &edmf_qc_dd1, & - &sd_aw1,sd_awthl1,sd_awqt1, & - &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1, & - &sd_awqke1, & - &qc_bl1d,cldfra_bl1d, & - &rthraten(i,:) ) - ENDIF - - !Capability to substep the eddy-diffusivity portion - !do nsub = 1,2 - delt2 = delt !*0.5 !only works if topdown=0 - - CALL mym_turbulence ( & - &kts,kte,closure, & - &dz1, DX(i), zw, & - &u1, v1, thl, thetav, sqc, sqw, & - &thlsg, sqwsg, & - &qke1, tsq1, qsq1, cov1, & - &vt, vq, & - &rmol(i), flt, flq, & - &PBLH(i),th1, & - &Sh,Sm,el, & - &Dfm,Dfh,Dfq, & - &Tcd,Qcd,Pdk, & - &Pdt,Pdq,Pdc, & - &qWT1,qSHEAR1,qBUOY1,qDISS1, & - &bl_mynn_tkebudget, & - &Psig_bl(i),Psig_shcu(i), & - &cldfra_bl1D,bl_mynn_mixlength, & - &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & - &TKEprodTD, & - &spp_pbl,rstoch_col) - -!> - Call mym_predict() to solve TKE and -!! \f$\theta^{'2}, q^{'2}, and \theta^{'}q^{'}\f$ -!! for the following time step. - CALL mym_predict (kts,kte,closure, & - &delt2, dz1, & - &ust(i), flt, flq, pmz, phh, & - &el, dfq, rho1, pdk, pdt, pdq, pdc,& - &Qke1, Tsq1, Qsq1, Cov1, & - &s_aw1, s_awqke1, bl_mynn_edmf_tke,& - &qWT1, qDISS1,bl_mynn_tkebudget) !! TKE budget (Puhales, 2020) - - if (dheat_opt > 0) then - DO k=kts,kte-1 - ! Set max dissipative heating rate to 7.2 K per hour - diss_heat(k) = MIN(MAX(0.75*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.002) - diss_heat(k) = diss_heat(k) * exp(-10000./MAX(p1(k),1.)) - ENDDO - diss_heat(kte) = 0. - else - diss_heat(1:kte) = 0. - endif - -!> - Call mynn_tendencies() to solve for tendencies of -!! \f$U, V, \theta, q_{v}, q_{c}, and q_{i}\f$. - CALL mynn_tendencies(kts,kte,i, & - &closure, & - &delt, dz1, rho1, & - &u1, v1, th1, tk1, qv1, & - &qc1, qi1, qnc1, qni1, & - &ps(i), p1, ex1, thl, & - &sqv, sqc, sqi, sqw, & - &qnwfa1, qnifa1, ozone1, & - &ust(i),flt,flq,flqv,flqc, & - &wspd(i),uoce(i),voce(i), & - &tsq1, qsq1, cov1, & - &tcd, qcd, & - &dfm, dfh, dfq, & - &Du1, Dv1, Dth1, Dqv1, & - &Dqc1, Dqi1, Dqnc1, Dqni1, & - &Dqnwfa1, Dqnifa1, Dozone1, & - &vdfg(i), diss_heat, & - ! mass flux components - &s_aw1,s_awthl1,s_awqt1, & - &s_awqv1,s_awqc1,s_awu1,s_awv1, & - &s_awqnc1,s_awqni1, & - &s_awqnwfa1,s_awqnifa1, & - &sd_aw1,sd_awthl1,sd_awqt1, & - &sd_awqv1,sd_awqc1, & - sd_awu1,sd_awv1, & - &sub_thl,sub_sqv, & - &sub_u,sub_v, & - &det_thl,det_sqv,det_sqc, & - &det_u,det_v, & - &FLAG_QC,FLAG_QI,FLAG_QNC, & - &FLAG_QNI,FLAG_QNWFA,FLAG_QNIFA, & - &cldfra_bl1d, & - &bl_mynn_cloudmix, & - &bl_mynn_mixqt, & - &bl_mynn_edmf, & - &bl_mynn_edmf_mom, & - &bl_mynn_mixscalars ) - - - IF ( mix_chem ) THEN - CALL mynn_mix_chem(kts,kte,i, & - &delt, dz1, pblh(i), & - &nchem, kdvel, ndvel, & - &chem1, vd1, & - &rho1,flt, & - &tcd, qcd, & - &dfh, & - &s_aw1,s_awchem1, & - &emis_ant_no(i), & - &frp(i), & - &fire_turb ) - - IF ( PRESENT(chem3d) ) THEN - DO ic = 1,nchem - DO k = kts,kte - chem3d(i,k,ic) = chem1(k,ic) - ENDDO - ENDDO - ENDIF - ENDIF - - CALL retrieve_exchange_coeffs(kts,kte,& - &dfm, dfh, dz1, K_m1, K_h1) - - !UPDATE 3D ARRAYS - DO k=KTS,KTE !KTF - exch_m(i,k)=K_m1(k) - exch_h(i,k)=K_h1(k) - RUBLTEN(i,k)=du1(k) - RVBLTEN(i,k)=dv1(k) - RTHBLTEN(i,k)=dth1(k) - RQVBLTEN(i,k)=dqv1(k) - IF(bl_mynn_cloudmix > 0)THEN - IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k)=dqc1(k) - IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k)=dqi1(k) - ELSE - IF (PRESENT(sqc3D) .AND. FLAG_QC) RQCBLTEN(i,k)=0. - IF (PRESENT(sqi3D) .AND. FLAG_QI) RQIBLTEN(i,k)=0. - ENDIF - IF(bl_mynn_cloudmix > 0 .AND. bl_mynn_mixscalars > 0)THEN - IF (PRESENT(qnc) .AND. FLAG_QNC) RQNCBLTEN(i,k)=dqnc1(k) - IF (PRESENT(qni) .AND. FLAG_QNI) RQNIBLTEN(i,k)=dqni1(k) - IF (PRESENT(qnwfa) .AND. FLAG_QNWFA) RQNWFABLTEN(i,k)=dqnwfa1(k) - IF (PRESENT(qnifa) .AND. FLAG_QNIFA) RQNIFABLTEN(i,k)=dqnifa1(k) - ELSE - IF (PRESENT(qnc) .AND. FLAG_QNC) RQNCBLTEN(i,k)=0. - IF (PRESENT(qni) .AND. FLAG_QNI) RQNIBLTEN(i,k)=0. - IF (PRESENT(qnwfa) .AND. FLAG_QNWFA) RQNWFABLTEN(i,k)=0. - IF (PRESENT(qnifa) .AND. FLAG_QNIFA) RQNIFABLTEN(i,k)=0. - ENDIF - DOZONE(i,k)=DOZONE1(k) - - IF(icloud_bl > 0)THEN - !DIAGNOSTIC-DECAY FOR SUBGRID-SCALE CLOUDS - IF (CLDFRA_BL1D(k) < cldfra_bl1D_old(k)) THEN - !DECAY TIMESCALE FOR CALM CONDITION IS THE EDDY TURNOVER - !TIMESCALE, BUT FOR WINDY CONDITIONS, IT IS THE ADVECTIVE - !TIMESCALE. USE THE MINIMUM OF THE TWO. - ts_decay = MIN( 1800., 3.*dx(i)/MAX(SQRT(u1(k)**2 + v1(k)**2),1.0) ) - cldfra_bl(i,k)= MAX(cldfra_bl1D(k),cldfra_bl1D_old(k)-(0.20*delt/ts_decay)) - ! qc_bl2 and qi_bl2 are linked to decay rates - qc_bl2 = MAX(qc_bl1D(k),qc_bl1D_old(k)) - qi_bl2 = MAX(qi_bl1D(k),qi_bl1D_old(k)) - qc_bl(i,k) = MAX(qc_bl1D(k),qc_bl1D_old(k)-(MIN(qc_bl2,1.0E-5) * delt/ts_decay)) - qi_bl(i,k) = MAX(qi_bl1D(k),qi_bl1D_old(k)-(MIN(qi_bl2,1.0E-6) * delt/ts_decay)) - IF (cldfra_bl(i,k) < 0.005 .OR. & - (qc_bl(i,k) + qi_bl(i,k)) < 1E-9) THEN - CLDFRA_BL(i,k)= 0. - QC_BL(i,k) = 0. - QI_BL(i,k) = 0. - ENDIF - ELSE - qc_bl(i,k)=qc_bl1D(k) - qi_bl(i,k)=qi_bl1D(k) - cldfra_bl(i,k)=cldfra_bl1D(k) - ENDIF - ENDIF - - el_pbl(i,k)=el(k) - qke(i,k)=qke1(k) - tsq(i,k)=tsq1(k) - qsq(i,k)=qsq1(k) - cov(i,k)=cov1(k) - sh3d(i,k)=sh(k) - - ENDDO !end-k - - IF ( bl_mynn_tkebudget == 1) THEN - !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) - !! Lower boundary condtions (using similarity relationships such as the prognostic equation for Qke) - k=kts - qSHEAR1(k)=4.*(ust(i)**3*phi_m/(karman*dz(i,k)))-qSHEAR1(k+1) !! staggered - qBUOY1(k)=4.*(-ust(i)**3*zet/(karman*dz(i,k)))-qBUOY1(k+1) !! staggered - !! unstaggering SHEAR and BUOY and trasfering all TKE budget to 3D array - DO k = kts,kte-1 - qSHEAR(i,k)=0.5*(qSHEAR1(k)+qSHEAR1(k+1)) !!! unstaggering in z - qBUOY(i,k)=0.5*(qBUOY1(k)+qBUOY1(k+1)) !!! unstaggering in z - qWT(i,k)=qWT1(k) - qDISS(i,k)=qDISS1(k) - dqke(i,k)=(qke1(k)-dqke(i,k))*0.5/delt - ENDDO - !! Upper boundary conditions - k=kte - qSHEAR(i,k)=0. - qBUOY(i,k)=0. - qWT(i,k)=0. - qDISS(i,k)=0. - dqke(i,k)=0. - ENDIF - - !update updraft/downdraft properties - if (bl_mynn_output > 0) THEN !research mode == 1 - if (bl_mynn_edmf > 0) THEN - DO k = kts,kte - edmf_a(i,k)=edmf_a1(k) - edmf_w(i,k)=edmf_w1(k) - edmf_qt(i,k)=edmf_qt1(k) - edmf_thl(i,k)=edmf_thl1(k) - edmf_ent(i,k)=edmf_ent1(k) - edmf_qc(i,k)=edmf_qc1(k) - sub_thl3D(i,k)=sub_thl(k) - sub_sqv3D(i,k)=sub_sqv(k) - det_thl3D(i,k)=det_thl(k) - det_sqv3D(i,k)=det_sqv(k) - ENDDO - endif -! if (bl_mynn_edmf_dd > 0) THEN -! DO k = kts,kte -! edmf_a_dd(i,k)=edmf_a_dd1(k) -! edmf_w_dd(i,k)=edmf_w_dd1(k) -! edmf_qt_dd(i,k)=edmf_qt_dd1(k) -! edmf_thl_dd(i,k)=edmf_thl_dd1(k) -! edmf_ent_dd(i,k)=edmf_ent_dd1(k) -! edmf_qc_dd(i,k)=edmf_qc_dd1(k) -! ENDDO -! ENDIF - ENDIF - - !*** Begin debug prints - IF ( debug_code .and. (i .eq. idbg)) THEN - IF ( ABS(QFX(i))>.001)print*,& - "SUSPICIOUS VALUES AT: i=",i," QFX=",QFX(i) - IF ( ABS(HFX(i))>1100.)print*,& - "SUSPICIOUS VALUES AT: i=",i," HFX=",HFX(i) - DO k = kts,kte - IF ( sh(k) < 0. .OR. sh(k)> 200.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," sh=",sh(k) - IF ( ABS(vt(k)) > 0.9 )print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," vt=",vt(k) - IF ( ABS(vq(k)) > 6000.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," vq=",vq(k) - IF ( qke(i,k) < -1. .OR. qke(i,k)> 200.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," qke=",qke(i,k) - IF ( el_pbl(i,k) < 0. .OR. el_pbl(i,k)> 1500.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," el_pbl=",el_pbl(i,k) - IF ( exch_m(i,k) < 0. .OR. exch_m(i,k)> 2000.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," exxch_m=",exch_m(i,k) - IF (icloud_bl > 0) then - IF( cldfra_bl(i,k) < 0.0 .OR. cldfra_bl(i,k)> 1.)THEN - PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k)," qc_bl=",QC_BL(i,k) - ENDIF - ENDIF - - !IF (I==IMD .AND. J==JMD) THEN - ! PRINT*,"MYNN DRIVER END: k=",k," sh=",sh(k) - ! PRINT*," sqw=",sqw(k)," thl=",thl(k)," exch_m=",exch_m(i,k) - ! PRINT*," xland=",xland(i)," rmol=",rmol(i)," ust=",ust(i) - ! PRINT*," qke=",qke(i,k)," el=",el_pbl(i,k)," tsq=",tsq(i,k) - ! PRINT*," PBLH=",PBLH(i)," u=",u(i,k)," v=",v(i,k) - ! PRINT*," vq=",vq(k)," vt=",vt(k)," vdfg=",vdfg(i) - !ENDIF - ENDDO !end-k - ENDIF - !*** End debug prints - - !JOE-add tke_pbl for coupling w/shallow-cu schemes (TKE_PBL = QKE/2.) - ! TKE_PBL is defined on interfaces, while QKE is at middle of layer. - !tke_pbl(i,kts) = 0.5*MAX(qke(i,kts),1.0e-10) - !DO k = kts+1,kte - ! afk = dz1(k)/( dz1(k)+dz1(k-1) ) - ! abk = 1.0 -afk - ! tke_pbl(i,k) = 0.5*MAX(qke(i,k)*abk+qke(i,k-1)*afk,1.0e-3) - !ENDDO - - ENDDO !end i-loop - -!ACF copy qke into qke_adv if using advection - IF (bl_mynn_tkeadvect) THEN - qke_adv=qke - ENDIF -!ACF-end - -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - - END SUBROUTINE mynn_bl_driver -!> @} - -!======================================================================= -! SUBROUTINE mym_initialize: -! -! Input variables: -! iniflag : <>0; turbulent quantities will be initialized -! = 0; turbulent quantities have been already -! given, i.e., they will not be initialized -! nx, nz : Dimension sizes of the -! x and z directions, respectively -! tref : Reference temperature (K) -! dz(nz) : Vertical grid spacings (m) -! # dz(nz)=dz(nz-1) -! zw(nz+1) : Heights of the walls of the grid boxes (m) -! # zw(1)=0.0 and zw(k)=zw(k-1)+dz(k-1) -! exner(nx,nz) : Exner function at zw*h+zg (J/kg K) -! defined by c_p*( p_basic/1000hPa )^kappa -! This is usually computed by integrating -! d(pi0)/dz = -h*g/tref. -! rmo(nx) : Inverse of the Obukhov length (m^(-1)) -! flt, flq(nx) : Turbulent fluxes of potential temperature and -! total water, respectively: -! flt=-u_*Theta_* (K m/s) -! flq=-u_*qw_* (kg/kg m/s) -! ust(nx) : Friction velocity (m/s) -! pmz(nx) : phi_m-zeta at z1*h+z0, where z1 (=0.5*dz(1)) -! is the first grid point above the surafce, z0 -! the roughness length and zeta=(z1*h+z0)*rmo -! phh(nx) : phi_h at z1*h+z0 -! u, v(nx,nz) : Components of the horizontal wind (m/s) -! thl(nx,nz) : Liquid water potential temperature -! (K) -! qw(nx,nz) : Total water content Q_w (kg/kg) -! -! Output variables: -! ql(nx,nz) : Liquid water content (kg/kg) -! vt, vq(nx,nz) : Functions for computing the buoyancy flux -! qke(nx,nz) : Twice the turbulent kinetic energy q^2 -! (m^2/s^2) -! tsq(nx,nz) : Variance of Theta_l (K^2) -! qsq(nx,nz) : Variance of Q_w -! cov(nx,nz) : Covariance of Theta_l and Q_w (K) -! el(nx,nz) : Master length scale L (m) -! defined on the walls of the grid boxes -! -! Work arrays: see subroutine mym_level2 -! pd?(nx,nz,ny) : Half of the production terms at Level 2 -! defined on the walls of the grid boxes -! qkw(nx,nz,ny) : q on the walls of the grid boxes (m/s) -! -! # As to dtl, ...gh, see subroutine mym_turbulence. -! -!------------------------------------------------------------------- - -!>\ingroup gsd_mynn_edmf -!! This subroutine initializes the mixing length, TKE, \f$\theta^{'2}\f$, -!! \f$q^{'2}\f$, and \f$\theta^{'}q^{'}\f$. -!!\section gen_mym_ini GSD MYNN-EDMF mym_initialize General Algorithm -!> @{ - SUBROUTINE mym_initialize ( & - & kts,kte, & - & dz, dx, zw, & - & u, v, thl, qw, & - & thlsg, qwsg, & -! & ust, rmo, pmz, phh, flt, flq, & - & zi, theta, thetav, sh, sm, & - & ust, rmo, el, & - & Qke, Tsq, Qsq, Cov, Psig_bl, cldfra_bl1D, & - & bl_mynn_mixlength, & - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & - & INITIALIZE_QKE, & - & spp_pbl,rstoch_col) -! -!------------------------------------------------------------------- - - INTEGER, INTENT(IN) :: kts,kte - INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf - LOGICAL, INTENT(IN) :: INITIALIZE_QKE -! REAL, INTENT(IN) :: ust, rmo, pmz, phh, flt, flq - REAL, INTENT(IN) :: ust, rmo, Psig_bl, dx - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,cldfra_bl1D,& - edmf_w1,edmf_a1,edmf_qc1 - REAL, DIMENSION(kts:kte), INTENT(out) :: tsq,qsq,cov - REAL, DIMENSION(kts:kte), INTENT(inout) :: el,qke - - REAL, DIMENSION(kts:kte) :: & - &ql,pdk,pdt,pdq,pdc,dtl,dqw,dtv,& - &gm,gh,sm,sh,qkw,vt,vq - INTEGER :: k,l,lmax - REAL :: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1.,flt=0.,flq=0.,tmpq - REAL :: zi - REAL, DIMENSION(kts:kte) :: theta,thetav,thlsg,qwsg - - REAL, DIMENSION(kts:kte) :: rstoch_col - INTEGER ::spp_pbl - -!> - At first ql, vt and vq are set to zero. - DO k = kts,kte - ql(k) = 0.0 - vt(k) = 0.0 - vq(k) = 0.0 - END DO -! -!> - Call mym_level2() to calculate the stability functions at level 2. - CALL mym_level2 ( kts,kte, & - & dz, & - & u, v, thl, thetav, qw, & - & thlsg, qwsg, & - & ql, vt, vq, & - & dtl, dqw, dtv, gm, gh, sm, sh ) -! -! ** Preliminary setting ** - - el (kts) = 0.0 - IF (INITIALIZE_QKE) THEN - !qke(kts) = ust**2 * ( b1*pmz )**(2.0/3.0) - qke(kts) = 1.5 * ust**2 * ( b1*pmz )**(2.0/3.0) - DO k = kts+1,kte - !qke(k) = 0.0 - !linearly taper off towards top of pbl - qke(k)=qke(kts)*MAX((ust*700. - zw(k))/(MAX(ust,0.01)*700.), 0.01) - ENDDO - ENDIF -! - phm = phh*b2 / ( b1*pmz )**(1.0/3.0) - tsq(kts) = phm*( flt/ust )**2 - qsq(kts) = phm*( flq/ust )**2 - cov(kts) = phm*( flt/ust )*( flq/ust ) -! - DO k = kts+1,kte - vkz = karman*zw(k) - el (k) = vkz/( 1.0 + vkz/100.0 ) -! qke(k) = 0.0 -! - tsq(k) = 0.0 - qsq(k) = 0.0 - cov(k) = 0.0 - END DO -! -! ** Initialization with an iterative manner ** -! ** lmax is the iteration count. This is arbitrary. ** - lmax = 5 -! - DO l = 1,lmax -! -!> - call mym_length() to calculate the master length scale. - CALL mym_length ( & - & kts,kte, & - & dz, dx, zw, & - & rmo, flt, flq, & - & vt, vq, & - & u, v, qke, & - & dtv, & - & el, & - & zi,theta, & - & qkw,Psig_bl,cldfra_bl1D,bl_mynn_mixlength,& - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf) -! - DO k = kts+1,kte - elq = el(k)*qkw(k) - pdk(k) = elq*( sm(k)*gm(k) + & - & sh(k)*gh(k) ) - pdt(k) = elq* sh(k)*dtl(k)**2 - pdq(k) = elq* sh(k)*dqw(k)**2 - pdc(k) = elq* sh(k)*dtl(k)*dqw(k) - END DO -! -! ** Strictly, vkz*h(i,j) -> karman*( 0.5*dz(1)*h(i,j)+z0 ) ** - vkz = karman*0.5*dz(kts) - elv = 0.5*( el(kts+1)+el(kts) ) / vkz - IF (INITIALIZE_QKE)THEN - !qke(kts) = ust**2 * ( b1*pmz*elv )**(2.0/3.0) - qke(kts) = 1.0 * MAX(ust,0.02)**2 * ( b1*pmz*elv )**(2.0/3.0) - ENDIF - - phm = phh*b2 / ( b1*pmz/elv**2 )**(1.0/3.0) - tsq(kts) = phm*( flt/ust )**2 - qsq(kts) = phm*( flq/ust )**2 - cov(kts) = phm*( flt/ust )*( flq/ust ) - - DO k = kts+1,kte-1 - b1l = b1*0.25*( el(k+1)+el(k) ) - !tmpq=MAX(b1l*( pdk(k+1)+pdk(k) ),qkemin) - !add MIN to limit unreasonable QKE - tmpq=MIN(MAX(b1l*( pdk(k+1)+pdk(k) ),qkemin),125.) -! PRINT *,'tmpqqqqq',tmpq,pdk(k+1),pdk(k) - IF (INITIALIZE_QKE)THEN - qke(k) = tmpq**twothirds - ENDIF - - IF ( qke(k) .LE. 0.0 ) THEN - b2l = 0.0 - ELSE - b2l = b2*( b1l/b1 ) / SQRT( qke(k) ) - END IF - - tsq(k) = b2l*( pdt(k+1)+pdt(k) ) - qsq(k) = b2l*( pdq(k+1)+pdq(k) ) - cov(k) = b2l*( pdc(k+1)+pdc(k) ) - END DO - - END DO - -!! qke(kts)=qke(kts+1) -!! tsq(kts)=tsq(kts+1) -!! qsq(kts)=qsq(kts+1) -!! cov(kts)=cov(kts+1) - - IF (INITIALIZE_QKE)THEN - qke(kts)=0.5*(qke(kts)+qke(kts+1)) - qke(kte)=qke(kte-1) - ENDIF - tsq(kte)=tsq(kte-1) - qsq(kte)=qsq(kte-1) - cov(kte)=cov(kte-1) - -! -! RETURN - - END SUBROUTINE mym_initialize -!> @} - -! -! ================================================================== -! SUBROUTINE mym_level2: -! -! Input variables: see subroutine mym_initialize -! -! Output variables: -! dtl(nx,nz,ny) : Vertical gradient of Theta_l (K/m) -! dqw(nx,nz,ny) : Vertical gradient of Q_w -! dtv(nx,nz,ny) : Vertical gradient of Theta_V (K/m) -! gm (nx,nz,ny) : G_M divided by L^2/q^2 (s^(-2)) -! gh (nx,nz,ny) : G_H divided by L^2/q^2 (s^(-2)) -! sm (nx,nz,ny) : Stability function for momentum, at Level 2 -! sh (nx,nz,ny) : Stability function for heat, at Level 2 -! -! These are defined on the walls of the grid boxes. -! - -!>\ingroup gsd_mynn_edmf -!! This subroutine calculates the level 2, non-dimensional wind shear -!! \f$G_M\f$ and vertical temperature gradient \f$G_H\f$ as well as -!! the level 2 stability funcitons \f$S_h\f$ and \f$S_m\f$. -!!\param kts horizontal dimension -!!\param kte vertical dimension -!!\param dz vertical grid spacings (\f$m\f$) -!!\param u west-east component of the horizontal wind (\f$m s^{-1}\f$) -!!\param v south-north component of the horizontal wind (\f$m s^{-1}\f$) -!!\param thl liquid water potential temperature -!!\param qw total water content \f$Q_w\f$ -!!\param ql liquid water content (\f$kg kg^{-1}\f$) -!!\param vt -!!\param vq -!!\param dtl vertical gradient of \f$\theta_l\f$ (\f$K m^{-1}\f$) -!!\param dqw vertical gradient of \f$Q_w\f$ -!!\param dtv vertical gradient of \f$\theta_V\f$ (\f$K m^{-1}\f$) -!!\param gm \f$G_M\f$ divided by \f$L^{2}/q^{2}\f$ (\f$s^{-2}\f$) -!!\param gh \f$G_H\f$ divided by \f$L^{2}/q^{2}\f$ (\f$s^{-2}\f$) -!!\param sm stability function for momentum, at Level 2 -!!\param sh stability function for heat, at Level 2 -!!\section gen_mym_level2 GSD MYNN-EDMF mym_level2 General Algorithm -!! @ { - SUBROUTINE mym_level2 (kts,kte, & - & dz, & - & u, v, thl, thetav, qw, & - & thlsg, qwsg, & - & ql, vt, vq, & - & dtl, dqw, dtv, gm, gh, sm, sh ) -! -!------------------------------------------------------------------- - - INTEGER, INTENT(IN) :: kts,kte - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,ql,vt,vq,& - thetav,thlsg,qwsg - REAL, DIMENSION(kts:kte), INTENT(out) :: & - &dtl,dqw,dtv,gm,gh,sm,sh - - INTEGER :: k - - REAL :: rfc,f1,f2,rf1,rf2,smc,shc,& - &ri1,ri2,ri3,ri4,duz,dtz,dqz,vtt,vqq,dtq,dzk,afk,abk,ri,rf - - REAL :: a2fac - -! ev = 2.5e6 -! tv0 = 0.61*tref -! tv1 = 1.61*tref -! gtr = 9.81/tref -! - rfc = g1/( g1+g2 ) - f1 = b1*( g1-c1 ) +3.0*a2*( 1.0 -c2 )*( 1.0-c5 ) & - & +2.0*a1*( 3.0-2.0*c2 ) - f2 = b1*( g1+g2 ) -3.0*a1*( 1.0 -c2 ) - rf1 = b1*( g1-c1 )/f1 - rf2 = b1* g1 /f2 - smc = a1 /a2* f1/f2 - shc = 3.0*a2*( g1+g2 ) -! - ri1 = 0.5/smc - ri2 = rf1*smc - ri3 = 4.0*rf2*smc -2.0*ri2 - ri4 = ri2**2 -! - DO k = kts+1,kte - dzk = 0.5 *( dz(k)+dz(k-1) ) - afk = dz(k)/( dz(k)+dz(k-1) ) - abk = 1.0 -afk - duz = ( u(k)-u(k-1) )**2 +( v(k)-v(k-1) )**2 - duz = duz /dzk**2 - dtz = ( thl(k)-thl(k-1) )/( dzk ) - !Alternatively, use SGS clouds for thl - !dtz = ( thlsg(k)-thlsg(k-1) )/( dzk ) - dqz = ( qw(k)-qw(k-1) )/( dzk ) - !Alternatively, use SGS clouds for qw - !dqz = ( qwsg(k)-qwsg(k-1) )/( dzk ) -! - vtt = 1.0 +vt(k)*abk +vt(k-1)*afk ! Beta-theta in NN09, Eq. 39 - vqq = tv0 +vq(k)*abk +vq(k-1)*afk ! Beta-q - dtq = vtt*dtz +vqq*dqz - !Alternatively, use theta-v without the SGS clouds - !dtq = ( thetav(k)-thetav(k-1) )/( dzk ) -! - dtl(k) = dtz - dqw(k) = dqz - dtv(k) = dtq -!? dtv(i,j,k) = dtz +tv0*dqz -!? : +( xlv/pi0(i,j,k)-tv1 ) -!? : *( ql(i,j,k)-ql(i,j,k-1) )/( dzk*h(i,j) ) -! - gm (k) = duz - gh (k) = -dtq*gtr -! -! ** Gradient Richardson number ** - ri = -gh(k)/MAX( duz, 1.0e-10 ) - - !a2fac is needed for the Canuto/Kitamura mod - IF (CKmod .eq. 1) THEN - a2fac = 1./(1. + MAX(ri,0.0)) - ELSE - a2fac = 1. - ENDIF - - rfc = g1/( g1+g2 ) - f1 = b1*( g1-c1 ) +3.0*a2*a2fac *( 1.0 -c2 )*( 1.0-c5 ) & - & +2.0*a1*( 3.0-2.0*c2 ) - f2 = b1*( g1+g2 ) -3.0*a1*( 1.0 -c2 ) - rf1 = b1*( g1-c1 )/f1 - rf2 = b1* g1 /f2 - smc = a1 /(a2*a2fac)* f1/f2 - shc = 3.0*(a2*a2fac)*( g1+g2 ) - - ri1 = 0.5/smc - ri2 = rf1*smc - ri3 = 4.0*rf2*smc -2.0*ri2 - ri4 = ri2**2 - -! ** Flux Richardson number ** - rf = MIN( ri1*( ri + ri2-SQRT(ri**2 - ri3*ri + ri4) ), rfc ) -! - sh (k) = shc*( rfc-rf )/( 1.0-rf ) - sm (k) = smc*( rf1-rf )/( rf2-rf ) * sh(k) - END DO -! -! RETURN - -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - - END SUBROUTINE mym_level2 -!! @} - -! ================================================================== -! SUBROUTINE mym_length: -! -! Input variables: see subroutine mym_initialize -! -! Output variables: see subroutine mym_initialize -! -! Work arrays: -! elt(nx,ny) : Length scale depending on the PBL depth (m) -! vsc(nx,ny) : Velocity scale q_c (m/s) -! at first, used for computing elt -! -! NOTE: the mixing lengths are meant to be calculated at the full- -! sigmal levels (or interfaces beween the model layers). -! -!>\ingroup gsd_mynn_edmf -!! This subroutine calculates the mixing lengths. - SUBROUTINE mym_length ( & - & kts,kte, & - & dz, dx, zw, & - & rmo, flt, flq, & - & vt, vq, & - & u1, v1, qke, & - & dtv, & - & el, & - & zi,theta, & - & qkw,Psig_bl,cldfra_bl1D,bl_mynn_mixlength,& - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf) - -!------------------------------------------------------------------- - - INTEGER, INTENT(IN) :: kts,kte - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - - INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,dx - REAL, DIMENSION(kts:kte), INTENT(IN) :: u1,v1,qke,vt,vq,cldfra_bl1D,& - edmf_w1,edmf_a1,edmf_qc1 - REAL, DIMENSION(kts:kte), INTENT(out) :: qkw, el - REAL, DIMENSION(kts:kte), INTENT(in) :: dtv - - REAL :: elt,vsc - - REAL, DIMENSION(kts:kte), INTENT(IN) :: theta - REAL, DIMENSION(kts:kte) :: qtke,elBLmin,elBLavg,thetaw - REAL :: wt,wt2,zi,zi2,h1,h2,hs,elBLmin0,elBLavg0,cldavg - - ! THE FOLLOWING CONSTANTS ARE IMPORTANT FOR REGULATING THE - ! MIXING LENGTHS: - REAL :: cns, & !< for surface layer (els) in stable conditions - alp1, & !< for turbulent length scale (elt) - alp2, & !< for buoyancy length scale (elb) - alp3, & !< for buoyancy enhancement factor of elb - alp4, & !< for surface layer (els) in unstable conditions - alp5, & !< for BouLac mixing length or above PBLH - alp6 !< for mass-flux/ - - !THE FOLLOWING LIMITS DO NOT DIRECTLY AFFECT THE ACTUAL PBLH. - !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, PARAMETER :: minzi = 300. !< min mixed-layer height - REAL, 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, PARAMETER :: mindz = 300. !< 300 !min (half) transition layer depth - - !SURFACE LAYER LENGTH SCALE MODS TO REDUCE IMPACT IN UPPER BOUNDARY LAYER - REAL, PARAMETER :: ZSLH = 100. !< Max height correlated to surface conditions (m) - REAL, PARAMETER :: CSL = 2. !< CSL = constant of proportionality to L O(1) - REAL :: z_m - - - INTEGER :: i,j,k - REAL :: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud,wstar,elb,els, & - & els1,elf,el_stab,el_unstab,el_mf,el_stab_mf,elb_mf, & - & PBLH_PLUS_ENT,Uonset,Ugrid,el_les - REAL, PARAMETER :: ctau = 1000. !constant for tau_cloud - -! tv0 = 0.61*tref -! gtr = 9.81/tref - - SELECT CASE(bl_mynn_mixlength) - - CASE (0) ! ORIGINAL MYNN MIXING LENGTH + BouLac - - cns = 2.7 - alp1 = 0.23 - alp2 = 1.0 - alp3 = 5.0 - alp4 = 100. - alp5 = 0.2 - - ! Impose limits on the height integration for elt and the transition layer depth - zi2 = MIN(10000.,zw(kte-2)) !originally integrated to model top, not just 10 km. - h1=MAX(0.3*zi2,mindz) - h1=MIN(h1,maxdz) ! 1/2 transition layer depth - h2=h1/2.0 ! 1/4 transition layer depth - - qkw(kts) = SQRT(MAX(qke(kts),1.0e-10)) - DO k = kts+1,kte - afk = dz(k)/( dz(k)+dz(k-1) ) - abk = 1.0 -afk - qkw(k) = SQRT(MAX(qke(k)*abk+qke(k-1)*afk,1.0e-3)) - END DO - - elt = 1.0e-5 - vsc = 1.0e-5 - - ! ** Strictly, zwk*h(i,j) -> ( zwk*h(i,j)+z0 ) ** - k = kts+1 - zwk = zw(k) - DO WHILE (zwk .LE. zi2+h1) - dzk = 0.5*( dz(k)+dz(k-1) ) - qdz = MAX( qkw(k)-qmin, 0.03 )*dzk - elt = elt +qdz*zwk - vsc = vsc +qdz - k = k+1 - zwk = zw(k) - END DO - - elt = alp1*elt/vsc - vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq - vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**(1.0/3.0) - - ! ** Strictly, el(i,k=1) is not zero. ** - el(kts) = 0.0 - zwk1 = zw(kts+1) - - DO k = kts+1,kte - zwk = zw(k) !full-sigma levels - - ! ** Length scale limited by the buoyancy effect ** - IF ( dtv(k) .GT. 0.0 ) THEN - bv = SQRT( gtr*dtv(k) ) - elb = alp2*qkw(k) / bv & - & *( 1.0 + alp3/alp2*& - &SQRT( vsc/( bv*elt ) ) ) - elf = alp2 * qkw(k)/bv - - ELSE - elb = 1.0e10 - elf = elb - ENDIF - - z_m = MAX(0.,zwk - 4.) - - ! ** Length scale in the surface layer ** - IF ( rmo .GT. 0.0 ) THEN - els = karman*zwk/(1.0+cns*MIN( zwk*rmo, zmax )) - els1 = karman*z_m/(1.0+cns*MIN( zwk*rmo, zmax )) - ELSE - els = karman*zwk*( 1.0 - alp4* zwk*rmo )**0.2 - els1 = karman*z_m*( 1.0 - alp4* zwk*rmo )**0.2 - END IF - - ! ** HARMONC AVERGING OF MIXING LENGTH SCALES: - ! el(k) = MIN(elb/( elb/elt+elb/els+1.0 ),elf) - ! el(k) = elb/( elb/elt+elb/els+1.0 ) - - wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 - - el(k) = MIN(elb/( elb/elt+elb/els+1.0 ),elf) - - END DO - - CASE (1, 2) !NONLOCAL (using BouLac) FORM OF MIXING LENGTH - - cns = 3.5 - alp1 = 0.21 - alp2 = 0.3 - alp3 = 1.5 - alp4 = 5.0 - alp5 = 0.2 - alp6 = 50. - - ! Impose limits on the height integration for elt and the transition layer depth - zi2=MAX(zi,200.) !minzi) - h1=MAX(0.3*zi2,200.) - h1=MIN(h1,500.) ! 1/2 transition layer depth - h2=h1/2.0 ! 1/4 transition layer depth - - qtke(kts)=MAX(0.5*qke(kts), 0.01) !tke at full sigma levels - thetaw(kts)=theta(kts) !theta at full-sigma levels - qkw(kts) = SQRT(MAX(qke(kts),1.0e-10)) - - DO k = kts+1,kte - afk = dz(k)/( dz(k)+dz(k-1) ) - abk = 1.0 -afk - qkw(k) = SQRT(MAX(qke(k)*abk+qke(k-1)*afk,1.0e-3)) - qtke(k) = 0.5*(qkw(k)**2) ! q -> TKE - thetaw(k)= theta(k)*abk + theta(k-1)*afk - END DO - - elt = 1.0e-5 - vsc = 1.0e-5 - - ! ** Strictly, zwk*h(i,j) -> ( zwk*h(i,j)+z0 ) ** - k = kts+1 - zwk = zw(k) - DO WHILE (zwk .LE. zi2+h1) - dzk = 0.5*( dz(k)+dz(k-1) ) - qdz = MAX( qkw(k)-qmin, 0.03 )*dzk - elt = elt +qdz*zwk - vsc = vsc +qdz - k = k+1 - zwk = zw(k) - END DO - - elt = MIN( MAX( alp1*elt/vsc, 10.), 400.) - vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq - vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird - - ! ** Strictly, el(i,j,1) is not zero. ** - el(kts) = 0.0 - zwk1 = zw(kts+1) !full-sigma levels - - ! COMPUTE BouLac mixing length - CALL boulac_length(kts,kte,zw,dz,qtke,thetaw,elBLmin,elBLavg) - - DO k = kts+1,kte - zwk = zw(k) !full-sigma levels - - ! ** Length scale limited by the buoyancy effect ** - IF ( dtv(k) .GT. 0.0 ) THEN - bv = SQRT( gtr*dtv(k) ) - !elb = alp2*qkw(k) / bv & ! formulation, - ! & *( 1.0 + alp3/alp2*& ! except keep - ! &SQRT( vsc/( bv*elt ) ) ) ! elb bounded by zwk - elb = MAX(alp2*qkw(k), & - & alp6*edmf_a1(k)*edmf_w1(k)) / bv & - & *( 1.0 + alp3*SQRT( vsc/(bv*elt) ) ) - elb = MIN(elb, zwk) - elf = 0.65 * qkw(k)/bv - !elBLavg(k) = MAX(elBLavg(k), alp6*edmf_a1(k)*edmf_w1(k)/bv) - ELSE - elb = 1.0e10 - elf = elb - ENDIF - - z_m = MAX(0.,zwk - 4.) - - ! ** Length scale in the surface layer ** - IF ( rmo .GT. 0.0 ) THEN - els = karman*zwk/(1.0+cns*MIN( zwk*rmo, zmax )) - els1 = karman*z_m/(1.0+cns*MIN( zwk*rmo, zmax )) - ELSE - els = karman*zwk*( 1.0 - alp4* zwk*rmo )**0.2 - els1 = karman*z_m*( 1.0 - alp4* zwk*rmo )**0.2 - END IF - - ! ** NOW BLEND THE MIXING LENGTH SCALES: - wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 - - !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_unstab = SQRT( els**2/(1. + (els1**2/elt**2) )) - el(k) = SQRT( els**2/(1. + (els1**2/elt**2) +(els1**2/elb**2))) - el(k) = MIN (el(k), elf) - el(k) = el(k)*(1.-wt) + alp5*elBLavg(k)*wt - - ! include scale-awareness, except for original MYNN - el(k) = el(k)*Psig_bl - - END DO - - CASE (3) !Local (mostly) mixing length formulation - - Uonset = 3.5 + dz(kts)*0.1 - Ugrid = sqrt(u1(kts)**2 + v1(kts)**2) - cns = 3.5 !JOE-test * (1.0 - MIN(MAX(Ugrid - Uonset, 0.0)/10.0, 1.0)) - alp1 = 0.21 - alp2 = 0.30 - alp3 = 1.5 - alp4 = 5.0 - alp5 = alp2 !like alp2, but for free atmosphere - alp6 = 50.0 !used for MF mixing length - - ! Impose limits on the height integration for elt and the transition layer depth - !zi2=MAX(zi,minzi) - zi2=MAX(zi, 200.) - !h1=MAX(0.3*zi2,mindz) - !h1=MIN(h1,maxdz) ! 1/2 transition layer depth - h1=MAX(0.3*zi2,200.) - h1=MIN(h1,500.) - h2=h1*0.5 ! 1/4 transition layer depth - - qtke(kts)=MAX(0.5*qke(kts),0.01) !tke at full sigma levels - qkw(kts) = SQRT(MAX(qke(kts),1.0e-4)) - - DO k = kts+1,kte - afk = dz(k)/( dz(k)+dz(k-1) ) - abk = 1.0 -afk - qkw(k) = SQRT(MAX(qke(k)*abk+qke(k-1)*afk,1.0e-3)) - qtke(k) = 0.5*qkw(k)**2 ! qkw -> TKE - END DO - - elt = 1.0e-5 - vsc = 1.0e-5 - - ! ** Strictly, zwk*h(i,j) -> ( zwk*h(i,j)+z0 ) ** - PBLH_PLUS_ENT = MAX(zi+h1, 100.) - k = kts+1 - zwk = zw(k) - DO WHILE (zwk .LE. PBLH_PLUS_ENT) - dzk = 0.5*( dz(k)+dz(k-1) ) - qdz = MAX( qkw(k)-qmin, 0.03 )*dzk - elt = elt +qdz*zwk - vsc = vsc +qdz - k = k+1 - zwk = zw(k) - END DO - - elt = MIN( MAX(alp1*elt/vsc, 10.), 400.) - vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq - vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird - - ! ** Strictly, el(i,j,1) is not zero. ** - el(kts) = 0.0 - zwk1 = zw(kts+1) - - DO k = kts+1,kte - zwk = zw(k) !full-sigma levels - dzk = 0.5*( dz(k)+dz(k-1) ) - cldavg = 0.5*(cldfra_bl1D(k-1)+cldfra_bl1D(k)) - - ! ** Length scale limited by the buoyancy effect ** - IF ( dtv(k) .GT. 0.0 ) THEN - !impose min value on bv - bv = MAX( SQRT( gtr*dtv(k) ), 0.001) - !elb_mf = alp2*qkw(k) / bv & - elb_mf = MAX(alp2*qkw(k), & - & alp6*edmf_a1(k)*edmf_w1(k)) / bv & - & *( 1.0 + alp3*SQRT( vsc/( bv*elt ) ) ) - elb = MIN(MAX(alp5*qkw(k), alp6*edmf_a1(k)*edmf_w1(k))/bv, zwk) - - !tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(vflx,1.0e-4))**onethird),30.),150.) - wstar = 1.25*(gtr*zi*MAX(vflx,1.0e-4))**onethird - tau_cloud = MIN(MAX(ctau * wstar/grav, 30.), 150.) - !minimize influence of surface heat flux on tau far away from the PBLH. - wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 - tau_cloud = tau_cloud*(1.-wt) + 50.*wt - elf = MIN(MAX(tau_cloud*SQRT(MIN(qtke(k),40.)), & - & alp6*edmf_a1(k)*edmf_w1(k)/bv), zwk) - - !IF (zwk > zi .AND. elf > 400.) THEN - ! ! COMPUTE BouLac mixing length - ! !CALL boulac_length0(k,kts,kte,zw,dz,qtke,thetaw,elBLmin0,elBLavg0) - ! !elf = alp5*elBLavg0 - ! elf = MIN(MAX(50.*SQRT(qtke(k)), 400.), zwk) - !ENDIF - - ELSE - ! use version in development for RAP/HRRR 2016 - ! JAYMES- - ! tau_cloud is an eddy turnover timescale; - ! see Teixeira and Cheinet (2004), Eq. 1, and - ! Cheinet and Teixeira (2003), Eq. 7. The - ! coefficient 0.5 is tuneable. Expression in - ! denominator is identical to vsc (a convective - ! velocity scale), except that elt is relpaced - ! by zi, and zero is replaced by 1.0e-4 to - ! prevent division by zero. - !tau_cloud = MIN(MAX(0.5*zi/((gtr*zi*MAX(vflx,1.0e-4))**onethird),50.),150.) - wstar = 1.25*(gtr*zi*MAX(vflx,1.0e-4))**onethird - tau_cloud = MIN(MAX(ctau * wstar/grav, 50.), 200.) - !minimize influence of surface heat flux on tau far away from the PBLH. - wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 - !tau_cloud = tau_cloud*(1.-wt) + 50.*wt - tau_cloud = tau_cloud*(1.-wt) + MAX(100.,dzk*0.25)*wt - - elb = MIN(tau_cloud*SQRT(MIN(qtke(k),40.)), zwk) - !elf = elb - elf = elb !/(1. + (elb/800.)) !bound free-atmos mixing length to < 800 m. - elb_mf = elb - END IF - elf = elf/(1. + (elf/800.)) !bound free-atmos mixing length to < 800 m. -! elb_mf = elb_mf/(1. + (elb_mf/800.)) !bound buoyancy mixing length to < 800 m. - elb_mf = MAX(elb_mf, 0.01) !to avoid divide-by-zero below - - z_m = MAX(0.,zwk - 4.) - - ! ** Length scale in the surface layer ** - IF ( rmo .GT. 0.0 ) THEN - els = karman*zwk/(1.0+cns*MIN( zwk*rmo, zmax )) - els1 = karman*z_m/(1.0+cns*MIN( zwk*rmo, zmax )) - ELSE - els = karman*zwk*( 1.0 - alp4* zwk*rmo )**0.2 - els1 = karman*z_m*( 1.0 - alp4* zwk*rmo )**0.2 - END IF - - ! ** NOW BLEND THE MIXING LENGTH SCALES: - wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 - - ! "el_unstab" = blended els-elt - !el_unstab = els/(1. + (els1/elt)) - !try squared-blending - !el(k) = SQRT( els**2/(1. + (els1**2/elt**2) )) - el(k) = SQRT( els**2/(1. + (els1**2/elt**2) +(els1**2/elb_mf**2))) - !el(k) = MIN(el_unstab, elb_mf) - el(k) = el(k)*(1.-wt) + elf*wt - - ! include scale-awareness. For now, use simple asymptotic kz -> 12 m. - el_les= MIN(els/(1. + (els1/12.)), elb_mf) - el(k) = el(k)*Psig_bl + (1.-Psig_bl)*el_les - - END DO - - END SELECT - - -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - - END SUBROUTINE mym_length - -! ================================================================== -!>\ingroup gsd_mynn_edmf -!! This subroutine was taken from the BouLac scheme in WRF-ARW and modified for -!! integration into the MYNN PBL scheme. WHILE loops were added to reduce the -!! computational expense. This subroutine computes the length scales up and down -!! and then computes the min, average of the up/down length scales, and also -!! considers the distance to the surface. -!\param dlu the distance a parcel can be lifted upwards give a finite -! amount of TKE. -!\param dld the distance a parcel can be displaced downwards given a -! finite amount of TKE. -!\param lb1 the minimum of the length up and length down -!\param lb2 the average of the length up and length down - SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2) -! -! NOTE: This subroutine was taken from the BouLac scheme in WRF-ARW -! and modified for integration into the MYNN PBL scheme. -! WHILE loops were added to reduce the computational expense. -! This subroutine computes the length scales up and down -! and then computes the min, average of the up/down -! length scales, and also considers the distance to the -! surface. -! -! dlu = the distance a parcel can be lifted upwards give a finite -! amount of TKE. -! dld = the distance a parcel can be displaced downwards given a -! finite amount of TKE. -! lb1 = the minimum of the length up and length down -! lb2 = the average of the length up and length down -!------------------------------------------------------------------- - - INTEGER, INTENT(IN) :: k,kts,kte - REAL, DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - REAL, INTENT(OUT) :: lb1,lb2 - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw - - !LOCAL VARS - INTEGER :: izz, found - REAL :: dlu,dld - REAL :: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz - - - !---------------------------------- - ! FIND DISTANCE UPWARD - !---------------------------------- - zup=0. - dlu=zw(kte+1)-zw(k)-dz(k)/2. - zzz=0. - zup_inf=0. - beta=grav/theta(k) !Buoyancy coefficient - - !print*,"FINDING Dup, k=",k," zw=",zw(k) - - if (k .lt. kte) then !cant integrate upwards from highest level - found = 0 - izz=k - DO WHILE (found .EQ. 0) - - if (izz .lt. kte) then - dzt=dz(izz) ! layer depth above - zup=zup-beta*theta(k)*dzt ! initial PE the parcel has at k - !print*," ",k,izz,theta(izz),dz(izz) - zup=zup+beta*(theta(izz+1)+theta(izz))*dzt/2. ! PE gained by lifting a parcel to izz+1 - zzz=zzz+dzt ! depth of layer k to izz+1 - !print*," PE=",zup," TKE=",qtke(k)," z=",zw(izz) - if (qtke(k).lt.zup .and. qtke(k).ge.zup_inf) then - bbb=(theta(izz+1)-theta(izz))/dzt - if (bbb .ne. 0.) then - !fractional distance up into the layer where TKE becomes < PE - tl=(-beta*(theta(izz)-theta(k)) + & - & sqrt( max(0.,(beta*(theta(izz)-theta(k)))**2. + & - & 2.*bbb*beta*(qtke(k)-zup_inf))))/bbb/beta - else - if (theta(izz) .ne. theta(k))then - tl=(qtke(k)-zup_inf)/(beta*(theta(izz)-theta(k))) - else - tl=0. - endif - endif - dlu=zzz-dzt+tl - !print*," FOUND Dup:",dlu," z=",zw(izz)," tl=",tl - found =1 - endif - zup_inf=zup - izz=izz+1 - ELSE - found = 1 - ENDIF - - ENDDO - - endif - - !---------------------------------- - ! FIND DISTANCE DOWN - !---------------------------------- - zdo=0. - zdo_sup=0. - dld=zw(k) - zzz=0. - - !print*,"FINDING Ddown, k=",k," zwk=",zw(k) - if (k .gt. kts) then !cant integrate downwards from lowest level - - found = 0 - izz=k - DO WHILE (found .EQ. 0) - - if (izz .gt. kts) then - dzt=dz(izz-1) - zdo=zdo+beta*theta(k)*dzt - !print*," ",k,izz,theta(izz),dz(izz-1) - zdo=zdo-beta*(theta(izz-1)+theta(izz))*dzt/2. - zzz=zzz+dzt - !print*," PE=",zdo," TKE=",qtke(k)," z=",zw(izz) - if (qtke(k).lt.zdo .and. qtke(k).ge.zdo_sup) then - bbb=(theta(izz)-theta(izz-1))/dzt - if (bbb .ne. 0.) then - tl=(beta*(theta(izz)-theta(k))+ & - & sqrt( max(0.,(beta*(theta(izz)-theta(k)))**2. + & - & 2.*bbb*beta*(qtke(k)-zdo_sup))))/bbb/beta - else - if (theta(izz) .ne. theta(k)) then - tl=(qtke(k)-zdo_sup)/(beta*(theta(izz)-theta(k))) - else - tl=0. - endif - endif - dld=zzz-dzt+tl - !print*," FOUND Ddown:",dld," z=",zw(izz)," tl=",tl - found = 1 - endif - zdo_sup=zdo - izz=izz-1 - ELSE - found = 1 - ENDIF - ENDDO - - endif - - !---------------------------------- - ! GET MINIMUM (OR AVERAGE) - !---------------------------------- - !The surface layer length scale can exceed z for large z/L, - !so keep maximum distance down > z. - dld = min(dld,zw(k+1))!not used in PBL anyway, only free atmos - lb1 = min(dlu,dld) !minimum - !JOE-fight floating point errors - dlu=MAX(0.1,MIN(dlu,1000.)) - dld=MAX(0.1,MIN(dld,1000.)) - lb2 = sqrt(dlu*dld) !average - biased towards smallest - !lb2 = 0.5*(dlu+dld) !average - - if (k .eq. kte) then - lb1 = 0. - lb2 = 0. - endif - !print*,"IN MYNN-BouLac",k,lb1 - !print*,"IN MYNN-BouLac",k,dld,dlu - - END SUBROUTINE boulac_length0 - -! ================================================================== -!>\ingroup gsd_mynn_edmf -!! This subroutine was taken from the BouLac scheme in WRF-ARW -!! and modified for integration into the MYNN PBL scheme. -!! WHILE loops were added to reduce the computational expense. -!! This subroutine computes the length scales up and down -!! and then computes the min, average of the up/down -!! length scales, and also considers the distance to the -!! surface. - SUBROUTINE boulac_length(kts,kte,zw,dz,qtke,theta,lb1,lb2) -! dlu = the distance a parcel can be lifted upwards give a finite -! amount of TKE. -! dld = the distance a parcel can be displaced downwards given a -! finite amount of TKE. -! lb1 = the minimum of the length up and length down -! lb2 = the average of the length up and length down -!------------------------------------------------------------------- - - INTEGER, INTENT(IN) :: kts,kte - REAL, DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - REAL, DIMENSION(kts:kte), INTENT(OUT) :: lb1,lb2 - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw - - !LOCAL VARS - INTEGER :: iz, izz, found - REAL, DIMENSION(kts:kte) :: dlu,dld - REAL, PARAMETER :: Lmax=2000. !soft limit - REAL :: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz - - !print*,"IN MYNN-BouLac",kts, kte - - do iz=kts,kte - - !---------------------------------- - ! FIND DISTANCE UPWARD - !---------------------------------- - zup=0. - dlu(iz)=zw(kte+1)-zw(iz)-dz(iz)/2. - zzz=0. - zup_inf=0. - beta=grav/theta(iz) !Buoyancy coefficient - - !print*,"FINDING Dup, k=",iz," zw=",zw(iz) - - if (iz .lt. kte) then !cant integrate upwards from highest level - - found = 0 - izz=iz - DO WHILE (found .EQ. 0) - - if (izz .lt. kte) then - dzt=dz(izz) ! layer depth above - zup=zup-beta*theta(iz)*dzt ! initial PE the parcel has at iz - !print*," ",iz,izz,theta(izz),dz(izz) - zup=zup+beta*(theta(izz+1)+theta(izz))*dzt/2. ! PE gained by lifting a parcel to izz+1 - zzz=zzz+dzt ! depth of layer iz to izz+1 - !print*," PE=",zup," TKE=",qtke(iz)," z=",zw(izz) - if (qtke(iz).lt.zup .and. qtke(iz).ge.zup_inf) then - bbb=(theta(izz+1)-theta(izz))/dzt - if (bbb .ne. 0.) then - !fractional distance up into the layer where TKE becomes < PE - tl=(-beta*(theta(izz)-theta(iz)) + & - & sqrt( max(0.,(beta*(theta(izz)-theta(iz)))**2. + & - & 2.*bbb*beta*(qtke(iz)-zup_inf))))/bbb/beta - else - if (theta(izz) .ne. theta(iz))then - tl=(qtke(iz)-zup_inf)/(beta*(theta(izz)-theta(iz))) - else - tl=0. - endif - endif - dlu(iz)=zzz-dzt+tl - !print*," FOUND Dup:",dlu(iz)," z=",zw(izz)," tl=",tl - found =1 - endif - zup_inf=zup - izz=izz+1 - ELSE - found = 1 - ENDIF - - ENDDO - - endif - - !---------------------------------- - ! FIND DISTANCE DOWN - !---------------------------------- - zdo=0. - zdo_sup=0. - dld(iz)=zw(iz) - zzz=0. - - !print*,"FINDING Ddown, k=",iz," zwk=",zw(iz) - if (iz .gt. kts) then !cant integrate downwards from lowest level - - found = 0 - izz=iz - DO WHILE (found .EQ. 0) - - if (izz .gt. kts) then - dzt=dz(izz-1) - zdo=zdo+beta*theta(iz)*dzt - !print*," ",iz,izz,theta(izz),dz(izz-1) - zdo=zdo-beta*(theta(izz-1)+theta(izz))*dzt/2. - zzz=zzz+dzt - !print*," PE=",zdo," TKE=",qtke(iz)," z=",zw(izz) - if (qtke(iz).lt.zdo .and. qtke(iz).ge.zdo_sup) then - bbb=(theta(izz)-theta(izz-1))/dzt - if (bbb .ne. 0.) then - tl=(beta*(theta(izz)-theta(iz))+ & - & sqrt( max(0.,(beta*(theta(izz)-theta(iz)))**2. + & - & 2.*bbb*beta*(qtke(iz)-zdo_sup))))/bbb/beta - else - if (theta(izz) .ne. theta(iz)) then - tl=(qtke(iz)-zdo_sup)/(beta*(theta(izz)-theta(iz))) - else - tl=0. - endif - endif - dld(iz)=zzz-dzt+tl - !print*," FOUND Ddown:",dld(iz)," z=",zw(izz)," tl=",tl - found = 1 - endif - zdo_sup=zdo - izz=izz-1 - ELSE - found = 1 - ENDIF - ENDDO - - endif - - !---------------------------------- - ! GET MINIMUM (OR AVERAGE) - !---------------------------------- - !The surface layer length scale can exceed z for large z/L, - !so keep maximum distance down > z. - dld(iz) = min(dld(iz),zw(iz+1))!not used in PBL anyway, only free atmos - lb1(iz) = min(dlu(iz),dld(iz)) !minimum - !JOE-fight floating point errors - dlu(iz)=MAX(0.1,MIN(dlu(iz),1000.)) - dld(iz)=MAX(0.1,MIN(dld(iz),1000.)) - lb2(iz) = sqrt(dlu(iz)*dld(iz)) !average - biased towards smallest - !lb2(iz) = 0.5*(dlu(iz)+dld(iz)) !average - - !Apply soft limit (only impacts very large lb; lb=100 by 5%, lb=500 by 20%). - lb1(iz) = lb1(iz)/(1. + (lb1(iz)/Lmax)) - lb2(iz) = lb2(iz)/(1. + (lb2(iz)/Lmax)) - - if (iz .eq. kte) then - lb1(kte) = lb1(kte-1) - lb2(kte) = lb2(kte-1) - endif - !print*,"IN MYNN-BouLac",kts, kte,lb1(iz) - !print*,"IN MYNN-BouLac",iz,dld(iz),dlu(iz) - - ENDDO - - END SUBROUTINE boulac_length -! -! ================================================================== -! SUBROUTINE mym_turbulence: -! -! Input variables: see subroutine mym_initialize -! closure : closure level (2.5, 2.6, or 3.0) -! -! # ql, vt, vq, qke, tsq, qsq and cov are changed to input variables. -! -! Output variables: see subroutine mym_initialize -! dfm(nx,nz,ny) : Diffusivity coefficient for momentum, -! divided by dz (not dz*h(i,j)) (m/s) -! dfh(nx,nz,ny) : Diffusivity coefficient for heat, -! divided by dz (not dz*h(i,j)) (m/s) -! dfq(nx,nz,ny) : Diffusivity coefficient for q^2, -! divided by dz (not dz*h(i,j)) (m/s) -! tcd(nx,nz,ny) : Countergradient diffusion term for Theta_l -! (K/s) -! qcd(nx,nz,ny) : Countergradient diffusion term for Q_w -! (kg/kg s) -! pd?(nx,nz,ny) : Half of the production terms -! -! Only tcd and qcd are defined at the center of the grid boxes -! -! # DO NOT forget that tcd and qcd are added on the right-hand side -! of the equations for Theta_l and Q_w, respectively. -! -! Work arrays: see subroutine mym_initialize and level2 -! -! # dtl, dqw, dtv, gm and gh are allowed to share storage units with -! dfm, dfh, dfq, tcd and qcd, respectively, for saving memory. -! -!>\ingroup gsd_mynn_edmf -!! This subroutine calculates the vertical diffusivity coefficients and the -!! production terms for the turbulent quantities. -!>\section gen_mym_turbulence GSD mym_turbulence General Algorithm -!! Two subroutines mym_level2() and mym_length() are called within this -!!subrouine to collect variable to carry out successive calculations: -!! - mym_level2() calculates the level 2 nondimensional wind shear \f$G_M\f$ -!! and vertical temperature gradient \f$G_H\f$ as well as the level 2 stability -!! functions \f$S_h\f$ and \f$S_m\f$. -!! - mym_length() calculates the mixing lengths. -!! - The stability criteria from Helfand and Labraga (1989) are applied. -!! - The stability functions for level 2.5 or level 3.0 are calculated. -!! - If level 3.0 is used, counter-gradient terms are calculated. -!! - Production terms of TKE,\f$\theta^{'2}\f$,\f$q^{'2}\f$, and \f$\theta^{'}q^{'}\f$ -!! are calculated. -!! - Eddy diffusivity \f$K_h\f$ and eddy viscosity \f$K_m\f$ are calculated. -!! - TKE budget terms are calculated (if the namelist parameter \p bl_mynn_tkebudget -!! is set to True) - SUBROUTINE mym_turbulence ( & - & kts,kte, & - & closure, & - & dz, dx, zw, & - & u, v, thl, thetav, ql, qw, & - & thlsg, qwsg, & - & qke, tsq, qsq, cov, & - & vt, vq, & - & rmo, flt, flq, & - & zi,theta, & - & sh, sm, & - & El, & - & Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & - & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D, & - & bl_mynn_tkebudget, & - & Psig_bl,Psig_shcu,cldfra_bl1D,bl_mynn_mixlength,& - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & - & TKEprodTD, & - & spp_pbl,rstoch_col) - -!------------------------------------------------------------------- -! - INTEGER, INTENT(IN) :: kts,kte - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - - INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf - REAL, INTENT(IN) :: closure - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,Psig_shcu,dx - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,thetav,qw,& - &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1,edmf_qc1,& - &TKEprodTD,thlsg,qwsg - - REAL, DIMENSION(kts:kte), INTENT(out) :: dfm,dfh,dfq,& - &pdk,pdt,pdq,pdc,tcd,qcd,el - - REAL, DIMENSION(kts:kte), INTENT(inout) :: & - qWT1D,qSHEAR1D,qBUOY1D,qDISS1D - REAL :: q3sq_old,dlsq1,qWTP_old,qWTP_new - REAL :: dudz,dvdz,dTdz,& - upwp,vpwp,Tpwp - INTEGER, INTENT(in) :: bl_mynn_tkebudget - - REAL, DIMENSION(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh - - INTEGER :: k -! REAL :: cc2,cc3,e1c,e2c,e3c,e4c,e5c - REAL :: e6c,dzk,afk,abk,vtt,vqq,& - &cw25,clow,cupp,gamt,gamq,smd,gamv,elq,elh - - REAL :: zi, cldavg - REAL, DIMENSION(kts:kte), INTENT(in) :: theta - - REAL :: a2fac, duz, ri !JOE-Canuto/Kitamura mod - - REAL:: auh,aum,adh,adm,aeh,aem,Req,Rsl,Rsl2,& - gmelq,sm20,sh20,sm25max,sh25max,sm25min,sh25min,& - sm_pbl,sh_pbl,zi2,wt - - DOUBLE PRECISION q2sq, t2sq, r2sq, c2sq, elsq, gmel, ghel - DOUBLE PRECISION q3sq, t3sq, r3sq, c3sq, dlsq, qdiv - DOUBLE PRECISION e1, e2, e3, e4, enum, eden, wden - -! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col - REAL :: Prnum - REAL, PARAMETER :: Prlimit = 5.0 - - -! -! tv0 = 0.61*tref -! gtr = 9.81/tref -! -! cc2 = 1.0-c2 -! cc3 = 1.0-c3 -! e1c = 3.0*a2*b2*cc3 -! e2c = 9.0*a1*a2*cc2 -! e3c = 9.0*a2*a2*cc2*( 1.0-c5 ) -! e4c = 12.0*a1*a2*cc2 -! e5c = 6.0*a1*a1 -! - - CALL mym_level2 (kts,kte, & - & dz, & - & u, v, thl, thetav, qw, & - & thlsg, qwsg, & - & ql, vt, vq, & - & dtl, dqw, dtv, gm, gh, sm, sh ) -! - CALL mym_length ( & - & kts,kte, & - & dz, dx, zw, & - & rmo, flt, flq, & - & vt, vq, & - & u, v, qke, & - & dtv, & - & el, & - & zi,theta, & - & qkw,Psig_bl,cldfra_bl1D,bl_mynn_mixlength, & - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf ) -! - - DO k = kts+1,kte - dzk = 0.5 *( dz(k)+dz(k-1) ) - afk = dz(k)/( dz(k)+dz(k-1) ) - abk = 1.0 -afk - elsq = el (k)**2 - q3sq = qkw(k)**2 - q2sq = b1*elsq*( sm(k)*gm(k)+sh(k)*gh(k) ) - - sh20 = MAX(sh(k), 1e-5) - sm20 = MAX(sm(k), 1e-5) - sh(k)= MAX(sh(k), 1e-5) - - !Canuto/Kitamura mod - duz = ( u(k)-u(k-1) )**2 +( v(k)-v(k-1) )**2 - duz = duz /dzk**2 - ! ** Gradient Richardson number ** - ri = -gh(k)/MAX( duz, 1.0e-10 ) - IF (CKmod .eq. 1) THEN - a2fac = 1./(1. + MAX(ri,0.0)) - ELSE - a2fac = 1. - ENDIF - !end Canuto/Kitamura mod - - !level 2.0 Prandtl number - !Prnum = MIN(sm20/sh20, 4.0) - !The form of Zilitinkevich et al. (2006) but modified - !half-way towards Esau and Grachev (2007, Wind Eng) - !Prnum = MIN(0.76 + 3.0*MAX(ri,0.0), Prlimit) - Prnum = MIN(0.76 + 4.0*MAX(ri,0.0), Prlimit) - !Prnum = MIN(0.76 + 5.0*MAX(ri,0.0), Prlimit) -! -! Modified: Dec/22/2005, from here, (dlsq -> elsq) - gmel = gm (k)*elsq - ghel = gh (k)*elsq -! Modified: Dec/22/2005, up to here - - ! Level 2.0 debug prints - IF ( debug_code ) THEN - IF (sh(k)<0.0 .OR. sm(k)<0.0) THEN - print*,"MYNN; mym_turbulence 2.0; sh=",sh(k)," k=",k - print*," gm=",gm(k)," gh=",gh(k)," sm=",sm(k) - print*," q2sq=",q2sq," q3sq=",q3sq," q3/q2=",q3sq/q2sq - print*," qke=",qke(k)," el=",el(k)," ri=",ri - print*," PBLH=",zi," u=",u(k)," v=",v(k) - ENDIF - ENDIF - -! ** Since qkw is set to more than 0.0, q3sq > 0.0. ** - -!JOE-test new stability criteria in level 2.5 (as well as level 3) - little/no impact -! ** Limitation on q, instead of L/q ** - dlsq = elsq - IF ( q3sq/dlsq .LT. -gh(k) ) q3sq = -dlsq*gh(k) -!JOE-end - - IF ( q3sq .LT. q2sq ) THEN - !Apply Helfand & Labraga mod - qdiv = SQRT( q3sq/q2sq ) !HL89: (1-alfa) -! - !Use level 2.5 stability functions - !e1 = q3sq - e1c*ghel*a2fac - !e2 = q3sq - e2c*ghel*a2fac - !e3 = e1 + e3c*ghel*a2fac**2 - !e4 = e1 - e4c*ghel*a2fac - !eden = e2*e4 + e3*e5c*gmel - !eden = MAX( eden, 1.0d-20 ) - !sm(k) = q3sq*a1*( e3-3.0*c1*e4 )/eden - !!JOE-Canuto/Kitamura mod - !!sh(k) = q3sq*a2*( e2+3.0*c1*e5c*gmel )/eden - !sh(k) = q3sq*(a2*a2fac)*( e2+3.0*c1*e5c*gmel )/eden - !sm(k) = Prnum*sh(k) - !sm(k) = sm(k) * qdiv - - !Use level 2.0 functions as in original MYNN - sh(k) = sh(k) * qdiv - sm(k) = sm(k) * qdiv - ! !sm_pbl = sm(k) * qdiv - ! - ! !Or, use the simple Pr relationship - ! sm(k) = Prnum*sh(k) - ! - ! !or blend them: - ! zi2 = MAX(zi, 300.) - ! wt =.5*TANH((zw(k) - zi2)/200.) + .5 - ! sm(k) = sm_pbl*(1.-wt) + sm(k)*wt - - !Recalculate terms for later use - !JOE-Canuto/Kitamura mod - !e1 = q3sq - e1c*ghel * qdiv**2 - !e2 = q3sq - e2c*ghel * qdiv**2 - !e3 = e1 + e3c*ghel * qdiv**2 - !e4 = e1 - e4c*ghel * qdiv**2 - e1 = q3sq - e1c*ghel*a2fac * qdiv**2 - e2 = q3sq - e2c*ghel*a2fac * qdiv**2 - e3 = e1 + e3c*ghel*a2fac**2 * qdiv**2 - e4 = e1 - e4c*ghel*a2fac * qdiv**2 - eden = e2*e4 + e3*e5c*gmel * qdiv**2 - eden = MAX( eden, 1.0d-20 ) - !!JOE-Canuto/Kitamura mod - !!sh(k) = q3sq*a2*( e2+3.0*c1*e5c*gmel )/eden - retro 5 - !sh(k) = q3sq*(a2*a2fac)*( e2+3.0*c1*e5c*gmel )/eden - !sm(k) = Prnum*sh(k) - ELSE - !JOE-Canuto/Kitamura mod - !e1 = q3sq - e1c*ghel - !e2 = q3sq - e2c*ghel - !e3 = e1 + e3c*ghel - !e4 = e1 - e4c*ghel - e1 = q3sq - e1c*ghel*a2fac - e2 = q3sq - e2c*ghel*a2fac - e3 = e1 + e3c*ghel*a2fac**2 - e4 = e1 - e4c*ghel*a2fac - eden = e2*e4 + e3*e5c*gmel - eden = MAX( eden, 1.0d-20 ) - - qdiv = 1.0 - !Use level 2.5 stability functions - sm(k) = q3sq*a1*( e3-3.0*c1*e4 )/eden - ! sm_pbl = q3sq*a1*( e3-3.0*c1*e4 )/eden - !!JOE-Canuto/Kitamura mod - !!sh(k) = q3sq*a2*( e2+3.0*c1*e5c*gmel )/eden - sh(k) = q3sq*(a2*a2fac)*( e2+3.0*c1*e5c*gmel )/eden - ! sm(k) = Prnum*sh(k) - - ! !or blend them: - ! zi2 = MAX(zi, 300.) - ! wt = .5*TANH((zw(k) - zi2)/200.) + .5 - ! sm(k) = sm_pbl*(1.-wt) + sm(k)*wt - END IF !end Helfand & Labraga check - - !Impose broad limits on Sh and Sm: - gmelq = MAX(gmel/q3sq, 1e-8) - sm25max = 4. !MIN(sm20*3.0, SQRT(.1936/gmelq)) - sh25max = 4. !MIN(sh20*3.0, 0.76*b2) - sm25min = 0.0 !MAX(sm20*0.1, 1e-6) - sh25min = 0.0 !MAX(sh20*0.1, 1e-6) - - !JOE: Level 2.5 debug prints - ! HL88 , lev2.5 criteria from eqs. 3.17, 3.19, & 3.20 - IF ( debug_code ) THEN - IF ((sh(k)sh25max .OR. sm(k)>sm25max) ) THEN - print*,"In mym_turbulence 2.5: k=",k - print*," sm=",sm(k)," sh=",sh(k) - print*," ri=",ri," Pr=",sm(k)/MAX(sh(k),1e-8) - print*," gm=",gm(k)," gh=",gh(k) - print*," q2sq=",q2sq," q3sq=",q3sq, q3sq/q2sq - print*," qke=",qke(k)," el=",el(k) - print*," PBLH=",zi," u=",u(k)," v=",v(k) - print*," SMnum=",q3sq*a1*( e3-3.0*c1*e4)," SMdenom=",eden - print*," SHnum=",q3sq*(a2*a2fac)*( e2+3.0*c1*e5c*gmel ),& - " SHdenom=",eden - ENDIF - ENDIF - - !Enforce constraints for level 2.5 functions - IF ( sh(k) > sh25max ) sh(k) = sh25max - IF ( sh(k) < sh25min ) sh(k) = sh25min - !IF ( sm(k) > sm25max ) sm(k) = sm25max - !IF ( sm(k) < sm25min ) sm(k) = sm25min - !sm(k) = Prnum*sh(k) - sm(k) = MIN(sm(k), Prlimit*Sh(k)) - -! ** Level 3 : start ** - IF ( closure .GE. 3.0 ) THEN - t2sq = qdiv*b2*elsq*sh(k)*dtl(k)**2 - r2sq = qdiv*b2*elsq*sh(k)*dqw(k)**2 - c2sq = qdiv*b2*elsq*sh(k)*dtl(k)*dqw(k) - t3sq = MAX( tsq(k)*abk+tsq(k-1)*afk, 0.0 ) - r3sq = MAX( qsq(k)*abk+qsq(k-1)*afk, 0.0 ) - c3sq = cov(k)*abk+cov(k-1)*afk - -! Modified: Dec/22/2005, from here - c3sq = SIGN( MIN( ABS(c3sq), SQRT(t3sq*r3sq) ), c3sq ) -! - vtt = 1.0 +vt(k)*abk +vt(k-1)*afk - vqq = tv0 +vq(k)*abk +vq(k-1)*afk - - t2sq = vtt*t2sq +vqq*c2sq - r2sq = vtt*c2sq +vqq*r2sq - c2sq = MAX( vtt*t2sq+vqq*r2sq, 0.0d0 ) - t3sq = vtt*t3sq +vqq*c3sq - r3sq = vtt*c3sq +vqq*r3sq - c3sq = MAX( vtt*t3sq+vqq*r3sq, 0.0d0 ) -! - cw25 = e1*( e2 + 3.0*c1*e5c*gmel*qdiv**2 )/( 3.0*eden ) -! -! ** Limitation on q, instead of L/q ** - dlsq = elsq - IF ( q3sq/dlsq .LT. -gh(k) ) q3sq = -dlsq*gh(k) -! -! ** Limitation on c3sq (0.12 =< cw =< 0.76) ** - ! Use Janjic's (2001; p 13-17) methodology (eqs 4.11-414 and 5.7-5.10) - ! to calculate an exact limit for c3sq: - auh = 27.*a1*((a2*a2fac)**2)*b2*(grav/tref)**2 - aum = 54.*(a1**2)*(a2*a2fac)*b2*c1*(grav/tref) - adh = 9.*a1*((a2*a2fac)**2)*(12.*a1 + 3.*b2)*(grav/tref)**2 - adm = 18.*(a1**2)*(a2*a2fac)*(b2 - 3.*(a2*a2fac))*(grav/tref) - - aeh = (9.*a1*((a2*a2fac)**2)*b1 +9.*a1*((a2*a2fac)**2)* & - (12.*a1 + 3.*b2))*(grav/tref) - aem = 3.*a1*(a2*a2fac)*b1*(3.*(a2*a2fac) + 3.*b2*c1 + & - (18.*a1*c1 - b2)) + & - (18.)*(a1**2)*(a2*a2fac)*(b2 - 3.*(a2*a2fac)) - - Req = -aeh/aem - Rsl = (auh + aum*Req)/(3.*adh + 3.*adm*Req) - !For now, use default values, since tests showed little/no sensitivity - Rsl = .12 !lower limit - Rsl2= 1.0 - 2.*Rsl !upper limit - !IF (k==2)print*,"Dynamic limit RSL=",Rsl - !IF (Rsl < 0.10 .OR. Rsl > 0.18) THEN - ! print*,'--- ERROR: MYNN: Dynamic Cw '// & - ! 'limit exceeds reasonable limits' - ! print*," MYNN: Dynamic Cw limit needs attention=",Rsl - !ENDIF - - !JOE-Canuto/Kitamura mod - !e2 = q3sq - e2c*ghel * qdiv**2 - !e3 = q3sq + e3c*ghel * qdiv**2 - !e4 = q3sq - e4c*ghel * qdiv**2 - e2 = q3sq - e2c*ghel*a2fac * qdiv**2 - e3 = q3sq + e3c*ghel*a2fac**2 * qdiv**2 - e4 = q3sq - e4c*ghel*a2fac * qdiv**2 - eden = e2*e4 + e3 *e5c*gmel * qdiv**2 - - !JOE-Canuto/Kitamura mod - !wden = cc3*gtr**2 * dlsq**2/elsq * qdiv**2 & - ! & *( e2*e4c - e3c*e5c*gmel * qdiv**2 ) - wden = cc3*gtr**2 * dlsq**2/elsq * qdiv**2 & - & *( e2*e4c*a2fac - e3c*e5c*gmel*a2fac**2 * qdiv**2 ) - - IF ( wden .NE. 0.0 ) THEN - !JOE: test dynamic limits - clow = q3sq*( 0.12-cw25 )*eden/wden - cupp = q3sq*( 0.76-cw25 )*eden/wden - !clow = q3sq*( Rsl -cw25 )*eden/wden - !cupp = q3sq*( Rsl2-cw25 )*eden/wden -! - IF ( wden .GT. 0.0 ) THEN - c3sq = MIN( MAX( c3sq, c2sq+clow ), c2sq+cupp ) - ELSE - c3sq = MAX( MIN( c3sq, c2sq+clow ), c2sq+cupp ) - END IF - END IF -! - e1 = e2 + e5c*gmel * qdiv**2 - eden = MAX( eden, 1.0d-20 ) -! Modified: Dec/22/2005, up to here - - !JOE-Canuto/Kitamura mod - !e6c = 3.0*a2*cc3*gtr * dlsq/elsq - e6c = 3.0*(a2*a2fac)*cc3*gtr * dlsq/elsq - - !============================ - ! ** for Gamma_theta ** - !! enum = qdiv*e6c*( t3sq-t2sq ) - IF ( t2sq .GE. 0.0 ) THEN - enum = MAX( qdiv*e6c*( t3sq-t2sq ), 0.0d0 ) - ELSE - enum = MIN( qdiv*e6c*( t3sq-t2sq ), 0.0d0 ) - ENDIF - gamt =-e1 *enum /eden - - !============================ - ! ** for Gamma_q ** - !! enum = qdiv*e6c*( r3sq-r2sq ) - IF ( r2sq .GE. 0.0 ) THEN - enum = MAX( qdiv*e6c*( r3sq-r2sq ), 0.0d0 ) - ELSE - enum = MIN( qdiv*e6c*( r3sq-r2sq ), 0.0d0 ) - ENDIF - gamq =-e1 *enum /eden - - !============================ - ! ** for Sm' and Sh'd(Theta_V)/dz ** - !! enum = qdiv*e6c*( c3sq-c2sq ) - enum = MAX( qdiv*e6c*( c3sq-c2sq ), 0.0d0) - - !JOE-Canuto/Kitamura mod - !smd = dlsq*enum*gtr/eden * qdiv**2 * (e3c+e4c)*a1/a2 - smd = dlsq*enum*gtr/eden * qdiv**2 * (e3c*a2fac**2 + & - & e4c*a2fac)*a1/(a2*a2fac) - - gamv = e1 *enum*gtr/eden - sm(k) = sm(k) +smd - - !============================ - ! ** For elh (see below), qdiv at Level 3 is reset to 1.0. ** - qdiv = 1.0 - - ! Level 3 debug prints - IF ( debug_code ) THEN - IF (sh(k)<-0.3 .OR. sm(k)<-0.3 .OR. & - qke(k) < -0.1 .or. ABS(smd) .gt. 2.0) THEN - print*," MYNN; mym_turbulence3.0; sh=",sh(k)," k=",k - print*," gm=",gm(k)," gh=",gh(k)," sm=",sm(k) - print*," q2sq=",q2sq," q3sq=",q3sq," q3/q2=",q3sq/q2sq - print*," qke=",qke(k)," el=",el(k)," ri=",ri - print*," PBLH=",zi," u=",u(k)," v=",v(k) - ENDIF - ENDIF - -! ** Level 3 : end ** - - ELSE -! ** At Level 2.5, qdiv is not reset. ** - gamt = 0.0 - gamq = 0.0 - gamv = 0.0 - END IF -! -! Add min background stability function (diffusivity) within model levels -! with active plumes and low cloud fractions. - cldavg = 0.5*(cldfra_bl1D(k-1) + cldfra_bl1D(k)) - IF (edmf_a1(k) > 0.001 .OR. cldavg > 0.02) THEN - cldavg = 0.5*(cldfra_bl1D(k-1) + cldfra_bl1D(k)) - !sm(k) = MAX(sm(k), MAX(1.0 - 2.0*cldavg, 0.0)**0.33 * 0.03 * & - ! & MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) - !sh(k) = MAX(sh(k), MAX(1.0 - 2.0*cldavg, 0.0)**0.33 * 0.03 * & - ! & MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) - - ! for mass-flux columns - sm(k) = MAX(sm(k), 0.03*MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) - sh(k) = MAX(sh(k), 0.03*MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) - ! for clouds - sm(k) = MAX(sm(k), 0.03*MIN(cldavg,1.0) ) - sh(k) = MAX(sh(k), 0.03*MIN(cldavg,1.0) ) - ENDIF -! - elq = el(k)*qkw(k) - elh = elq*qdiv - - ! Production of TKE (pdk), T-variance (pdt), - ! q-variance (pdq), and covariance (pdc) - pdk(k) = elq*( sm(k)*gm(k) & - & +sh(k)*gh(k)+gamv ) + & - & TKEprodTD(k) - 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 )& - &*dqw(k)*0.5 & - &+elh*( sh(k)*dqw(k)+gamq )*dtl(k)*0.5 - - ! Contergradient terms - tcd(k) = elq*gamt - qcd(k) = elq*gamq - - ! Eddy Diffusivity/Viscosity divided by dz - dfm(k) = elq*sm(k) / dzk - dfh(k) = elq*sh(k) / dzk -! Modified: Dec/22/2005, from here -! ** In sub.mym_predict, dfq for the TKE and scalar variance ** -! ** are set to 3.0*dfm and 1.0*dfm, respectively. (Sqfac) ** - dfq(k) = dfm(k) -! Modified: Dec/22/2005, up to here - - IF ( bl_mynn_tkebudget == 1) THEN - !TKE BUDGET -! dudz = ( u(k)-u(k-1) )/dzk -! dvdz = ( v(k)-v(k-1) )/dzk -! dTdz = ( thl(k)-thl(k-1) )/dzk - -! upwp = -elq*sm(k)*dudz -! vpwp = -elq*sm(k)*dvdz -! Tpwp = -elq*sh(k)*dTdz -! Tpwp = SIGN(MAX(ABS(Tpwp),1.E-6),Tpwp) - - -!! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - - !!!Shear Term - !!!qSHEAR1D(k)=-(upwp*dudz + vpwp*dvdz) - qSHEAR1D(k) = elq*sm(k)*gm(k) !staggered - - !!!Buoyancy Term - !!!qBUOY1D(k)=grav*Tpwp/thl(k) - !qBUOY1D(k)= elq*(sh(k)*gh(k) + gamv) - !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 - - !!!Dissipation Term (now it evaluated on mym_predict) - !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE - - !! >> EOB - ENDIF - - END DO -! - - dfm(kts) = 0.0 - dfh(kts) = 0.0 - dfq(kts) = 0.0 - tcd(kts) = 0.0 - qcd(kts) = 0.0 - - tcd(kte) = 0.0 - qcd(kte) = 0.0 - -! - DO k = kts,kte-1 - dzk = dz(k) - tcd(k) = ( tcd(k+1)-tcd(k) )/( dzk ) - 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) - dfh(k)= dfh(k) + dfh(k)* rstoch_col(k) * 1.5 * MAX(exp(-MAX(zw(k)-8000.,0.0)/2000.),0.001) - END DO - endif - -! RETURN -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - - END SUBROUTINE mym_turbulence - -! ================================================================== -! SUBROUTINE mym_predict: -! -! Input variables: see subroutine mym_initialize and turbulence -! qke(nx,nz,ny) : qke at (n)th time level -! tsq, ...cov : ditto -! -! Output variables: -! qke(nx,nz,ny) : qke at (n+1)th time level -! tsq, ...cov : ditto -! -! Work arrays: -! qkw(nx,nz,ny) : q at the center of the grid boxes (m/s) -! bp (nx,nz,ny) : = 1/2*F, see below -! rp (nx,nz,ny) : = P-1/2*F*Q, see below -! -! # The equation for a turbulent quantity Q can be expressed as -! dQ/dt + Ah + Av = Dh + Dv + P - F*Q, (1) -! where A is the advection, D the diffusion, P the production, -! F*Q the dissipation and h and v denote horizontal and vertical, -! respectively. If Q is q^2, F is 2q/B_1L. -! Using the Crank-Nicholson scheme for Av, Dv and F*Q, a finite -! difference equation is written as -! Q{n+1} - Q{n} = dt *( Dh{n} - Ah{n} + P{n} ) -! + dt/2*( Dv{n} - Av{n} - F*Q{n} ) -! + dt/2*( Dv{n+1} - Av{n+1} - F*Q{n+1} ), (2) -! where n denotes the time level. -! When the advection and diffusion terms are discretized as -! dt/2*( Dv - Av ) = a(k)Q(k+1) - b(k)Q(k) + c(k)Q(k-1), (3) -! Eq.(2) can be rewritten as -! - a(k)Q(k+1) + [ 1 + b(k) + dt/2*F ]Q(k) - c(k)Q(k-1) -! = Q{n} + dt *( Dh{n} - Ah{n} + P{n} ) -! + dt/2*( Dv{n} - Av{n} - F*Q{n} ), (4) -! where Q on the left-hand side is at (n+1)th time level. -! -! In this subroutine, a(k), b(k) and c(k) are obtained from -! subprogram coefvu and are passed to subprogram tinteg via -! common. 1/2*F and P-1/2*F*Q are stored in bp and rp, -! respectively. Subprogram tinteg solves Eq.(4). -! -! Modify this subroutine according to your numerical integration -! scheme (program). -! -!------------------------------------------------------------------- -!>\ingroup gsd_mynn_edmf -!! This subroutine predicts the turbulent quantities at the next step. - SUBROUTINE mym_predict (kts,kte, & - & closure, & - & delt, & - & dz, & - & ust, flt, flq, pmz, phh, & - & el, dfq, rho, & - & pdk, pdt, pdq, pdc, & - & qke, tsq, qsq, cov, & - & s_aw,s_awqke,bl_mynn_edmf_tke, & - & qWT1D, qDISS1D,bl_mynn_tkebudget) !! TKE budget (Puhales, 2020) - -!------------------------------------------------------------------- - INTEGER, INTENT(IN) :: kts,kte - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - - REAL, INTENT(IN) :: closure - INTEGER, INTENT(IN) :: bl_mynn_edmf_tke - REAL, INTENT(IN) :: delt - REAL, DIMENSION(kts:kte), INTENT(IN) :: dz, dfq, el, rho - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: pdk, pdt, pdq, pdc - REAL, INTENT(IN) :: flt, flq, ust, pmz, phh - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: qke,tsq, qsq, cov -! WA 8/3/15 - REAL, DIMENSION(kts:kte+1), INTENT(INOUT) :: s_awqke,s_aw - - !! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qWT1D, qDISS1D - INTEGER, INTENT(IN) :: bl_mynn_tkebudget - REAL, DIMENSION(kts:kte) :: tke_up,dzinv - !! >> EOB - - INTEGER :: k - REAL, DIMENSION(kts:kte) :: qkw, bp, rp, df3q - REAL :: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff - REAL, DIMENSION(kts:kte) :: dtz - REAL, DIMENSION(kts:kte) :: a,b,c,d,x - - REAL, DIMENSION(kts:kte) :: rhoinv - REAL, 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 - onoff=0.0 - ELSE - onoff=1.0 - ENDIF - -! ** Strictly, vkz*h(i,j) -> karman*( 0.5*dz(1)*h(i,j)+z0 ) ** - vkz = karman*0.5*dz(kts) -! -! ** dfq for the TKE is 3.0*dfm. ** -! - DO k = kts,kte -!! qke(k) = MAX(qke(k), 0.0) - qkw(k) = SQRT( MAX( qke(k), 0.0 ) ) - df3q(k)=Sqfac*dfq(k) - dtz(k)=delt/dz(k) - END DO -! -!JOE-add conservation + stability criteria - !Prepare "constants" for diffusion equation. - !khdz = rho*Kh/dz = rho*dfh - rhoz(kts) =rho(kts) - rhoinv(kts)=1./rho(kts) - kqdz(kts) =rhoz(kts)*df3q(kts) - kmdz(kts) =rhoz(kts)*dfq(kts) - DO k=kts+1,kte - rhoz(k) =(rho(k)*dz(k-1) + rho(k-1)*dz(k))/(dz(k-1)+dz(k)) - rhoz(k) = MAX(rhoz(k),1E-4) - rhoinv(k)=1./MAX(rho(k),1E-4) - kqdz(k) = rhoz(k)*df3q(k) ! for TKE - kmdz(k) = rhoz(k)*dfq(k) ! for T'2, q'2, and T'q' - ENDDO - rhoz(kte+1)=rhoz(kte) - kqdz(kte+1)=rhoz(kte+1)*df3q(kte) - kmdz(kte+1)=rhoz(kte+1)*dfq(kte) - - !stability criteria for mf - DO k=kts+1,kte-1 - kqdz(k) = MAX(kqdz(k), 0.5* s_aw(k)) - kqdz(k) = MAX(kqdz(k), -0.5*(s_aw(k)-s_aw(k+1))) - 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 - - pdk1 = 2.0*ust**3*pmz/( vkz ) - phm = 2.0/ust *phh/( vkz ) - pdt1 = phm*flt**2 - 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) - -!! pdt(kts) = pdt1 -pdt(kts+1) -!! pdq(kts) = pdq1 -pdq(kts+1) -!! pdc(kts) = pdc1 -pdc(kts+1) - pdt(kts) = pdt(kts+1) - pdq(kts) = pdq(kts+1) - pdc(kts) = pdc(kts+1) -! -! ** Prediction of twice the turbulent kinetic energy ** -!! DO k = kts+1,kte-1 - DO k = kts,kte-1 - b1l = b1*0.5*( el(k+1)+el(k) ) - bp(k) = 2.*qkw(k) / b1l - rp(k) = pdk(k+1) + pdk(k) - END DO - -!! a(1)=0. -!! b(1)=1. -!! c(1)=-1. -!! d(1)=0. - -! Since df3q(kts)=0.0, a(1)=0.0 and b(1)=1.+dtz(k)*df3q(k+1)+bp(k)*delt. - DO k=kts,kte-1 -! a(k-kts+1)=-dtz(k)*df3q(k) -! b(k-kts+1)=1.+dtz(k)*(df3q(k)+df3q(k+1))+bp(k)*delt -! c(k-kts+1)=-dtz(k)*df3q(k+1) -! d(k-kts+1)=rp(k)*delt + qke(k) -! WA 8/3/15 add EDMF contribution -! a(k)= - dtz(k)*df3q(k) + 0.5*dtz(k)*s_aw(k)*onoff -! b(k)=1. + dtz(k)*(df3q(k)+df3q(k+1)) & -! + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1))*onoff + bp(k)*delt -! c(k)= - dtz(k)*df3q(k+1) - 0.5*dtz(k)*s_aw(k+1)*onoff -! d(k)=rp(k)*delt + qke(k) + dtz(k)*(s_awqke(k)-s_awqke(k+1))*onoff -!JOE 8/22/20 improve conservation - a(k)= - dtz(k)*kqdz(k)*rhoinv(k) & - & + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*onoff - b(k)=1. + dtz(k)*(kqdz(k)+kqdz(k+1))*rhoinv(k) & - & + 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*onoff & - & + bp(k)*delt - c(k)= - dtz(k)*kqdz(k+1)*rhoinv(k) & - & - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*onoff - d(k)=rp(k)*delt + qke(k) & - & + dtz(k)*rhoinv(k)*(s_awqke(k)-s_awqke(k+1))*onoff - ENDDO - -!! DO k=kts+1,kte-1 -!! a(k-kts+1)=-dtz(k)*df3q(k) -!! b(k-kts+1)=1.+dtz(k)*(df3q(k)+df3q(k+1)) -!! c(k-kts+1)=-dtz(k)*df3q(k+1) -!! d(k-kts+1)=rp(k)*delt + qke(k) - qke(k)*bp(k)*delt -!! ENDDO - -!! "no flux at top" -! a(kte)=-1. !0. -! b(kte)=1. -! c(kte)=0. -! d(kte)=0. -!! "prescribed value" - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=qke(kte) - -! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) - - DO k=kts,kte -! qke(k)=max(d(k-kts+1), 1.e-4) - qke(k)=max(x(k), 1.e-4) - qke(k)=min(qke(k), 150.) - ENDDO - - -!! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - IF (bl_mynn_tkebudget == 1) THEN - !! TKE Vertical transport << EOBvt - tke_up=0.5*qke - dzinv=1./dz - k=kts - qWT1D(k)=dzinv(k)*( & - & (kqdz(k+1)*(tke_up(k+1)-tke_up(k))-kqdz(k)*tke_up(k)) & - & + 0.5*rhoinv(k)*(s_aw(k+1)*tke_up(k+1) & - & + (s_aw(k+1)-s_aw(k))*tke_up(k) & - & + (s_awqke(k)-s_awqke(k+1)))*onoff) !unstaggered - DO k=kts+1,kte-1 - qWT1D(k)=dzinv(k)*( & - & (kqdz(k+1)*(tke_up(k+1)-tke_up(k))-kqdz(k)*(tke_up(k)-tke_up(k-1))) & - & + 0.5*rhoinv(k)*(s_aw(k+1)*tke_up(k+1) & - & + (s_aw(k+1)-s_aw(k))*tke_up(k) & - & - s_aw(k)*tke_up(k-1) & - & + (s_awqke(k)-s_awqke(k+1)))*onoff) !unstaggered - 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 - !! >> EOBvt - qDISS1D=bp*tke_up !! TKE dissipation rate !unstaggered - END IF -!! >> EOB - - IF ( closure > 2.5 ) THEN - - ! ** Prediction of the moisture variance ** - DO k = kts,kte-1 - b2l = b2*0.5*( el(k+1)+el(k) ) - bp(k) = 2.*qkw(k) / b2l - rp(k) = pdq(k+1) + pdq(k) - END DO - - !zero gradient for qsq at bottom and top - !a(1)=0. - !b(1)=1. - !c(1)=-1. - !d(1)=0. - - ! Since dfq(kts)=0.0, a(1)=0.0 and b(1)=1.+dtz(k)*dfq(k+1)+bp(k)*delt. - DO k=kts,kte-1 - a(k)= - dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1. + dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + bp(k)*delt - c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) - d(k)=rp(k)*delt + qsq(k) - ENDDO - - a(kte)=-1. !0. - b(kte)=1. - c(kte)=0. - d(kte)=0. - -! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) - - DO k=kts,kte - !qsq(k)=d(k-kts+1) - qsq(k)=MAX(x(k),1e-12) - ENDDO - ELSE - !level 2.5 - use level 2 diagnostic - DO k = kts,kte-1 - IF ( qkw(k) .LE. 0.0 ) THEN - b2l = 0.0 - ELSE - b2l = b2*0.25*( el(k+1)+el(k) )/qkw(k) - END IF - qsq(k) = b2l*( pdq(k+1)+pdq(k) ) - END DO - qsq(kte)=qsq(kte-1) - END IF -!!!!!!!!!!!!!!!!!!!!!!end level 2.6 - - IF ( closure .GE. 3.0 ) THEN -! -! ** dfq for the scalar variance is 1.0*dfm. ** -! -! ** Prediction of the temperature variance ** -!! DO k = kts+1,kte-1 - DO k = kts,kte-1 - b2l = b2*0.5*( el(k+1)+el(k) ) - bp(k) = 2.*qkw(k) / b2l - rp(k) = pdt(k+1) + pdt(k) - END DO - -!zero gradient for tsq at bottom and top - -!! a(1)=0. -!! b(1)=1. -!! c(1)=-1. -!! d(1)=0. - -! Since dfq(kts)=0.0, a(1)=0.0 and b(1)=1.+dtz(k)*dfq(k+1)+bp(k)*delt. - DO k=kts,kte-1 - !a(k-kts+1)=-dtz(k)*dfq(k) - !b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1))+bp(k)*delt - !c(k-kts+1)=-dtz(k)*dfq(k+1) - !d(k-kts+1)=rp(k)*delt + tsq(k) -!JOE 8/22/20 improve conservation - a(k)= - dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1. + dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + bp(k)*delt - c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) - d(k)=rp(k)*delt + tsq(k) - ENDDO - -!! DO k=kts+1,kte-1 -!! a(k-kts+1)=-dtz(k)*dfq(k) -!! b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1)) -!! c(k-kts+1)=-dtz(k)*dfq(k+1) -!! d(k-kts+1)=rp(k)*delt + tsq(k) - tsq(k)*bp(k)*delt -!! ENDDO - - a(kte)=-1. !0. - b(kte)=1. - c(kte)=0. - d(kte)=0. - -! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) - - DO k=kts,kte -! tsq(k)=d(k-kts+1) - tsq(k)=x(k) - ENDDO - -! ** Prediction of the temperature-moisture covariance ** -!! DO k = kts+1,kte-1 - DO k = kts,kte-1 - b2l = b2*0.5*( el(k+1)+el(k) ) - bp(k) = 2.*qkw(k) / b2l - rp(k) = pdc(k+1) + pdc(k) - END DO - -!zero gradient for tqcov at bottom and top - -!! a(1)=0. -!! b(1)=1. -!! c(1)=-1. -!! d(1)=0. - -! Since dfq(kts)=0.0, a(1)=0.0 and b(1)=1.+dtz(k)*dfq(k+1)+bp(k)*delt. - DO k=kts,kte-1 - !a(k-kts+1)=-dtz(k)*dfq(k) - !b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1))+bp(k)*delt - !c(k-kts+1)=-dtz(k)*dfq(k+1) - !d(k-kts+1)=rp(k)*delt + cov(k) -!JOE 8/22/20 improve conservation - a(k)= - dtz(k)*kmdz(k)*rhoinv(k) - b(k)=1. + dtz(k)*(kmdz(k)+kmdz(k+1))*rhoinv(k) + bp(k)*delt - c(k)= - dtz(k)*kmdz(k+1)*rhoinv(k) - d(k)=rp(k)*delt + cov(k) - ENDDO - -!! DO k=kts+1,kte-1 -!! a(k-kts+1)=-dtz(k)*dfq(k) -!! b(k-kts+1)=1.+dtz(k)*(dfq(k)+dfq(k+1)) -!! c(k-kts+1)=-dtz(k)*dfq(k+1) -!! d(k-kts+1)=rp(k)*delt + cov(k) - cov(k)*bp(k)*delt -!! ENDDO - - a(kte)=-1. !0. - b(kte)=1. - c(kte)=0. - d(kte)=0. - -! CALL tridiag(kte,a,b,c,d) - CALL tridiag2(kte,a,b,c,d,x) - - DO k=kts,kte -! cov(k)=d(k-kts+1) - cov(k)=x(k) - ENDDO - - ELSE - - !Not level 3 - default to level 2 diagnostic - DO k = kts,kte-1 - IF ( qkw(k) .LE. 0.0 ) THEN - b2l = 0.0 - ELSE - b2l = b2*0.25*( el(k+1)+el(k) )/qkw(k) - END IF -! - tsq(k) = b2l*( pdt(k+1)+pdt(k) ) - cov(k) = b2l*( pdc(k+1)+pdc(k) ) - END DO - - tsq(kte)=tsq(kte-1) - cov(kte)=cov(kte-1) - - END IF - -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - - END SUBROUTINE mym_predict - -! ================================================================== -! SUBROUTINE mym_condensation: -! -! Input variables: see subroutine mym_initialize and turbulence -! exner(nz) : Perturbation of the Exner function (J/kg K) -! defined on the walls of the grid boxes -! This is usually computed by integrating -! d(pi)/dz = h*g*tv/tref**2 -! from the upper boundary, where tv is the -! virtual potential temperature minus tref. -! -! Output variables: see subroutine mym_initialize -! cld(nx,nz,ny) : Cloud fraction -! -! Work arrays: -! qmq(nx,nz,ny) : Q_w-Q_{sl}, where Q_{sl} is the saturation -! specific humidity at T=Tl -! alp(nx,nz,ny) : Functions in the condensation process -! bet(nx,nz,ny) : ditto -! sgm(nx,nz,ny) : Combined standard deviation sigma_s -! multiplied by 2/alp -! -! # qmq, alp, bet and sgm are allowed to share storage units with -! any four of other work arrays for saving memory. -! -! # Results are sensitive particularly to values of cp and r_d. -! Set these values to those adopted by you. -! -!------------------------------------------------------------------- -!>\ingroup gsd_mynn_edmf -!! This subroutine calculates the nonconvective component of the -!! subgrid cloud fraction and mixing ratio as well as the functions used to -!! calculate the buoyancy flux. Different cloud PDFs can be selected by -!! use of the namelist parameter \p bl_mynn_cloudpdf . - SUBROUTINE mym_condensation (kts,kte, & - & dx, dz, zw, & - & thl, qw, qv, qc, qi, & - & p,exner, & - & tsq, qsq, cov, & - & Sh, el, bl_mynn_cloudpdf,& - & qc_bl1D, qi_bl1D, & - & cldfra_bl1D, & - & PBLH1,HFX1, & - & Vt, Vq, th, sgm, rmo, & - & spp_pbl,rstoch_col ) - -!------------------------------------------------------------------- - - INTEGER, INTENT(IN) :: kts,kte, bl_mynn_cloudpdf - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - - REAL, INTENT(IN) :: dx,PBLH1,HFX1,rmo - REAL, DIMENSION(kts:kte), INTENT(IN) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw - REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw,qv,qc,qi, & - &tsq, qsq, cov, th - - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm - - REAL, DIMENSION(kts:kte) :: qmq,alp,a,bet,b,ql,q1,RH - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & - cldfra_bl1D - DOUBLE PRECISION :: t3sq, r3sq, c3sq - - REAL :: qsl,esat,qsat,tlk,qsat_tl,dqsl,cld0,q1k,qlk,eq1,qll,& - &q2p,pt,rac,qt,t,xl,rsl,cpm,cdhdz,Fng,qww,alpha,beta,bb,& - &ls_min,ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water,& - &low_weight - INTEGER :: i,j,k - - REAL :: erf - - !VARIABLES FOR ALTERNATIVE SIGMA - REAL::dth,dtl,dqw,dzk,els - REAL, DIMENSION(kts:kte), INTENT(IN) :: Sh,el - - !variables for SGS BL clouds - REAL :: zagl,damp,PBLH2 - REAL :: lfac - INTEGER, PARAMETER :: sig_order = 2 !sigma form, 1: use state variables, 2: higher-order variables - - !JAYMES: variables for tropopause-height estimation - REAL :: theta1, theta2, ht1, ht2 - INTEGER :: k_tropo - -! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col - REAL :: qw_pert - -! First, obtain an estimate for the tropopause height (k), using the method employed in the -! Thompson subgrid-cloud scheme. This height will be a consideration later when determining -! the "final" subgrid-cloud properties. -! JAYMES: added 3 Nov 2016, adapted from G. Thompson - - DO k = kte-3, kts, -1 - theta1 = th(k) - theta2 = th(k+2) - ht1 = 44307.692 * (1.0 - (p(k)/101325.)**0.190) - ht2 = 44307.692 * (1.0 - (p(k+2)/101325.)**0.190) - if ( (((theta2-theta1)/(ht2-ht1)) .lt. 10./1500. ) .AND. & - & (ht1.lt.19000.) .and. (ht1.gt.4000.) ) then - goto 86 - endif - ENDDO - 86 continue - k_tropo = MAX(kts+2, k+2) - - zagl = 0. - - SELECT CASE(bl_mynn_cloudpdf) - - CASE (0) ! ORIGINAL MYNN PARTIAL-CONDENSATION SCHEME - - DO k = kts,kte-1 - t = th(k)*exner(k) - -!x if ( ct .gt. 0.0 ) then -! a = 17.27 -! b = 237.3 -!x else -!x a = 21.87 -!x b = 265.5 -!x end if -! -! ** 3.8 = 0.622*6.11 (hPa) ** - - !SATURATED VAPOR PRESSURE - esat = esat_blend(t) - !SATURATED SPECIFIC HUMIDITY - !qsl=ep_2*esat/(p(k)-ep_3*esat) - qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) - !dqw/dT: Clausius-Clapeyron - dqsl = qsl*ep_2*xlv/( r_d*t**2 ) - - alp(k) = 1.0/( 1.0+dqsl*xlvcp ) - bet(k) = dqsl*exner(k) - - !Sommeria and Deardorff (1977) scheme, as implemented - !in Nakanishi and Niino (2009), Appendix B - t3sq = MAX( tsq(k), 0.0 ) - r3sq = MAX( qsq(k), 0.0 ) - c3sq = cov(k) - c3sq = SIGN( MIN( ABS(c3sq), SQRT(t3sq*r3sq) ), c3sq ) - r3sq = r3sq +bet(k)**2*t3sq -2.0*bet(k)*c3sq - !DEFICIT/EXCESS WATER CONTENT - qmq(k) = qw(k) -qsl - !ORIGINAL STANDARD DEVIATION - sgm(k) = SQRT( MAX( r3sq, 1.0d-10 )) - !NORMALIZED DEPARTURE FROM SATURATION - q1(k) = qmq(k) / sgm(k) - !CLOUD FRACTION. rr2 = 1/SQRT(2) = 0.707 - cldfra_bl1D(k) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) - - q1k = q1(k) - eq1 = rrp*EXP( -0.5*q1k*q1k ) - qll = MAX( cldfra_bl1D(k)*q1k + eq1, 0.0 ) - !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) - ql(k) = alp(k)*sgm(k)*qll - !LIMIT SPECIES TO TEMPERATURE RANGES - liq_frac = min(1.0, max(0.0,(t-240.0)/29.0)) - qc_bl1D(k) = liq_frac*ql(k) - qi_bl1D(k) = (1.0 - liq_frac)*ql(k) - - if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 - if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 - - !Now estimate the buoyancy flux functions - q2p = xlvcp/exner(k) - pt = thl(k) +q2p*ql(k) ! potential temp - - !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) - qt = 1.0 +p608*qw(k) -(1.+p608)*(qc_bl1D(k)+qi_bl1D(k))*cldfra_bl1D(k) - rac = alp(k)*( cldfra_bl1D(K)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) - - !BUOYANCY FACTORS: wherever vt and vq are used, there is a - !"+1" and "+tv0", respectively, so these are subtracted out here. - !vt is unitless and vq has units of K. - vt(k) = qt-1.0 -rac*bet(k) - vq(k) = p608*pt-tv0 +rac - - END DO - - CASE (1, -1) !ALTERNATIVE FORM (Nakanishi & Niino 2004 BLM, eq. B6, and - !Kuwano-Yoshida et al. 2010 QJRMS, eq. 7): - DO k = kts,kte-1 - t = th(k)*exner(k) - !SATURATED VAPOR PRESSURE - esat = esat_blend(t) - !SATURATED SPECIFIC HUMIDITY - !qsl=ep_2*esat/(p(k)-ep_3*esat) - qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) - !dqw/dT: Clausius-Clapeyron - dqsl = qsl*ep_2*xlv/( r_d*t**2 ) - - alp(k) = 1.0/( 1.0+dqsl*xlvcp ) - bet(k) = dqsl*exner(k) - - if (k .eq. kts) then - dzk = 0.5*dz(k) - else - dzk = dz(k) - end if - dth = 0.5*(thl(k+1)+thl(k)) - 0.5*(thl(k)+thl(MAX(k-1,kts))) - dqw = 0.5*(qw(k+1) + qw(k)) - 0.5*(qw(k) + qw(MAX(k-1,kts))) - sgm(k) = SQRT( MAX( (alp(k)**2 * MAX(el(k)**2,0.1) * & - b2 * MAX(Sh(k),0.03))/4. * & - (dqw/dzk - bet(k)*(dth/dzk ))**2 , 1.0e-10) ) - qmq(k) = qw(k) -qsl - q1(k) = qmq(k) / sgm(k) - cldfra_bl1D(K) = 0.5*( 1.0+erf( q1(k)*rr2 ) ) - - !now compute estimated lwc for PBL scheme's use - !qll IS THE NORMALIZED LIQUID WATER CONTENT (Sommeria and - !Deardorff (1977, eq 29a). rrp = 1/(sqrt(2*pi)) = 0.3989 - q1k = q1(k) - eq1 = rrp*EXP( -0.5*q1k*q1k ) - qll = MAX( cldfra_bl1D(K)*q1k + eq1, 0.0 ) - !ESTIMATED LIQUID WATER CONTENT (UNNORMALIZED) - ql (k) = alp(k)*sgm(k)*qll - liq_frac = min(1.0, max(0.0,(t-240.0)/29.0)) - qc_bl1D(k) = liq_frac*ql(k) - qi_bl1D(k) = (1.0 - liq_frac)*ql(k) - - if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 - if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 - - !Now estimate the buoyancy flux functions - q2p = xlvcp/exner(k) - pt = thl(k) +q2p*ql(k) ! potential temp - - !qt is a THETA-V CONVERSION FOR TOTAL WATER (i.e., THETA-V = qt*THETA) - qt = 1.0 +p608*qw(k) -(1.+p608)*(qc_bl1D(k)+qi_bl1D(k))*cldfra_bl1D(k) - rac = alp(k)*( cldfra_bl1D(K)-qll*eq1 )*( q2p*qt-(1.+p608)*pt ) - - !BUOYANCY FACTORS: wherever vt and vq are used, there is a - !"+1" and "+tv0", respectively, so these are subtracted out here. - !vt is unitless and vq has units of K. - vt(k) = qt-1.0 -rac*bet(k) - vq(k) = p608*pt-tv0 +rac - - END DO - - CASE (2, -2) - - if (sig_order == 1) then - !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS - !using the first-order version of sigma (their eq. 5). - !JAYMES- this added 27 Apr 2015 - PBLH2=MAX(10.,PBLH1) - zagl = 0. - DO k = kts,kte-1 - t = th(k)*exner(k) - !SATURATED VAPOR PRESSURE - esat = esat_blend(t) - !SATURATED SPECIFIC HUMIDITY - !qsl=ep_2*esat/(p(k)-ep_3*esat) - qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) - !dqw/dT: Clausius-Clapeyron - dqsl = qsl*ep_2*xlv/( r_d*t**2 ) - !RH (0 to 1.0) - RH(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsl)),0.001) - - alp(k) = 1.0/( 1.0+dqsl*xlvcp ) - bet(k) = dqsl*exner(k) - - xl = xl_blend(t) ! obtain latent heat - tlk = thl(k)*(p(k)/p1000mb)**rcp ! recover liquid temp (tl) from thl - qsat_tl = qsat_blend(tlk,p(k)) ! get saturation water vapor mixing ratio - ! at tl and p - rsl = xl*qsat_tl / (r_v*tlk**2) ! slope of C-C curve at t = tl - ! CB02, Eqn. 4 - cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 - a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - !SPP - qw_pert = qw(k) + qw(k)*0.5*rstoch_col(k)*real(spp_pbl) - !qmq(k) = a(k) * (qw(k) - qsat_tl) ! saturation deficit/excess; - ! the numerator of Q1 - qmq(k) = a(k) * (qw_pert - qsat_tl) - b(k) = a(k)*rsl ! CB02 variable "b" - - dtl = 0.5*(thl(k+1)*(p(k+1)/p1000mb)**rcp + tlk) & - & - 0.5*(tlk + thl(MAX(k-1,kts))*(p(MAX(k-1,kts))/p1000mb)**rcp) - dqw = 0.5*(qw(k+1) + qw(k)) - 0.5*(qw(k) + qw(MAX(k-1,kts))) - - if (k .eq. kts) then - dzk = 0.5*dz(k) - else - dzk = dz(k) - end if - - cdhdz = dtl/dzk + (grav/cpm)*(1.+qw(k)) ! expression below Eq. 9 - ! in CB02 - zagl = zagl + dz(k) - !Use analog to surface layer length scale to make the cloud mixing length scale - !become less than z in stable conditions. - els = zagl !save for more testing: /(1.0 + 1.0*MIN( 0.5*dz(1)*MAX(rmo,0.0), 1. )) - - !ls_min = 300. + MIN(3.*MAX(HFX1,0.),300.) - ls_min = 300. + MIN(2.*MAX(HFX1,0.),150.) - ls_min = MIN(MAX(els,25.),ls_min) ! Let this be the minimum possible length scale: - if (zagl > PBLH1+2000.) ls_min = MAX(ls_min + 0.5*(PBLH1+2000.-zagl),300.) - ! 25 m < ls_min(=zagl) < 300 m - lfac=MIN(4.25+dx/4000.,6.) ! A dx-dependent multiplier for the master length scale: - ! lfac(750 m) = 4.4 - ! lfac(3 km) = 5.0 - ! lfac(13 km) = 6.0 - ls = MAX(MIN(lfac*el(k),600.),ls_min) ! Bounded: ls_min < ls < 600 m - ! Note: CB02 use 900 m as a constant free-atmosphere length scale. - - ! Above 300 m AGL, ls_min remains 300 m. For dx = 3 km, the - ! MYNN master length scale (el) must exceed 60 m before ls - ! becomes responsive to el, otherwise ls = ls_min = 300 m. - - sgm(k) = MAX(1.e-10, 0.225*ls*SQRT(MAX(0., & ! Eq. 9 in CB02: - & (a(k)*dqw/dzk)**2 & ! < 1st term in brackets, - & -2*a(k)*b(k)*cdhdz*dqw/dzk & ! < 2nd term, - & +b(k)**2 * cdhdz**2))) ! < 3rd term - ! CB02 use a multiplier of 0.2, but 0.225 is chosen - ! based on tests - - q1(k) = qmq(k) / sgm(k) ! Q1, the normalized saturation - cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 - END DO - - else - - !Diagnostic statistical scheme of Chaboureau and Bechtold (2002), JAS - !but with use of higher-order moments to estimate sigma - PBLH2=MAX(10.,PBLH1) - zagl = 0. - DO k = kts,kte-1 - t = th(k)*exner(k) - !SATURATED VAPOR PRESSURE - esat = esat_blend(t) - !SATURATED SPECIFIC HUMIDITY - !qsl=ep_2*esat/(p(k)-ep_3*esat) - qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) - !dqw/dT: Clausius-Clapeyron - dqsl = qsl*ep_2*xlv/( r_d*t**2 ) - !RH (0 to 1.0) - RH(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsl)),0.001) - - alp(k) = 1.0/( 1.0+dqsl*xlvcp ) - bet(k) = dqsl*exner(k) - - xl = xl_blend(t) ! obtain latent heat - tlk = thl(k)*(p(k)/p1000mb)**rcp ! recover liquid temp (tl) from thl - qsat_tl = qsat_blend(tlk,p(k)) ! get saturation water vapor mixing ratio - ! at tl and p - rsl = xl*qsat_tl / (r_v*tlk**2) ! slope of C-C curve at t = tl - ! CB02, Eqn. 4 - cpm = cp + qw(k)*cpv ! CB02, sec. 2, para. 1 - a(k) = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - b(k) = a(k)*rsl ! CB02 variable "b" - - !SPP - 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(k) = qw_pert - qsat_tl ! saturation deficit/excess; - - !Use the form of Eq. (6) in Chaboureau and Bechtold (2002) - !except neglect all but the first term for sig_r - 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 - sgm(k) = MIN( sgm(k), qsat_tl*0.666 ) !500 ) - sgm(k) = MAX( sgm(k), qsat_tl*0.050 ) !Note: 0.02 results in SWDOWN similar - !to the first-order version of sigma - q1(k) = qmq(k) / sgm(k) ! Q1, the normalized saturation - - !Original C-B cloud fraction, allows cloud fractions out to q1 = -3.5 - cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.36*ATAN(1.55*q1(k)))) ! Eq. 7 in CB02 - !This form only allows cloud fractions out to q1 = -1.8 - !cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.41*ATAN(1.55*q1(k)))) - !This form only allows cloud fractions out to q1 = -1 - !cldfra_bl1D(K) = MAX(0., MIN(1., 0.5+0.50*ATAN(1.55*q1(k)))) - - END DO - - endif !end sig_order option - - ! Specify hydrometeors - ! JAYMES- this option added 8 May 2015 - ! The cloud water formulations are taken from CB02, Eq. 8. - ! "fng" represents the non-Gaussian contribution to the liquid - ! water flux; these formulations are from Cuijpers and Bechtold - ! (1995), Eq. 7. CB95 also draws from Bechtold et al. 1995, - ! hereafter BCMT95 - zagl = 0. - DO k = kts,kte-1 - t = th(k)*exner(k) - q1k = q1(k) - zagl = zagl + dz(k) - - !CLOUD WATER AND ICE - IF (q1k < 0.) THEN !unsaturated - ql_water = sgm(k)*EXP(1.2*q1k-1) - ql_ice = sgm(k)*EXP(1.2*q1k-1.) - !Reduce ice mixing ratios in the upper troposphere -! low_weight = MIN(MAX(p(k)-40000.0, 0.0),40000.0)/40000.0 -! ql_ice = low_weight * sgm(k)*EXP(1.1*q1k-1.6) & !low-lev -! + (1.-low_weight) * sgm(k)*EXP(1.1*q1k-2.8)!upper-lev - ELSE IF (q1k > 2.) THEN !supersaturated - ql_water = sgm(k)*q1k - ql_ice = sgm(k)*q1k - !ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*q1k - ELSE !slightly saturated (0 > q1 < 2) - ql_water = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ql_ice = sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - !ql_ice = MIN(80.*qv(k),0.1)*sgm(k)*(EXP(-1.) + 0.66*q1k + 0.086*q1k**2) - ENDIF - - !In saturated grid cells, use average of current estimate and prev time step - IF ( qc(k) > 1.e-7 ) ql_water = 0.5 * ( ql_water + qc(k) ) - IF ( qi(k) > 1.e-9 ) ql_ice = 0.5 * ( ql_ice + qi(k) ) - - IF (cldfra_bl1D(k) < 0.01) THEN - ql_ice = 0.0 - ql_water = 0.0 - cldfra_bl1D(k) = 0.0 - ENDIF - - !PHASE PARTITIONING: Make some inferences about the relative amounts of - !subgrid cloud water vs. ice based on collocated explicit clouds. Otherise, - !use a simple temperature-dependent partitioning. - IF ( qc(k) + qi(k) > 0.0 ) THEN ! explicit condensate exists, retain its phase partitioning - IF ( qi(k) == 0.0 ) THEN ! explicit contains no ice; assume subgrid liquid - liq_frac = 1.0 - ELSE IF ( qc(k) == 0.0 ) THEN ! explicit contains no liquid; assume subgrid ice - liq_frac = 0.0 - ELSE IF ( (qc(k) >= 1.E-10) .AND. (qi(k) >= 1.E-10) ) THEN ! explicit contains mixed phase of workably - ! large amounts; assume subgrid follows - ! same partioning - liq_frac = qc(k) / ( qc(k) + qi(k) ) - ELSE - liq_frac = MIN(1.0, MAX(0.0, (t-238.)/31.)) ! explicit contains mixed phase, but at least one - ! species is very small, so make a temperature- - ! depedent guess - ENDIF - ELSE ! no explicit condensate, so make a temperature-dependent guess - liq_frac = MIN(1.0, MAX(0.0, (t-238.)/31.)) - ENDIF - - qc_bl1D(k) = liq_frac*ql_water ! apply liq_frac to ql_water and ql_ice - qi_bl1D(k) = (1.0-liq_frac)*ql_ice - - !Above tropopause: eliminate subgrid clouds from CB scheme - if (k .ge. k_tropo-1) then - cldfra_bl1D(K) = 0. - qc_bl1D(k) = 0. - qi_bl1D(k) = 0. - endif - ENDDO - - !Buoyancy-flux-related calculations follow... - DO k = kts,kte-1 - t = th(k)*exner(k) - - ! "Fng" represents the non-Gaussian transport factor - ! (non-dimensional) from Bechtold et al. 1995 - ! (hereafter BCMT95), section 3(c). Their suggested - ! forms for Fng (from their Eq. 20) are: - !IF (q1k < -2.) THEN - ! Fng = 2.-q1k - !ELSE IF (q1k > 0.) THEN - ! Fng = 1. - !ELSE - ! Fng = 1.-1.5*q1k - !ENDIF - !limiting to avoid mixing away stratus, was -5 - q1k=MAX(Q1(k),-1.0) - 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 - Fng = MIN(Fng, 20.) - - xl = xl_blend(t) - bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from - ! "b" in CB02 (i.e., b(k) above) by a factor - ! of T/theta. Strictly, b(k) above is formulated in - ! terms of sat. mixing ratio, but bb in BCMT95 is - ! cast in terms of sat. specific humidity. The - ! conversion is neglected here. - qww = 1.+0.61*qw(k) - alpha = 0.61*th(k) - beta = (th(k)/t)*(xl/cp) - 1.61*th(k) - vt(k) = qww - MIN(cldfra_bl1D(K),0.5)*beta*bb*Fng - 1. - vq(k) = alpha + MIN(cldfra_bl1D(K),0.5)*beta*a(k)*Fng - tv0 - ! vt and vq correspond to beta-theta and beta-q, respectively, - ! in NN09, Eq. B8. They also correspond to the bracketed - ! expressions in BCMT95, Eq. 15, since (s*ql/sigma^2) = cldfra*Fng - ! The "-1" and "-tv0" terms are included for consistency with - ! the legacy vt and vq formulations (above). - - ! dampen the amplification factor (cld_factor) with height in order - ! to limit excessively large cloud fractions aloft - fac_damp = 1. -MIN(MAX( zagl-(PBLH2+1000.),0.0)/ & - MAX((zw(k_tropo)-(PBLH2+1000.)),500.), 1.) - !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.5 ) / 0.51 )**3.3 - cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 - cldfra_bl1D(K) = MIN( 1., cld_factor*cldfra_bl1D(K) ) - ENDDO - - END SELECT !end cloudPDF option - - !FOR TESTING PURPOSES ONLY, ISOLATE ON THE MASS-CLOUDS. - IF (bl_mynn_cloudpdf .LT. 0) THEN - DO k = kts,kte-1 - cldfra_bl1D(k) = 0.0 - qc_bl1D(k) = 0.0 - qi_bl1D(k) = 0.0 - END DO - ENDIF -! - ql(kte) = ql(kte-1) - vt(kte) = vt(kte-1) - vq(kte) = vq(kte-1) - qc_bl1D(kte)=0. - qi_bl1D(kte)=0. - cldfra_bl1D(kte)=0. - RETURN - -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - - END SUBROUTINE mym_condensation - -! ================================================================== -!>\ingroup gsd_mynn_edmf -!! This subroutine solves for tendencies of U, V, \f$\theta\f$, qv, -!! qc, and qi - SUBROUTINE mynn_tendencies(kts,kte,i, & - &closure, & - &delt,dz,rho, & - &u,v,th,tk,qv,qc,qi,qnc,qni, & - &psfc,p,exner, & - &thl,sqv,sqc,sqi,sqw, & - &qnwfa,qnifa,ozone, & - &ust,flt,flq,flqv,flqc,wspd, & - &uoce,voce, & - &tsq,qsq,cov, & - &tcd,qcd, & - &dfm,dfh,dfq, & - &Du,Dv,Dth,Dqv,Dqc,Dqi,Dqnc,Dqni, & - &Dqnwfa,Dqnifa,Dozone, & - &vdfg1,diss_heat, & - &s_aw,s_awthl,s_awqt,s_awqv,s_awqc, & - &s_awu,s_awv, & - &s_awqnc,s_awqni, & - &s_awqnwfa,s_awqnifa, & - &sd_aw,sd_awthl,sd_awqt,sd_awqv, & - &sd_awqc,sd_awu,sd_awv, & - &sub_thl,sub_sqv, & - &sub_u,sub_v, & - &det_thl,det_sqv,det_sqc, & - &det_u,det_v, & - &FLAG_QC,FLAG_QI,FLAG_QNC,FLAG_QNI, & - &FLAG_QNWFA,FLAG_QNIFA, & - &cldfra_bl1d, & - &bl_mynn_cloudmix, & - &bl_mynn_mixqt, & - &bl_mynn_edmf, & - &bl_mynn_edmf_mom, & - &bl_mynn_mixscalars ) - -!------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - - REAL, INTENT(in) :: closure - 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_QNC,& - FLAG_QNWFA,FLAG_QNIFA - -! thl - liquid water potential temperature -! qw - total water -! dfm,dfh,dfq - diffusivities i.e., dfh(k) = elq*sh(k) / dzk -! flt - surface flux of thl -! flq - surface flux of qw - -! mass-flux plumes - REAL, DIMENSION(kts:kte+1), INTENT(in) :: s_aw,s_awthl,s_awqt,& - &s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & - &s_awqnwfa,s_awqnifa, & - &sd_aw,sd_awthl,sd_awqt,sd_awqv,sd_awqc,sd_awu,sd_awv -! tendencies from mass-flux environmental subsidence and detrainment - REAL, DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & - &sub_u,sub_v,det_thl,det_sqv,det_sqc,det_u,det_v - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,qni,qnc,& - &rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd,cldfra_bl1d,diss_heat - REAL, DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,sqi,& - &qnwfa,qnifa,ozone,dfm,dfh - REAL, DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv,dqc,dqi,& - &dqni,dqnc,dqnwfa,dqnifa,dozone - REAL, INTENT(IN) :: delt,ust,flt,flq,flqv,flqc,wspd,uoce,voce,& - &psfc - !debugging - REAL ::wsp,wsp2 - LOGICAL :: problem - integer :: kproblem - -! REAL, INTENT(IN) :: gradu_top,gradv_top,gradth_top,gradqv_top - -!local vars - - REAL, DIMENSION(kts:kte) :: dtz,dfhc,dfmc,delp - REAL, DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqw2,qni2,qnc2, & !AFTER MIXING - qnwfa2,qnifa2,ozone2 - REAL, DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv - REAL, DIMENSION(kts:kte) :: a,b,c,d,x - REAL, DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface - & khdz, kmdz - REAL :: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw - REAL :: vdfg1 !Katata-fogdes - REAL :: t,esat,qsl,onoff,kh,km,dzk,rhosfc - REAL :: ustdrag,ustdiff,qvflux - REAL :: th_new,portion_qc,portion_qi,condensate,qsat - INTEGER :: k,kk - - !Activate nonlocal mixing from the mass-flux scheme for - !number concentrations and aerosols (0.0 = no; 1.0 = yes) - REAL, PARAMETER :: nonloc = 1.0 - - dztop=.5*(dz(kte)+dz(kte-1)) - - ! REGULATE THE MOMENTUM MIXING FROM THE MASS-FLUX SCHEME (on or off) - ! Note that s_awu and s_awv already come in as 0.0 if bl_mynn_edmf_mom == 0, so - ! we only need to zero-out the MF term - IF (bl_mynn_edmf_mom == 0) THEN - onoff=0.0 - ELSE - onoff=1.0 - ENDIF - - !Prepare "constants" for diffusion equation. - !khdz = rho*Kh/dz = rho*dfh - rhosfc = psfc/(R_d*(tk(kts)+p608*qv(kts))) - dtz(kts) =delt/dz(kts) - rhoz(kts) =rho(kts) - rhoinv(kts)=1./rho(kts) - khdz(kts) =rhoz(kts)*dfh(kts) - kmdz(kts) =rhoz(kts)*dfm(kts) - delp(kts) = psfc - (p(kts+1)*dz(kts) + p(kts)*dz(kts+1))/(dz(kts)+dz(kts+1)) - DO k=kts+1,kte - dtz(k) =delt/dz(k) - rhoz(k) =(rho(k)*dz(k-1) + rho(k-1)*dz(k))/(dz(k-1)+dz(k)) - rhoz(k) = MAX(rhoz(k),1E-4) - rhoinv(k)=1./MAX(rho(k),1E-4) - dzk = 0.5 *( dz(k)+dz(k-1) ) - khdz(k) = rhoz(k)*dfh(k) - kmdz(k) = rhoz(k)*dfm(k) - ENDDO - DO k=kts+1,kte-1 - delp(k) = (p(k)*dz(k-1) + p(k-1)*dz(k))/(dz(k)+dz(k-1)) - & - (p(k+1)*dz(k) + p(k)*dz(k+1))/(dz(k)+dz(k+1)) - ENDDO - delp(kte) =delp(kte-1) - rhoz(kte+1)=rhoz(kte) - khdz(kte+1)=rhoz(kte+1)*dfh(kte) - kmdz(kte+1)=rhoz(kte+1)*dfm(kte) - - !stability criteria for mf - DO k=kts+1,kte-1 - khdz(k) = MAX(khdz(k), 0.5*s_aw(k)) - khdz(k) = MAX(khdz(k), -0.5*(s_aw(k)-s_aw(k+1))) - 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 - - ustdrag = MIN(ust*ust,0.99)/wspd ! limit at ~ 20 m/s - ustdiff = MIN(ust*ust,0.01)/wspd ! limit at ~ 2 m/s - dth(kts:kte) = 0.0 ! must initialize for moisture_check routine - -!!============================================ -!! u -!!============================================ - - 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 - 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 - -!! no flux at the top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=0. - -!! specified gradient at the top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=gradu_top*dztop - -!! prescribed value - a(kte)=0 - b(kte)=1. - c(kte)=0. - d(kte)=u(kte) - -! CALL tridiag(kte,a,b,c,d) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte -! du(k)=(d(k-kts+1)-u(k))/delt - du(k)=(x(k)-u(k))/delt - ENDDO - -!!============================================ -!! v -!!============================================ - - 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 - -!! no flux at the top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=0. - -!! specified gradient at the top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=gradv_top*dztop - -!! prescribed value - a(kte)=0 - b(kte)=1. - c(kte)=0. - d(kte)=v(kte) - -! CALL tridiag(kte,a,b,c,d) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte -! dv(k)=(d(k-kts+1)-v(k))/delt - dv(k)=(x(k)-v(k))/delt - ENDDO - -!!============================================ -!! thl tendency -!!============================================ - k=kts - -! a(k)=0. -! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt & -! & -dtz(k)*s_awthl(kts+1) + diss_heat(k)*delt + & -! & sub_thl(k)*delt + det_thl(k)*delt -! -! DO k=kts+1,kte-1 -! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) -! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) -! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! d(k)=thl(k) + tcd(k)*delt + dtz(k)*(s_awthl(k)-s_awthl(k+1)) & -! & + diss_heat(k)*delt + & -! & sub_thl(k)*delt + det_thl(k)*delt -! ENDDO - -!rho-weighted: - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - d(k)=thl(k) + dtz(k)*flt + tcd(k)*delt - dtz(k)*rhoinv(k)*s_awthl(k+1) -dtz(k)*rhoinv(k)*sd_awthl(k+1) + & - & diss_heat(k)*delt + sub_thl(k)*delt + det_thl(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k) + 0.5*dtz(k)*rhoinv(k)*sd_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1)) + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - d(k)=thl(k) + tcd(k)*delt + & - & dtz(k)*rhoinv(k)*(s_awthl(k)-s_awthl(k+1)) + dtz(k)*rhoinv(k)*(sd_awthl(k)-sd_awthl(k+1)) + & - & diss_heat(k)*delt + & - & sub_thl(k)*delt + det_thl(k)*delt - ENDDO - -!! no flux at the top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=0. - -!! specified gradient at the top -!assume gradthl_top=gradth_top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=gradth_top*dztop - -!! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=thl(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte - !thl(k)=d(k-kts+1) - thl(k)=x(k) - ENDDO - -IF (bl_mynn_mixqt > 0) THEN - !============================================ - ! MIX total water (sqw = sqc + sqv + sqi) - ! NOTE: no total water tendency is output; instead, we must calculate - ! the saturation specific humidity and then - ! subtract out the moisture excess (sqc & sqi) - !============================================ - - k=kts - -! a(k)=0. -! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! !rhs= qcd(k) !+ (gfluxp - gfluxm)/dz(k)& -! d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*s_awqt(k+1) -! -! DO k=kts+1,kte-1 -! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) -! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) -! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! d(k)=sqw(k) + qcd(k)*delt + dtz(k)*(s_awqt(k)-s_awqt(k+1)) -! ENDDO - -!rho-weighted: - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - d(k)=sqw(k) + dtz(k)*flq + qcd(k)*delt - dtz(k)*rhoinv(k)*s_awqt(k+1) - dtz(k)*rhoinv(k)*sd_awqt(k+1) - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k) + 0.5*dtz(k)*rhoinv(k)*sd_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1)) + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - d(k)=sqw(k) + qcd(k)*delt + dtz(k)*rhoinv(k)*(s_awqt(k)-s_awqt(k+1)) + dtz(k)*rhoinv(k)*(sd_awqt(k)-sd_awqt(k+1)) - ENDDO - -!! no flux at the top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=0. -!! specified gradient at the top -!assume gradqw_top=gradqv_top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=gradqv_top*dztop -!! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=sqw(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,sqw2) - CALL tridiag3(kte,a,b,c,d,sqw2) - -! DO k=kts,kte -! sqw2(k)=d(k-kts+1) -! ENDDO -ELSE - sqw2=sqw -ENDIF - -IF (bl_mynn_mixqt == 0) THEN -!============================================ -! cloud water ( sqc ). If mixing total water (bl_mynn_mixqt > 0), -! then sqc will be backed out of saturation check (below). -!============================================ - IF (bl_mynn_cloudmix > 0 .AND. FLAG_QC) THEN - - k=kts - -! a(k)=0. -! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt - & -! dtz(k)*s_awqc(k+1) + det_sqc(k)*delt -! -! DO k=kts+1,kte-1 -! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) -! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) -! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! d(k)=sqc(k) + qcd(k)*delt + dtz(k)*(s_awqc(k)-s_awqc(k+1)) + & -! det_sqc(k)*delt -! ENDDO - -!rho-weighted: - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - d(k)=sqc(k) + dtz(k)*flqc + qcd(k)*delt - dtz(k)*rhoinv(k)*s_awqc(k+1) - dtz(k)*rhoinv(k)*sd_awqc(k+1) + & - & det_sqc(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k) + 0.5*dtz(k)*rhoinv(k)*sd_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1)) + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - d(k)=sqc(k) + qcd(k)*delt + dtz(k)*rhoinv(k)*(s_awqc(k)-s_awqc(k+1)) + dtz(k)*rhoinv(k)*(sd_awqc(k)-sd_awqc(k+1)) + & - & det_sqc(k)*delt - ENDDO - -! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=sqc(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,sqc2) - CALL tridiag3(kte,a,b,c,d,sqc2) - -! DO k=kts,kte -! sqc2(k)=d(k-kts+1) -! ENDDO - ELSE - !If not mixing clouds, set "updated" array equal to original array - sqc2=sqc - ENDIF -ENDIF - -IF (bl_mynn_mixqt == 0) THEN - !============================================ - ! MIX WATER VAPOR ONLY ( sqv ). If mixing total water (bl_mynn_mixqt > 0), - ! then sqv will be backed out of saturation check (below). - !============================================ - - k=kts - -! a(k)=0. -! b(k)=1.+dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*s_awqv(k+1) + & -! & sub_sqv(k)*delt + det_sqv(k)*delt -! -! DO k=kts+1,kte-1 -! a(k)= -dtz(k)*dfh(k) + 0.5*dtz(k)*s_aw(k) -! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) + 0.5*dtz(k)*(s_aw(k)-s_aw(k+1)) -! c(k)= -dtz(k)*dfh(k+1) - 0.5*dtz(k)*s_aw(k+1) -! d(k)=sqv(k) + qcd(k)*delt + dtz(k)*(s_awqv(k)-s_awqv(k+1)) + & -! & sub_sqv(k)*delt + det_sqv(k)*delt -! ENDDO - -!test to limit unreasonably large negative fluxes: - qvflux = flqv - if (qvflux < 0.0) then - !do not flux out more than 80% of moisture in a single dt - !qvflux = max(qvflux, (-1.0*max(0.8*sqv(k),1e-8) /dtz(k))) - !do not allow flux to reduce sfc qv below 1e-8 kg/kg - qvflux = max(qvflux, (min(0.9*sqv(kts) - 1e-8, 0.0)/dtz(kts))) - endif -!rho-weighted: - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) -! d(k)=sqv(k) + dtz(k)*flqv + qcd(k)*delt - dtz(k)*rhoinv(k)*s_awqv(k+1) - dtz(k)*rhoinv(k)*sd_awqv(k+1) + & - d(k)=sqv(k) + dtz(k)*qvflux + qcd(k)*delt - dtz(k)*rhoinv(k)*s_awqv(k+1) - dtz(k)*rhoinv(k)*sd_awqv(k+1) + & - & sub_sqv(k)*delt + det_sqv(k)*delt - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k) + 0.5*dtz(k)*rhoinv(k)*sd_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1)) + 0.5*dtz(k)*rhoinv(k)*(sd_aw(k)-sd_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - 0.5*dtz(k)*rhoinv(k)*sd_aw(k+1) - d(k)=sqv(k) + qcd(k)*delt + dtz(k)*rhoinv(k)*(s_awqv(k)-s_awqv(k+1)) + dtz(k)*rhoinv(k)*(sd_awqv(k)-sd_awqv(k+1)) + & - & sub_sqv(k)*delt + det_sqv(k)*delt - ENDDO - -! no flux at the top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=0. - -! specified gradient at the top -! assume gradqw_top=gradqv_top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=gradqv_top*dztop - -! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=sqv(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,sqv2) - CALL tridiag3(kte,a,b,c,d,sqv2) - -! DO k=kts,kte -! sqv2(k)=d(k-kts+1) -! ENDDO -ELSE - sqv2=sqv -ENDIF - -!============================================ -! MIX CLOUD ICE ( sqi ) -!============================================ -IF (bl_mynn_cloudmix > 0 .AND. FLAG_QI) THEN - - k=kts - -! a(k)=0. -! b(k)=1.+dtz(k)*dfh(k+1) -! c(k)= -dtz(k)*dfh(k+1) -! d(k)=sqi(k) !+ qcd(k)*delt !should we have qcd for ice? -! -! DO k=kts+1,kte-1 -! a(k)= -dtz(k)*dfh(k) -! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) -! c(k)= -dtz(k)*dfh(k+1) -! d(k)=sqi(k) !+ qcd(k)*delt -! ENDDO - -!rho-weighted: - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - d(k)=sqi(k) - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - d(k)=sqi(k) - ENDDO - -!! no flux at the top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=0. - -!! specified gradient at the top -!assume gradqw_top=gradqv_top -! a(kte)=-1. -! b(kte)=1. -! c(kte)=0. -! d(kte)=gradqv_top*dztop - -!! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=sqi(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,sqi2) - CALL tridiag3(kte,a,b,c,d,sqi2) - -! DO k=kts,kte -! sqi2(k)=d(k-kts+1) -! ENDDO -ELSE - sqi2=sqi -ENDIF - -!!============================================ -!! cloud ice number concentration (qni) -!!============================================ -IF (bl_mynn_cloudmix > 0 .AND. FLAG_QNI .AND. & - bl_mynn_mixscalars > 0) THEN - - k=kts - - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - d(k)=qni(k) - dtz(k)*rhoinv(k)*s_awqni(k+1)*nonloc - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - d(k)=qni(k) + dtz(k)*rhoinv(k)*(s_awqni(k)-s_awqni(k+1))*nonloc - ENDDO - -!! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=qni(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte - !qni2(k)=d(k-kts+1) - qni2(k)=x(k) - ENDDO - -ELSE - qni2=qni -ENDIF - -!!============================================ -!! cloud water number concentration (qnc) -!! include non-local transport -!!============================================ - IF (bl_mynn_cloudmix > 0 .AND. FLAG_QNC .AND. & - bl_mynn_mixscalars > 0) THEN - - k=kts - - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - d(k)=qnc(k) - dtz(k)*rhoinv(k)*s_awqnc(k+1)*nonloc - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - d(k)=qnc(k) + dtz(k)*rhoinv(k)*(s_awqnc(k)-s_awqnc(k+1))*nonloc - ENDDO - -!! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=qnc(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte - !qnc2(k)=d(k-kts+1) - qnc2(k)=x(k) - ENDDO - -ELSE - qnc2=qnc -ENDIF - -!============================================ -! Water-friendly aerosols ( qnwfa ). -!============================================ -IF (bl_mynn_cloudmix > 0 .AND. FLAG_QNWFA .AND. & - bl_mynn_mixscalars > 0) THEN - - k=kts - - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) - & - & 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - d(k)=qnwfa(k) - dtz(k)*rhoinv(k)*s_awqnwfa(k+1)*nonloc - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - d(k)=qnwfa(k) + dtz(k)*rhoinv(k)*(s_awqnwfa(k)-s_awqnwfa(k+1))*nonloc - ENDDO - -! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=qnwfa(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte - !qnwfa2(k)=d(k) - qnwfa2(k)=x(k) - ENDDO - -ELSE - !If not mixing aerosols, set "updated" array equal to original array - qnwfa2=qnwfa -ENDIF - -!============================================ -! Ice-friendly aerosols ( qnifa ). -!============================================ -IF (bl_mynn_cloudmix > 0 .AND. FLAG_QNIFA .AND. & - bl_mynn_mixscalars > 0) THEN - - k=kts - - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) - & - & 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - d(k)=qnifa(k) - dtz(k)*rhoinv(k)*s_awqnifa(k+1)*nonloc - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*nonloc - b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*nonloc - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc - d(k)=qnifa(k) + dtz(k)*rhoinv(k)*(s_awqnifa(k)-s_awqnifa(k+1))*nonloc - ENDDO - -! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=qnifa(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte - !qnifa2(k)=d(k-kts+1) - qnifa2(k)=x(k) - ENDDO - -ELSE - !If not mixing aerosols, set "updated" array equal to original array - qnifa2=qnifa -ENDIF - -!============================================ -! Ozone - local mixing only -!============================================ - - k=kts - -!rho-weighted: - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - d(k)=ozone(k) - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - d(k)=ozone(k) - ENDDO - -! prescribed value - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=ozone(kte) - -! CALL tridiag(kte,a,b,c,d) -! CALL tridiag2(kte,a,b,c,d,x) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte - !ozone2(k)=d(k-kts+1) - dozone(k)=(x(k)-ozone(k))/delt - ENDDO - -!!============================================ -!! Compute tendencies and convert to mixing ratios for WRF. -!! Note that the momentum tendencies are calculated above. -!!============================================ - - IF (bl_mynn_mixqt > 0) THEN - DO k=kts,kte - !compute updated theta using updated thl and old condensate - th_new = thl(k) + xlvcp/exner(k)*sqc(k) & - & + xlscp/exner(k)*sqi(k) - - t = th_new*exner(k) - qsat = qsat_blend(t,p(k)) - !SATURATED VAPOR PRESSURE - !esat=esat_blend(t) - !SATURATED SPECIFIC HUMIDITY - !qsl=ep_2*esat/(p(k)-ep_3*esat) - !qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) - - IF (sqc(k) > 0.0 .or. sqi(k) > 0.0) THEN !initially saturated - sqv2(k) = MIN(sqw2(k),qsat) - portion_qc = sqc(k)/(sqc(k) + sqi(k)) - portion_qi = sqi(k)/(sqc(k) + sqi(k)) - condensate = MAX(sqw2(k) - qsat, 0.0) - sqc2(k) = condensate*portion_qc - sqi2(k) = condensate*portion_qi - ELSE ! initially unsaturated ----- - sqv2(k) = sqw2(k) ! let microphys decide what to do - 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 - - - !===================== - ! WATER VAPOR TENDENCY - !===================== - DO k=kts,kte - Dqv(k)=(sqv2(k)/(1.-sqv2(k)) - qv(k))/delt - !if (sqv2(k) < 0.0)print*,"neg qv:",sqv2(k),k - ENDDO - - IF (bl_mynn_cloudmix > 0) THEN - !===================== - ! CLOUD WATER TENDENCY - !===================== - !print*,"FLAG_QC:",FLAG_QC - IF (FLAG_QC) THEN - DO k=kts,kte - Dqc(k)=(sqc2(k)/(1.-sqv2(k)) - qc(k))/delt - !if (sqc2(k) < 0.0)print*,"neg qc:",sqc2(k),k - ENDDO - ELSE - DO k=kts,kte - Dqc(k) = 0. - ENDDO - ENDIF - - !=================== - ! CLOUD WATER NUM CONC TENDENCY - !=================== - IF (FLAG_QNC .AND. bl_mynn_mixscalars > 0) THEN - DO k=kts,kte - Dqnc(k) = (qnc2(k)-qnc(k))/delt - !IF(Dqnc(k)*delt + qnc(k) < 0.)Dqnc(k)=-qnc(k)/delt - ENDDO - ELSE - DO k=kts,kte - Dqnc(k) = 0. - ENDDO - ENDIF - - !=================== - ! CLOUD ICE TENDENCY - !=================== - IF (FLAG_QI) THEN - DO k=kts,kte - Dqi(k)=(sqi2(k)/(1.-sqv2(k)) - qi(k))/delt - !if (sqi2(k) < 0.0)print*,"neg qi:",sqi2(k),k - ENDDO - ELSE - DO k=kts,kte - Dqi(k) = 0. - ENDDO - ENDIF - - !=================== - ! CLOUD ICE NUM CONC TENDENCY - !=================== - IF (FLAG_QNI .AND. bl_mynn_mixscalars > 0) THEN - DO k=kts,kte - Dqni(k)=(qni2(k)-qni(k))/delt - !IF(Dqni(k)*delt + qni(k) < 0.)Dqni(k)=-qni(k)/delt - ENDDO - ELSE - DO k=kts,kte - Dqni(k)=0. - ENDDO - ENDIF - ELSE !-MIX CLOUD SPECIES? - !CLOUDS ARE NOT NIXED (when bl_mynn_cloudmix == 0) - DO k=kts,kte - Dqc(k)=0. - Dqnc(k)=0. - Dqi(k)=0. - Dqni(k)=0. - ENDDO - ENDIF - - !ensure non-negative moist species - CALL moisture_check(kte, delt, delp, exner, & - sqv2, sqc2, sqi2, thl, & - dqv, dqc, dqi, dth ) - - !===================== - ! OZONE TENDENCY CHECK - !===================== - DO k=kts,kte - IF(Dozone(k)*delt + ozone(k) < 0.) THEN - Dozone(k)=-ozone(k)*0.99/delt - ENDIF - ENDDO - - !=================== - ! THETA TENDENCY - !=================== - IF (FLAG_QI) THEN - DO k=kts,kte - Dth(k)=(thl(k) + xlvcp/exner(k)*sqc2(k) & - & + xlscp/exner(k)*sqi2(k) & - & - th(k))/delt - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy: - !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc(k) & - ! & + xlscp/MAX(tk(k),TKmin)*sqi(k)) & - ! & - th(k))/delt - ENDDO - ELSE - DO k=kts,kte - Dth(k)=(thl(k)+xlvcp/exner(k)*sqc2(k) - th(k))/delt - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !Dth(k)=(thl(k)*(1.+ xlvcp/MAX(tk(k),TKmin)*sqc(k)) & - !& - th(k))/delt - ENDDO - ENDIF - - !=================== - ! AEROSOL TENDENCIES - !=================== - IF (FLAG_QNWFA .AND. FLAG_QNIFA .AND. & - bl_mynn_mixscalars > 0) THEN - DO k=kts,kte - !===================== - ! WATER-friendly aerosols - !===================== - Dqnwfa(k)=(qnwfa2(k) - qnwfa(k))/delt - !===================== - ! Ice-friendly aerosols - !===================== - Dqnifa(k)=(qnifa2(k) - qnifa(k))/delt - ENDDO - ELSE - DO k=kts,kte - Dqnwfa(k)=0. - Dqnifa(k)=0. - ENDDO - ENDIF - - !ensure non-negative moist species - !note: if called down here, dth needs to be updated, but - ! if called before the theta-tendency calculation, do not compute dth - !CALL moisture_check(kte, delt, delp, exner, & - ! sqv, sqc, sqi, thl, & - ! dqv, dqc, dqi, dth ) - - problem = .false. - do k=kts,kte - wsp = sqrt(u(k)**2 + v(k)**2) - wsp2 = sqrt((u(k)+du(k)*delt)**2 + (v(k)+du(k)*delt)**2) - if (wsp2 > 200.) then - problem = .true. - print*,"Problem: i=",i," k=",k," wsp=",wsp2 - print*," du=",du(k)*delt," dv=",dv(k)*delt - print*," km=",kmdz(k)*dz(k)," kh=",khdz(k)*dz(k) - print*," u*=",ust," wspd=",wspd,"rhosfc=",rhosfc - print*," drag term=",ust**2/wspd*dtz(k)*rhosfc/rho(k) - kproblem = k - endif - enddo - if (problem) then - print*,"=temp:",thl(max(kproblem-5,1):min(kproblem+5,kte)) - print*,"===qv:",sqv(max(kproblem-5,1):min(kproblem+5,kte)) - print*,"====u:",u(max(kproblem-5,1):min(kproblem+5,kte)) - print*,"====v:",v(max(kproblem-5,1):min(kproblem+5,kte)) - endif - -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - - END SUBROUTINE mynn_tendencies - -! ================================================================== - SUBROUTINE moisture_check(kte, delt, dp, exner, & - qv, qc, qi, th, & - dqv, dqc, dqi, dth ) - - ! This subroutine was adopted from the CAM-UW ShCu scheme and - ! adapted for use here. - ! - ! If qc < qcmin, qi < qimin, or qv < qvmin happens in any layer, - ! force them to be larger than minimum value by (1) condensating - ! water vapor into liquid or ice, and (2) by transporting water vapor - ! from the very lower layer. - ! - ! We then update the final state variables and tendencies associated - ! with this correction. If any condensation happens, update theta too. - ! Note that (qv,qc,qi,th) are the final state variables after - ! applying corresponding input tendencies and corrective tendencies. - - implicit none - integer, intent(in) :: kte - real, intent(in) :: delt - real, dimension(kte), intent(in) :: dp, exner - real, dimension(kte), intent(inout) :: qv, qc, qi, th - real, dimension(kte), intent(inout) :: dqv, dqc, dqi, dth - integer k - real :: dqc2, dqi2, dqv2, sum, aa, dum - real, parameter :: qvmin = 1e-20, & - qcmin = 0.0, & - qimin = 0.0 - - do k = kte, 1, -1 ! From the top to the surface - dqc2 = max(0.0, qcmin-qc(k)) !qc deficit (>=0) - dqi2 = max(0.0, qimin-qi(k)) !qi deficit (>=0) - - !fix tendencies - dqc(k) = dqc(k) + dqc2/delt - dqi(k) = dqi(k) + dqi2/delt - dqv(k) = dqv(k) - (dqc2+dqi2)/delt - dth(k) = dth(k) + xlvcp/exner(k)*(dqc2/delt) + & - xlscp/exner(k)*(dqi2/delt) - !update species - qc(k) = qc(k) + dqc2 - qi(k) = qi(k) + dqi2 - qv(k) = qv(k) - dqc2 - dqi2 - th(k) = th(k) + xlvcp/exner(k)*dqc2 + & - xlscp/exner(k)*dqi2 - - !then fix qv - dqv2 = max(0.0, qvmin-qv(k)) !qv deficit (>=0) - dqv(k) = dqv(k) + dqv2/delt - qv(k) = qv(k) + dqv2 - if( k .ne. 1 ) then - qv(k-1) = qv(k-1) - dqv2*dp(k)/dp(k-1) - dqv(k-1) = dqv(k-1) - dqv2*dp(k)/dp(k-1)/delt - endif - qv(k) = max(qv(k),qvmin) - qc(k) = max(qc(k),qcmin) - qi(k) = max(qi(k),qimin) - end do - ! Extra moisture used to satisfy 'qv(1)>=qvmin' is proportionally - ! extracted from all the layers that has 'qv > 2*qvmin'. This fully - ! preserves column moisture. - if( dqv2 .gt. 1.e-20 ) then - sum = 0.0 - do k = 1, kte - if( qv(k) .gt. 2.0*qvmin ) sum = sum + qv(k)*dp(k) - enddo - aa = dqv2*dp(1)/max(1.e-20,sum) - if( aa .lt. 0.5 ) then - do k = 1, kte - if( qv(k) .gt. 2.0*qvmin ) then - dum = aa*qv(k) - qv(k) = qv(k) - dum - dqv(k) = dqv(k) - dum/delt - endif - enddo - else - ! For testing purposes only (not yet found in any output): - ! write(*,*) 'Full moisture conservation is impossible' - endif - endif - - return - - END SUBROUTINE moisture_check - -! ================================================================== - - SUBROUTINE mynn_mix_chem(kts,kte,i, & - delt,dz,pblh, & - nchem, kdvel, ndvel, & - chem1, vd1, & - rho, & - flt, tcd, qcd, & - dfh, & - s_aw, s_awchem, & - emis_ant_no,frp, & - fire_turb ) - -!------------------------------------------------------------------- - INTEGER, INTENT(in) :: kts,kte,i - - REAL, DIMENSION(kts:kte), INTENT(IN) :: dfh,dz,tcd,qcd - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: rho - REAL, INTENT(IN) :: delt,flt - INTEGER, INTENT(IN) :: nchem, kdvel, ndvel - REAL, DIMENSION( kts:kte+1), INTENT(IN) :: s_aw - REAL, DIMENSION( kts:kte, nchem ), INTENT(INOUT) :: chem1 - REAL, DIMENSION( kts:kte+1,nchem), INTENT(IN) :: s_awchem - REAL, DIMENSION( ndvel ), INTENT(IN) :: vd1 - REAL, INTENT(IN) :: emis_ant_no,frp,pblh - LOGICAL, INTENT(IN) :: fire_turb -!local vars - - REAL, DIMENSION(kts:kte) :: dtz - REAL, DIMENSION(1:kte-kts+1) :: a,b,c,d,x - REAL :: rhs,dztop - REAL :: t,dzk - REAL :: hght - REAL :: khdz_old, khdz_back - INTEGER :: k,kk,kmaxfire ! JLS 12/21/21 - INTEGER :: ic ! Chemical array loop index - - INTEGER, SAVE :: icall - - REAL, DIMENSION(kts:kte) :: rhoinv - REAL, DIMENSION(kts:kte+1) :: rhoz,khdz - REAL, PARAMETER :: no_threshold = 0.1 - REAL, PARAMETER :: frp_threshold = 1.0 ! JLS 12/21/21 - REAL, PARAMETER :: pblh_threshold = 250.0 - - dztop=.5*(dz(kte)+dz(kte-1)) - - DO k=kts,kte - dtz(k)=delt/dz(k) - ENDDO - - !Prepare "constants" for diffusion equation. - !khdz = rho*Kh/dz = rho*dfh - rhoz(kts) =rho(kts) - rhoinv(kts)=1./rho(kts) - khdz(kts) =rhoz(kts)*dfh(kts) - - khdz_old = khdz(kts) - khdz_back = pblh * 0.15 / dz(kts) - !Enhance diffusion over fires - IF ( fire_turb ) THEN - IF ( pblh < pblh_threshold ) THEN - IF ( emis_ant_no > no_threshold ) THEN -! khdz(kts) = MAX(khdz(kts),khdz_back) - khdz(kts) = MAX(1.1*khdz(kts), sqrt((emis_ant_no / no_threshold))/dz(kts)*rhoz(kts)) ! JLS 12/21/21 - ENDIF - IF ( frp > frp_threshold ) THEN - !kmaxfire = ceiling(log(curr_frp)) ! JLS 12/21/21 - need to bring in curr_frp - kmaxfire = ceiling(log(frp)) - IF (k .le. kmaxfire) THEN ! JLS -! khdz(kts) = MAX(khdz(kts),khdz_back) - khdz(kts) = MAX(1.1*khdz(kts),((log(frp))**2.- 2.*log(frp)) / dz(kts)*rhoz(kts)) ! JLS 12/21/21 - ENDIF ! JLS - ENDIF - ENDIF - ENDIF - - DO k=kts+1,kte - rhoz(k) =(rho(k)*dz(k-1) + rho(k-1)*dz(k))/(dz(k-1)+dz(k)) - rhoz(k) = MAX(rhoz(k),1E-4) - rhoinv(k)=1./MAX(rho(k),1E-4) - dzk = 0.5 *( dz(k)+dz(k-1) ) - khdz(k) = rhoz(k)*dfh(k) - ENDDO - rhoz(kte+1)=rhoz(kte) - khdz(kte+1)=rhoz(kte+1)*dfh(kte) - - !stability criteria for mf - DO k=kts+1,kte-1 - khdz(k) = MAX(khdz(k), 0.5*s_aw(k)) - khdz(k) = MAX(khdz(k), -0.5*(s_aw(k)-s_aw(k+1))) - ENDDO - - !Enhance diffusion over fires - IF ( fire_turb ) THEN - DO k=kts+1,kte-1 - khdz_old = khdz(k) - khdz_back = pblh * 0.15 / dz(k) - !Modify based on anthropogenic emissions of NO and FRP - IF ( pblh < pblh_threshold ) THEN - IF ( emis_ant_no > no_threshold ) THEN - khdz(k) = MAX(1.1*khdz(k),sqrt((emis_ant_no / no_threshold)) / dz(k) * rhoz(k)) ! JLS 12/21/21 -! khdz(k) = MAX(khdz(k),khdz_back) - ENDIF - IF ( frp > frp_threshold ) THEN - khdz(k) = MAX(1.1*khdz(k), (1. - k/(kmaxfire*2.)) * ((log(frp))**2.- 2.*log(frp)) / dz(k)*rhoz(k)) ! JLS 12/21/21 -! khdz(k) = MAX(khdz(k),khdz_back) - ENDIF - ENDIF - ENDDO - ENDIF - - !============================================ - ! Patterned after mixing of water vapor in mynn_tendencies. - !============================================ - - DO ic = 1,nchem - k=kts - - a(k)= -dtz(k)*khdz(k)*rhoinv(k) - b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - d(k)=chem1(k,ic) & !dtz(k)*flt !neglecting surface sources - & + dtz(k) * -vd1(ic)*chem1(1,ic) & - & - dtz(k)*rhoinv(k)*s_awchem(k+1,ic) - - DO k=kts+1,kte-1 - a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k) - b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + & - & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1)) - c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1) - d(k)=chem1(k,ic) + dtz(k)*rhoinv(k)*(s_awchem(k,ic)-s_awchem(k+1,ic)) - ENDDO - - ! prescribed value at top - a(kte)=0. - b(kte)=1. - c(kte)=0. - d(kte)=chem1(kte,ic) - - !CALL tridiag(kte,a,b,c,d) - CALL tridiag3(kte,a,b,c,d,x) - - DO k=kts,kte - !chem_new(k,ic)=d(k) - chem1(k,ic)=x(k) - ENDDO - ENDDO - - END SUBROUTINE mynn_mix_chem - -! ================================================================== -!>\ingroup gsd_mynn_edmf - SUBROUTINE retrieve_exchange_coeffs(kts,kte,& - &dfm,dfh,dz,K_m,K_h) - -!------------------------------------------------------------------- - - INTEGER , INTENT(in) :: kts,kte - - REAL, DIMENSION(KtS:KtE), INTENT(in) :: dz,dfm,dfh - - REAL, DIMENSION(KtS:KtE), INTENT(out) :: K_m, K_h - - - INTEGER :: k - REAL :: dzk - - K_m(kts)=0. - K_h(kts)=0. - - DO k=kts+1,kte - dzk = 0.5 *( dz(k)+dz(k-1) ) - K_m(k)=dfm(k)*dzk - K_h(k)=dfh(k)*dzk - ENDDO - - END SUBROUTINE retrieve_exchange_coeffs - -! ================================================================== -!>\ingroup gsd_mynn_edmf - SUBROUTINE tridiag(n,a,b,c,d) - -!! to solve system of linear eqs on tridiagonal matrix n times n -!! after Peaceman and Rachford, 1955 -!! a,b,c,d - are vectors of order n -!! a,b,c - are coefficients on the LHS -!! d - is initially RHS on the output becomes a solution vector - -!------------------------------------------------------------------- - - INTEGER, INTENT(in):: n - REAL, DIMENSION(n), INTENT(in) :: a,b - REAL, DIMENSION(n), INTENT(inout) :: c,d - - INTEGER :: i - REAL :: p - REAL, DIMENSION(n) :: q - - c(n)=0. - q(1)=-c(1)/b(1) - d(1)=d(1)/b(1) - - DO i=2,n - p=1./(b(i)+a(i)*q(i-1)) - q(i)=-c(i)*p - d(i)=(d(i)-a(i)*d(i-1))*p - ENDDO - - DO i=n-1,1,-1 - d(i)=d(i)+q(i)*d(i+1) - ENDDO - - END SUBROUTINE tridiag - -! ================================================================== -!>\ingroup gsd_mynn_edmf - subroutine tridiag2(n,a,b,c,d,x) - implicit none -! a - sub-diagonal (means it is the diagonal below the main diagonal) -! b - the main diagonal -! c - sup-diagonal (means it is the diagonal above the main diagonal) -! d - right part -! x - the answer -! n - number of unknowns (levels) - - integer,intent(in) :: n - real, dimension(n),intent(in) :: a,b,c,d - real ,dimension(n),intent(out) :: x - real ,dimension(n) :: cp,dp - real :: m - integer :: i - - ! initialize c-prime and d-prime - cp(1) = c(1)/b(1) - dp(1) = d(1)/b(1) - ! solve for vectors c-prime and d-prime - do i = 2,n - m = b(i)-cp(i-1)*a(i) - cp(i) = c(i)/m - dp(i) = (d(i)-dp(i-1)*a(i))/m - enddo - ! initialize x - x(n) = dp(n) - ! solve for x from the vectors c-prime and d-prime - do i = n-1, 1, -1 - x(i) = dp(i)-cp(i)*x(i+1) - end do - - end subroutine tridiag2 -! ================================================================== -!>\ingroup gsd_mynn_edmf - subroutine tridiag3(kte,a,b,c,d,x) - -!ccccccccccccccccccccccccccccccc -! Aim: Inversion and resolution of a tridiagonal matrix -! A X = D -! Input: -! a(*) lower diagonal (Ai,i-1) -! b(*) principal diagonal (Ai,i) -! c(*) upper diagonal (Ai,i+1) -! d -! Output -! x results -!ccccccccccccccccccccccccccccccc - - implicit none - integer,intent(in) :: kte - integer, parameter :: kts=1 - real, dimension(kte) :: a,b,c,d - real ,dimension(kte),intent(out) :: x - integer :: in - -! integer kms,kme,kts,kte,in -! real a(kms:kme,3),c(kms:kme),x(kms:kme) - - do in=kte-1,kts,-1 - d(in)=d(in)-c(in)*d(in+1)/b(in+1) - b(in)=b(in)-c(in)*a(in+1)/b(in+1) - enddo - - do in=kts+1,kte - d(in)=d(in)-a(in)*d(in-1)/b(in-1) - enddo - - do in=kts,kte - x(in)=d(in)/b(in) - enddo - - return - end subroutine tridiag3 - -! ================================================================== - -!>\ingroup gsd_mynn_edmf - SUBROUTINE mynn_bl_init_driver( & - &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & - &RQCBLTEN,RQIBLTEN & !,RQNIBLTEN,RQNCBLTEN & - &,QKE, & - &EXCH_H & - !&,icloud_bl,qc_bl,cldfra_bl & - &,RESTART,ALLOWED_TO_READ,LEVEL & - &,IDS,IDE,JDS,JDE,KDS,KDE & - &,IMS,IME,JMS,JME,KMS,KME & - &,ITS,ITE,JTS,JTE,KTS,KTE) - - !--------------------------------------------------------------- - LOGICAL,INTENT(IN) :: ALLOWED_TO_READ,RESTART - INTEGER,INTENT(IN) :: LEVEL !,icloud_bl - - INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE, & - & IMS,IME,JMS,JME,KMS,KME, & - & ITS,ITE,JTS,JTE,KTS,KTE - - - REAL,DIMENSION(IMS:IME,KMS:KME),INTENT(INOUT) :: & - &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & - &RQCBLTEN,RQIBLTEN,& !RQNIBLTEN,RQNCBLTEN & - &QKE,EXCH_H - - INTEGER :: I,J,K,ITF,JTF,KTF - - JTF=MIN0(JTE,JDE-1) - KTF=MIN0(KTE,KDE-1) - ITF=MIN0(ITE,IDE-1) - - IF(.NOT.RESTART)THEN - DO K=KTS,KTF - DO I=ITS,ITF - RUBLTEN(i,k)=0. - RVBLTEN(i,k)=0. - RTHBLTEN(i,k)=0. - RQVBLTEN(i,k)=0. - if( p_qc >= param_first_scalar ) RQCBLTEN(i,k)=0. - if( p_qi >= param_first_scalar ) RQIBLTEN(i,k)=0. - !if( p_qnc >= param_first_scalar ) RQNCBLTEN(i,k)=0. - !if( p_qni >= param_first_scalar ) RQNIBLTEN(i,k)=0. - !QKE(i,k)=0. - EXCH_H(i,k)=0. -! if(icloud_bl > 0) qc_bl(i,k)=0. -! if(icloud_bl > 0) cldfra_bl(i,k)=0. - ENDDO - ENDDO - ENDIF - - mynn_level=level - - END SUBROUTINE mynn_bl_init_driver - -! ================================================================== -!>\ingroup gsd_mynn_edmf -!! This subroutine calculates hybrid diagnotic boundary-layer height (PBLH). -!! -!! NOTES ON THE PBLH FORMULATION: The 1.5-theta-increase method defines -!!PBL heights as the level at. -!!which the potential temperature first exceeds the minimum potential. -!!temperature within the boundary layer by 1.5 K. When applied to. -!!observed temperatures, this method has been shown to produce PBL- -!!height estimates that are unbiased relative to profiler-based. -!!estimates (Nielsen-Gammon et al. 2008 \cite Nielsen_Gammon_2008). -!! However, their study did not -!!include LLJs. Banta and Pichugina (2008) \cite Pichugina_2008 show that a TKE-based. -!!threshold is a good estimate of the PBL height in LLJs. Therefore, -!!a hybrid definition is implemented that uses both methods, weighting -!!the TKE-method more during stable conditions (PBLH < 400 m). -!!A variable tke threshold (TKEeps) is used since no hard-wired -!!value could be found to work best in all conditions. -!>\section gen_get_pblh GSD get_pblh General Algorithm -!> @{ - SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) - - !--------------------------------------------------------------- - ! NOTES ON THE PBLH FORMULATION - ! - !The 1.5-theta-increase method defines PBL heights as the level at - !which the potential temperature first exceeds the minimum potential - !temperature within the boundary layer by 1.5 K. When applied to - !observed temperatures, this method has been shown to produce PBL- - !height estimates that are unbiased relative to profiler-based - !estimates (Nielsen-Gammon et al. 2008). However, their study did not - !include LLJs. Banta and Pichugina (2008) show that a TKE-based - !threshold is a good estimate of the PBL height in LLJs. Therefore, - !a hybrid definition is implemented that uses both methods, weighting - !the TKE-method more during stable conditions (PBLH < 400 m). - !A variable tke threshold (TKEeps) is used since no hard-wired - !value could be found to work best in all conditions. - !--------------------------------------------------------------- - - INTEGER,INTENT(IN) :: KTS,KTE - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - - REAL, INTENT(OUT) :: zi - REAL, INTENT(IN) :: landsea - REAL, DIMENSION(KTS:KTE), INTENT(IN) :: thetav1D, qke1D, dz1D - REAL, DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D - !LOCAL VARS - REAL :: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv - REAL :: delt_thv !delta theta-v; dependent on land/sea point - REAL, PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). - REAL, PARAMETER :: sbl_damp = 400. !transition length for blending (m). - INTEGER :: I,J,K,kthv,ktke,kzi - - !Initialize KPBL (kzi) - kzi = 2 - - !> - FIND MIN THETAV IN THE LOWEST 200 M AGL - k = kts+1 - kthv = 1 - minthv = 9.E9 - DO WHILE (zw1D(k) .LE. 200.) - !DO k=kts+1,kte-1 - IF (minthv > thetav1D(k)) then - minthv = thetav1D(k) - kthv = k - ENDIF - k = k+1 - !IF (zw1D(k) .GT. sbl_lim) exit - ENDDO - - !> - FIND THETAV-BASED PBLH (BEST FOR DAYTIME). - zi=0. - k = kthv+1 - IF((landsea-1.5).GE.0)THEN - ! WATER - delt_thv = 1.0 - ELSE - ! LAND - delt_thv = 1.25 - ENDIF - - zi=0. - k = kthv+1 -! DO WHILE (zi .EQ. 0.) - DO k=kts+1,kte-1 - IF (thetav1D(k) .GE. (minthv + delt_thv))THEN - zi = zw1D(k) - dz1D(k-1)* & - & MIN((thetav1D(k)-(minthv + delt_thv))/ & - & MAX(thetav1D(k)-thetav1D(k-1),1E-6),1.0) - ENDIF - !k = k+1 - IF (k .EQ. kte-1) zi = zw1D(kts+1) !EXIT SAFEGUARD - IF (zi .NE. 0.0) exit - ENDDO - !print*,"IN GET_PBLH:",thsfc,zi - - !> - FOR STABLE BOUNDARY LAYERS, USE TKE METHOD TO COMPLEMENT THE - !! THETAV-BASED DEFINITION (WHEN THE THETA-V BASED PBLH IS BELOW ~0.5 KM). - !!THE TANH WEIGHTING FUNCTION WILL MAKE THE TKE-BASED DEFINITION NEGLIGIBLE - !!WHEN THE THETA-V-BASED DEFINITION IS ABOVE ~1 KM. - ktke = 1 - maxqke = MAX(Qke1D(kts),0.) - !Use 5% of tke max (Kosovic and Curry, 2000; JAS) - !TKEeps = maxtke/20. = maxqke/40. - TKEeps = maxqke/40. - TKEeps = MAX(TKEeps,0.02) !0.025) - PBLH_TKE=0. - - k = ktke+1 -! DO WHILE (PBLH_TKE .EQ. 0.) - DO k=kts+1,kte-1 - !QKE CAN BE NEGATIVE (IF CKmod == 0)... MAKE TKE NON-NEGATIVE. - qtke =MAX(Qke1D(k)/2.,0.) ! maximum TKE - qtkem1=MAX(Qke1D(k-1)/2.,0.) - IF (qtke .LE. TKEeps) THEN - PBLH_TKE = zw1D(k) - dz1D(k-1)* & - & MIN((TKEeps-qtke)/MAX(qtkem1-qtke, 1E-6), 1.0) - !IN CASE OF NEAR ZERO TKE, SET PBLH = LOWEST LEVEL. - PBLH_TKE = MAX(PBLH_TKE,zw1D(kts+1)) - !print *,"PBLH_TKE:",i,PBLH_TKE, Qke1D(k)/2., zw1D(kts+1) - ENDIF - !k = k+1 - IF (k .EQ. kte-1) PBLH_TKE = zw1D(kts+1) !EXIT SAFEGUARD - IF (PBLH_TKE .NE. 0.) exit - ENDDO - - !> - With TKE advection turned on, the TKE-based PBLH can be very large - !! in grid points with convective precipitation (> 8 km!), - !! so an artificial limit is imposed to not let PBLH_TKE exceed the - !!theta_v-based PBL height +/- 350 m. - !!This has no impact on 98-99% of the domain, but is the simplest patch - !!that adequately addresses these extremely large PBLHs. - PBLH_TKE = MIN(PBLH_TKE,zi+350.) - PBLH_TKE = MAX(PBLH_TKE,MAX(zi-350.,10.)) - - wt=.5*TANH((zi - sbl_lim)/sbl_damp) + .5 - IF (maxqke <= 0.05) THEN - !Cold pool situation - default to theta_v-based def - ELSE - !BLEND THE TWO PBLH TYPES HERE: - zi=PBLH_TKE*(1.-wt) + zi*wt - ENDIF - - !Compute KPBL (kzi) - DO k=kts+1,kte-1 - IF ( zw1D(k) >= zi) THEN - kzi = k-1 - exit - ENDIF - ENDDO - -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - - END SUBROUTINE GET_PBLH -!> @} - -! ================================================================== -!>\ingroup gsd_mynn_edmf -!! This subroutine is the Dynamic Multi-Plume (DMP) Mass-Flux Scheme. -!! -!! dmp_mf() calculates the nonlocal turbulent transport from the dynamic -!! multiplume mass-flux scheme as well as the shallow-cumulus component of -!! the subgrid clouds. Note that this mass-flux scheme is called when the -!! namelist paramter \p bl_mynn_edmf is set to 1 (recommended). -!! -!! Much thanks to Kay Suslj of NASA-JPL for contributing the original version -!! of this mass-flux scheme. Considerable changes have been made from it's -!! original form. Some additions include: -!! -# scale-aware tapering as dx -> 0 -!! -# transport of TKE (extra namelist option) -!! -# Chaboureau-Bechtold cloud fraction & coupling to radiation (when icloud_bl > 0) -!! -# some extra limits for numerical stability -!! -!! This scheme remains under development, so consider it experimental code. -!! - SUBROUTINE DMP_mf( & - & kts,kte,dt,zw,dz,p,rho, & - & momentum_opt, & - & tke_opt, & - & scalar_opt, & - & u,v,w,th,thl,thv,tk, & - & qt,qv,qc,qke, & - & qnc,qni,qnwfa,qnifa, & - & exner,vt,vq,sgm, & - & ust,flt,flq,flqv,flqc, & - & pblh,kpbl,DX,landsea,ts, & - ! outputs - updraft properties - & edmf_a,edmf_w, & - & edmf_qt,edmf_thl, & - & edmf_ent,edmf_qc, & - ! outputs - variables needed for solver - & s_aw,s_awthl,s_awqt, & - & s_awqv,s_awqc, & - & s_awu,s_awv,s_awqke, & - & s_awqnc,s_awqni, & - & s_awqnwfa,s_awqnifa, & - & sub_thl,sub_sqv, & - & sub_u,sub_v, & - & det_thl,det_sqv,det_sqc, & - & det_u,det_v, & - ! chem/smoke - & nchem,chem1,s_awchem, & - & mix_chem, & - ! in/outputs - subgrid scale clouds - & qc_bl1d,cldfra_bl1d, & - & qc_bl1D_old,cldfra_bl1D_old, & - ! inputs - flags for moist arrays - & F_QC,F_QI, & - F_QNC,F_QNI, & - & F_QNWFA,F_QNIFA, & - & Psig_shcu, & - ! output info - &nup2,ktop,maxmf,ztop, & - ! unputs for stochastic perturbations - &spp_pbl,rstoch_col) - - ! inputs: - INTEGER, INTENT(IN) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt - -#ifdef HARDCODE_VERTICAL -# define kts 1 -# define kte HARDCODE_VERTICAL -#endif - -! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col - - REAL,DIMENSION(KTS:KTE), INTENT(IN) :: U,V,W,TH,THL,TK,QT,QV,QC,& - exner,dz,THV,P,rho,qke,qnc,qni,qnwfa,qnifa - REAL,DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW !height at full-sigma - REAL, INTENT(IN) :: DT,UST,FLT,FLQ,FLQV,FLQC,PBLH,& - DX,Psig_shcu,landsea,ts - LOGICAL, OPTIONAL :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA - - ! outputs - updraft properties - REAL,DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a,edmf_w, & - & edmf_qt,edmf_thl, edmf_ent,edmf_qc - !add one local edmf variable: - REAL,DIMENSION(KTS:KTE) :: edmf_th - ! output - INTEGER, INTENT(OUT) :: nup2,ktop - REAL, INTENT(OUT) :: maxmf,ztop - ! outputs - variables needed for solver - REAL,DIMENSION(KTS:KTE+1) :: s_aw, & !sum ai*rho*wis_awphi - s_awthl, & !sum ai*rho*wi*phii - s_awqt, & - s_awqv, & - s_awqc, & - s_awqnc, & - s_awqni, & - s_awqnwfa, & - s_awqnifa, & - s_awu, & - s_awv, & - s_awqke, s_aw2 - - REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: qc_bl1d,cldfra_bl1d, & - qc_bl1d_old,cldfra_bl1d_old - - INTEGER, PARAMETER :: NUP=10, debug_mf=0 - - !------------- local variables ------------------- - ! updraft properties defined on interfaces (k=1 is the top of the - ! first model layer - REAL,DIMENSION(KTS:KTE+1,1:NUP) :: UPW,UPTHL,UPQT,UPQC,UPQV, & - UPA,UPU,UPV,UPTHV,UPQKE,UPQNC, & - UPQNI,UPQNWFA,UPQNIFA - ! entrainment variables - REAL,DIMENSION(KTS:KTE,1:NUP) :: ENT,ENTf - INTEGER,DIMENSION(KTS:KTE,1:NUP) :: ENTi - ! internal variables - INTEGER :: K,I,k50 - REAL :: fltv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl - REAL :: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn,QNWFAn,QNIFAn, & - Wn2,Wn,EntEXP,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int - - ! w parameters - REAL,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,PARAMETER :: & - & L0=100.,& - & ENT0=0.1 - - ! Implement ideas from Neggers (2016, JAMES): - REAL, PARAMETER :: Atot = 0.10 ! Maximum total fractional area of all updrafts - REAL, PARAMETER :: lmax = 1000.! diameter of largest plume - REAL, PARAMETER :: dl = 100. ! diff size of each plume - the differential multiplied by the integrand - REAL, PARAMETER :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) - REAL :: 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 :: cn,c,l,n,an2,hux,maxwidth,wspd_pbl,cloud_base,width_flx - - ! chem/smoke - INTEGER, INTENT(IN) :: nchem - REAL,DIMENSION(:, :) :: chem1 - REAL,DIMENSION(kts:kte+1, nchem) :: s_awchem - REAL,DIMENSION(nchem) :: chemn - REAL,DIMENSION(KTS:KTE+1,1:NUP, nchem) :: UPCHEM - INTEGER :: ic - REAL,DIMENSION(KTS:KTE+1, nchem) :: edmf_chem - LOGICAL, INTENT(IN) :: mix_chem - - !JOE: add declaration of ERF - REAL :: ERF - - LOGICAL :: superadiabatic - - ! VARIABLES FOR CHABOUREAU-BECHTOLD CLOUD FRACTION - REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm - REAL :: sigq,xl,tlk,qsat_tl,rsl,cpm,a,qmq,mf_cf,Q1,diffqt,& - Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & - Ac_mf,Ac_strat,qc_mf - - ! Variables for plume interpolation/saturation check - REAL,DIMENSION(KTS:KTE) :: exneri,dzi - REAL :: THp, QTp, QCp, QCs, esat, qsl - - ! WA TEST 11/9/15 for consistent reduction of updraft params - REAL :: csigma,acfac - - !JOE- plume overshoot - INTEGER :: overshoot - REAL :: bvf, Frz, dzp - - !Flux limiter: not let mass-flux of heat between k=1&2 exceed (fluxportion)*(surface heat flux). - !This limiter makes adjustments to the entire column. - REAL :: adjustment, flx1 - REAL, PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact - ! over land (decrease maxMF by 10-20%), but no impact over water. - - !Subsidence - REAL,DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence - det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment - envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & - envm_u,envm_v !environmental variables defined at middle of layer - REAL,DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface - REAL :: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & - detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs,& - qc_plume - REAL, PARAMETER :: Cdet = 1./45. - REAL, PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers - !parameter "Csub" determines the propotion of upward vertical velocity that contributes to - !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of - !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme - !is compensated by "gentle" environmental subsidence. - REAL, PARAMETER :: Csub=0.25 - - !Factor for the pressure gradient effects on momentum transport - REAL, PARAMETER :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere - REAL :: Uk,Ukm1,Vk,Vkm1,dxsa - -! check the inputs -! print *,'dt',dt -! print *,'dz',dz -! print *,'u',u -! print *,'v',v -! print *,'thl',thl -! print *,'qt',qt -! print *,'ust',ust -! print *,'flt',flt -! print *,'flq',flq -! print *,'pblh',pblh - -! Initialize individual updraft properties - UPW=0. - UPTHL=0. - UPTHV=0. - UPQT=0. - UPA=0. - UPU=0. - UPV=0. - UPQC=0. - UPQV=0. - UPQKE=0. - UPQNC=0. - UPQNI=0. - UPQNWFA=0. - UPQNIFA=0. - IF ( mix_chem ) THEN - UPCHEM(KTS:KTE+1,1:NUP,1:nchem)=0.0 - ENDIF - - ENT=0.001 -! Initialize mean updraft properties - edmf_a =0. - edmf_w =0. - edmf_qt =0. - edmf_thl=0. - edmf_ent=0. - edmf_qc =0. - IF ( mix_chem ) THEN - edmf_chem(kts:kte+1,1:nchem) = 0.0 - ENDIF - -! Initialize the variables needed for implicit solver - s_aw=0. - s_awthl=0. - s_awqt=0. - s_awqv=0. - s_awqc=0. - s_awu=0. - s_awv=0. - s_awqke=0. - s_awqnc=0. - s_awqni=0. - s_awqnwfa=0. - s_awqnifa=0. - IF ( mix_chem ) THEN - s_awchem(kts:kte+1,1:nchem) = 0.0 - ENDIF - -! Initialize explicit tendencies for subsidence & detrainment - sub_thl = 0. - sub_sqv = 0. - sub_u = 0. - sub_v = 0. - det_thl = 0. - det_sqv = 0. - det_sqc = 0. - det_u = 0. - det_v = 0. - - ! Taper off MF scheme when significant resolved-scale motions - ! are present This function needs to be asymetric... - k = 1 - maxw = 0.0 - cloud_base = 9000.0 -! DO WHILE (ZW(k) < pblh + 500.) - 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)) - - !Find highest k-level below 50m AGL - IF(ZW(k)<=50.)k50=k - - !Search for cloud base - qc_sgs = MAX(qc(k), qc_bl1d(k)*cldfra_bl1d(k)) - !IF(qc(k) >1E-5 .AND. cloud_base == 9000.0)THEN - IF(qc_sgs> 1E-5 .AND. cloud_base == 9000.0)THEN - cloud_base = 0.5*(ZW(k)+ZW(k+1)) - ENDIF - - !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 - - fltv = flt + svp1*flq - !PRINT*," fltv=",fltv," zi=",pblh - - !Completely shut off MF scheme for strong resolved-scale vertical velocities. - IF(Psig_w == 0.0 .and. fltv > 0.0) fltv = -1.*fltv - -! if surface buoyancy is positive we do integration, otherwise not, and make sure that -! PBLH > twice the height of the surface layer (set at z0 = 50m) -! Also, ensure that it is at least slightly superadiabatic up through 50 m - superadiabatic = .false. - IF((landsea-1.5).GE.0)THEN - hux = -0.002 ! WATER ! dT/dz must be < - 0.2 K per 100 m. - 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 - superadiabatic = .true. - ELSE - superadiabatic = .false. - exit - ENDIF - ELSE - IF ((th(k)-th(k-1))/(0.5*(dz(k)+dz(k-1))) < hux) THEN - superadiabatic = .true. - ELSE - superadiabatic = .false. - exit - 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. - ! (3) max plume size beneath clouds deck approx = 0.5 * cloud_base. - ! (4) add wspd-dependent limit, when plume model breaks down. (hurricanes) - ! (5) land-only limit to reduce plume sizes in weakly forced conditions - ! Criteria (1) - NUP2 = max(1,min(NUP,INT(dx*dcut/dl))) - !Criteria (2) - maxwidth = 1.2*PBLH - ! Criteria (3) - maxwidth = MIN(maxwidth,0.666*cloud_base) - ! Criteria (4) - wspd_pbl=SQRT(MAX(u(kts)**2 + v(kts)**2, 0.01)) - !Note: area fraction (acfac) is modified below - ! Criteria (5) - IF((landsea-1.5).LT.0)THEN - width_flx = MAX(MIN(1000.*(0.6*tanh((flt - 0.050)/0.03) + .5),1000.), 0.) - maxwidth = MIN(maxwidth,width_flx) - ENDIF - ! Convert maxwidth to number of plumes - NUP2 = MIN(MAX(INT((maxwidth - MOD(maxwidth,100.))/100), 0), NUP2) - - !Initialize values: - ktop = 0 - ztop = 0.0 - maxmf= 0.0 - - IF ( fltv > 0.002 .AND. NUP2 .GE. 1 .AND. superadiabatic) then - !PRINT*," Conditions met to run mass-flux scheme",fltv,pblh - - ! 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((fltv - 0.05)/0.15) - do I=1,NUP !NUP2 - IF(I > NUP2) exit - l = dl*I ! diameter of plume - 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) - - ! 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 - N = C*l**d ! number density of plume n - UPA(1,I) = N*l*l/(dx*dx) * dl ! fractional area of plume n - ! Make updraft area (UPA) a function of the buoyancy flux -! acfac = .5*tanh((fltv - 0.03)/0.09) + .5 -! acfac = .5*tanh((fltv - 0.02)/0.09) + .5 - acfac = .5*tanh((fltv - 0.01)/0.09) + .5 - - !add a windspeed-dependent adjustment to acfac that tapers off - !the mass-flux scheme linearly above sfc wind speeds of 20 m/s: - acfac = acfac*(1. - MIN(MAX(wspd_pbl - 20.0, 0.0), 10.0)/10.) - - UPA(1,I)=UPA(1,I)*acfac - An2 = An2 + UPA(1,I) ! total fractional area of all plumes - !print*," plume size=",l,"; area=",UPA(1,I),"; total=",An2 - end do - - ! set initial conditions for updrafts - z0=50. - pwmin=0.1 ! was 0.5 - pwmax=0.4 ! was 3.0 - - wstar=max(1.E-2,(gtr*fltv*pblh)**(1./3.)) - qstar=max(flq,1.0E-5)/wstar - thstar=flt/wstar - - IF((landsea-1.5).GE.0)THEN - csigma = 1.34 ! WATER - ELSE - csigma = 1.34 ! LAND - ENDIF - - IF (env_subs) THEN - exc_fac = 0.0 - ELSE - exc_fac = 0.58 - ENDIF - - !Note: sigmaW is typically about 0.5*wstar - sigmaW =1.34*wstar*(z0/pblh)**(1./3.)*(1 - 0.8*z0/pblh) - sigmaQT=csigma*qstar*(z0/pblh)**(-1./3.) - sigmaTH=csigma*thstar*(z0/pblh)**(-1./3.) - - !Note: Given the pwmin & pwmax set above, these max/mins are - ! rarely exceeded. - wmin=MIN(sigmaW*pwmin,0.05) - wmax=MIN(sigmaW*pwmax,0.4) - - !SPECIFY SURFACE UPDRAFT PROPERTIES AT MODEL INTERFACE BETWEEN K = 1 & 2 - DO I=1,NUP !NUP2 - IF(I > NUP2) exit - 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 - !UPQC(1,I)=(QC(KTS)*DZ(KTS+1)+QC(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - UPQT(1,I)=(QT(KTS)*DZ(KTS+1)+QT(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1))& - & +exc_fac*UPW(1,I)*sigmaQT/sigmaW - UPTHV(1,I)=(THV(KTS)*DZ(KTS+1)+THV(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & - & +exc_fac*UPW(1,I)*sigmaTH/sigmaW -!was UPTHL(1,I)= UPTHV(1,I)/(1.+svp1*UPQT(1,I)) !assume no saturated parcel at surface - UPTHL(1,I)=(THL(KTS)*DZ(KTS+1)+THL(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) & - & +exc_fac*UPW(1,I)*sigmaTH/sigmaW - UPQKE(1,I)=(QKE(KTS)*DZ(KTS+1)+QKE(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - UPQNC(1,I)=(QNC(KTS)*DZ(KTS+1)+QNC(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - UPQNI(1,I)=(QNI(KTS)*DZ(KTS+1)+QNI(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - UPQNWFA(1,I)=(QNWFA(KTS)*DZ(KTS+1)+QNWFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - UPQNIFA(1,I)=(QNIFA(KTS)*DZ(KTS+1)+QNIFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) - ENDDO - - IF ( mix_chem ) THEN - DO I=1,NUP !NUP2 - IF(I > NUP2) exit - 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)) - enddo - 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 - - !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.) - - !QCn = 0. - ! do integration updraft - DO I=1,NUP !NUP2 - IF(I > NUP2) exit - QCn = 0. - overshoot = 0 - l = dl*I ! 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 - !ENT(k,i) = 0.33/(MIN(MAX(UPW(K-1,I),wmin),0.9)*l) - - !Entrainment from Negggers (2015, JAMES) - !ENT(k,i) = 0.02*l**-0.35 - 0.0009 - ENT(k,i) = 0.04*l**-0.50 - 0.0009 !more plume diversity - - !Minimum background entrainment - ENT(k,i) = max(ENT(k,i),0.0003) - ENT(k,i) = max(ENT(k,i),0.05/ZW(k)) !not needed for Tian and Kuang - - !JOE - increase entrainment for plumes extending very high. - IF(ZW(k) >= MIN(pblh+1500., 4000.))THEN - ENT(k,i)=ENT(k,i) + (ZW(k)-MIN(pblh+1500.,4000.))*5.0E-6 - ENDIF - - !SPP - ENT(k,i) = ENT(k,i) * (1.0 - rstoch_col(k)) - - ENT(k,i) = min(ENT(k,i),0.9/(ZW(k+1)-ZW(k))) - - ! Define environment U & V at the model interface levels - Uk =(U(k)*DZ(k+1)+U(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - Ukm1=(U(k-1)*DZ(k)+U(k)*DZ(k-1))/(DZ(k-1)+DZ(k)) - Vk =(V(k)*DZ(k+1)+V(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - Vkm1=(V(k-1)*DZ(k)+V(k)*DZ(k-1))/(DZ(k-1)+DZ(k)) - - ! Linear entrainment: - EntExp= ENT(K,I)*(ZW(k+1)-ZW(k)) - QTn =UPQT(k-1,I) *(1.-EntExp) + QT(k)*EntExp - THLn=UPTHL(k-1,I)*(1.-EntExp) + THL(k)*EntExp - Un =UPU(k-1,I) *(1.-EntExp) + U(k)*EntExp + dxsa*pgfac*(Uk - Ukm1) - Vn =UPV(k-1,I) *(1.-EntExp) + V(k)*EntExp + dxsa*pgfac*(Vk - Vkm1) - QKEn=UPQKE(k-1,I)*(1.-EntExp) + QKE(k)*EntExp - QNCn=UPQNC(k-1,I)*(1.-EntExp) + QNC(k)*EntExp - QNIn=UPQNI(k-1,I)*(1.-EntExp) + QNI(k)*EntExp - QNWFAn=UPQNWFA(k-1,I)*(1.-EntExp) + QNWFA(k)*EntExp - QNIFAn=UPQNIFA(k-1,I)*(1.-EntExp) + QNIFA(k)*EntExp - - !capture the updated qc, qt & thl modified by entranment alone, - !since they will be modified later if condensation occurs. - qc_ent = QCn - qt_ent = QTn - thl_ent = THLn - - ! Exponential Entrainment: - !EntExp= exp(-ENT(K,I)*(ZW(k)-ZW(k-1))) - !QTn =QT(K) *(1-EntExp)+UPQT(K-1,I)*EntExp - !THLn=THL(K)*(1-EntExp)+UPTHL(K-1,I)*EntExp - !Un =U(K) *(1-EntExp)+UPU(K-1,I)*EntExp - !Vn =V(K) *(1-EntExp)+UPV(K-1,I)*EntExp - !QKEn=QKE(k)*(1-EntExp)+UPQKE(K-1,I)*EntExp - - IF ( mix_chem ) THEN - do ic = 1,nchem - ! Exponential Entrainment: - !chemn(ic) = chem(k,ic)*(1-EntExp)+UPCHEM(K-1,I,ic)*EntExp - ! Linear entrainment: - chemn(ic)=UPCHEM(k-1,i,ic)*(1.-EntExp) + chem1(k,ic)*EntExp - enddo - ENDIF - - ! Define pressure at model interface - Pk =(P(k)*DZ(k+1)+P(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - ! Compute plume properties thvn and qcn - call condensation_edmf(QTn,THLn,Pk,ZW(k+1),THVn,QCn) - - ! Define environment THV at the model interface levels - THVk =(THV(k)*DZ(k+1)+THV(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - THVkm1=(THV(k-1)*DZ(k)+THV(k)*DZ(k-1))/(DZ(k-1)+DZ(k)) - -! B=g*(0.5*(THVn+UPTHV(k-1,I))/THV(k-1) - 1.0) - B=grav*(THVn/THVk - 1.0) - IF(B>0.)THEN - BCOEFF = 0.15 !w typically stays < 2.5, so doesnt hit the limits nearly as much - ELSE - BCOEFF = 0.2 !0.33 - ENDIF - - ! Original StEM with exponential entrainment - !EntW=exp(-2.*(Wb+Wc*ENT(K,I))*(ZW(k)-ZW(k-1))) - !Wn2=UPW(K-1,I)**2*EntW + (1.-EntW)*0.5*Wa*B/(Wb+Wc*ENT(K,I)) - ! Original StEM with linear entrainment - !Wn2=UPW(K-1,I)**2*(1.-EntExp) + EntExp*0.5*Wa*B/(Wb+Wc*ENT(K,I)) - !Wn2=MAX(Wn2,0.0) - !WA: TEMF form -! IF (B>0.0 .AND. UPW(K-1,I) < 0.2 ) THEN - IF (UPW(K-1,I) < 0.2 ) THEN - Wn = UPW(K-1,I) + (-2. * ENT(K,I) * UPW(K-1,I) + BCOEFF*B / MAX(UPW(K-1,I),0.2)) * MIN(ZW(k)-ZW(k-1), 250.) - ELSE - Wn = UPW(K-1,I) + (-2. * ENT(K,I) * UPW(K-1,I) + BCOEFF*B / UPW(K-1,I)) * MIN(ZW(k)-ZW(k-1), 250.) - ENDIF - !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 > UPW(K-1,I) + MIN(1.25*(ZW(k)-ZW(k-1))/200., 2.0) ) THEN - Wn = UPW(K-1,I) + MIN(1.25*(ZW(k)-ZW(k-1))/200., 2.0) - ENDIF - !Add symmetrical max decrease in w - IF(Wn < UPW(K-1,I) - MIN(1.25*(ZW(k)-ZW(k-1))/200., 2.0) ) THEN - Wn = UPW(K-1,I) - MIN(1.25*(ZW(k)-ZW(k-1))/200., 2.0) - ENDIF - Wn = MIN(MAX(Wn,0.0), 3.0) - - !Check to make sure that the plume made it up at least one level. - !if it failed, then set nup2=0 and exit the mass-flux portion. - IF (k==kts+1 .AND. Wn == 0.) THEN - NUP2=0 - exit - ENDIF - - IF (debug_mf == 1) THEN - IF (Wn .GE. 3.0) THEN - ! surface values - print *," **** SUSPICIOUSLY LARGE W:" - print *,' QCn:',QCn,' ENT=',ENT(k,i),' Nup2=',Nup2 - print *,'pblh:',pblh,' Wn:',Wn,' UPW(k-1)=',UPW(K-1,I) - print *,'K=',k,' B=',B,' dz=',ZW(k)-ZW(k-1) - ENDIF - ENDIF - - !Allow strongly forced plumes to overshoot if KE is sufficient - !IF (fltv > 0.05 .AND. Wn <= 0 .AND. overshoot == 0) THEN - IF (Wn <= 0.0 .AND. overshoot == 0) THEN - overshoot = 1 - IF ( THVk-THVkm1 .GT. 0.0 ) THEN - bvf = SQRT( gtr*(THVk-THVkm1)/dz(k) ) - !vertical Froude number - Frz = UPW(K-1,I)/(bvf*dz(k)) - !IF ( Frz >= 0.5 ) Wn = MIN(Frz,1.0)*UPW(K-1,I) - dzp = dz(k)*MAX(MIN(Frz,1.0),0.0) ! portion of highest layer the plume penetrates - ENDIF - !ELSEIF (fltv > 0.05 .AND. overshoot == 1) THEN - ELSE - dzp = dz(k) - ! !Do not let overshooting parcel go more than 1 layer up - ! Wn = 0.0 - ENDIF - - !Limit very tall plumes -! Wn2=Wn2*EXP(-MAX(ZW(k)-(pblh+2000.),0.0)/1000.) -! IF(ZW(k) >= pblh+3000.)Wn2=0. - Wn=Wn*EXP(-MAX(ZW(k+1)-MIN(pblh+2000.,3500.),0.0)/1000.) - - !JOE- minimize the plume penetratration in stratocu-topped PBL - ! IF (fltv < 0.06) THEN - ! IF(ZW(k+1) >= pblh-200. .AND. qc(k) > 1e-5 .AND. I > 4) Wn=0. - ! ENDIF - - !Modify environment variables (representative of the model layer - envm*) - !following the updraft dynamical detrainment of Asai and Kasahara (1967, JAS). - !Reminder: w is limited to be non-negative (above) - aratio = MIN(UPA(K-1,I)/(1.-UPA(K-1,I)), 0.5) !limit should never get hit - detturb = 0.00008 - oow = -0.060/MAX(1.0,(0.5*(Wn+UPW(K-1,I)))) !coef for dynamical detrainment rate - detrate = MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0002) ! dynamical detrainment rate (m^-1) - detrateUV= MIN(MAX(oow*(Wn-UPW(K-1,I))/dz(k), detturb), .0001) ! dynamical detrainment rate (m^-1) - envm_thl(k)=envm_thl(k) + (0.5*(thl_ent + UPTHL(K-1,I)) - thl(k))*detrate*aratio*MIN(dzp,dzpmax) - qv_ent = 0.5*(MAX(qt_ent-qc_ent,0.) + MAX(UPQT(K-1,I)-UPQC(K-1,I),0.)) - envm_sqv(k)=envm_sqv(k) + (qv_ent-QV(K))*detrate*aratio*MIN(dzp,dzpmax) - IF (UPQC(K-1,I) > 1E-8) THEN - IF (QC(K) > 1E-6) THEN - qc_grid = QC(K) - ELSE - qc_grid = cldfra_bl1d(k)*qc_bl1d(K) - ENDIF - envm_sqc(k)=envm_sqc(k) + MAX(UPA(K-1,I)*0.5*(QCn + UPQC(K-1,I)) - qc_grid, 0.0)*detrate*aratio*MIN(dzp,dzpmax) - ENDIF - envm_u(k) =envm_u(k) + (0.5*(Un + UPU(K-1,I)) - U(K))*detrateUV*aratio*MIN(dzp,dzpmax) - envm_v(k) =envm_v(k) + (0.5*(Vn + UPV(K-1,I)) - V(K))*detrateUV*aratio*MIN(dzp,dzpmax) - - IF (Wn > 0.) THEN - !Update plume variables at current k index - UPW(K,I)=Wn !sqrt(Wn2) - UPTHV(K,I)=THVn - UPTHL(K,I)=THLn - UPQT(K,I)=QTn - UPQC(K,I)=QCn - UPU(K,I)=Un - UPV(K,I)=Vn - UPQKE(K,I)=QKEn - UPQNC(K,I)=QNCn - UPQNI(K,I)=QNIn - UPQNWFA(K,I)=QNWFAn - UPQNIFA(K,I)=QNIFAn - UPA(K,I)=UPA(K-1,I) - IF ( mix_chem ) THEN - do ic = 1,nchem - UPCHEM(k,I,ic) = chemn(ic) - enddo - ENDIF - ktop = MAX(ktop,k) - ELSE - 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 - ! surface values - print *,'flq:',flq,' fltv:',fltv,' Nup2=',Nup2 - print *,'pblh:',pblh,' wstar:',wstar,' ktop=',ktop - print *,'sigmaW=',sigmaW,' sigmaTH=',sigmaTH,' sigmaQT=',sigmaQT - ! means - print *,'u:',u - print *,'v:',v - print *,'thl:',thl - print *,'UPA:',UPA(:,I) - print *,'UPW:',UPW(:,I) - print *,'UPTHL:',UPTHL(:,I) - print *,'UPQT:',UPQT(:,I) - print *,'ENT:',ENT(:,I) - ENDIF - ENDIF - ENDDO - 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 - - 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 - - !Calculate the fluxes for each variable - !All s_aw* variable are == 0 at k=1 -! DO k=KTS,KTE -! IF(k > KTOP) exit -! DO i=1,NUP !NUP2 -! IF(I > NUP2) exit -! s_aw(k+1) = s_aw(k+1) + UPA(K,i)*UPW(K,i)*Psig_w -! s_awthl(k+1)= s_awthl(k+1) + UPA(K,i)*UPW(K,i)*UPTHL(K,i)*Psig_w -! s_awqt(k+1) = s_awqt(k+1) + UPA(K,i)*UPW(K,i)*UPQT(K,i)*Psig_w -! s_awqc(k+1) = s_awqc(k+1) + UPA(K,i)*UPW(K,i)*UPQC(K,i)*Psig_w -! IF (momentum_opt > 0) THEN -! s_awu(k+1) = s_awu(k+1) + UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w -! s_awv(k+1) = s_awv(k+1) + 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) + UPA(K,i)*UPW(K,i)*UPQKE(K,i)*Psig_w -! ENDIF -! ENDDO -! s_awqv(k+1) = s_awqt(k+1) - s_awqc(k+1) -! ENDDO - DO i=1,NUP !NUP2 - IF(I > NUP2) exit - 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 - !to conform to grid mean properties, move qc to qv in grid mean - !saturated layers, so total water fluxes are preserve but - !negative qc fluxes in unsaturated layers is reduced. - IF (qc(k) > 1e-12 .OR. qc(k+1) > 1e-12) then - qc_plume = UPQC(K,i) - 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_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 - 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 - dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) !dz centered at model interface - flx1 = MAX(s_aw(kts+1)*(TH(kts)-TH(kts+1))/dzi(kts),1.0e-5) - ELSE - flx1 = 0.0 - !print*,"ERROR: s_aw(kts+1) == 0, NUP=",NUP," NUP2=",NUP2,& - ! " superadiabatic=",superadiabatic," KTOP=",KTOP - ENDIF - 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 - IF (momentum_opt > 0) THEN - s_awu = s_awu*adjustment - s_awv = s_awv*adjustment - ENDIF - IF (tke_opt > 0) THEN - s_awqke= s_awqke*adjustment - ENDIF - IF ( mix_chem ) THEN - 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 - - !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 - do ic = 1,nchem - edmf_chem(k,ic) = edmf_chem(k,ic) + rho_int*UPA(K,I)*UPCHEM(k,i,ic) - enddo - ENDDO - - 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 - - !Calculate the effects environmental subsidence. - !All envi_*variables are valid at the interfaces, like the edmf_* variables - IF (env_subs) THEN - DO k=KTS+1,KTE-1 - !First, smooth the profiles of w & a, since sharp vertical gradients - !in plume variables are not likely extended to env variables - !Note1: w is treated as negative further below - !Note2: both w & a will be transformed into env variables further below - envi_w(k) = onethird*(edmf_w(K-1)+edmf_w(K)+edmf_w(K+1)) - envi_a(k) = onethird*(edmf_a(k-1)+edmf_a(k)+edmf_a(k+1))*adjustment - ENDDO - !define env variables at k=1 (top of first model layer) - envi_w(kts) = edmf_w(kts) - envi_a(kts) = edmf_a(kts) - !define env variables at k=kte - envi_w(kte) = 0.0 - envi_a(kte) = edmf_a(kte) - !define env variables at k=kte+1 - envi_w(kte+1) = 0.0 - envi_a(kte+1) = edmf_a(kte) - !Add limiter for very long time steps (i.e. dt > 300 s) - !Note that this is not a robust check - only for violations in - ! the first model level. - IF (envi_w(kts) > 0.9*DZ(kts)/dt) THEN - sublim = 0.9*DZ(kts)/dt/envi_w(kts) - ELSE - sublim = 1.0 - ENDIF - !Transform w & a into env variables - DO k=KTS,KTE - temp=envi_a(k) - envi_a(k)=1.0-temp - envi_w(k)=csub*sublim*envi_w(k)*temp/(1.-temp) - ENDDO - !calculate tendencies from subsidence and detrainment valid at the middle of - !each model layer - dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) - sub_thl(kts)=0.5*envi_w(kts)*envi_a(kts)*(thl(kts+1)-thl(kts))/dzi(kts) - sub_sqv(kts)=0.5*envi_w(kts)*envi_a(kts)*(qv(kts+1)-qv(kts))/dzi(kts) - DO k=KTS+1,KTE-1 - dzi(k) = 0.5*(DZ(k)+DZ(k+1)) - sub_thl(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (thl(k+1)-thl(k))/dzi(k) - sub_sqv(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (qv(k+1)-qv(k))/dzi(k) - ENDDO - - DO k=KTS,KTE-1 - det_thl(k)=Cdet*(envm_thl(k)-thl(k))*envi_a(k)*Psig_w - det_sqv(k)=Cdet*(envm_sqv(k)-qv(k))*envi_a(k)*Psig_w - det_sqc(k)=Cdet*(envm_sqc(k)-qc(k))*envi_a(k)*Psig_w - ENDDO - - IF (momentum_opt > 0) THEN - sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)*(u(kts+1)-u(kts))/dzi(kts) - sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)*(v(kts+1)-v(kts))/dzi(kts) - DO k=KTS+1,KTE-1 - sub_u(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (u(k+1)-u(k))/dzi(k) - sub_v(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (v(k+1)-v(k))/dzi(k) - ENDDO - - DO k=KTS,KTE-1 - det_u(k) = Cdet*(envm_u(k)-u(k))*envi_a(k)*Psig_w - det_v(k) = Cdet*(envm_v(k)-v(k))*envi_a(k)*Psig_w - ENDDO - ENDIF - ENDIF !end subsidence/env detranment - - !First, compute exner, plume theta, and dz centered at interface - !Here, k=1 is the top of the first model layer. These values do not - !need to be defined at k=kte (unused level). - 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 - -!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)THEN - - satvp = 3.80*exp(17.27*(th(k)-273.)/ & - (th(k)-36.))/(.01*p(k)) - rhgrid = max(.01,MIN( 1., qv(k) /satvp)) - - !then interpolate plume thl, th, and qt to mass levels - THp = (edmf_th(k)*dzi(k-1)+edmf_th(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) - QTp = (edmf_qt(k)*dzi(k-1)+edmf_qt(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) - !convert TH to T - t = THp*exner(k) - !SATURATED VAPOR PRESSURE - esat = esat_blend(t) - !SATURATED SPECIFIC HUMIDITY - qsl=ep_2*esat/max(1.e-4,(p(k)-ep_3*esat)) - - !condensed liquid in the plume on mass levels - IF (edmf_qc(k)>0.0 .AND. edmf_qc(k-1)>0.0)THEN - QCp = 0.5*(edmf_qc(k)+edmf_qc(k-1)) - ELSE - QCp = MAX(edmf_qc(k),edmf_qc(k-1)) - ENDIF - - !COMPUTE CLDFRA & QC_BL FROM MASS-FLUX SCHEME and recompute vt & vq - - xl = xl_blend(tk(k)) ! obtain blended heat capacity - tlk = thl(k)*(p(k)/p1000mb)**rcp ! recover liquid temp (tl) from thl - qsat_tl = qsat_blend(tlk,p(k)) ! get saturation water vapor mixing ratio - ! at tl and p - rsl = xl*qsat_tl / (r_v*tlk**2) ! slope of C-C curve at t = tl - ! CB02, Eqn. 4 - cpm = cp + qt(k)*cpv ! CB02, sec. 2, para. 1 - a = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" - b9 = a*rsl ! CB02 variable "b" - - q2p = xlvcp/exner(k) - pt = thl(k) +q2p*QCp*0.5*(edmf_a(k)+edmf_a(k-1)) ! potential temp (env + plume) - bb = b9*tk(k)/pt ! bb is "b9" in BCMT95. Their "b9" differs from - ! "b9" in CB02 by a factor - ! of T/theta. Strictly, b9 above is formulated in - ! terms of sat. mixing ratio, but bb in BCMT95 is - ! cast in terms of sat. specific humidity. The - ! conversion is neglected here. - qww = 1.+0.61*qt(k) - alpha = 0.61*pt - t = TH(k)*exner(k) - beta = pt*xl/(t*cp) - 1.61*pt - !Buoyancy flux terms have been moved to the end of this section... - - !Now calculate convective component of the cloud fraction: - if (a > 0.0) then - f = MIN(1.0/a, 4.0) ! f is vertical profile scaling function (CB2005) - else - f = 1.0 - endif - - sigq = 9.E-3 * 0.5*(edmf_a(k)+edmf_a(k-1)) * & - & 0.5*(edmf_w(k)+edmf_w(k-1)) * f ! convective component of sigma (CB2005) - sigq = SQRT(sigq**2 + sgm(k)**2) ! combined conv + stratus components - sigq = MAX(sigq, 1.0E-6) - - qmq = a * (qt(k) - qsat_tl) ! saturation deficit/excess; - ! the numerator of Q1 - mf_cf = min(max(0.5 + 0.36 * atan(1.55*(qmq/sigq)),0.01),0.6) - !IF ( debug_code ) THEN - ! print*,"In MYNN, StEM edmf" - ! print*," CB: env qt=",qt(k)," qsat=",qsat_tl - ! print*," k=",k," satdef=",QTp - qsat_tl," sgm=",sgm(k) - ! print*," CB: sigq=",sigq," qmq=",qmq," tlk=",tlk - ! print*," CB: mf_cf=",mf_cf," cldfra_bl=",cldfra_bl1d(k)," edmf_a=",edmf_a(k) - !ENDIF - - ! Update cloud fractions and specific humidities in grid cells - ! where the mass-flux scheme is active. Now, we also use the - ! stratus component of the SGS clouds as well. The stratus cloud - ! fractions (Ac_strat) are reduced slightly to give way to the - ! mass-flux SGS cloud fractions (Ac_mf). - IF (cldfra_bl1d(k) < 0.5) THEN - IF (mf_cf > 0.5*(edmf_a(k)+edmf_a(k-1))) THEN - !cldfra_bl1d(k) = mf_cf - !qc_bl1d(k) = QCp*0.5*(edmf_a(k)+edmf_a(k-1))/mf_cf - Ac_mf = mf_cf - Ac_strat = cldfra_bl1d(k)*(1.0-mf_cf) - cldfra_bl1d(k) = Ac_mf + Ac_strat - !dillute Qc from updraft area to larger cloud area - qc_mf = QCp*0.5*(edmf_a(k)+edmf_a(k-1))/mf_cf - !The mixing ratios from the stratus component are not well - !estimated in shallow-cumulus regimes. Ensure stratus clouds - !have mixing ratio similar to cumulus - QCs = MIN(MAX(qc_bl1d(k), 0.5*qc_mf), 5E-4) - qc_bl1d(k) = (qc_mf*Ac_mf + QCs*Ac_strat)/cldfra_bl1d(k) - ELSE - !cldfra_bl1d(k)=0.5*(edmf_a(k)+edmf_a(k-1)) - !qc_bl1d(k) = QCp - Ac_mf = 0.5*(edmf_a(k)+edmf_a(k-1)) - Ac_strat = cldfra_bl1d(k)*(1.0-Ac_mf) - cldfra_bl1d(k)=Ac_mf + Ac_strat - qc_mf = QCp - !Ensure stratus clouds have mixing ratio similar to cumulus - QCs = MIN(MAX(qc_bl1d(k), 0.5*qc_mf), 5E-4) - qc_bl1d(k) = (QCp*Ac_mf + QCs*Ac_strat)/cldfra_bl1d(k) - ENDIF - ELSE - Ac_mf = mf_cf - ENDIF - - !Now recalculate the terms for the buoyancy flux for mass-flux clouds: - !See mym_condensation for details on these formulations. The - !cloud-fraction bounding was added to improve cloud retention, - !following RAP and HRRR testing. - !Fng = 2.05 ! the non-Gaussian transport factor (assumed constant) - !Use Bechtold and Siebesma (1998) piecewise estimation of Fng: - Q1 = qmq/MAX(sigq,1E-6) - Q1=MAX(Q1,-5.0) - IF (Q1 .GE. 1.0) THEN - Fng = 1.0 - ELSEIF (Q1 .GE. -1.7 .AND. Q1 .LT. 1.0) THEN - Fng = EXP(-0.4*(Q1-1.0)) - ELSEIF (Q1 .GE. -2.5 .AND. Q1 .LT. -1.7) THEN - Fng = 3.0 + EXP(-3.8*(Q1+1.7)) - ELSE - Fng = MIN(23.9 + EXP(-1.6*(Q1+2.5)), 60.) - ENDIF - - vt(k) = qww - MIN(0.40,Ac_mf)*beta*bb*Fng - 1. - vq(k) = alpha + MIN(0.40,Ac_mf)*beta*a*Fng - tv0 - ENDIF - ENDDO - - 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 - -! -! debugging -! -IF (edmf_w(1) > 4.0) THEN -! surface values - print *,'flq:',flq,' fltv:',fltv - print *,'pblh:',pblh,' wstar:',wstar - print *,'sigmaW=',sigmaW,' sigmaTH=',sigmaTH,' sigmaQT=',sigmaQT -! means -! print *,'u:',u -! print *,'v:',v -! print *,'thl:',thl -! print *,'thv:',thv -! print *,'qt:',qt -! print *,'p:',p - -! updrafts -! DO I=1,NUP2 -! print *,'up:A',i -! print *,UPA(:,i) -! print *,'up:W',i -! print*,UPW(:,i) -! print *,'up:thv',i -! print *,UPTHV(:,i) -! print *,'up:thl',i -! print *,UPTHL(:,i) -! print *,'up:qt',i -! print *,UPQT(:,i) -! print *,'up:tQC',i -! print *,UPQC(:,i) -! print *,'up:ent',i -! print *,ENT(:,i) -! ENDDO - -! mean updrafts - print *,' edmf_a',edmf_a(1:14) - print *,' edmf_w',edmf_w(1:14) - print *,' edmf_qt:',edmf_qt(1:14) - print *,' edmf_thl:',edmf_thl(1:14) - -ENDIF !END Debugging - - -#ifdef HARDCODE_VERTICAL -# undef kts -# undef kte -#endif - -END SUBROUTINE DMP_MF -!================================================================= -!>\ingroup gsd_mynn_edmf -!! This subroutine -subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) -! -! zero or one condensation for edmf: calculates THV and QC -! -real,intent(in) :: QT,THL,P,zagl -real,intent(out) :: THV -real,intent(inout):: QC - -integer :: niter,i -real :: diff,exn,t,th,qs,qcold - -! constants used from module_model_constants.F -! p1000mb -! rcp ... Rd/cp -! xlv ... latent heat for water (2.5e6) -! cp -! rvord .. r_v/r_d (1.6) - -! number of iterations - niter=50 -! minimum difference (usually converges in < 8 iterations with diff = 2e-5) - diff=1.e-6 - - EXN=(P/p1000mb)**rcp - !QC=0. !better first guess QC is incoming from lower level, do not set to zero - do i=1,NITER - T=EXN*THL + xlvcp*QC - QS=qsat_blend(T,P) - QCOLD=QC - QC=0.5*QC + 0.5*MAX((QT-QS),0.) - if (abs(QC-QCOLD) 0.0) THEN -! PRINT*,"EDMF SAT, p:",p," iterations:",i -! PRINT*," T=",T," THL=",THL," THV=",THV -! PRINT*," QS=",QS," QT=",QT," QC=",QC,"ratio=",qc/qs -! ENDIF - - !THIS BASICALLY GIVE THE SAME RESULT AS THE PREVIOUS LINE - !TH = THL + xlv/cp/EXN*QC - !THV= TH*(1. + 0.608*QT) - - !print *,'t,p,qt,qs,qc' - !print *,t,p,qt,qs,qc - - -end subroutine condensation_edmf - -!=============================================================== - -subroutine condensation_edmf_r(QT,THL,P,zagl,THV,QC) -! -! zero or one condensation for edmf: calculates THL and QC -! similar to condensation_edmf but with different inputs -! -real,intent(in) :: QT,THV,P,zagl -real,intent(out) :: THL, QC - -integer :: niter,i -real :: diff,exn,t,th,qs,qcold - -! number of iterations - niter=50 -! minimum difference - diff=2.e-5 - - EXN=(P/p1000mb)**rcp - ! assume first that th = thv - T = THV*EXN - !QS = qsat_blend(T,P) - !QC = QS - QT - - QC=0. - - do i=1,NITER - QCOLD = QC - T = EXN*THV/(1.+QT*(rvovrd-1.)-rvovrd*QC) - QS=qsat_blend(T,P) - QC= MAX((QT-QS),0.) - if (abs(QC-QCOLD)0) then -! Wn2=DOWNW(K+1,I)**2*EntW - Wa*B/Beta_dm * (1. - EntW) -! else -! Wn2=DOWNW(K+1,I)**2 - 2.*Wa*B*dz(k) -! end if - - mindownw = MIN(DOWNW(K+1,I),-0.2) - Wn = DOWNW(K+1,I) + (-2.*ENT(K,I)*DOWNW(K+1,I) - & - 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) - ENDIF - !Add symmetrical max decrease in w - 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 - Wn = MAX(MIN(Wn,0.0), -3.0) - - !print *, " k =", k, " z =", ZW(k) - !print *, " entw =",ENT(K,I), " Bouy =", B - !print *, " downthv =", THVn, " thvk =", thvk - !print *, " downthl =", THLn, " thl =", thl(k) - !print *, " downqt =", QTn , " qt =", qt(k) - !print *, " downw+1 =",DOWNW(K+1,I), " Wn2 =", Wn - - IF (Wn .lt. 0.) THEN !terminate when velocity is too small - DOWNW(K,I) = Wn !-sqrt(Wn2) - DOWNTHV(K,I)= THVn - DOWNTHL(K,I)= THLn - DOWNQT(K,I) = QTn - DOWNQC(K,I) = QCn - DOWNU(K,I) = Un - DOWNV(K,I) = Vn - DOWNA(K,I) = DOWNA(K+1,I) - ELSE - !plumes must go at least 2 levels - if (DD_initK(I) - K .lt. 2) then - DOWNW(:,I) = 0.0 - DOWNTHV(:,I)= 0.0 - DOWNTHL(:,I)= 0.0 - DOWNQT(:,I) = 0.0 - DOWNQC(:,I) = 0.0 - DOWNU(:,I) = 0.0 - DOWNV(:,I) = 0.0 - endif - exit - ENDIF - ENDDO - ENDDO - endif ! end cloud flag - - DOWNW(1,:) = 0. !make sure downdraft does not go to the surface - DOWNA(1,:) = 0. - - ! Combine both moist and dry plume, write as one averaged plume - ! 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) - edmf_thl_dd(K)=edmf_thl_dd(K)+DOWNA(K-1,I)*DOWNTHL(K-1,I) - edmf_ent_dd(K)=edmf_ent_dd(K)+DOWNA(K-1,I)*ENT(K-1,I) - edmf_qc_dd(K) =edmf_qc_dd(K) +DOWNA(K-1,I)*DOWNQC(K-1,I) - ENDDO - - IF (edmf_a_dd(k) >0.) THEN - edmf_w_dd(k) =edmf_w_dd(k) /edmf_a_dd(k) - edmf_qt_dd(k) =edmf_qt_dd(k) /edmf_a_dd(k) - edmf_thl_dd(k)=edmf_thl_dd(k)/edmf_a_dd(k) - edmf_ent_dd(k)=edmf_ent_dd(k)/edmf_a_dd(k) - edmf_qc_dd(k) =edmf_qc_dd(k) /edmf_a_dd(k) - ENDIF - ENDDO - - ! - ! computing variables needed for solver - ! - - DO k=KTS,qlTop - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) - DO I=1,NDOWN - sd_aw(k) =sd_aw(k) +rho_int*DOWNA(k,i)*DOWNW(k,i) - sd_awthl(k)=sd_awthl(k)+rho_int*DOWNA(k,i)*DOWNW(k,i)*DOWNTHL(k,i) - sd_awqt(k) =sd_awqt(k) +rho_int*DOWNA(k,i)*DOWNW(k,i)*DOWNQT(k,i) - sd_awqc(k) =sd_awqc(k) +rho_int*DOWNA(k,i)*DOWNW(k,i)*DOWNQC(k,i) - sd_awu(k) =sd_awu(k) +rho_int*DOWNA(k,i)*DOWNW(k,i)*DOWNU(k,i) - sd_awv(k) =sd_awv(k) +rho_int*DOWNA(k,i)*DOWNW(k,i)*DOWNV(k,i) - ENDDO - sd_awqv(k) = sd_awqt(k) - sd_awqc(k) - ENDDO - -END SUBROUTINE DDMF_JPL -!=============================================================== - - -SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) - - !--------------------------------------------------------------- - ! NOTES ON SCALE-AWARE FORMULATION - ! - !JOE: add scale-aware factor (Psig) here, taken from Honnert et al. (2011, - ! JAS) and/or from Hyeyum Hailey Shin and Song-You Hong (2013, JAS) - ! - ! Psig_bl tapers local mixing - ! Psig_shcu tapers nonlocal mixing - - REAL,INTENT(IN) :: dx,PBL1 - REAL, INTENT(OUT) :: Psig_bl,Psig_shcu - REAL :: dxdh - - Psig_bl=1.0 - Psig_shcu=1.0 - dxdh=MAX(2.5*dx,10.)/MIN(PBL1,3000.) - ! Honnert et al. 2011, TKE in PBL *** original form used until 201605 - !Psig_bl= ((dxdh**2) + 0.07*(dxdh**0.667))/((dxdh**2) + & - ! (3./21.)*(dxdh**0.67) + (3./42.)) - ! Honnert et al. 2011, TKE in entrainment layer - !Psig_bl= ((dxdh**2) + (4./21.)*(dxdh**0.667))/((dxdh**2) + & - ! (3./20.)*(dxdh**0.67) + (7./21.)) - ! New form to preseve parameterized mixing - only down 5% at dx = 750 m - Psig_bl= ((dxdh**2) + 0.106*(dxdh**0.667))/((dxdh**2) +0.066*(dxdh**0.667) + 0.071) - - !assume a 500 m cloud depth for shallow-cu clods - dxdh=MAX(2.5*dx,10.)/MIN(PBL1+500.,3500.) - ! Honnert et al. 2011, TKE in entrainment layer *** original form used until 201605 - !Psig_shcu= ((dxdh**2) + (4./21.)*(dxdh**0.667))/((dxdh**2) + & - ! (3./20.)*(dxdh**0.67) + (7./21.)) - - ! Honnert et al. 2011, TKE in cumulus - !Psig(i)= ((dxdh**2) + 1.67*(dxdh**1.4))/((dxdh**2) +1.66*(dxdh**1.4) + - !0.2) - - ! Honnert et al. 2011, w'q' in PBL - !Psig(i)= 0.5 + 0.5*((dxdh**2) + 0.03*(dxdh**1.4) - - !(4./13.))/((dxdh**2) + 0.03*(dxdh**1.4) + (4./13.)) - ! Honnert et al. 2011, w'q' in cumulus - !Psig(i)= ((dxdh**2) - 0.07*(dxdh**1.4))/((dxdh**2) -0.07*(dxdh**1.4) + - !0.02) - - ! Honnert et al. 2011, q'q' in PBL - !Psig(i)= 0.5 + 0.5*((dxdh**2) + 0.25*(dxdh**0.667) -0.73)/((dxdh**2) - !-0.03*(dxdh**0.667) + 0.73) - ! Honnert et al. 2011, q'q' in cumulus - !Psig(i)= ((dxdh**2) - 0.34*(dxdh**1.4))/((dxdh**2) - 0.35*(dxdh**1.4) - !+ 0.37) - - ! Hyeyum Hailey Shin and Song-You Hong 2013, TKE in PBL (same as Honnert's above) - !Psig_shcu= ((dxdh**2) + 0.070*(dxdh**0.667))/((dxdh**2) - !+0.142*(dxdh**0.667) + 0.071) - ! Hyeyum Hailey Shin and Song-You Hong 2013, TKE in entrainment zone *** switch to this form 201605 - Psig_shcu= ((dxdh**2) + 0.145*(dxdh**0.667))/((dxdh**2) +0.172*(dxdh**0.667) + 0.170) - - ! Hyeyum Hailey Shin and Song-You Hong 2013, w'theta' in PBL - !Psig(i)= 0.5 + 0.5*((dxdh**2) -0.098)/((dxdh**2) + 0.106) - ! Hyeyum Hailey Shin and Song-You Hong 2013, w'theta' in entrainment zone - !Psig(i)= 0.5 + 0.5*((dxdh**2) - 0.112*(dxdh**0.25) -0.071)/((dxdh**2) - !+ 0.054*(dxdh**0.25) + 0.10) - - !print*,"in scale_aware; dx, dxdh, Psig(i)=",dx,dxdh,Psig(i) - !If(Psig_bl(i) < 0.0 .OR. Psig(i) > 1.)print*,"dx, dxdh, Psig(i)=",dx,dxdh,Psig_bl(i) - If(Psig_bl > 1.0) Psig_bl=1.0 - If(Psig_bl < 0.0) Psig_bl=0.0 - - If(Psig_shcu > 1.0) Psig_shcu=1.0 - If(Psig_shcu < 0.0) Psig_shcu=0.0 - - END SUBROUTINE SCALE_AWARE - -! ===================================================================== -!>\ingroup gsd_mynn_edmf -!! \author JAYMES- added 22 Apr 2015 -!! This function calculates saturation vapor pressure. Separate ice and liquid functions -!! are used (identical to those in module_mp_thompson.F, v3.6). Then, the -!! final returned value is a temperature-dependant "blend". Because the final -!! value is "phase-aware", this formulation may be preferred for use throughout -!! the module (replacing "svp"). - FUNCTION esat_blend(t) - - IMPLICIT NONE - - REAL, INTENT(IN):: t - REAL :: esat_blend,XC,ESL,ESI,chi - - XC=MAX(-80.,t-273.16) - -! For 253 < t < 273.16 K, the vapor pressures are "blended" as a function of temperature, -! using the approach of Chaboureau and Bechtold (2002), JAS, p. 2363. The resulting -! values are returned from the function. - IF (t .GE. 273.16) THEN - esat_blend = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) - ELSE IF (t .LE. 253.) THEN - esat_blend = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) - ELSE - ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) - ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) - chi = (273.16-t)/20.16 - esat_blend = (1.-chi)*ESL + chi*ESI - END IF - - END FUNCTION esat_blend - -! ==================================================================== - -!>\ingroup gsd_mynn_edmf -!! This function extends function "esat" and returns a "blended" -!! saturation mixing ratio. -!!\author JAYMES - FUNCTION qsat_blend(t, P, waterice) - - IMPLICIT NONE - - REAL, INTENT(IN):: t, P - CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: waterice - CHARACTER(LEN=1) :: wrt - REAL :: qsat_blend,XC,ESL,ESI,RSLF,RSIF,chi - - IF ( .NOT. PRESENT(waterice) ) THEN - wrt = 'b' - ELSE - wrt = waterice - ENDIF - - XC=MAX(-80.,t-273.16) - - IF ((t .GE. 273.16) .OR. (wrt .EQ. 'w')) THEN - ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) - qsat_blend = 0.622*ESL/(P-ESL) - ELSE IF (t .LE. 253.) THEN - ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) - qsat_blend = 0.622*ESI/(P-ESI) - ELSE - ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) - ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) - RSLF = 0.622*ESL/(P-ESL) - RSIF = 0.622*ESI/(P-ESI) - chi = (273.16-t)/20.16 - qsat_blend = (1.-chi)*RSLF + chi*RSIF - END IF - - END FUNCTION qsat_blend - -! =================================================================== - -!>\ingroup gsd_mynn_edmf -!! This function interpolates the latent heats of vaporization and sublimation into -!! a single, temperature-dependent, "blended" value, following -!! Chaboureau and Bechtold (2002) \cite Chaboureau_2002, Appendix. -!!\author JAYMES - FUNCTION xl_blend(t) - - IMPLICIT NONE - - REAL, INTENT(IN):: t - REAL :: xl_blend,xlvt,xlst,chi - - IF (t .GE. 273.16) THEN - xl_blend = xlv + (cpv-cliq)*(t-273.16) !vaporization/condensation - ELSE IF (t .LE. 253.) THEN - xl_blend = xls + (cpv-cice)*(t-273.16) !sublimation/deposition - ELSE - xlvt = xlv + (cpv-cliq)*(t-273.16) !vaporization/condensation - xlst = xls + (cpv-cice)*(t-273.16) !sublimation/deposition - chi = (273.16-t)/20.16 - xl_blend = (1.-chi)*xlvt + chi*xlst !blended - END IF - - END FUNCTION xl_blend - -! =================================================================== - - FUNCTION phim(zet) - ! New stability function parameters for momentum (Puhales, 2020, WRF 4.2.1) - ! The forms in unstable conditions (z/L < 0) use Grachev et al. (2000), which are a blend of - ! the classical (Kansas) forms (i.e., Paulson 1970, Dyer and Hicks 1970), valid for weakly - ! unstable conditions (-1 < z/L < 0). The stability functions for stable conditions use an - ! updated form taken from Cheng and Brutsaert (2005), which extends the validity into very - ! stable conditions [z/L ~ O(10)]. - IMPLICIT NONE - - REAL, INTENT(IN):: zet - REAL :: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - REAL, PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - REAL, PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - REAL, PARAMETER :: am_unst=10., ah_unst=34. - REAL :: phi_m,phim - - if ( zet >= 0.0 ) then - dummy_0=1+zet**bm_st - dummy_1=zet+dummy_0**(rbm_st) - dummy_11=1+dummy_0**(rbm_st-1)*zet**(bm_st-1) - dummy_2=(-am_st/dummy_1)*dummy_11 - phi_m = 1-zet*dummy_2 - else - dummy_0 = (1.0-cphm_unst*zet)**0.25 - phi_m = 1./dummy_0 - dummy_psi = 2.*log(0.5*(1.+dummy_0))+log(0.5*(1.+dummy_0**2))-2.*atan(dummy_0)+1.570796 - - dummy_0=(1.-am_unst*zet) ! parentesis arg - dummy_1=dummy_0**0.333333 ! y - dummy_11=-0.33333*am_unst*dummy_0**-0.6666667 ! dy/dzet - dummy_2 = 0.33333*(dummy_1**2.+dummy_1+1.) ! f - dummy_22 = 0.3333*dummy_11*(2.*dummy_1+1.) ! df/dzet - dummy_3 = 0.57735*(2.*dummy_1+1.) ! g - dummy_33 = 1.1547*dummy_11 ! dg/dzet - dummy_4 = 1.5*log(dummy_2)-1.73205*atan(dummy_3)+1.813799364 !psic - dummy_44 = (1.5/dummy_2)*dummy_22-1.73205*dummy_33/(1.+dummy_3**2)! dpsic/dzet - - dummy_0 = zet**2 - dummy_1 = 1./(1.+dummy_0) ! denon - dummy_11 = 2.*zet ! denon/dzet - dummy_2 = ((1-phi_m)/zet+dummy_11*dummy_4+dummy_0*dummy_44)*dummy_1 - dummy_22 = -dummy_11*(dummy_psi+dummy_0*dummy_4)*dummy_1**2 - - phi_m = 1.-zet*(dummy_2+dummy_22) - end if - - !phim = phi_m - zet - phim = phi_m - - END FUNCTION phim -! =================================================================== - - FUNCTION phih(zet) - ! New stability function parameters for heat (Puhales, 2020, WRF 4.2.1) - ! The forms in unstable conditions (z/L < 0) use Grachev et al. (2000), which are a blend of - ! the classical (Kansas) forms (i.e., Paulson 1970, Dyer and Hicks 1970), valid for weakly - ! unstable conditions (-1 < z/L < 0). The stability functions for stable conditions use an - ! updated form taken from Cheng and Brutsaert (2005), which extends the validity into very - ! stable conditions [z/L ~ O(10)]. - IMPLICIT NONE - - REAL, INTENT(IN):: zet - REAL :: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - REAL, PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - REAL, PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - REAL, PARAMETER :: am_unst=10., ah_unst=34. - REAL :: phh,phih - - if ( zet >= 0.0 ) then - dummy_0=1+zet**bh_st - dummy_1=zet+dummy_0**(rbh_st) - dummy_11=1+dummy_0**(rbh_st-1)*zet**(bh_st-1) - dummy_2=(-ah_st/dummy_1)*dummy_11 - phih = 1-zet*dummy_2 - else - dummy_0 = (1.0-cphh_unst*zet)**0.5 - phh = 1./dummy_0 - dummy_psi = 2.*log(0.5*(1.+dummy_0)) - - dummy_0=(1.-ah_unst*zet) ! parentesis arg - dummy_1=dummy_0**0.333333 ! y - dummy_11=-0.33333*ah_unst*dummy_0**-0.6666667 ! dy/dzet - dummy_2 = 0.33333*(dummy_1**2.+dummy_1+1.) ! f - dummy_22 = 0.3333*dummy_11*(2.*dummy_1+1.) ! df/dzet - dummy_3 = 0.57735*(2.*dummy_1+1.) ! g - dummy_33 = 1.1547*dummy_11 ! dg/dzet - dummy_4 = 1.5*log(dummy_2)-1.73205*atan(dummy_3)+1.813799364 !psic - dummy_44 = (1.5/dummy_2)*dummy_22-1.73205*dummy_33/(1.+dummy_3**2)! dpsic/dzet - - dummy_0 = zet**2 - dummy_1 = 1./(1.+dummy_0) ! denon - dummy_11 = 2.*zet ! ddenon/dzet - dummy_2 = ((1-phh)/zet+dummy_11*dummy_4+dummy_0*dummy_44)*dummy_1 - dummy_22 = -dummy_11*(dummy_psi+dummy_0*dummy_4)*dummy_1**2 - - phih = 1.-zet*(dummy_2+dummy_22) - end if - -END FUNCTION phih -! ================================================================== - SUBROUTINE topdown_cloudrad(kts,kte,dz1,zw,xland,kpbl,PBLH, & - &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & - &cldfra_bl1D,rthraten, & - &maxKHtopdown,KHtopdown,TKEprodTD ) - - !input - integer, intent(in) :: kte,kts - real, dimension(kts:kte), intent(in) :: dz1,sqc,sqi,sqw,& - thl,th1,ex1,p1,rho1,thetav,cldfra_bl1D,rthraten - real, dimension(kts:kte+1), intent(in) :: zw - real, intent(in) :: pblh,xland - integer,intent(in) :: kpbl - !output - real, intent(out) :: maxKHtopdown - real, dimension(kts:kte), intent(out) :: KHtopdown,TKEprodTD - !local - real, dimension(kts:kte) :: zfac,wscalek2,zfacent - real :: bfx0,sflux,wm2,wm3,h1,h2,bfxpbl,dthvx,tmp1 - real :: temps,templ,zl1,wstar3_2 - real :: ent_eff,radsum,radflux,we,rcldb,rvls,minrad,zminrad - real, parameter :: pfac =2.0, zfmin = 0.01, phifac=8.0 - integer :: k,kk,kminrad - logical :: cloudflg - - cloudflg=.false. - minrad=100. - kminrad=kpbl - zminrad=PBLH - KHtopdown(kts:kte)=0.0 - TKEprodTD(kts:kte)=0.0 - maxKHtopdown=0.0 - - !CHECK FOR STRATOCUMULUS-TOPPED BOUNDARY LAYERS - DO kk = MAX(1,kpbl-2),kpbl+3 - if (sqc(kk).gt. 1.e-6 .OR. sqi(kk).gt. 1.e-6 .OR. & - cldfra_bl1D(kk).gt.0.5) then - cloudflg=.true. - endif - if (rthraten(kk) < minrad)then - minrad=rthraten(kk) - kminrad=kk - zminrad=zw(kk) + 0.5*dz1(kk) - endif - ENDDO - - IF (MAX(kminrad,kpbl) < 2)cloudflg = .false. - IF (cloudflg) THEN - zl1 = dz1(kts) - k = MAX(kpbl-1, kminrad-1) - !Best estimate of height of TKE source (top of downdrafts): - !zminrad = 0.5*pblh(i) + 0.5*zminrad - - templ=thl(k)*ex1(k) - !rvls is ws at full level - rvls=100.*6.112*EXP(17.67*(templ-273.16)/(templ-29.65))*(ep_2/p1(k+1)) - temps=templ + (sqw(k)-rvls)/(cp/xlv + ep_2*xlv*rvls/(r_d*templ**2)) - rvls=100.*6.112*EXP(17.67*(temps-273.15)/(temps-29.65))*(ep_2/p1(k+1)) - rcldb=max(sqw(k)-rvls,0.) - - !entrainment efficiency - dthvx = (thl(k+2) + th1(k+2)*p608*sqw(k+2)) & - - (thl(k) + th1(k) *p608*sqw(k)) - dthvx = max(dthvx,0.1) - tmp1 = xlvcp * rcldb/(ex1(k)*dthvx) - !Originally from Nichols and Turton (1986), where a2 = 60, but lowered - !here to 8, as in Grenier and Bretherton (2001). - ent_eff = 0.2 + 0.2*8.*tmp1 - - radsum=0. - DO kk = MAX(1,kpbl-3),kpbl+3 - radflux=rthraten(kk)*ex1(kk) !converts theta/s to temp/s - radflux=radflux*cp/grav*(p1(kk)-p1(kk+1)) ! converts temp/s to W/m^2 - if (radflux < 0.0 ) radsum=abs(radflux)+radsum - ENDDO - - !More strict limits over land to reduce stable-layer mixouts - if ((xland-1.5).GE.0)THEN ! WATER - radsum=MIN(radsum,90.0) - bfx0 = max(radsum/rho1(k)/cp,0.) - else ! LAND - radsum=MIN(0.25*radsum,30.0)!practically turn off over land - bfx0 = max(radsum/rho1(k)/cp - max(sflux,0.0),0.) - endif - - !entrainment from PBL top thermals - wm3 = grav/thetav(k)*bfx0*MIN(pblh,1500.) ! this is wstar3(i) - wm2 = wm2 + wm3**h2 - bfxpbl = - ent_eff * bfx0 - dthvx = max(thetav(k+1)-thetav(k),0.1) - we = max(bfxpbl/dthvx,-sqrt(wm3**h2)) - - DO kk = kts,kpbl+3 - !Analytic vertical profile - zfac(kk) = min(max((1.-(zw(kk+1)-zl1)/(zminrad-zl1)),zfmin),1.) - zfacent(kk) = 10.*MAX((zminrad-zw(kk+1))/zminrad,0.0)*(1.-zfac(kk))**3 - - !Calculate an eddy diffusivity profile (not used at the moment) - wscalek2(kk) = (phifac*karman*wm3*(zfac(kk)))**h1 - !Modify shape of Kh to be similar to Lock et al (2000): use pfac = 3.0 - KHtopdown(kk) = wscalek2(kk)*karman*(zminrad-zw(kk+1))*(1.-zfac(kk))**3 !pfac - KHtopdown(kk) = MAX(KHtopdown(kk),0.0) - - !Calculate TKE production = 2(g/TH)(w'TH'), where w'TH' = A(TH/g)wstar^3/PBLH, - !A = ent_eff, and wstar is associated with the radiative cooling at top of PBL. - !An analytic profile controls the magnitude of this TKE prod in the vertical. - TKEprodTD(kk)=2.*ent_eff*wm3/MAX(pblh,100.)*zfacent(kk) - TKEprodTD(kk)= MAX(TKEprodTD(kk),0.0) - ENDDO - ENDIF !end cloud check - maxKHtopdown=MAXVAL(KHtopdown(:)) - - END SUBROUTINE topdown_cloudrad -! ================================================================== -! =================================================================== -! =================================================================== - -END MODULE module_bl_mynn