<HTML> <BODY BGCOLOR=#bbeeee LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE><a name='1'>
<font color=#447700>!-----------------------------------------------------------------------<a name='2'></font>
<font color=#447700>!<a name='3'></font>
<font color=#447700>!NCEP_MESO:MODEL_LAYER: PHYSICS<a name='4'></font>
<font color=#447700>!<a name='5'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='6'></font>
#include "<A href='../../html_code/include/nmm_loop_basemacros.h.html'>nmm_loop_basemacros.h</A>"<A NAME="nmm_loop_basemacros.h_1"><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='7'>
#include "<A href='../../html_code/include/nmm_loop_macros.h.html'>nmm_loop_macros.h</A>"<A NAME="nmm_loop_macros.h_2"><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='8'>
<font color=#447700>!-----------------------------------------------------------------------<a name='9'></font>
<font color=#447700>!<a name='10'></font>
<A NAME='MODULE_PHYSICS_CALLS'><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#MODULE_PHYSICS_CALLS' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A><a name='11'>
<font color=#993300>MODULE </font><font color=#cc0000>MODULE_PHYSICS_CALLS</font> <A href='../../call_to/MODULE_PHYSICS_CALLS.html' TARGET='index'>1</A><a name='12'>
<font color=#447700>!<a name='13'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='14'></font>
USE <A href='../../html_code/frame/module_domain.F.html#MODULE_DOMAIN'>MODULE_DOMAIN</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_DOMAIN_19"><a name='15'>
USE <A href='../../html_code/frame/module_dm_stubs.F.html#MODULE_DM'>MODULE_DM</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_DM_16"><a name='16'>
USE <A href='../../html_code/frame/module_configure.F.html#MODULE_CONFIGURE'>MODULE_CONFIGURE</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_CONFIGURE_21"><a name='17'>
USE <A href='../../html_code/frame/module_tiles.F.html#MODULE_TILES'>MODULE_TILES</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_TILES_5"><a name='18'>
USE MODULE_STATE_DESCRIPTION,ONLY : P_QV,P_QC,P_QR,P_QI,P_QS,P_QG<a name='19'>
USE <A href='../../html_code/share/module_model_constants.F.html#MODULE_MODEL_CONSTANTS'>MODULE_MODEL_CONSTANTS</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_MODEL_CONSTANTS_20"><a name='20'>
USE <A href='../../html_code/phys/module_ra_gfdleta.F.html#MODULE_RA_GFDLETA'>MODULE_RA_GFDLETA</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_RA_GFDLETA_2">,ONLY : CAL_MON_DAY,ZENITH<a name='21'>
USE <A href='../../html_code/phys/module_radiation_driver.F.html#MODULE_RADIATION_DRIVER'>MODULE_RADIATION_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_RADIATION_DRIVER_2"><a name='22'>
USE <A href='../../html_code/phys/module_sf_myjsfc.F.html#MODULE_SF_MYJSFC'>MODULE_SF_MYJSFC</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_SF_MYJSFC_1"><a name='23'>
USE <A href='../../html_code/phys/module_surface_driver.F.html#MODULE_SURFACE_DRIVER'>MODULE_SURFACE_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_SURFACE_DRIVER_2"><a name='24'>
USE <A href='../../html_code/phys/module_pbl_driver.F.html#MODULE_PBL_DRIVER'>MODULE_PBL_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_PBL_DRIVER_2"><a name='25'>
USE <A href='../../html_code/phys/module_cu_bmj.F.html#MODULE_CU_BMJ'>MODULE_CU_BMJ</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_CU_BMJ_1"><a name='26'>
USE <A href='../../html_code/phys/module_cumulus_driver.F.html#MODULE_CUMULUS_DRIVER'>MODULE_CUMULUS_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_CUMULUS_DRIVER_2"><a name='27'>
USE <A href='../../html_code/phys/module_mp_etanew.F.html#MODULE_MP_ETANEW'>MODULE_MP_ETANEW</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_MP_ETANEW_1"><a name='28'>
USE <A href='../../html_code/phys/module_microphysics_driver.F.html#MODULE_MICROPHYSICS_DRIVER'>MODULE_MICROPHYSICS_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_MICROPHYSICS_DRIVER_2"><a name='29'>
USE <A href='../../html_code/phys/module_microphysics_zero_out.F.html#MODULE_MICROPHYSICS_ZERO_OUT'>MODULE_MICROPHYSICS_ZERO_OUT</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#module_PHYSICS_CALLS.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_MICROPHYSICS_ZERO_OUT_2"><a name='30'>
<font color=#447700>!-----------------------------------------------------------------------<a name='31'></font>
<font color=#447700>!<a name='32'></font>
CONTAINS<a name='33'>
<font color=#447700>!<a name='34'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='35'></font>
<font color=#447700>!***********************************************************************<a name='36'></font>
<A NAME='RADIATION'><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#RADIATION' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='37'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>RADIATION</font>(NTSD,DT,JULDAY,JULYR,IHRST,NPHS,GLAT,GLON & <A href='../../call_to/RADIATION.html' TARGET='index'>1</A>,<A href='../../call_from/RADIATION.html' TARGET='index'>4</A><a name='38'>
& ,NRADS,NRADL &<a name='39'>
& ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT &<a name='40'>
& ,PD,RES,PINT,T,Q,CWM,THS,ALBEDO,EPSR &<a name='41'>
& ,F_ICE,F_RAIN &<a name='42'>
& ,SM,HBM2,LMH,CLDFRA,N_MOIST,RESTRT &<a name='43'>
& ,RLWTT,RSWTT,RLWIN,RSWIN,RSWINC,RSWOUT &<a name='44'>
& ,RLWTOA,RSWTOA,CZMEAN &<a name='45'>
& ,CFRACL,CFRACM,CFRACH,SIGT4 &<a name='46'>
& ,ACFRST,NCFRST,ACFRCV,NCFRCV &<a name='47'>
& ,CUPPT,VEGFRC,SNOW &<a name='48'>
& ,HTOP,HBOT,HTOPD,HBOTD,HTOPS,HBOTS &<a name='49'>
& ,GRID,CONFIG_FLAGS &<a name='50'>
& ,IDS,IDE,JDS,JDE,KDS,KDE &<a name='51'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='52'>
& ,ITS,ITE,JTS,JTE,KTS,KTE)<a name='53'>
<font color=#447700>!*** NOTE ***<a name='54'></font>
<font color=#447700>! RLWIN - downward longwave at the surface (=TOTLWDN, now a local array)<a name='55'></font>
<font color=#447700>! RSWIN - downward shortwave at the surface (=TOTSWDN, now a local array)<a name='56'></font>
<font color=#447700>! RSWINC - CLEAR-SKY downward shortwave at the surface (=TOTSWDNC, new for AQ)<a name='57'></font>
<font color=#447700>!***********************************************************************<a name='58'></font>
<font color=#447700>!$$$ SUBPROGRAM DOCUMENTATION BLOCK<a name='59'></font>
<font color=#447700>! . . . <a name='60'></font>
<font color=#447700>! SUBPROGRAM: RADIATION RADIATION OUTER DRIVER<a name='61'></font>
<font color=#447700>! PRGRMMR: BLACK ORG: W/NP22 DATE: 2002-06-04 <a name='62'></font>
<font color=#447700>! <a name='63'></font>
<font color=#447700>! ABSTRACT:<a name='64'></font>
<font color=#447700>! RADIATION SERVES AS THE INTERFACE BETWEEN THE NCEP NONHYDROSTATIC<a name='65'></font>
<font color=#447700>! MESOSCALE MODEL AND THE WRF RADIATION DRIVER.<a name='66'></font>
<font color=#447700>! <a name='67'></font>
<font color=#447700>! PROGRAM HISTORY LOG:<a name='68'></font>
<font color=#447700>! 02-06-04 BLACK - ORIGINATOR<a name='69'></font>
<font color=#447700>! 02-09-09 WOLFE - CONVERTING TO GLOBAL INDEXING<a name='70'></font>
<font color=#447700>! 04-11-18 BLACK - THREADED<a name='71'></font>
<font color=#447700>! <a name='72'></font>
<font color=#447700>! USAGE: CALL RADIATION FROM SOLVE_NMM <a name='73'></font>
<font color=#447700>!<a name='74'></font>
<font color=#447700>! ATTRIBUTES:<a name='75'></font>
<font color=#447700>! LANGUAGE: FORTRAN 90<a name='76'></font>
<font color=#447700>! MACHINE : IBM <a name='77'></font>
<font color=#447700>!$$$ <a name='78'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='79'></font>
<font color=#447700>!<a name='80'></font>
IMPLICIT NONE<a name='81'>
<font color=#447700>!<a name='82'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='83'></font>
<font color=#447700>!<a name='84'></font>
INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &<a name='85'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='86'>
& ,ITS,ITE,JTS,JTE,KTS,KTE &<a name='87'>
& ,IHRST,JULDAY,JULYR &<a name='88'>
& ,N_MOIST,NPHS,NRADL,NRADS,NTSD<a name='89'>
<font color=#447700>!<a name='90'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: NCFRCV,NCFRST<a name='91'>
<font color=#447700>!<a name='92'></font>
REAL,INTENT(IN) :: DT,PDTOP,PT<a name='93'>
<font color=#447700>!<a name='94'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH<a name='95'>
<font color=#447700>!<a name='96'></font>
REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2<a name='97'>
<font color=#447700>!<a name='98'></font>
REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2<a name='99'>
<font color=#447700>!<a name='100'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: ALBEDO &<a name='101'>
& ,EPSR,GLAT,GLON &<a name='102'>
& ,HBM2,PD,RES,SM &<a name='103'>
& ,SNOW,THS,VEGFRC<a name='104'>
<font color=#447700>!<a name='105'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM,F_ICE &<a name='106'>
& ,F_RAIN,Q,T<a name='107'>
<font color=#447700>!<a name='108'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACFRCV,ACFRST &<a name='109'>
& ,CUPPT &<a name='110'>
& ,HBOT,HTOP &<a name='111'>
& ,RLWIN,RLWTOA &<a name='112'>
& ,RSWIN,RSWOUT &<a name='113'>
& ,RSWINC,RSWTOA<a name='114'>
<font color=#447700>!<a name='115'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: RLWTT &<a name='116'>
& ,RSWTT &<a name='117'>
& ,PINT<a name='118'>
<font color=#447700>!<a name='119'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CFRACH,CFRACL &<a name='120'>
& ,CFRACM,CZMEAN &<a name='121'>
& ,HBOTD,HTOPD &<a name='122'>
& ,HBOTS,HTOPS &<a name='123'>
& ,SIGT4<a name='124'>
<font color=#447700>!<a name='125'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: CLDFRA<a name='126'>
<font color=#447700>!<a name='127'></font>
LOGICAL,INTENT(IN) :: RESTRT<a name='128'>
<font color=#447700>!<a name='129'></font>
TYPE(DOMAIN),TARGET :: GRID<a name='130'>
<font color=#447700>!<a name='131'></font>
TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS<a name='132'>
<font color=#447700>!<a name='133'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='134'></font>
<font color=#447700>!***<a name='135'></font>
<font color=#447700>!*** LOCAL VARIABLES<a name='136'></font>
<font color=#447700>!***<a name='137'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='138'></font>
INTEGER :: I,ICLOUD,IENDX,II,J,JDAY,JMONTH,K,KMNTH,LMHIJ,NRAD<a name='139'>
<font color=#447700>!<a name='140'></font>
INTEGER,DIMENSION(3) :: IDAT<a name='141'>
INTEGER,DIMENSION(12) :: MONTH=(/31,28,31,30,31,30,31,31 &<a name='142'>
& ,30,31,30,31/)<a name='143'>
<font color=#447700>!<a name='144'></font>
REAL :: CAPA,DAYI,DPL,FICE,FRAIN,GMT,HOUR,PDSL,PLYR,PSFC &<a name='145'>
& ,QI,QR,QW,RADT,TIMES,WC,TDUM<a name='146'>
<font color=#447700>!<a name='147'></font>
REAL,DIMENSION(KMS:KME-1) :: QL,TL<a name='148'>
<font color=#447700>!<a name='149'></font>
REAL,DIMENSION(IMS:IME,JMS:JME) :: REXNSFC,SWNETDN &<a name='150'>
& ,TOT,TSFC,XLAND,XLAT,XLON &<a name='151'>
& ,TOTLWDN,TOTSWDN,TOTSWDNC,CZEN<a name='152'>
<font color=#447700>!<a name='153'></font>
<font color=#447700>!<a name='154'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: AER_DRY,AER_WATER &<a name='155'>
& ,DZ,P8W,P_PHY,PI_PHY &<a name='156'>
& ,RR,T8W,THRATEN &<a name='157'>
& ,THRATENLW,THRATENSW &<a name='158'>
& ,TH_PHY,T_PHY,CLFR<a name='159'>
<font color=#447700>!<a name='160'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST) :: WATER<a name='161'>
<font color=#447700>!<a name='162'></font>
LOGICAL :: WARM_RAIN<a name='163'>
<font color=#447700>!<a name='164'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='165'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='166'></font>
<font color=#447700>!*****<a name='167'></font>
<font color=#447700>!***** NOTE: THIS IS HARDWIRED FOR CALLS TO LONGWAVE AND SHORTWAVE<a name='168'></font>
<font color=#447700>!***** AT EQUAL INTERVALS<a name='169'></font>
<font color=#447700>!*****<a name='170'></font>
NRAD=NRADS<a name='171'>
RADT=DT*NRADS/60.<a name='172'>
<font color=#447700>!-----------------------------------------------------------------------<a name='173'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='174'></font>
CAPA=R_D/CP<a name='175'>
<font color=#447700>!-----------------------------------------------------------------------<a name='176'></font>
<font color=#447700>!$omp parallel do &<a name='177'></font>
<font color=#447700>!$omp& private(i,j,k)<a name='178'></font>
DO J=MYJS,MYJE<a name='179'>
DO K=KTS,KTE<a name='180'>
DO I=MYIS,MYIE<a name='181'>
WATER(I,K,J,P_QS)=0.<a name='182'>
WATER(I,K,J,P_QG)=0.<a name='183'>
ENDDO<a name='184'>
ENDDO<a name='185'>
ENDDO<a name='186'>
<font color=#447700>!-----------------------------------------------------------------------<a name='187'></font>
<font color=#447700>!<a name='188'></font>
<font color=#447700>!$omp parallel do &<a name='189'></font>
<font color=#447700>!$omp& private(dpl,fice,frain,i,j,k,pdsl,plyr,qi,ql,qr,qw,tl,wc)<a name='190'></font>
DO J=MYJS2,MYJE2<a name='191'>
DO I=MYIS1,MYIE1<a name='192'>
<font color=#447700>!<a name='193'></font>
PDSL=PD(I,J)*RES(I,J)<a name='194'>
P8W(I,KTE+1,J)=PT<a name='195'>
XLAT(I,J)=GLAT(I,J)/DEGRAD<a name='196'>
XLON(I,J)=GLON(I,J)/DEGRAD<a name='197'>
XLAND(I,J)=SM(I,J)+1.<a name='198'>
PSFC=PD(I,J)+PDTOP+PT<a name='199'>
REXNSFC(I,J)=(PSFC*1.E-5)**CAPA<a name='200'>
TSFC(I,J)=THS(I,J)*REXNSFC(I,J)<a name='201'>
T8W(I,1,J)=TSFC(I,J)<a name='202'>
P8W(I,KTS,J)=ETA1(KTS)*PDTOP+ETA2(KTS)*PDSL+PT<a name='203'>
<font color=#447700>!<a name='204'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='205'></font>
<font color=#447700>!*** FILL THE SINGLE-COLUMN INPUT<a name='206'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='207'></font>
<font color=#447700>!<a name='208'></font>
DO K=KTS,KTE<a name='209'>
DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL<a name='210'>
QL(K)=AMAX1(Q(I,K,J),EPSQ)<a name='211'>
PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT<a name='212'>
TL(K)=T(I,K,J)<a name='213'>
<font color=#447700>!<a name='214'></font>
RR(I,K,J)=PLYR/(R_D*TL(K)*(1.+P608*QL(K)))<a name='215'>
T_PHY(I,K,J)=TL(K)<a name='216'>
WATER(I,K,J,P_QV)=QL(K)/(1.-QL(K))<a name='217'>
TH_PHY(I,K,J)=TL(K)*(1.E5/PLYR)**CAPA<a name='218'>
P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT<a name='219'>
P_PHY(I,K,J)=PLYR<a name='220'>
PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA<a name='221'>
DZ(I,K,J)=TL(K)*(P608*QL(K)+1.)*R_D &<a name='222'>
& *(P8W(I,K,J)-P8W(I,K+1,J)) &<a name='223'>
& /(P_PHY(I,K,J)*G)<a name='224'>
<font color=#447700>!!! & *ALOG(P8W(I,KFLIP,J)/P8W(I,KFLIP+1,J))/G &<a name='225'></font>
<font color=#447700>!!! & *ALOG(PINT(I,K+1,J)/PINT(I,K,J))/G &<a name='226'></font>
<font color=#447700>!<a name='227'></font>
THRATEN(I,K,J)=0.<a name='228'>
THRATENLW(I,K,J)=0.<a name='229'>
THRATENSW(I,K,J)=0.<a name='230'>
AER_DRY(I,K,J)=0.<a name='231'>
AER_WATER(I,K,J)=0.<a name='232'>
<font color=#447700>!<a name='233'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='234'></font>
<font color=#447700>!*** DECOMPOSE CLOUDS TO CLOUD LIQUID, RAIN, AND CLOUD ICE + SNOW.<a name='235'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='236'></font>
<font color=#447700>!<a name='237'></font>
WC=CWM(I,K,J)<a name='238'>
QI=0.<a name='239'>
QR=0.<a name='240'>
QW=0.<a name='241'>
FICE=F_ICE(I,K,J)<a name='242'>
FRAIN=F_RAIN(I,K,J)<a name='243'>
<font color=#447700>!<a name='244'></font>
IF(FICE>=1.)THEN<a name='245'>
QI=WC<a name='246'>
ELSEIF(FICE<=0.)THEN<a name='247'>
QW=WC<a name='248'>
ELSE<a name='249'>
QI=FICE*WC<a name='250'>
QW=WC-QI<a name='251'>
ENDIF<a name='252'>
<font color=#447700>!<a name='253'></font>
IF(QW>0..AND.FRAIN>0.)THEN<a name='254'>
IF(FRAIN.GE.1.)THEN<a name='255'>
QR=QW<a name='256'>
QW=0.<a name='257'>
ELSE<a name='258'>
QR=FRAIN*QW<a name='259'>
QW=QW-QR<a name='260'>
ENDIF<a name='261'>
ENDIF<a name='262'>
<font color=#447700>!<a name='263'></font>
WATER(I,K,J,P_QC)=QW<a name='264'>
WATER(I,K,J,P_QR)=QR<a name='265'>
WATER(I,K,J,P_QI)=QI<a name='266'>
ENDDO<a name='267'>
<font color=#447700>!<a name='268'></font>
DO K=KTS+1,KTE<a name='269'>
T8W(I,K,J)=0.5*(TL(K-1)+TL(K))<a name='270'>
ENDDO<a name='271'>
T8W(I,KTE+1,J)=-1.E20<a name='272'>
<font color=#447700>!<a name='273'></font>
ENDDO<a name='274'>
ENDDO<a name='275'>
<font color=#447700>!<a name='276'></font>
ICLOUD=999<a name='277'>
<font color=#447700>!<a name='278'></font>
GMT=REAL(IHRST)<a name='279'>
<font color=#447700>!<a name='280'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='281'></font>
<font color=#447700>!<a name='282'></font>
<font color=#447700>!*** CALL THE INNER DRIVER.<a name='283'></font>
<font color=#447700>!<a name='284'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='285'></font>
<font color=#447700>!<a name='286'></font>
DO J=JMS,JME<a name='287'>
DO K=KMS,KME<a name='288'>
DO I=IMS,IME<a name='289'>
CLDFRA(I,K,J)=0.<a name='290'>
ENDDO<a name='291'>
ENDDO<a name='292'>
<font color=#447700>!<a name='293'></font>
DO I=IMS,IME<a name='294'>
CFRACH(I,J)=0.<a name='295'>
CFRACL(I,J)=0.<a name='296'>
CFRACM(I,J)=0.<a name='297'>
CZMEAN(I,J)=0.<a name='298'>
SIGT4(I,J)=0.<a name='299'>
TOTSWDN(I,J)=0. <font color=#447700>! TOTAL (clear+cloudy sky) shortwave down at the surface<a name='300'></font>
TOTSWDNC(I,J)=0. <font color=#447700>! CLEAR SKY shortwave down at the surface<a name='301'></font>
SWNETDN(I,J)=0. <font color=#447700>! Net (down - up) total (clear+cloudy sky) shortwave at the surface<a name='302'></font>
TOTLWDN(I,J)=0. <font color=#447700>! Total longwave down at the surface<a name='303'></font>
ENDDO<a name='304'>
ENDDO<a name='305'>
<font color=#447700>!<a name='306'></font>
CALL <A href='../../html_code/frame/module_tiles.F.html#SET_TILES'>SET_TILES</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#RADIATION' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="SET_TILES_3">(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)<a name='307'>
<font color=#447700>!<a name='308'></font>
CALL <A href='../../html_code/phys/module_radiation_driver.F.html#RADIATION_DRIVER'>RADIATION_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#RADIATION' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="RADIATION_DRIVER_2">( &<a name='309'>
& IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &<a name='310'>
& ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &<a name='311'>
& ,I_START=GRID%I_START,I_END=GRID%I_END &<a name='312'>
& ,J_START=GRID%J_START,J_END=GRID%J_END &<a name='313'>
& ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &<a name='314'>
& ,ITIMESTEP=NTSD,DT=DT &<a name='315'>
& ,AER_DRY=AER_DRY,AER_WATER=AER_WATER &<a name='316'>
& ,RTHRATENLW=THRATENLW,RTHRATENSW=THRATENSW &<a name='317'>
& ,RTHRATEN=THRATEN &<a name='318'>
& ,GLW=TOTLWDN,GSW=SWNETDN,SWDOWN=TOTSWDN &<a name='319'>
& ,XLAT=XLAT,XLONG=XLON,ALBEDO=ALBEDO,EMISS=EPSR &<a name='320'>
& ,XLAND=XLAND,TSK=TSFC &<a name='321'>
& ,HTOP=HTOP,HBOT=HBOT,CUPPT=CUPPT &<a name='322'>
& ,VEGFRA=VEGFRC,SNOW=SNOW &<a name='323'>
& ,RHO=RR,P8W=P8W,P=P_PHY,PI=PI_PHY &<a name='324'>
& ,DZ8W=DZ,T=T_PHY,T8W=T8W,GMT=GMT &<a name='325'>
& ,JULDAY=JULDAY,JULYR=JULYR,NPHS=NPHS &<a name='326'>
& ,LW_PHYSICS=CONFIG_FLAGS%RA_LW_PHYSICS &<a name='327'>
& ,SW_PHYSICS=CONFIG_FLAGS%RA_SW_PHYSICS &<a name='328'>
& ,RADT=RADT,STEPRA=NRAD,ICLOUD=ICLOUD &<a name='329'>
& ,WARM_RAIN=WARM_RAIN & <a name='330'>
& ,SWDOWNC=TOTSWDNC,CLDFRA=CLFR &<a name='331'>
& ,RSWTOA=RSWTOA,RLWTOA=RLWTOA &<a name='332'>
& ,CZMEAN=CZMEAN,CFRACL=CFRACL &<a name='333'>
& ,CFRACM=CFRACM,CFRACH=CFRACH &<a name='334'>
& ,ACFRST=ACFRST,NCFRST=NCFRST &<a name='335'>
& ,ACFRCV=ACFRCV,NCFRCV=NCFRCV &<a name='336'>
& ,QV=WATER(IMS,KMS,JMS,P_QV),F_QV=F_QV &<a name='337'>
& ,QC=WATER(IMS,KMS,JMS,P_QC),F_QC=F_QC &<a name='338'>
& ,QR=WATER(IMS,KMS,JMS,P_QR),F_QR=F_QR &<a name='339'>
& ,QI=WATER(IMS,KMS,JMS,P_QI),F_QI=F_QI &<a name='340'>
& ,QS=WATER(IMS,KMS,JMS,P_QS),F_QS=F_QS &<a name='341'>
& ,QG=WATER(IMS,KMS,JMS,P_QG),F_QG=F_QG )<a name='342'>
<font color=#447700>!<a name='343'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='344'></font>
<font color=#447700>!<a name='345'></font>
<font color=#447700>!*** UPDATE FLUXES AND TEMPERATURE TENDENCIES.<a name='346'></font>
<font color=#447700>!<a name='347'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='348'></font>
<font color=#447700>!*** SHORTWAVE<a name='349'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='350'></font>
<font color=#447700>!<a name='351'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='352'></font>
IF(MOD(NTSD,NRADS)==0)THEN<a name='353'>
<font color=#447700>!-----------------------------------------------------------------------<a name='354'></font>
<font color=#447700>!<a name='355'></font>
IF(CONFIG_FLAGS%RA_SW_PHYSICS/=GFDLSWSCHEME)THEN<a name='356'>
<font color=#447700>!<a name='357'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='358'></font>
<font color=#447700>!*** COMPUTE CZMEAN FOR NON-GFDL SHORTWAVE<a name='359'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='360'></font>
<font color=#447700>!<a name='361'></font>
DO J=MYJS,MYJE<a name='362'>
DO I=MYIS,MYIE<a name='363'>
CZMEAN(I,J)=0.<a name='364'>
TOT(I,J)=0.<a name='365'>
ENDDO<a name='366'>
ENDDO<a name='367'>
<font color=#447700>!<a name='368'></font>
CALL <A href='../../html_code/phys/module_ra_gfdleta.F.html#CAL_MON_DAY'>CAL_MON_DAY</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#RADIATION' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="CAL_MON_DAY_2">(JULDAY,JULYR,JMONTH,JDAY)<a name='369'>
IDAT(1)=JMONTH<a name='370'>
IDAT(2)=JDAY<a name='371'>
IDAT(3)=JULYR<a name='372'>
<font color=#447700>!<a name='373'></font>
DO II=0,NRADS,NPHS<a name='374'>
TIMES=NTSD*DT+II*DT<a name='375'>
CALL <A href='../../html_code/phys/module_ra_gfdleta.F.html#ZENITH'>ZENITH</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#RADIATION' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="ZENITH_2">(TIMES,DAYI,HOUR,IDAT,IHRST,GLON,GLAT,CZEN &<a name='376'>
& ,MYIS &<a name='377'>
& ,MYIE &<a name='378'>
& ,MYJS &<a name='379'>
& ,MYJE &<a name='380'>
& ,IDS,IDE,JDS,JDE,KDS,KDE &<a name='381'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='382'>
& ,ITS,ITE,JTS,JTE,KTS,KTE)<a name='383'>
DO J=MYJS,MYJE<a name='384'>
DO I=MYIS,MYIE<a name='385'>
IF(CZEN(I,J)>0.)THEN<a name='386'>
CZMEAN(I,J)=CZMEAN(I,J)+CZEN(I,J)<a name='387'>
TOT(I,J)=TOT(I,J)+1.<a name='388'>
ENDIF<a name='389'>
ENDDO<a name='390'>
ENDDO<a name='391'>
<font color=#447700>!<a name='392'></font>
ENDDO<a name='393'>
<font color=#447700>!<a name='394'></font>
DO J=MYJS,MYJE<a name='395'>
DO I=MYIS,MYIE<a name='396'>
IF(TOT(I,J)>0.)CZMEAN(I,J)=CZMEAN(I,J)/TOT(I,J)<a name='397'>
ENDDO<a name='398'>
ENDDO<a name='399'>
<font color=#447700>!<a name='400'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='401'></font>
<font color=#447700>!*** COMPUTE TOTAL SFC SHORTWAVE DOWN FOR NON-GFDL SCHEMES<a name='402'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='403'></font>
<font color=#447700>!<a name='404'></font>
<font color=#447700>!$omp parallel do &<a name='405'></font>
<font color=#447700>!$omp& private(i,j)<a name='406'></font>
DO J=MYJS2,MYJE2<a name='407'>
DO I=MYIS1,MYIE1<a name='408'>
<font color=#447700>!<a name='409'></font>
IF(HBM2(I,J)>0.5)THEN<a name='410'>
TOTSWDN(I,J)=SWNETDN(I,J)/(1.-ALBEDO(I,J)) <a name='411'>
<font color=#447700>!--- No value currently available for clear-sky solar fluxes from<a name='412'></font>
<font color=#447700>! non GFDL schemes, though it's needed for air quality forecasts.<a name='413'></font>
<font color=#447700>! For the time being, set to the total downward solar fluxes.<a name='414'></font>
TOTSWDNC(I,J)=TOTSWDN(I,J)<a name='415'>
ENDIF<a name='416'>
<font color=#447700>!<a name='417'></font>
ENDDO<a name='418'>
ENDDO<a name='419'>
<font color=#447700>!<a name='420'></font>
ENDIF <font color=#447700>!End non-GFDL block<a name='421'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='422'></font>
<font color=#447700>!<a name='423'></font>
<font color=#447700>!$omp parallel do &<a name='424'></font>
<font color=#447700>!$omp& private(i,iendx,j,k)<a name='425'></font>
DO J=MYJS2,MYJE2<a name='426'>
IENDX=MYIE1<a name='427'>
IF(MOD(J,2)==0.AND.ITE+1==IDE)IENDX=IENDX-1<a name='428'>
DO I=MYIS1,IENDX<a name='429'>
<font color=#447700>!<a name='430'></font>
RSWIN(I,J)=TOTSWDN(I,J)<a name='431'>
RSWINC(I,J)=TOTSWDNC(I,J)<a name='432'>
RSWOUT(I,J)=TOTSWDN(I,J)-SWNETDN(I,J)<a name='433'>
<font color=#447700>!<a name='434'></font>
DO K=KTS,KTE<a name='435'>
RSWTT(I,K,J)=THRATENSW(I,K,J)*PI_PHY(I,K,J)<a name='436'>
ENDDO<a name='437'>
<font color=#447700>!<a name='438'></font>
ENDDO<a name='439'>
ENDDO<a name='440'>
<font color=#447700>!<a name='441'></font>
ENDIF<a name='442'>
<font color=#447700>!<a name='443'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='444'></font>
<font color=#447700>!*** LONGWAVE<a name='445'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='446'></font>
<font color=#447700>!<a name='447'></font>
IF(MOD(NTSD,NRADL)==0)THEN<a name='448'>
<font color=#447700>!<a name='449'></font>
<font color=#447700>!$omp parallel do &<a name='450'></font>
<font color=#447700>!$omp& private(i,iendx,j,k,lmhij)<a name='451'></font>
DO J=MYJS2,MYJE2<a name='452'>
IENDX=MYIE1<a name='453'>
IF(MOD(J,2)==0.AND.ITE+1==IDE)IENDX=IENDX-1<a name='454'>
DO I=MYIS1,IENDX<a name='455'>
<font color=#447700>!<a name='456'></font>
IF(HBM2(I,J)>0.5)THEN<a name='457'>
LMHIJ=KTE+1-LMH(I,J)<a name='458'>
TDUM=T(I,LMHIJ,J)<a name='459'>
SIGT4(I,J)=STBOLT*TDUM*TDUM*TDUM*TDUM<a name='460'>
<font color=#447700>!<a name='461'></font>
DO K=KTS,KTE<a name='462'>
RLWTT(I,K,J)=THRATENLW(I,K,J)*PI_PHY(I,K,J)<a name='463'>
ENDDO<a name='464'>
<font color=#447700>!<a name='465'></font>
RLWIN(I,J)=TOTLWDN(I,J)<a name='466'>
ENDIF<a name='467'>
<font color=#447700>!<a name='468'></font>
ENDDO<a name='469'>
ENDDO<a name='470'>
<font color=#447700>!<a name='471'></font>
ENDIF<a name='472'>
<font color=#447700>!<a name='473'></font>
<font color=#447700>!-- Store 3D cloud fractions<a name='474'></font>
<font color=#447700>!<a name='475'></font>
DO J=MYJS2,MYJE2<a name='476'>
IENDX=MYIE1<a name='477'>
IF(MOD(J,2)==0.AND.ITE+1==IDE)IENDX=IENDX-1<a name='478'>
DO K=KTS,KTE<a name='479'>
DO I=MYIS1,IENDX<a name='480'>
CLDFRA(I,K,J)=CLFR(I,K,J)<a name='481'>
ENDDO<a name='482'>
ENDDO<a name='483'>
ENDDO<a name='484'>
<font color=#447700>!-----------------------------------------------------------------------<a name='485'></font>
<font color=#447700>!*** RESET THE DIAGNOSTIC CONVECTIVE CLOUD TOPS/BOTTOMS AFTER<a name='486'></font>
<font color=#447700>!*** EACH RADIATION CALL.<a name='487'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='488'></font>
<font color=#447700>!<a name='489'></font>
<font color=#447700>!$omp parallel do &<a name='490'></font>
<font color=#447700>!$omp& private(i,j)<a name='491'></font>
DO J=JMS,JME<a name='492'>
DO I=IMS,IME<a name='493'>
HTOPD(I,J)=0.<a name='494'>
HTOPS(I,J)=0.<a name='495'>
HBOTD(I,J)=KTE+1.<a name='496'>
HBOTS(I,J)=KTE+1.<a name='497'>
ENDDO<a name='498'>
ENDDO<a name='499'>
<font color=#447700>!-----------------------------------------------------------------------<a name='500'></font>
<font color=#447700>!<a name='501'></font>
<a name='502'>
END SUBROUTINE RADIATION<a name='503'>
<font color=#447700>!<a name='504'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='505'></font>
<font color=#447700>!***********************************************************************<a name='506'></font>
<A NAME='TURBL'><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#TURBL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='507'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>TURBL</font>(NTSD,DT,NPHS,RESTRT & <A href='../../call_to/TURBL.html' TARGET='index'>1</A>,<A href='../../call_from/TURBL.html' TARGET='index'>3</A><a name='508'>
& ,N_MOIST,NSOIL,SLDPTH,DZSOIL &<a name='509'>
& ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT &<a name='510'>
& ,SM,LMH,HTM,VTM,HBM2,VBM2,DX_ARRAY,DFRLG &<a name='511'>
& ,CZEN,CZMEAN,SIGT4,RLWIN,RSWIN,RADOT &<a name='512'>
<font color=#447700>!- RLWIN/RSWIN - downward longwave/shortwave at the surface (also TOTLWDN/TOTSWDN in RADIATION)<a name='513'></font>
& ,PD,RES,PINT,T,Q,CWM,F_ICE,F_RAIN,SR &<a name='514'>
& ,Q2,U,V,THS,SST,PREC,SNO,ZERO_3D &<a name='515'>
& ,FIS,Z0,Z0BASE,USTAR,PBLH,LPBL,EL_MYJ &<a name='516'>
& ,EXCH_H,AKHS,AKMS,AKHS_OUT,AKMS_OUT &<a name='517'>
& ,THZ0,QZ0,UZ0,VZ0,QS &<a name='518'>
& ,STC,SMC,CMC,SMSTAV,SMSTOT,SSROFF,BGROFF &<a name='519'>
& ,IVGTYP,ISLTYP,VEGFRC,SHDMIN,SHDMAX,GRNFLX &<a name='520'>
& ,SFCEXC,ACSNOW,ACSNOM,SNOPCX,SICE,TG,SOILTB &<a name='521'>
& ,ALBASE,MXSNAL,ALBEDO,SH2O,SI,EPSR &<a name='522'>
& ,U10,V10,TH10,Q10,TSHLTR,QSHLTR,PSHLTR &<a name='523'>
& ,TWBS,QWBS,SFCSHX,SFCLHX,SFCEVP &<a name='524'>
& ,POTEVP,POTFLX,SUBSHX &<a name='525'>
& ,APHTIM,ARDSW,ARDLW,ASRFC &<a name='526'>
& ,RSWOUT,RSWTOA,RLWTOA &<a name='527'>
& ,ASWIN,ASWOUT,ASWTOA,ALWIN,ALWOUT,ALWTOA &<a name='528'>
& ,UZ0H,VZ0H,DUDT,DVDT & <a name='529'>
& ,PCPFLG,DDATA & <font color=#447700>! PRECIP ASSIM<a name='530'></font>
& ,GRID,CONFIG_FLAGS &<a name='531'>
& ,IHE,IHW,IVE,IVW &<a name='532'>
& ,IDS,IDE,JDS,JDE,KDS,KDE &<a name='533'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='534'>
& ,ITS,ITE,JTS,JTE,KTS,KTE)<a name='535'>
<font color=#447700>!***********************************************************************<a name='536'></font>
<font color=#447700>!$$$ SUBPROGRAM DOCUMENTATION BLOCK<a name='537'></font>
<font color=#447700>! . . . <a name='538'></font>
<font color=#447700>! SUBPROGRAM: TURBL TURBULENCE OUTER DRIVER<a name='539'></font>
<font color=#447700>! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-04-19 <a name='540'></font>
<font color=#447700>! <a name='541'></font>
<font color=#447700>! ABSTRACT:<a name='542'></font>
<font color=#447700>! TURBL DRIVES THE TURBULENCE SCHEMES<a name='543'></font>
<font color=#447700>! <a name='544'></font>
<font color=#447700>! PROGRAM HISTORY LOG (with changes to called routines) :<a name='545'></font>
<font color=#447700>! 95-03-15 JANJIC - ORIGINATOR OF THE SUBROUTINES CALLED<a name='546'></font>
<font color=#447700>! BLACK & JANJIC - ORIGINATORS OF THE DRIVER<a name='547'></font>
<font color=#447700>! 95-03-28 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL<a name='548'></font>
<font color=#447700>! 96-03-29 BLACK - ADDED EXTERNAL EDGE; REMOVED SCRCH COMMON<a name='549'></font>
<font color=#447700>! 96-07-19 MESINGER - ADDED Z0 EFFECTIVE<a name='550'></font>
<font color=#447700>! 98-??-?? TUCCILLO - MODIFIED FOR CLASS VIII PARALLELISM<a name='551'></font>
<font color=#447700>! 98-10-27 BLACK - PARALLEL CHANGES INTO MOST RECENT CODE<a name='552'></font>
<font color=#447700>! 02-01-10 JANJIC - MOIST TURBULENCE (DRIVER, MIXLEN, VDIFH)<a name='553'></font>
<font color=#447700>! 02-01-10 JANJIC - VERT. DIF OF Q2 INCREASED (Grenier & Bretherton)<a name='554'></font>
<font color=#447700>! 02-02-02 JANJIC - NEW SFCDIF<a name='555'></font>
<font color=#447700>! 02-04-19 BLACK - ORIGINATOR OF THIS OUTER DRIVER FOR WRF<a name='556'></font>
<font color=#447700>! 02-05-03 JANJIC - REMOVAL OF SUPERSATURATION AT 2m AND 10m<a name='557'></font>
<font color=#447700>! 04-11-18 BLACK - THREADED<a name='558'></font>
<font color=#447700>! <a name='559'></font>
<font color=#447700>! USAGE: CALL TURBL FROM SOLVE_NMM<a name='560'></font>
<font color=#447700>!<a name='561'></font>
<font color=#447700>! ATTRIBUTES:<a name='562'></font>
<font color=#447700>! LANGUAGE: FORTRAN 90<a name='563'></font>
<font color=#447700>! MACHINE : IBM<a name='564'></font>
<font color=#447700>!$$$ <a name='565'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='566'></font>
<font color=#447700>!<a name='567'></font>
IMPLICIT NONE<a name='568'>
<font color=#447700>!<a name='569'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='570'></font>
<font color=#447700>!<a name='571'></font>
INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &<a name='572'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='573'>
& ,ITS,ITE,JTS,JTE,KTS,KTE &<a name='574'>
& ,N_MOIST,NPHS,NSOIL,NTSD<a name='575'>
<font color=#447700>!<a name='576'></font>
INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW<a name='577'>
<font color=#447700>!<a name='578'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: ISLTYP,IVGTYP &<a name='579'>
& ,LMH<a name='580'>
<font color=#447700>!<a name='581'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: LPBL<a name='582'>
<font color=#447700>!<a name='583'></font>
REAL,INTENT(IN) :: DT,PDTOP,PT<a name='584'>
<font color=#447700>!<a name='585'></font>
REAL,INTENT(INOUT) :: APHTIM,ARDSW,ARDLW,ASRFC<a name='586'>
<font color=#447700>!<a name='587'></font>
REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2<a name='588'>
<font color=#447700>!<a name='589'></font>
REAL,DIMENSION(KMS:KME),INTENT(IN) :: DFRLG,ETA1,ETA2<a name='590'>
<font color=#447700>!<a name='591'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ALBASE,MXSNAL<a name='592'>
<font color=#447700>!<a name='593'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CZEN,CZMEAN &<a name='594'>
& ,DX_ARRAY &<a name='595'>
& ,EPSR,FIS,HBM2 &<a name='596'>
& ,PD,RES &<a name='597'>
& ,RLWIN,RLWTOA &<a name='598'>
& ,RSWIN,RSWOUT,RSWTOA &<a name='599'>
& ,SHDMIN,SHDMAX &<a name='600'>
& ,SICE,SIGT4,SM,SR &<a name='601'>
& ,SST,TG,VBM2,VEGFRC<a name='602'>
<font color=#447700>!<a name='603'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: GRNFLX,QWBS,RADOT &<a name='604'>
,SFCEXC,SMSTAV &<a name='605'>
,SMSTOT,SOILTB,TWBS<a name='606'>
<font color=#447700>!<a name='607'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACSNOM,ACSNOW &<a name='608'>
& ,AKHS,AKMS &<a name='609'>
& ,ALBEDO &<a name='610'>
& ,BGROFF,CMC &<a name='611'>
& ,PBLH,POTEVP &<a name='612'>
& ,POTFLX,PREC &<a name='613'>
& ,QS,QZ0,SFCEVP &<a name='614'>
& ,SFCLHX,SFCSHX &<a name='615'>
& ,SH2O,SI &<a name='616'>
& ,SNO,SNOPCX &<a name='617'>
& ,SSROFF,SUBSHX &<a name='618'>
& ,THS,THZ0 &<a name='619'>
& ,USTAR,UZ0,UZ0H &<a name='620'>
& ,VZ0,VZ0H &<a name='621'>
& ,Z0,Z0BASE<a name='622'>
<font color=#447700>!<a name='623'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: AKHS_OUT,AKMS_OUT &<a name='624'>
& ,ALWIN,ALWOUT &<a name='625'>
& ,ALWTOA,ASWIN &<a name='626'>
& ,ASWOUT,ASWTOA &<a name='627'>
& ,PSHLTR,Q10,QSHLTR &<a name='628'>
& ,TH10,TSHLTR &<a name='629'>
& ,U10,V10<a name='630'>
<font color=#447700>!<a name='631'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM &<a name='632'>
& ,DUDT &<a name='633'>
& ,DVDT &<a name='634'>
& ,EXCH_H &<a name='635'>
& ,F_ICE &<a name='636'>
& ,F_RAIN &<a name='637'>
& ,Q,Q2 &<a name='638'>
& ,T,U,V<a name='639'>
<font color=#447700>!<a name='640'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM<a name='641'>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT<a name='642'>
<font color=#447700>!<a name='643'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D<a name='644'>
<font color=#447700>!<a name='645'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: EL_MYJ<a name='646'>
<font color=#447700>!<a name='647'></font>
REAL,DIMENSION(NSOIL),INTENT(IN) :: DZSOIL,SLDPTH<a name='648'>
<font color=#447700>!<a name='649'></font>
REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME),INTENT(INOUT) :: SMC,STC<a name='650'>
<font color=#447700>!<a name='651'></font>
LOGICAL,INTENT(IN) :: RESTRT<a name='652'>
<font color=#447700>!<a name='653'></font>
TYPE(DOMAIN),TARGET :: GRID<a name='654'>
<font color=#447700>!<a name='655'></font>
TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS<a name='656'>
<font color=#447700>!<a name='657'></font>
<font color=#447700>! For precip assimilation:<a name='658'></font>
LOGICAL,INTENT(IN) :: PCPFLG<a name='659'>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DDATA<a name='660'>
<font color=#447700>!<a name='661'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='662'></font>
<font color=#447700>!***<a name='663'></font>
<font color=#447700>!*** LOCAL VARIABLES<a name='664'></font>
<font color=#447700>!***<a name='665'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='666'></font>
INTEGER :: I,IDUMMY,IEND,ISFFLX,ISTR,J,K,KOUNT_ALL,LENGTH_ROW &<a name='667'>
& ,LLIJ,LLMH,LLYR,N,SST_UPDATE<a name='668'>
<font color=#447700>!<a name='669'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME) :: KPBL,LOWLYR<a name='670'>
<font color=#447700>!<a name='671'></font>
REAL :: TRESH=0.95<a name='672'>
<font color=#447700>!<a name='673'></font>
REAL :: ALTITUDE,CWML,DQDT,DTDT,DTPHS,DX,DZHALF,FACTR,FACTRL &<a name='674'>
& ,G_INV,PDSL,PLYR,PSFC,QI,QL,QOLD,QR,QW,RATIOMX,RDTPHS &<a name='675'>
& ,ROG,RWMSK,SDEPTH,TL,TLMH,TLMH4,TNEW,TSFC2,U_FRAME,V_FRAME &<a name='676'>
& ,WMSK,XLVRW<a name='677'>
<font color=#447700>!<a name='678'></font>
REAL :: APES,CKLQ,FACTOR,FFS,PQ0X,Q2SAT,QFC1,QLOWX,RLIVWV &<a name='679'>
& ,THBOT<a name='680'>
<font color=#447700>!<a name='681'></font>
REAL,DIMENSION(IMS:IME,JMS:JME) :: BR,CHKLOWQ,CT,CWMLOW,ELFLX &<a name='682'>
& ,EXNSFC,FACTRS,FLHC,FLQC,GZ1OZ0 &<a name='683'>
& ,ONE,PLM,PSFC_OUT,PSIH,PSIM &<a name='684'>
& ,Q2X,QLOW,RAIN,RAINBL &<a name='685'>
& ,RLW_DN_SFC,RMOL,RSW_NET_SFC &<a name='686'>
& ,SFCEVPX,SFCZ,SNOW,SNOWC,SNOWH &<a name='687'>
& ,TH2X,THLOW,TLOW,TSFC,VGFRCK &<a name='688'>
& ,WSPD,XLAND,ZERO_2D<a name='689'>
<font color=#447700>!<a name='690'></font>
REAL,DIMENSION(IMS:IME,KMS:KME-1,JMS:JME) :: EXNER<a name='691'>
<font color=#447700>!<a name='692'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W &<a name='693'>
& ,P_PHY,PI_PHY &<a name='694'>
& ,RQCBLTEN,RQIBLTEN &<a name='695'>
& ,RQVBLTEN,RR,RTHBLTEN &<a name='696'>
& ,T_PHY,TH_PHY,TKE &<a name='697'>
& ,U_PHY,V_PHY,Z<a name='698'>
<font color=#447700>!<a name='699'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST) :: WATER<a name='700'>
<font color=#447700>!<a name='701'></font>
REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME) :: ZERO_SOIL<a name='702'>
<font color=#447700>!<a name='703'></font>
LOGICAL :: E_BDY,WARM_RAIN<a name='704'>
<font color=#447700>!<a name='705'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='706'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='707'></font>
DTPHS=NPHS*DT<a name='708'>
RDTPHS=1./DTPHS<a name='709'>
G_INV=1./G<a name='710'>
ROG=R_D*G_INV<a name='711'>
FACTOR=-XLV*RHOWATER/DTPHS<a name='712'>
<font color=#447700>!<a name='713'></font>
U_FRAME=0.<a name='714'>
V_FRAME=0.<a name='715'>
<font color=#447700>!<a name='716'></font>
IDUMMY=0<a name='717'>
ISFFLX=1<a name='718'>
DX=0.<a name='719'>
SST_UPDATE=0<a name='720'>
<font color=#447700>!<a name='721'></font>
DO J=JMS,JME<a name='722'>
DO I=IMS,IME<a name='723'>
UZ0H(I,J)=0.<a name='724'>
VZ0H(I,J)=0.<a name='725'>
ONE(I,J)=1.<a name='726'>
RMOL(I,J)=0. <font color=#447700>!Reciprocal of Monin-Obukhov length<a name='727'></font>
SFCEVPX(I,J)=0. <font color=#447700>!Dummy for accumulated latent energy, not flux<a name='728'></font>
ENDDO<a name='729'>
ENDDO<a name='730'>
<font color=#447700>!<a name='731'></font>
<font color=#447700>!$omp parallel do &<a name='732'></font>
<font color=#447700>!$omp& private(i,j)<a name='733'></font>
DO J=MYJS,MYJE<a name='734'>
DO I=MYIS,MYIE<a name='735'>
LOWLYR(I,J)=1<a name='736'>
VGFRCK(I,J)=100.*VEGFRC(I,J)<a name='737'>
SNOW(I,J)=SNO(I,J)<a name='738'>
SNOWH(I,J)=SI(I,J)<a name='739'>
XLAND(I,J)=SM(I,J)+1.<a name='740'>
ENDDO<a name='741'>
ENDDO<a name='742'>
<font color=#447700>!<a name='743'></font>
IF(NTSD==0)THEN<a name='744'>
<font color=#447700>!$omp parallel do &<a name='745'></font>
<font color=#447700>!$omp& private(i,j)<a name='746'></font>
DO J=MYJS,MYJE<a name='747'>
DO I=MYIS,MYIE<a name='748'>
Z0BASE(I,J)=Z0(I,J)<a name='749'>
ENDDO<a name='750'>
ENDDO<a name='751'>
ENDIF<a name='752'>
<font color=#447700>!<a name='753'></font>
<font color=#447700>!$omp parallel do &<a name='754'></font>
<font color=#447700>!$omp& private(i,j,k)<a name='755'></font>
DO J=MYJS,MYJE<a name='756'>
DO K=KTS,KTE+1<a name='757'>
DO I=MYIS,MYIE<a name='758'>
Z(I,K,J)=0.<a name='759'>
DZ(I,K,J)=0.<a name='760'>
EXCH_H(I,K,J)=0.<a name='761'>
ENDDO<a name='762'>
ENDDO<a name='763'>
ENDDO<a name='764'>
<font color=#447700>!<a name='765'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='766'></font>
<font color=#447700>!<a name='767'></font>
<font color=#447700>!*** PREPARE NEEDED ARRAYS<a name='768'></font>
<font color=#447700>!<a name='769'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='770'></font>
<font color=#447700>!<a name='771'></font>
<font color=#447700>!$omp parallel do &<a name='772'></font>
<font color=#447700>!$omp& private(cwml,factrl,i,j,k,llij,llmh,pdsl,plyr,psfc,qi,ql,qr,qw &<a name='773'></font>
<font color=#447700>!$omp& ,tl,tlmh,tlmh4)<a name='774'></font>
DO J=MYJS,MYJE<a name='775'>
DO I=MYIS,MYIE<a name='776'>
<font color=#447700>!<a name='777'></font>
LLMH=LMH(I,J)<a name='778'>
PDSL=PD(I,J)*RES(I,J)<a name='779'>
<font color=#447700>!!! PSFC=PD(I,J)+PDTOP+PT<a name='780'></font>
<font color=#447700>!!! P8W(I,KTS,J)=PSFC<a name='781'></font>
P8W(I,KTS,J)=PINT(I,KTS,J)<a name='782'>
PSFC=PINT(I,KTS,J)<a name='783'>
LOWLYR(I,J)=KTE+1-LLMH<a name='784'>
EXNSFC(I,J)=(1.E5/PSFC)**CAPA<a name='785'>
THS(I,J)=(SST(I,J)*EXNSFC(I,J))*SM(I,J)+THS(I,J)*(1.-SM(I,J))<a name='786'>
TSFC(I,J)=THS(I,J)/EXNSFC(I,J)<a name='787'>
SFCZ(I,J)=FIS(I,J)*G_INV<a name='788'>
ZERO_2D(I,J)=0.<a name='789'>
<font color=#447700>!YL RAIN(I,J)=PREC(I,J)*RHOWATER<a name='790'></font>
IF (PCPFLG.AND.DDATA(I,J)<100.)THEN<a name='791'>
RAIN(I,J)=DDATA(I,J)*RHOWATER<a name='792'>
ELSE<a name='793'>
RAIN(I,J)=PREC(I,J)*RHOWATER<a name='794'>
ENDIF<a name='795'>
<font color=#447700>!YL<a name='796'></font>
RAINBL(I,J)=0.<a name='797'>
IF(SNO(I,J)>0.)SNOWC(I,J)=1.<a name='798'>
LLIJ=LOWLYR(I,J)<a name='799'>
PLM(I,J)=(PINT(I,LLIJ,J)+PINT(I,LLIJ+1,J))*0.5<a name='800'>
TH2X(I,J)=T(I,LLIJ,J)*(1.E5/PLM(I,J))**CAPA<a name='801'>
Q2X(I,J)=Q(I,LLIJ,J)<a name='802'>
<font color=#447700>!<a name='803'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='804'></font>
<font color=#447700>!*** LONG AND SHORTWAVE FLUX AT GROUND SURFACE<a name='805'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='806'></font>
<font color=#447700>!<a name='807'></font>
IF(CZMEAN(I,J)>0.)THEN<a name='808'>
FACTRS(I,J)=CZEN(I,J)/CZMEAN(I,J)<a name='809'>
ELSE<a name='810'>
FACTRS(I,J)=0.<a name='811'>
ENDIF<a name='812'>
<font color=#447700>!<a name='813'></font>
IF(SIGT4(I,J)>0.)THEN<a name='814'>
TLMH=T(I,LLIJ,J)<a name='815'>
FACTRL=STBOLT*TLMH*TLMH*TLMH*TLMH/SIGT4(I,J)<a name='816'>
ELSE<a name='817'>
FACTRL=0.<a name='818'>
ENDIF<a name='819'>
<font color=#447700>! <a name='820'></font>
<font color=#447700>!- RLWIN/RSWIN - downward longwave/shortwave at the surface<a name='821'></font>
<font color=#447700>!<a name='822'></font>
RLW_DN_SFC(I,J)=RLWIN(I,J)*HBM2(I,J)*FACTRL<a name='823'>
RSW_NET_SFC(I,J)=(RSWIN(I,J)-RSWOUT(I,J))*HBM2(I,J)*FACTRS(I,J)<a name='824'>
<font color=#447700>!<a name='825'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='826'></font>
<font color=#447700>!*** FILL THE ARRAYS FOR CALLING THE INNER DRIVER.<a name='827'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='828'></font>
<font color=#447700>!<a name='829'></font>
Z(I,KTS,J)=SFCZ(I,J)<a name='830'>
<font color=#447700>!<a name='831'></font>
DO K=KTS,KTE<a name='832'>
Q2(I,K,J)=AMAX1(Q2(I,K,J)*HBM2(I,J),EPSQ2)<a name='833'>
QL=AMAX1(Q(I,K,J),EPSQ)<a name='834'>
PLYR=(PINT(I,K,J)+PINT(I,K+1,J))*0.5<a name='835'>
<font color=#447700>!!! PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT<a name='836'></font>
TL=T(I,K,J)<a name='837'>
CWML=CWM(I,K,J)<a name='838'>
<font color=#447700>!<a name='839'></font>
RR(I,K,J)=PLYR/(R_D*TL)<a name='840'>
T_PHY(I,K,J)=TL<a name='841'>
<font color=#447700>!<a name='842'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='843'></font>
<font color=#447700>!*** WATER VAPOR, CLOUD LIQUID AND ICE<a name='844'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='845'></font>
<font color=#447700>!<a name='846'></font>
WATER(I,K,J,P_QV)=QL/(1.-QL) <font color=#447700>!Need to pass mixing ratio<a name='847'></font>
<font color=#447700>!<a name='848'></font>
QW=0.<a name='849'>
QI=0.<a name='850'>
QR=0.<a name='851'>
<font color=#447700>!<a name='852'></font>
IF(F_ICE(I,K,J)>=1.)THEN<a name='853'>
QI=CWML<a name='854'>
ELSEIF(F_ICE(I,K,J)<=0.)THEN<a name='855'>
QW=CWML<a name='856'>
ELSE<a name='857'>
QI=F_ICE(I,K,J)*CWML<a name='858'>
QW=CWML-QI<a name='859'>
ENDIF<a name='860'>
<font color=#447700>!<a name='861'></font>
IF(QW>0..AND.F_RAIN(I,K,J)>0.)THEN<a name='862'>
IF(F_RAIN(I,K,J)>=1.)THEN<a name='863'>
QR=QW<a name='864'>
QW=0.<a name='865'>
ELSE<a name='866'>
QR=F_RAIN(I,K,J)*QW<a name='867'>
QW=QW-QR<a name='868'>
ENDIF<a name='869'>
ENDIF <a name='870'>
<font color=#447700>!<a name='871'></font>
WATER(I,K,J,P_QC)=QW<a name='872'>
WATER(I,K,J,P_QI)=QI<a name='873'>
WATER(I,K,J,P_QR)=QR<a name='874'>
<font color=#447700>!<a name='875'></font>
EXNER(I,K,J)=(1.E5/PLYR)**CAPA<a name='876'>
PI_PHY(I,K,J)=1./EXNER(I,K,J)<a name='877'>
TH_PHY(I,K,J)=TL*EXNER(I,K,J)<a name='878'>
P8W(I,K+1,J)=PINT(I,K+1,J)<a name='879'>
<font color=#447700>!!! P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT<a name='880'></font>
P_PHY(I,K,J)=PLYR<a name='881'>
TKE(I,K,J)=0.5*Q2(I,K,J)<a name='882'>
<font color=#447700>!<a name='883'></font>
RTHBLTEN(I,K,J)=0.<a name='884'>
RQVBLTEN(I,K,J)=0.<a name='885'>
RQCBLTEN(I,K,J)=0.<a name='886'>
RQIBLTEN(I,K,J)=0.<a name='887'>
<font color=#447700>!<a name='888'></font>
Z(I,K+1,J)=Z(I,K,J)+TL/PLYR &<a name='889'>
& *(DETA1(K)*PDTOP+DETA2(K)*PDSL)*ROG &<a name='890'>
*(Q(I,K,J)*P608-CWML+1.)<a name='891'>
Z(I,K+1,J)=(Z(I,K+1,J)-DFRLG(K+1))*HTM(I,K,J)+DFRLG(K+1)<a name='892'>
<font color=#447700>!!! FACTR=1.-HTM(I,K,J)<a name='893'></font>
<font color=#447700>!!! Z(I,K+1,J)=Z(I,K+1,J)*HTM(I,K,J)+FACTR*DFRLG(K+1)<a name='894'></font>
DZ(I,K,J)=Z(I,K+1,J)-Z(I,K,J)<a name='895'>
ENDDO<a name='896'>
ENDDO<a name='897'>
ENDDO<a name='898'>
<font color=#447700>!<a name='899'></font>
<font color=#447700>!$omp parallel do &<a name='900'></font>
<font color=#447700>!$omp& private(i,j,llyr,qlowx)<a name='901'></font>
DO J=MYJS,MYJE<a name='902'>
DO I=MYIS,MYIE<a name='903'>
TWBS(I,J)=0.<a name='904'>
QWBS(I,J)=0.<a name='905'>
LLYR=LOWLYR(I,J)<a name='906'>
THLOW(I,J)=TH_PHY(I,LLYR,J)<a name='907'>
TLOW(I,J)=T_PHY(I,LLYR,J)<a name='908'>
QLOW(I,J)=MAX(Q(I,LLYR,J),EPSQ)<a name='909'>
QLOWX=QLOW(I,J)/(1.-QLOW(I,J))<a name='910'>
QLOW(I,J)=QLOWX/(1.+QLOWX)<a name='911'>
CWMLOW(I,J)=CWM(I,LLYR,J)<a name='912'>
PBLH(I,J)=MAX(PBLH(I,J),0.)<a name='913'>
PBLH(I,J)=MIN(PBLH(I,J),Z(I,KTE,J))<a name='914'>
ENDDO<a name='915'>
ENDDO<a name='916'>
<font color=#447700>!-----------------------------------------------------------------------<a name='917'></font>
<font color=#447700>!<a name='918'></font>
<font color=#447700>!*** COMPUTE VELOCITY COMPONENTS AT MASS POINTS<a name='919'></font>
<font color=#447700>!<a name='920'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='921'></font>
<font color=#447700>!$omp parallel do &<a name='922'></font>
<font color=#447700>!$omp& private(i,j,k,rwmsk,wmsk)<a name='923'></font>
DO J=MYJS1_P1,MYJE1_P1<a name='924'>
<font color=#447700>!<a name='925'></font>
DO K=KTS,KTE<a name='926'>
DO I=MYIS_P1,MYIE_P1<a name='927'>
WMSK=VTM(I+IHE(J),K,J)+VTM(I+IHW(J),K,J) &<a name='928'>
& +VTM(I,K,J+1)+VTM(I,K,J-1)<a name='929'>
IF(WMSK>0.)THEN<a name='930'>
RWMSK=1./WMSK<a name='931'>
U_PHY(I,K,J)=(U(I+IHE(J),K,J)*VTM(I+IHE(J),K,J) &<a name='932'>
& +U(I+IHW(J),K,J)*VTM(I+IHW(J),K,J) &<a name='933'>
& +U(I,K,J+1)*VTM(I,K,J+1) &<a name='934'>
& +U(I,K,J-1)*VTM(I,K,J-1))*RWMSK<a name='935'>
V_PHY(I,K,J)=(V(I+IHE(J),K,J)*VTM(I+IHE(J),K,J) &<a name='936'>
& +V(I+IHW(J),K,J)*VTM(I+IHW(J),K,J) &<a name='937'>
& +V(I,K,J+1)*VTM(I,K,J+1) &<a name='938'>
& +V(I,K,J-1)*VTM(I,K,J-1))*RWMSK<a name='939'>
ELSE<a name='940'>
U_PHY(I,K,J)=0.<a name='941'>
V_PHY(I,K,J)=0.<a name='942'>
ENDIF<a name='943'>
ENDDO<a name='944'>
ENDDO<a name='945'>
ENDDO<a name='946'>
<font color=#447700>!<a name='947'></font>
<font color=#447700>!$omp parallel do &<a name='948'></font>
<font color=#447700>!$omp& private(i,iend,istr,j)<a name='949'></font>
DO J=MYJS1_P1,MYJE1_P1<a name='950'>
IF(MOD(J,2)==0)THEN<a name='951'>
ISTR=MYIS_P1<a name='952'>
IEND=MIN(MYIE_P1,IDE-1)<a name='953'>
ELSE<a name='954'>
ISTR=MAX(MYIS_P1,IDS+1)<a name='955'>
IEND=MIN(MYIE_P1,IDE-1)<a name='956'>
ENDIF<a name='957'>
<font color=#447700>! <a name='958'></font>
DO I=ISTR,IEND<a name='959'>
UZ0H(I,J)=(UZ0(I+IHE(J),J)+UZ0(I+IHW(J),J) &<a name='960'>
& +UZ0(I,J+1)+UZ0(I,J-1))*0.25<a name='961'>
<font color=#447700>!!! & +UZ0(I,J+1)+UZ0(I,J-1))*HBM2(I,J)*0.25<a name='962'></font>
VZ0H(I,J)=(VZ0(I+IHE(J),J)+VZ0(I+IHW(J),J) &<a name='963'>
& +VZ0(I,J+1)+VZ0(I,J-1))*0.25<a name='964'>
<font color=#447700>!!! & +VZ0(I,J+1)+VZ0(I,J-1))*HBM2(I,J)*0.25<a name='965'></font>
ENDDO<a name='966'>
ENDDO<a name='967'>
<font color=#447700>!-----------------------------------------------------------------------<a name='968'></font>
<font color=#447700>!<a name='969'></font>
<font color=#447700>!*** CALL SURFACE LAYER AND LAND SURFACE PHYSICS<a name='970'></font>
<font color=#447700>!<a name='971'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='972'></font>
<font color=#447700>!<a name='973'></font>
CALL <A href='../../html_code/frame/module_tiles.F.html#SET_TILES'>SET_TILES</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#TURBL' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="SET_TILES_4">(GRID,IDS,IDE-1,JDS+1,JDE-1,ITS,ITE,JTS,JTE)<a name='974'>
<font color=#447700>!<a name='975'></font>
CALL <A href='../../html_code/phys/module_surface_driver.F.html#SURFACE_DRIVER'>SURFACE_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#TURBL' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="SURFACE_DRIVER_2">( &<a name='976'>
& ACSNOM=ACSNOM,ACSNOW=ACSNOW,AKHS=AKHS,AKMS=AKMS &<a name='977'>
& ,ALBEDO=ALBEDO,BR=BR,CANWAT=CMC,CHKLOWQ=CHKLOWQ &<a name='978'>
& ,DT=DT,DX=DX,DZ8W=DZ,DZS=SLDPTH,GLW=RLW_DN_SFC &<a name='979'>
& ,GRDFLX=GRNFLX,GSW=RSW_NET_SFC,GZ1OZ0=GZ1OZ0,HFX=TWBS &<a name='980'>
& ,HT=SFCZ,IFSNOW=IDUMMY,ISFFLX=ISFFLX,ISLTYP=ISLTYP &<a name='981'>
& ,ITIMESTEP=NTSD,IVGTYP=IVGTYP,LOWLYR=LOWLYR &<a name='982'>
& ,MAVAIL=ONE,RMOL=RMOL,NUM_SOIL_LAYERS=NSOIL,P8W=P8W &<a name='983'>
& ,PBLH=PBLH,PI_PHY=PI_PHY,PSHLTR=PSHLTR,PSIH=PSIH &<a name='984'>
& ,PSIM=PSIM,P_PHY=P_PHY,Q10=Q10,Q2=Q2X,QFX=QWBS,QSFC=QS &<a name='985'>
& ,QSHLTR=QSHLTR,QZ0=QZ0,RAINCV=RAIN &<a name='986'>
& ,RHO=RR,SFCEVP=SFCEVPX,SFCEXC=SFCEXC,SFCRUNOFF=SSROFF &<a name='987'>
& ,SMOIS=SMC,SMSTAV=SMSTAV,SMSTOT=SMSTOT,SNOALB=MXSNAL &<a name='988'>
& ,SNOW=SNOW,SNOWC=SNOWC,SNOWH=SNOWH,STEPBL=NPHS &<a name='989'>
& ,SST=sst ,SST_UPDATE=sst_update &<a name='990'>
& ,TH10=TH10,TH2=TH2X,THZ0=THZ0,TH_PHY=TH_PHY &<a name='991'>
& ,TMN=TG,TSHLTR=TSHLTR,TSK=TSFC,TSLB=STC,T_PHY=T_PHY &<a name='992'>
& ,U10=U10,UDRUNOFF=BGROFF,UST=USTAR,UZ0=UZ0H &<a name='993'>
& ,U_FRAME=U_FRAME,U_PHY=U_PHY,V10=V10,VEGFRA=VGFRCK &<a name='994'>
& ,VZ0=VZ0H,V_FRAME=V_FRAME,V_PHY=V_PHY &<a name='995'>
& ,WARM_RAIN=WARM_RAIN,WSPD=WSPD,XICE=SICE &<a name='996'>
& ,XLAND=XLAND,Z=Z,ZNT=Z0,ZS=DZSOIL,CT=CT,TKE_MYJ=TKE &<a name='997'>
& ,ALBBCK=ALBASE,LH=ELFLX,SH2O=SH2O,SHDMAX=SHDMAX &<a name='998'>
& ,SHDMIN=SHDMIN,Z0=Z0BASE,FLQC=FLQC,FLHC=FLHC &<a name='999'>
& ,PSFC=PSFC_OUT &<a name='1000'>
& ,SF_SFCLAY_PHYSICS=CONFIG_FLAGS%SF_SFCLAY_PHYSICS &<a name='1001'>
& ,SF_SURFACE_PHYSICS=CONFIG_FLAGS%SF_SURFACE_PHYSICS &<a name='1002'>
& ,RA_LW_PHYSICS=CONFIG_FLAGS%RA_LW_PHYSICS &<a name='1003'>
& ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &<a name='1004'>
& ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &<a name='1005'>
& ,I_START=GRID%I_START,I_END=GRID%I_END &<a name='1006'>
& ,J_START=GRID%J_START,J_END=GRID%J_END &<a name='1007'>
& ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &<a name='1008'>
<font color=#447700>! Optional args<a name='1009'></font>
& ,QV_CURR=WATER(IMS,KMS,JMS,P_QV),F_QV=F_QV &<a name='1010'>
& ,QC_CURR=WATER(IMS,KMS,JMS,P_QC),F_QC=F_QC &<a name='1011'>
& ,QR_CURR=WATER(IMS,KMS,JMS,P_QR),F_QR=F_QR &<a name='1012'>
& ,QI_CURR=WATER(IMS,KMS,JMS,P_QI),F_QI=F_QI &<a name='1013'>
& ,QS_CURR=WATER(IMS,KMS,JMS,P_QS),F_QS=F_QS &<a name='1014'>
& ,QG_CURR=WATER(IMS,KMS,JMS,P_QG),F_QG=F_QG &<a name='1015'>
& ,RAINBL=RAINBL &<a name='1016'>
& ,POTEVP=POTEVP,SNOPCX=SNOPCX,SOILTB=SOILTB,SR=SR)<a name='1017'>
<font color=#447700>!<a name='1018'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1019'></font>
<font color=#447700>!<a name='1020'></font>
<font color=#447700>!*** CALL FREE ATMOSPHERE TURBULENCE<a name='1021'></font>
<font color=#447700>!<a name='1022'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1023'></font>
<font color=#447700>!<a name='1024'></font>
<font color=#447700>!$omp parallel do &<a name='1025'></font>
<font color=#447700>!$omp& private(i,j,k)<a name='1026'></font>
DO J=JMS,JME<a name='1027'>
DO K=KMS,KME<a name='1028'>
DO I=IMS,IME<a name='1029'>
DUDT(I,K,J)=0.<a name='1030'>
DVDT(I,K,J)=0.<a name='1031'>
ENDDO<a name='1032'>
ENDDO<a name='1033'>
ENDDO<a name='1034'>
<font color=#447700>!<a name='1035'></font>
<font color=#447700>!*** THE SURFACE EXCHANGE COEFFICIENTS AKHS AND AKMS ARE ACTUALLY<a name='1036'></font>
<font color=#447700>!*** MULTIPLIED BY HALF THE DEPTH OF THE LOWEST LAYER. WE MUST RETAIN<a name='1037'></font>
<font color=#447700>!*** THOSE VALUES FOR THE NEXT TIMESTEP SO USE AUXILLIARY ARRAYS FOR<a name='1038'></font>
<font color=#447700>!*** THE OUTPUT.<a name='1039'></font>
<font color=#447700>!<a name='1040'></font>
<font color=#447700>!$omp parallel do &<a name='1041'></font>
<font color=#447700>!$omp& private(dzhalf,i,j)<a name='1042'></font>
DO J=JTS,JTE<a name='1043'>
DO I=ITS,ITE<a name='1044'>
DZHALF=0.5*DZ(I,KTS,J)<a name='1045'>
AKHS_OUT(I,J)=AKHS(I,J)*DZHALF<a name='1046'>
AKMS_OUT(I,J)=AKMS(I,J)*DZHALF<a name='1047'>
ENDDO<a name='1048'>
ENDDO<a name='1049'>
<font color=#447700>!<a name='1050'></font>
CALL <A href='../../html_code/phys/module_pbl_driver.F.html#PBL_DRIVER'>PBL_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#TURBL' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="PBL_DRIVER_2">( &<a name='1051'>
& ITIMESTEP=NTSD,DT=DT &<a name='1052'>
& ,U_FRAME=U_FRAME,V_FRAME=V_FRAME &<a name='1053'>
& ,RUBLTEN=DUDT,RVBLTEN=DVDT,RTHBLTEN=RTHBLTEN &<a name='1054'>
& ,RQVBLTEN=RQVBLTEN,RQCBLTEN=RQCBLTEN &<a name='1055'>
& ,RQIBLTEN=RQIBLTEN &<a name='1056'>
& ,TSK=TSFC,XLAND=XLAND,ZNT=Z0,HT=SFCZ &<a name='1057'>
& ,UST=USTAR, PBLH=PBLH &<a name='1058'>
& ,HFX=TWBS,QFX=QWBS, GRDFLX=GRNFLX &<a name='1059'>
& ,U_PHY=U_PHY,V_PHY=V_PHY,TH_PHY=TH_PHY,RHO=RR &<a name='1060'>
& ,P_PHY=P_PHY,PI_PHY=PI_PHY,P8W=P8W,T_PHY=T_PHY &<a name='1061'>
& ,DZ8W=DZ,Z=Z,TKE_MYJ=TKE,EL_MYJ=EL_MYJ &<a name='1062'>
& ,EXCH_H=EXCH_H,AKHS=AKHS,AKMS=AKMS &<a name='1063'>
& ,THZ0=THZ0,QZ0=QZ0,UZ0=UZ0H,VZ0=VZ0H &<a name='1064'>
& ,QSFC=QS,LOWLYR=LOWLYR &<a name='1065'>
& ,PSIM=PSIM,PSIH=PSIH,GZ1OZ0=GZ1OZ0 &<a name='1066'>
& ,WSPD=WSPD,BR=BR,CHKLOWQ=CHKLOWQ &<a name='1067'>
& ,DX=DX,STEPBL=NPHS,WARM_RAIN=WARM_RAIN &<a name='1068'>
& ,KPBL=KPBL,CT=CT,LH=ELFLX,SNOW=SNOW,XICE=SICE &<a name='1069'>
& ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics &<a name='1070'>
& ,RA_LW_PHYSICS=config_flags%ra_lw_physics &<a name='1071'>
& ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &<a name='1072'>
& ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &<a name='1073'>
& ,I_START=GRID%I_START,I_END=GRID%I_END &<a name='1074'>
& ,J_START=GRID%J_START,J_END=GRID%J_END &<a name='1075'>
& ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &<a name='1076'>
<font color=#447700>! Optional args<a name='1077'></font>
& ,QV_CURR=WATER(IMS,KMS,JMS,P_QV) , F_QV=F_QV &<a name='1078'>
& ,QC_CURR=WATER(IMS,KMS,JMS,P_QC) , F_QC=F_QC &<a name='1079'>
& ,QR_CURR=WATER(IMS,KMS,JMS,P_QR) , F_QR=F_QR &<a name='1080'>
& ,QI_CURR=WATER(IMS,KMS,JMS,P_QI) , F_QI=F_QI &<a name='1081'>
& ,QS_CURR=WATER(IMS,KMS,JMS,P_QS) , F_QS=F_QS &<a name='1082'>
& ,QG_CURR=WATER(IMS,KMS,JMS,P_QG) , F_QG=F_QG )<a name='1083'>
<font color=#447700>!<a name='1084'></font>
<font color=#447700>!*** NOTE THAT THE EXCHANGE COEFFICIENTS FOR HEAT EXCH_H COMING OUT OF<a name='1085'></font>
<font color=#447700>!*** PBL_DRIVER ARE DEFINED AT THE TOPS OF THE LAYERS KTS TO KTE-1<a name='1086'></font>
<font color=#447700>!*** IF MODULE_BL_MYJPBL WAS INVOKED.<a name='1087'></font>
<font color=#447700>!<a name='1088'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1089'></font>
<font color=#447700>! UNCOMPUTED LOCATIONS MUST BE FILLED IN FOR THE POST-PROCESSOR<a name='1090'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1091'></font>
<font color=#447700>!<a name='1092'></font>
<font color=#447700>!*** EASTERN GLOBAL BOUNDARY<a name='1093'></font>
<font color=#447700>!<a name='1094'></font>
IF(MYIE==IDE)THEN<a name='1095'>
<font color=#447700>!$omp parallel do &<a name='1096'></font>
<font color=#447700>!$omp& private(i,j)<a name='1097'></font>
DO J=JDS,JDE<a name='1098'>
IF (J>=MYJS.AND.J<=MYJE)THEN<a name='1099'>
TH10(MYIE,J)=TH10(MYIE-1,J)<a name='1100'>
Q10(MYIE,J)=Q10(MYIE-1,J)<a name='1101'>
U10(MYIE,J)=U10(MYIE-1,J)<a name='1102'>
V10(MYIE,J)=V10(MYIE-1,J)<a name='1103'>
TSHLTR(MYIE,J)=TSHLTR(MYIE-1,J)<a name='1104'>
QSHLTR(MYIE,J)=QSHLTR(MYIE-1,J)<a name='1105'>
ENDIF<a name='1106'>
ENDDO<a name='1107'>
ENDIF<a name='1108'>
<font color=#447700>!<a name='1109'></font>
<font color=#447700>!*** SOUTHERN GLOBAL BOUNDARY<a name='1110'></font>
<font color=#447700>!<a name='1111'></font>
<a name='1112'>
IF(MYJS==1)THEN<a name='1113'>
DO J=1,2<a name='1114'>
DO I=IDS,IDE<a name='1115'>
IF (I>=MYIS.AND.I<=MYIE) THEN<a name='1116'>
TH10(I,J)=TH10(I,MYJS+2)<a name='1117'>
Q10(I,J)=Q10(I,MYJS+2)<a name='1118'>
U10(I,J)=U10(I,MYJS+2)<a name='1119'>
V10(I,J)=V10(I,MYJS+2)<a name='1120'>
TSHLTR(I,J)=TSHLTR(I,MYJS+2)<a name='1121'>
QSHLTR(I,J)=QSHLTR(I,MYJS+2)<a name='1122'>
ENDIF<a name='1123'>
ENDDO<a name='1124'>
ENDDO<a name='1125'>
ENDIF<a name='1126'>
<font color=#447700>!<a name='1127'></font>
<font color=#447700>!*** NORTHERN GLOBAL BOUNDARY<a name='1128'></font>
<font color=#447700>!<a name='1129'></font>
IF(MYJE==JDE)THEN<a name='1130'>
<font color=#447700>!$omp parallel do &<a name='1131'></font>
<font color=#447700>!$omp& private(i,j)<a name='1132'></font>
DO J=MYJE-1,MYJE<a name='1133'>
DO I=IDS,JDE<a name='1134'>
IF (I>=MYIS.AND.I<=MYIE) THEN<a name='1135'>
TH10(I,J)=TH10(I,MYJE-2)<a name='1136'>
Q10(I,J)=Q10(I,MYJE-2)<a name='1137'>
U10(I,J)=U10(I,MYJE-2)<a name='1138'>
V10(I,J)=V10(I,MYJE-2)<a name='1139'>
TSHLTR(I,J)=TSHLTR(I,MYJE-2)<a name='1140'>
QSHLTR(I,J)=QSHLTR(I,MYJE-2)<a name='1141'>
ENDIF<a name='1142'>
ENDDO<a name='1143'>
ENDDO<a name='1144'>
ENDIF<a name='1145'>
<font color=#447700>!<a name='1146'></font>
IF(CONFIG_FLAGS%SF_SFCLAY_PHYSICS==1)THEN <font color=#447700>! non-NMM package<a name='1147'></font>
<font color=#447700>!$omp parallel do &<a name='1148'></font>
<font color=#447700>!$omp& private(i,j)<a name='1149'></font>
DO J=MYJS1,MYJE1<a name='1150'>
DO I=MYIS,MYIE1<a name='1151'>
<font color=#447700>! TSHLTR(I,J)=TSHLTR(I,J)*(1.E5/PSHLTR(I,J))**RCP<a name='1152'></font>
IF(TSHLTR(I,J)<200..OR.TSHLTR(I,J)>350.)THEN<a name='1153'>
WRITE(0,*)'Troublesome TSHLTR...I,J,TSHLTR,PSHLTR: ', &<a name='1154'>
I,J,TSHLTR(I,J),PSHLTR(I,J)<a name='1155'>
ENDIF<a name='1156'>
ENDDO<a name='1157'>
ENDDO<a name='1158'>
ENDIF<a name='1159'>
<font color=#447700>!<a name='1160'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1161'></font>
<font color=#447700>!*** COMPUTE MODEL LAYER CONTAINING THE TOP OF THE BOUNDARY LAYER<a name='1162'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1163'></font>
<font color=#447700>!<a name='1164'></font>
IF(CONFIG_FLAGS%BL_PBL_PHYSICS/=MYJPBLSCHEME)THEN<a name='1165'>
LENGTH_ROW=MYIE1-MYIS1+1<a name='1166'>
DO J=MYJS2,MYJE2<a name='1167'>
DO I=MYIS1,MYIE1<a name='1168'>
KPBL(I,J)=-1000<a name='1169'>
ENDDO<a name='1170'>
ENDDO<a name='1171'>
<font color=#447700>!<a name='1172'></font>
<font color=#447700>!$omp parallel do &<a name='1173'></font>
<font color=#447700>!$omp& private(altitude,i,j,k,kount_all)<a name='1174'></font>
DO J=MYJS2,MYJE2<a name='1175'>
KOUNT_ALL=0<a name='1176'>
find_kpbl : DO K=KTS,KTE<a name='1177'>
DO I=MYIS1,MYIE1<a name='1178'>
ALTITUDE=Z(I,K+1,J)-SFCZ(I,J)<a name='1179'>
IF(PBLH(I,J)<=ALTITUDE.AND.KPBL(I,J)<0)THEN<a name='1180'>
KPBL(I,J)=K<a name='1181'>
KOUNT_ALL=KOUNT_ALL+1<a name='1182'>
ENDIF<a name='1183'>
IF(KOUNT_ALL==LENGTH_ROW)EXIT find_kpbl<a name='1184'>
ENDDO<a name='1185'>
ENDDO find_kpbl<a name='1186'>
ENDDO<a name='1187'>
ENDIF<a name='1188'>
<font color=#447700>!<a name='1189'></font>
<font color=#447700>!$omp parallel do &<a name='1190'></font>
<font color=#447700>!$omp& private(i,j)<a name='1191'></font>
DO J=MYJS2,MYJE2<a name='1192'>
DO I=MYIS1,MYIE1<a name='1193'>
SNO(I,J)=SNOW(I,J)<a name='1194'>
SI(I,J)=SNOWH(I,J)<a name='1195'>
LPBL(I,J)=KTE-KPBL(I,J)+1<a name='1196'>
ENDDO<a name='1197'>
ENDDO<a name='1198'>
<font color=#447700>!<a name='1199'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1200'></font>
<font color=#447700>!*** DIAGNOSTIC RADIATION ACCUMULATION<a name='1201'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1202'></font>
<font color=#447700>!<a name='1203'></font>
<font color=#447700>!$omp parallel do &<a name='1204'></font>
<font color=#447700>!$omp& private(i,j,tsfc2)<a name='1205'></font>
DO J=MYJS2,MYJE2<a name='1206'>
DO I=MYIS,MYIE<a name='1207'>
ASWIN (I,J)=ASWIN (I,J)+RSWIN(I,J)*HBM2(I,J)*FACTRS(I,J)<a name='1208'>
ASWOUT(I,J)=ASWOUT(I,J)-RSWOUT(I,J)*HBM2(I,J)*FACTRS(I,J)<a name='1209'>
ASWTOA(I,J)=ASWTOA(I,J)+RSWTOA(I,J)*HBM2(I,J)*FACTRS(I,J)<a name='1210'>
ALWIN (I,J)=ALWIN (I,J)+RLW_DN_SFC(I,J)<a name='1211'>
ALWOUT(I,J)=ALWOUT(I,J)-RADOT (I,J)*HBM2(I,J)<a name='1212'>
ALWTOA(I,J)=ALWTOA(I,J)+RLWTOA(I,J)*HBM2(I,J)<a name='1213'>
<font color=#447700>!<a name='1214'></font>
TSFC2=TSFC(I,J)*TSFC(I,J)<a name='1215'>
RADOT(I,J)=HBM2(I,J)*EPSR(I,J)*STBOLT*TSFC2*TSFC2<a name='1216'>
THS(I,J)=TSFC(I,J)*EXNSFC(I,J)<a name='1217'>
PREC(I,J)=0.<a name='1218'>
ENDDO<a name='1219'>
ENDDO<a name='1220'>
<font color=#447700>!<a name='1221'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1222'></font>
<font color=#447700>!*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD, AND TKE.<a name='1223'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1224'></font>
<font color=#447700>!<a name='1225'></font>
E_BDY=(ITE>=IDE)<a name='1226'>
<font color=#447700>!<a name='1227'></font>
<font color=#447700>!$omp parallel do &<a name='1228'></font>
<font color=#447700>!$omp& private(dqdt,dtdt,i,iend,j,k,qi,qold,qr,qw,ratiomx)<a name='1229'></font>
DO J=MYJS2,MYJE2<a name='1230'>
IEND=MYIE1<a name='1231'>
IF(E_BDY.AND.MOD(J,2)==0)IEND=IEND-1<a name='1232'>
<font color=#447700>!<a name='1233'></font>
DO K=KTS,KTE<a name='1234'>
DO I=MYIS1,IEND<a name='1235'>
DTDT=RTHBLTEN(I,K,J)*PI_PHY(I,K,J)<a name='1236'>
DQDT=RQVBLTEN(I,K,J) <font color=#447700>!Mixing ratio tendency<a name='1237'></font>
T(I,K,J)=T(I,K,J)+DTDT*DTPHS<a name='1238'>
QOLD=Q(I,K,J)<a name='1239'>
RATIOMX=QOLD/(1.-QOLD)+DQDT*DTPHS<a name='1240'>
Q(I,K,J)=RATIOMX/(1.+RATIOMX)<a name='1241'>
<font color=#447700>! Q(I,K,J)=MAX(Q(I,K,J),EPSQ)<a name='1242'></font>
QW=WATER(I,K,J,P_QC)+RQCBLTEN(I,K,J)*DTPHS <a name='1243'>
QI=WATER(I,K,J,P_QI)+RQIBLTEN(I,K,J)*DTPHS <a name='1244'>
QR=WATER(I,K,J,P_QR) <a name='1245'>
CWM(I,K,J)=QW+QI+QR <a name='1246'>
<font color=#447700>!<a name='1247'></font>
IF(QI<=EPSQ)THEN <a name='1248'>
F_ICE(I,K,J)=0. <a name='1249'>
ELSE <a name='1250'>
F_ICE(I,K,J)=MAX(0.,MIN(1.,QI/CWM(I,K,J))) <a name='1251'>
ENDIF <a name='1252'>
IF(QR<=EPSQ)THEN <a name='1253'>
F_RAIN(I,K,J)=0. <a name='1254'>
ELSE <a name='1255'>
F_RAIN(I,K,J)=QR/(QW+QR) <a name='1256'>
ENDIF <a name='1257'>
<font color=#447700>!<a name='1258'></font>
Q2(I,K,J)=2.*TKE(I,K,J)<a name='1259'>
ENDDO<a name='1260'>
ENDDO<a name='1261'>
<font color=#447700>!<a name='1262'></font>
ENDDO<a name='1263'>
<font color=#447700>!<a name='1264'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1265'></font>
<font color=#447700>!***<a name='1266'></font>
<font color=#447700>!*** SAVE SURFACE-RELATED FIELDS.<a name='1267'></font>
<font color=#447700>!***<a name='1268'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1269'></font>
<font color=#447700>!$omp parallel do &<a name='1270'></font>
<font color=#447700>!$omp& private(i,j,llij,xlvrw)<a name='1271'></font>
DO J=MYJS2,MYJE2<a name='1272'>
DO I=MYIS1,MYIE1<a name='1273'>
LLIJ=LOWLYR(I,J)<a name='1274'>
<font color=#447700>!<a name='1275'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1276'></font>
<font color=#447700>!*** INSTANTANEOUS SENSIBLE AND LATENT HEAT FLUX<a name='1277'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1278'></font>
<font color=#447700>!<a name='1279'></font>
TWBS(I,J)=-TWBS(I,J)<a name='1280'>
QWBS(I,J)=-QWBS(I,J)*XLV<a name='1281'>
<font color=#447700>!<a name='1282'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1283'></font>
<font color=#447700>!*** ACCUMULATED QUANTITIES.<a name='1284'></font>
<font color=#447700>!*** IN OPNL LSM, SFCEVP APPEARS TO BE IN UNITS OF<a name='1285'></font>
<font color=#447700>!*** METERS OF LIQUID WATER. IT IS COMING FROM<a name='1286'></font>
<font color=#447700>!*** WRF MODULE AS KG/M**2.<a name='1287'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1288'></font>
<font color=#447700>!<a name='1289'></font>
SFCSHX(I,J)=SFCSHX(I,J)+TWBS(I,J)<a name='1290'>
SFCLHX(I,J)=SFCLHX(I,J)+QWBS(I,J)<a name='1291'>
XLVRW=DTPHS/(XLV*RHOWATER)<a name='1292'>
SFCEVP(I,J)=SFCEVP(I,J)-QWBS(I,J)*XLVRW<a name='1293'>
POTEVP(I,J)=POTEVP(I,J)-QWBS(I,J)*SM(I,J)*XLVRW<a name='1294'>
POTFLX(I,J)=POTEVP(I,J)*FACTOR<a name='1295'>
SUBSHX(I,J)=SUBSHX(I,J)+GRNFLX(I,J)<a name='1296'>
ENDDO<a name='1297'>
ENDDO<a name='1298'>
<font color=#447700>!<a name='1299'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1300'></font>
<font color=#447700>!*** COUNTERS<a name='1301'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1302'></font>
<font color=#447700>!<a name='1303'></font>
APHTIM=APHTIM+1.<a name='1304'>
ARDSW =ARDSW +1.<a name='1305'>
ARDLW =ARDLW +1.<a name='1306'>
ASRFC =ASRFC +1.<a name='1307'>
<font color=#447700>!-----------------------------------------------------------------------<a name='1308'></font>
<font color=#447700>!<a name='1309'></font>
END SUBROUTINE TURBL<a name='1310'>
<font color=#447700>!<a name='1311'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1312'></font>
<font color=#447700>!***********************************************************************<a name='1313'></font>
<A NAME='UV_H_TO_V'><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#UV_H_TO_V' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='1314'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>UV_H_TO_V</font>(NTSD,DT,NPHS,UZ0H,VZ0H,UZ0,VZ0 & <A href='../../call_to/UV_H_TO_V.html' TARGET='index'>1</A><a name='1315'>
& ,DUDT,DVDT,U,V,HBM2,VTM,IVE,IVW & <a name='1316'>
& ,IDS,IDE,JDS,JDE,KDS,KDE &<a name='1317'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='1318'>
& ,ITS,ITE,JTS,JTE,KTS,KTE)<a name='1319'>
<font color=#447700>!***********************************************************************<a name='1320'></font>
<font color=#447700>!$$$ SUBPROGRAM DOCUMENTATION BLOCK<a name='1321'></font>
<font color=#447700>! . . . <a name='1322'></font>
<font color=#447700>! SUBPROGRAM: UV_H_TO_V INTERPOLATE WINDS FROM H TO V POINTS<a name='1323'></font>
<font color=#447700>! PRGRMMR: BLACK ORG: W/NP22 DATE: 05-02-22 <a name='1324'></font>
<font color=#447700>! <a name='1325'></font>
<font color=#447700>! ABSTRACT:<a name='1326'></font>
<font color=#447700>! INTERPOLATE WINDS BACK TO V POINTS AFTER TURBULENCE<a name='1327'></font>
<font color=#447700>! <a name='1328'></font>
<font color=#447700>! PROGRAM HISTORY LOG :<a name='1329'></font>
<font color=#447700>! 05-02-22 BLACK - ORIGINATOR<a name='1330'></font>
<font color=#447700>! <a name='1331'></font>
<font color=#447700>! USAGE: CALL TURBL FROM SOLVE_NMM<a name='1332'></font>
<font color=#447700>!<a name='1333'></font>
<font color=#447700>! ATTRIBUTES:<a name='1334'></font>
<font color=#447700>! LANGUAGE: FORTRAN 90<a name='1335'></font>
<font color=#447700>! MACHINE : IBM<a name='1336'></font>
<font color=#447700>!$$$ <a name='1337'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1338'></font>
<font color=#447700>!<a name='1339'></font>
IMPLICIT NONE<a name='1340'>
<font color=#447700>!<a name='1341'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1342'></font>
<font color=#447700>!<a name='1343'></font>
INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &<a name='1344'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='1345'>
& ,ITS,ITE,JTS,JTE,KTS,KTE &<a name='1346'>
& ,NPHS,NTSD<a name='1347'>
<font color=#447700>!<a name='1348'></font>
INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IVE,IVW<a name='1349'>
<font color=#447700>!<a name='1350'></font>
REAL,INTENT(IN) :: DT<a name='1351'>
<font color=#447700>!<a name='1352'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HBM2,UZ0H,VZ0H<a name='1353'>
<font color=#447700>!<a name='1354'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DUDT,DVDT &<a name='1355'>
& ,VTM<a name='1356'>
<font color=#447700>!<a name='1357'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: UZ0,VZ0<a name='1358'>
<font color=#447700>!<a name='1359'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: U,V<a name='1360'>
<font color=#447700>!<a name='1361'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1362'></font>
<font color=#447700>!***<a name='1363'></font>
<font color=#447700>!*** LOCAL VARIABLES<a name='1364'></font>
<font color=#447700>!***<a name='1365'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1366'></font>
<font color=#447700>!<a name='1367'></font>
INTEGER :: I,IEND,J,K<a name='1368'>
<font color=#447700>!<a name='1369'></font>
REAL :: DTPHS<a name='1370'>
<font color=#447700>!<a name='1371'></font>
LOGICAL :: E_BDY<a name='1372'>
<font color=#447700>!<a name='1373'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1374'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1375'></font>
<font color=#447700>!<a name='1376'></font>
DTPHS=NPHS*DT<a name='1377'>
E_BDY=(ITE>=IDE)<a name='1378'>
<font color=#447700>!<a name='1379'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1380'></font>
<font color=#447700>!*** RECONSTRUCT UZ0 AND VZ0 ON VELOCITY POINTS.<a name='1381'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1382'></font>
<font color=#447700>!<a name='1383'></font>
<font color=#447700>!$omp parallel do &<a name='1384'></font>
<font color=#447700>!$omp& private(i,j)<a name='1385'></font>
DO J=MYJS2,MYJE2<a name='1386'>
DO I=MYIS,MYIE<a name='1387'>
UZ0(I,J)=(UZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J) &<a name='1388'>
& +UZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J) &<a name='1389'>
& +UZ0H(I,J+1)*HBM2(I,J+1)+UZ0H(I,J-1)*HBM2(I,J-1))*0.25<a name='1390'>
VZ0(I,J)=(VZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J) &<a name='1391'>
& +VZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J) &<a name='1392'>
& +VZ0H(I,J+1)*HBM2(I,J+1)+VZ0H(I,J-1)*HBM2(I,J-1))*0.25<a name='1393'>
ENDDO<a name='1394'>
ENDDO<a name='1395'>
<font color=#447700>!<a name='1396'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1397'></font>
<font color=#447700>!*** INTERPOLATE WIND TENDENCIES TO VELOCITY POINTS AND UPDATE WINDS.<a name='1398'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1399'></font>
<font color=#447700>!<a name='1400'></font>
<font color=#447700>!$omp parallel do &<a name='1401'></font>
<font color=#447700>!$omp& private(i,iend,j,k)<a name='1402'></font>
DO J=MYJS2,MYJE2<a name='1403'>
IEND=MYIE1<a name='1404'>
IF(E_BDY.AND.MOD(J,2)==1)IEND=IEND-1<a name='1405'>
<font color=#447700>!<a name='1406'></font>
DO K=KTS,KTE<a name='1407'>
DO I=MYIS1,IEND<a name='1408'>
U(I,K,J)=(DUDT(I+IVE(J),K,J)+DUDT(I+IVW(J),K,J) &<a name='1409'>
& +DUDT(I,K,J+1)+DUDT(I,K,J-1))*0.25*DTPHS &<a name='1410'>
& *VTM(I,K,J)+U(I,K,J)<a name='1411'>
V(I,K,J)=(DVDT(I+IVE(J),K,J)+DVDT(I+IVW(J),K,J) &<a name='1412'>
& +DVDT(I,K,J+1)+DVDT(I,K,J-1))*0.25*DTPHS &<a name='1413'>
& *VTM(I,K,J)+V(I,K,J)<a name='1414'>
ENDDO<a name='1415'>
ENDDO<a name='1416'>
ENDDO<a name='1417'>
<font color=#447700>!-----------------------------------------------------------------------<a name='1418'></font>
<font color=#447700>!<a name='1419'></font>
END SUBROUTINE UV_H_TO_V<a name='1420'>
<font color=#447700>!<a name='1421'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1422'></font>
<font color=#447700>!***********************************************************************<a name='1423'></font>
<A NAME='CUCNVC'><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#CUCNVC' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='1424'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>CUCNVC</font>(NTSD,DT,NCNVC,GPS,RESTRT,HYDRO & <A href='../../call_to/CUCNVC.html' TARGET='index'>1</A>,<A href='../../call_from/CUCNVC.html' TARGET='index'>2</A><a name='1425'>
<font color=#447700>! & ,CLDEFI,LMH,WATER,N_MOIST,ENSDIM &<a name='1426'></font>
& ,CLDEFI,LMH,N_MOIST,ENSDIM &<a name='1427'>
& ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2 &<a name='1428'>
& ,F_ICE,F_RAIN &<a name='1429'>
& ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TCUCN &<a name='1430'>
& ,OMGALF,U,V,VTM,WINT,Z,FIS,W0AVG &<a name='1431'>
& ,PREC,ACPREC,CUPREC,CUPPT,CPRATE &<a name='1432'>
& ,SM,HBM2,LPBL,CNVBOT,CNVTOP &<a name='1433'>
& ,HTOP,HBOT,HTOPD,HBOTD,HTOPS,HBOTS &<a name='1434'>
& ,AVCNVC,ACUTIM,ZERO_3D,IHE,IHW &<a name='1435'>
& ,GRID,CONFIG_FLAGS &<a name='1436'>
& ,IDS,IDE,JDS,JDE,KDS,KDE &<a name='1437'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='1438'>
& ,ITS,ITE,JTS,JTE,KTS,KTE)<a name='1439'>
<font color=#447700>!***********************************************************************<a name='1440'></font>
<font color=#447700>!$$$ SUBPROGRAM DOCUMENTATION BLOCK<a name='1441'></font>
<font color=#447700>! . . . <a name='1442'></font>
<font color=#447700>! SUBPROGRAM: CUCNVC CONVECTIVE PRECIPITATION OUTER DRIVER<a name='1443'></font>
<font color=#447700>! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-03-21 <a name='1444'></font>
<font color=#447700>! <a name='1445'></font>
<font color=#447700>! ABSTRACT:<a name='1446'></font>
<font color=#447700>! CUCVNC DRIVES THE WRF CONVECTION SCHEMES<a name='1447'></font>
<font color=#447700>! <a name='1448'></font>
<font color=#447700>! PROGRAM HISTORY LOG:<a name='1449'></font>
<font color=#447700>! 02-03-21 BLACK - ORIGINATOR<a name='1450'></font>
<font color=#447700>! 04-11-18 BLACK - THREADED<a name='1451'></font>
<font color=#447700>! <a name='1452'></font>
<font color=#447700>! USAGE: CALL CUCNVC FROM SOLVE_NMM<a name='1453'></font>
<font color=#447700>!<a name='1454'></font>
<font color=#447700>! ATTRIBUTES:<a name='1455'></font>
<font color=#447700>! LANGUAGE: FORTRAN 90<a name='1456'></font>
<font color=#447700>! MACHINE : IBM <a name='1457'></font>
<font color=#447700>!$$$ <a name='1458'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1459'></font>
<font color=#447700>!<a name='1460'></font>
IMPLICIT NONE<a name='1461'>
<font color=#447700>!<a name='1462'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1463'></font>
<font color=#447700>!<a name='1464'></font>
INTEGER,INTENT(IN) :: ENSDIM &<a name='1465'>
& ,IDS,IDE,JDS,JDE,KDS,KDE &<a name='1466'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='1467'>
& ,ITS,ITE,JTS,JTE,KTS,KTE &<a name='1468'>
& ,N_MOIST,NCNVC,NTSD<a name='1469'>
<font color=#447700>!<a name='1470'></font>
INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW<a name='1471'>
<font color=#447700>!<a name='1472'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH,LPBL<a name='1473'>
<font color=#447700>!<a name='1474'></font>
REAL,INTENT(IN) :: DT,GPS,PDTOP,PT<a name='1475'>
<font color=#447700>!<a name='1476'></font>
REAL,INTENT(INOUT) :: ACUTIM,AVCNVC<a name='1477'>
<font color=#447700>!<a name='1478'></font>
REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2<a name='1479'>
REAL,DIMENSION(KMS:KME ),INTENT(IN) :: ETA1,ETA2<a name='1480'>
<font color=#447700>!<a name='1481'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PD,RES,SM<a name='1482'>
<font color=#447700>!<a name='1483'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,CLDEFI &<a name='1484'>
& ,CNVBOT,CNVTOP &<a name='1485'>
& ,CUPPT,CUPREC &<a name='1486'>
& ,HBOT,HTOP &<a name='1487'>
& ,HBOTD,HTOPD &<a name='1488'>
& ,HBOTS,HTOPS &<a name='1489'>
& ,PREC,CPRATE<a name='1490'>
<font color=#447700>!<a name='1491'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: F_ICE &<a name='1492'>
& ,F_RAIN<a name='1493'>
<a name='1494'>
<font color=#447700>!<a name='1495'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: Q,T &<a name='1496'>
& ,CWM &<a name='1497'>
& ,TCUCN &<a name='1498'>
& ,W0AVG &<a name='1499'>
& ,WINT<a name='1500'>
<font color=#447700>!<a name='1501'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: OMGALF &<a name='1502'>
& ,PINT,U,V &<a name='1503'>
& ,VTM,Z<a name='1504'>
<font color=#447700>!<a name='1505'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D<a name='1506'>
<font color=#447700>!<a name='1507'></font>
<font color=#447700>! REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST) &<a name='1508'></font>
<font color=#447700>! & ,INTENT(INOUT) :: WATER<a name='1509'></font>
<font color=#447700>!<a name='1510'></font>
LOGICAL,INTENT(IN) :: HYDRO,RESTRT<a name='1511'>
<font color=#447700>!<a name='1512'></font>
TYPE(DOMAIN),TARGET :: GRID<a name='1513'>
<font color=#447700>!<a name='1514'></font>
TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS<a name='1515'>
<font color=#447700>!<a name='1516'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1517'></font>
<font color=#447700>!***<a name='1518'></font>
<font color=#447700>!*** LOCAL VARIABLES<a name='1519'></font>
<font color=#447700>!***<a name='1520'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1521'></font>
INTEGER :: I,ICLDCK,IENDX,J,K,MNTO,NCUBOT,NCUTOP,NSTEP_CNV &<a name='1522'>
& ,N_TIMSTPS_OUTPUT<a name='1523'>
<font color=#447700>!<a name='1524'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME) :: KPBL,LBOT,LOWLYR,LTOP<a name='1525'>
<font color=#447700>!<a name='1526'></font>
REAL :: CAPA,CF_HI,DPL,DQDT,DTCNVC,DTDT,FICE,FRAIN,G_INV &<a name='1527'>
& ,PCPCOL,PDSL,PLYR,QI,QR,QW,RDTCNVC,RWMSK,WMSK,WC<a name='1528'>
<font color=#447700>!<a name='1529'></font>
REAL,DIMENSION(KMS:KME-1) :: QL,TL<a name='1530'>
<font color=#447700>!<a name='1531'></font>
REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,NCA,RAINC,RAINCV &<a name='1532'>
& ,SFCZ,XLAND<a name='1533'>
<font color=#447700>!<a name='1534'></font>
REAL,DIMENSION(IMS:IME,KMS:KME) :: WMID<a name='1535'>
<font color=#447700>!<a name='1536'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY &<a name='1537'>
& ,RQCCUTEN,RQRCUTEN &<a name='1538'>
& ,RQVCUTEN,RR,RTHCUTEN &<a name='1539'>
& ,T_PHY,TH_PHY &<a name='1540'>
& ,U_PHY,V_PHY<a name='1541'>
<font color=#447700>!<a name='1542'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST) :: WATER<a name='1543'>
<font color=#447700>!<a name='1544'></font>
REAL,DIMENSION(IMS:IME,JMS:JME) :: ZERO_2D<a name='1545'>
REAL,DIMENSION(IMS:IME,JMS:JME,ENSDIM) :: ZERO_GD<a name='1546'>
<font color=#447700>!<a name='1547'></font>
LOGICAL :: RESTART,WARM_RAIN<a name='1548'>
LOGICAL,DIMENSION(IMS:IME,JMS:JME) :: CU_ACT_FLAG<a name='1549'>
<font color=#447700>!<a name='1550'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1551'></font>
<font color=#447700>!*** FOR TEMPERATURE CHANGE CHECK ONLY.<a name='1552'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1553'></font>
INTEGER :: DTEMP_CHECK=1.0<a name='1554'>
REAL :: TCHANGE<a name='1555'>
<font color=#447700>!-----------------------------------------------------------------------<a name='1556'></font>
<font color=#447700>!***********************************************************************<a name='1557'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1558'></font>
IF(MOD(NTSD,NCNVC)/=0.AND. &<a name='1559'>
& CONFIG_FLAGS%CU_PHYSICS==BMJSCHEME)RETURN<a name='1560'>
IF(MOD(NTSD,NCNVC)/=0.AND. &<a name='1561'>
& CONFIG_FLAGS%CU_PHYSICS==SASSCHEME)RETURN<a name='1562'>
<font color=#447700>!-----------------------------------------------------------------------<a name='1563'></font>
NSTEP_CNV=NCNVC<a name='1564'>
<font color=#447700>!<a name='1565'></font>
RESTART=RESTRT<a name='1566'>
<font color=#447700>!-----------------------------------------------------------------------<a name='1567'></font>
IF(CONFIG_FLAGS%CU_PHYSICS==KFETASCHEME)THEN<a name='1568'>
<font color=#447700>!<a name='1569'></font>
IF(.NOT.RESTART.AND.NTSD==0)THEN<a name='1570'>
<font color=#447700>!$omp parallel do &<a name='1571'></font>
<font color=#447700>!$omp& private(i,j,k)<a name='1572'></font>
DO J=JTS,JTE<a name='1573'>
DO K=KTS,KTE<a name='1574'>
DO I=ITS,ITE<a name='1575'>
W0AVG(I,K,J)=0.<a name='1576'>
ENDDO<a name='1577'>
ENDDO<a name='1578'>
ENDDO<a name='1579'>
ENDIF<a name='1580'>
<font color=#447700>!<a name='1581'></font>
ENDIF<a name='1582'>
<font color=#447700>!<a name='1583'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1584'></font>
<font color=#447700>!*** GENERAL PREPARATION <a name='1585'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1586'></font>
<font color=#447700>!<a name='1587'></font>
AVCNVC=AVCNVC+1.<a name='1588'>
ACUTIM=ACUTIM+1.<a name='1589'>
<font color=#447700>!<a name='1590'></font>
DTCNVC=NCNVC*DT<a name='1591'>
RDTCNVC=1./DTCNVC<a name='1592'>
CAPA=R_D/CP<a name='1593'>
G_INV=1./G<a name='1594'>
<font color=#447700>!<a name='1595'></font>
<font color=#447700>!$omp parallel do &<a name='1596'></font>
<font color=#447700>!$omp& private(dpl,fice,frain,i,j,k,pdsl,plyr,qi,ql,qr,qw,tl,wc)<a name='1597'></font>
DO J=MYJS2,MYJE2<a name='1598'>
DO I=MYIS1,MYIE1<a name='1599'>
<font color=#447700>!<a name='1600'></font>
PDSL=PD(I,J)*RES(I,J)<a name='1601'>
RAINCV(I,J)=0.<a name='1602'>
RAINC(I,J)=0.<a name='1603'>
P8W(I,KTS,J)=PD(I,J)+PDTOP+PT<a name='1604'>
LOWLYR(I,J)=KTE+1-LMH(I,J)<a name='1605'>
XLAND(I,J)=SM(I,J)+1.<a name='1606'>
NCA(I,J)=0.<a name='1607'>
SFCZ(I,J)=FIS(I,J)*G_INV<a name='1608'>
<font color=#447700>!<a name='1609'></font>
<font color=#447700>!*** LPBL IS THE MODEL LAYER CONTAINING THE PBL TOP<a name='1610'></font>
<font color=#447700>!*** COUNTING DOWNWARD FROM THE TOP OF THE DOMAIN<a name='1611'></font>
<font color=#447700>!*** SO KPBL IS THE SAME LAYER COUNTING UPWARD FROM <a name='1612'></font>
<font color=#447700>!*** THE GROUND.<a name='1613'></font>
<font color=#447700>!<a name='1614'></font>
KPBL(I,J)=KTE-LPBL(I,J)+1<a name='1615'>
ZERO_2D(I,J)=0<a name='1616'>
<font color=#447700>!<a name='1617'></font>
DO K=KTS,KTE<a name='1618'>
DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL<a name='1619'>
QL(K)=AMAX1(Q(I,K,J),EPSQ)<a name='1620'>
PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT<a name='1621'>
TL(K)=T(I,K,J)<a name='1622'>
<font color=#447700>!<a name='1623'></font>
RR(I,K,J)=PLYR/(R_D*TL(K)*(P608*QL(K)+1.))<a name='1624'>
T_PHY(I,K,J)=TL(K)<a name='1625'>
<a name='1626'>
WATER(I,K,J,P_QV)=QL(K)/(1.-QL(K))<a name='1627'>
<a name='1628'>
<font color=#447700>!<a name='1629'></font>
<font color=#447700>!*** DECOMPOSE CLOUDS TO CLOUD LIQUID, RAIN, AND CLOUD ICE + SNOW.<a name='1630'></font>
<font color=#447700>!<a name='1631'></font>
WC=CWM(I,K,J)<a name='1632'>
QI=0.<a name='1633'>
QR=0.<a name='1634'>
QW=0.<a name='1635'>
FICE=F_ICE(I,K,J)<a name='1636'>
FRAIN=F_RAIN(I,K,J)<a name='1637'>
<font color=#447700>!<a name='1638'></font>
IF(FICE>=1.)THEN<a name='1639'>
QI=WC<a name='1640'>
ELSEIF(FICE<=0.)THEN<a name='1641'>
QW=WC<a name='1642'>
ELSE<a name='1643'>
QI=FICE*WC<a name='1644'>
QW=WC-QI<a name='1645'>
ENDIF<a name='1646'>
<font color=#447700>!<a name='1647'></font>
IF(QW>0..AND.FRAIN>0.)THEN<a name='1648'>
IF(FRAIN>=1.)THEN<a name='1649'>
QR=QW<a name='1650'>
QW=0.<a name='1651'>
ELSE<a name='1652'>
QR=FRAIN*QW<a name='1653'>
QW=QW-QR<a name='1654'>
ENDIF<a name='1655'>
ENDIF<a name='1656'>
<font color=#447700>!<a name='1657'></font>
WATER(I,K,J,P_QC)=QW<a name='1658'>
WATER(I,K,J,P_QR)=QR<a name='1659'>
WATER(I,K,J,P_QI)=QI<a name='1660'>
<a name='1661'>
TH_PHY(I,K,J)=TL(K)*(1.E5/PLYR)**CAPA<a name='1662'>
<font color=#447700>!!! P8W(I,KFLIP,J)=PINT(I,K+1,J)<a name='1663'></font>
P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT<a name='1664'>
P_PHY(I,K,J)=PLYR<a name='1665'>
PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA<a name='1666'>
<font color=#447700>!<a name='1667'></font>
RTHCUTEN(I,K,J)=0.<a name='1668'>
RQVCUTEN(I,K,J)=0.<a name='1669'>
RQCCUTEN(I,K,J)=0.<a name='1670'>
RQRCUTEN(I,K,J)=0.<a name='1671'>
ENDDO<a name='1672'>
<font color=#447700>!<a name='1673'></font>
ENDDO<a name='1674'>
ENDDO<a name='1675'>
<font color=#447700>!<a name='1676'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1677'></font>
<font color=#447700>!<a name='1678'></font>
<a name='1679'>
IF(.NOT.HYDRO)THEN<a name='1680'>
<font color=#447700>!$omp parallel do &<a name='1681'></font>
<font color=#447700>!$omp& private(i,j,k)<a name='1682'></font>
DO J=MYJS2,MYJE2<a name='1683'>
DO K=KTS,KTE<a name='1684'>
DO I=MYIS1,MYIE1<a name='1685'>
DZ(I,K,J)=Z(I,K+1,J)-Z(I,K,J)<a name='1686'>
ENDDO<a name='1687'>
ENDDO<a name='1688'>
ENDDO<a name='1689'>
<font color=#447700>!<a name='1690'></font>
IF(NTSD==0)THEN<a name='1691'>
<font color=#447700>!$omp parallel do &<a name='1692'></font>
<font color=#447700>!$omp& private(i,j,k)<a name='1693'></font>
DO J=MYJS2,MYJE2<a name='1694'>
DO K=KTS,KTE<a name='1695'>
DO I=MYIS1,MYIE1<a name='1696'>
WINT(I,K,J)=0.<a name='1697'>
ENDDO<a name='1698'>
ENDDO<a name='1699'>
ENDDO<a name='1700'>
ENDIF<a name='1701'>
ELSE<a name='1702'>
DO J=MYJS2,MYJE2<a name='1703'>
DO I=MYIS1,MYIE1<a name='1704'>
WINT(I,1,J)=0.<a name='1705'>
WINT(I,KTE+1,J)=0.<a name='1706'>
ENDDO<a name='1707'>
ENDDO<a name='1708'>
<font color=#447700>!<a name='1709'></font>
<font color=#447700>!$omp parallel do &<a name='1710'></font>
<font color=#447700>!$omp& private(i,j,k,plyr,wmid)<a name='1711'></font>
DO J=MYJS2,MYJE2<a name='1712'>
DO I=MYIS1,MYIE1<a name='1713'>
WMID(I,KTS)=-OMGALF(I,KTS,J)*CP/(G*DT)<a name='1714'>
PLYR=AETA1(KTS)*PDTOP+AETA2(KTS)*PDSL+PT<a name='1715'>
DZ(I,KTS,J)=T(I,KTS,J)*(P608*Q(I,KTS,J)+1.)*R_D &<a name='1716'>
& *(P8W(I,KTS,J)-P8W(I,KTS+1,J)) &<a name='1717'>
& /(PLYR*G)<a name='1718'>
ENDDO<a name='1719'>
<font color=#447700>!<a name='1720'></font>
DO K=KTS+1,KTE<a name='1721'>
DO I=MYIS1,MYIE1<a name='1722'>
WMID(I,K)=-OMGALF(I,K,J)*CP/(G*DT)<a name='1723'>
WINT(I,K,J)=0.5*(WMID(I,K-1)+WMID(I,K))<a name='1724'>
DZ(I,K,J)=TL(K)*(P608*QL(K)+1.)*R_D &<a name='1725'>
& *(P8W(I,K,J)-P8W(I,K+1,J)) &<a name='1726'>
& /(P_PHY(I,K,J)*G)<a name='1727'>
ENDDO<a name='1728'>
ENDDO<a name='1729'>
ENDDO<a name='1730'>
<font color=#447700>!<a name='1731'></font>
ENDIF<a name='1732'>
<font color=#447700>!<a name='1733'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1734'></font>
<font color=#447700>!*** COMPUTE VELOCITY COMPONENTS AT MASS POINTS<a name='1735'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1736'></font>
<font color=#447700>!<a name='1737'></font>
IF(CONFIG_FLAGS%CU_PHYSICS.NE.BMJSCHEME)THEN<a name='1738'>
<font color=#447700>!<a name='1739'></font>
<font color=#447700>!$omp parallel do &<a name='1740'></font>
<font color=#447700>!$omp& private(i,j,k,rwmsk,wmsk)<a name='1741'></font>
DO J=MYJS1_P1,MYJE1_P1<a name='1742'>
<font color=#447700>!<a name='1743'></font>
DO K=KTS,KTE<a name='1744'>
DO I=MYIS_P1,MYIE_P1<a name='1745'>
WMSK=VTM(I+IHE(J),K,J)+VTM(I+IHW(J),K,J) &<a name='1746'>
& +VTM(I,K,J+1)+VTM(I,K,J-1)<a name='1747'>
IF(WMSK>0.)THEN<a name='1748'>
RWMSK=1./WMSK<a name='1749'>
U_PHY(I,K,J)=(U(I+IHE(J),K,J)*VTM(I+IHE(J),K,J) &<a name='1750'>
& +U(I+IHW(J),K,J)*VTM(I+IHW(J),K,J) &<a name='1751'>
& +U(I,K,J+1)*VTM(I,K,J+1) &<a name='1752'>
& +U(I,K,J-1)*VTM(I,K,J-1))*RWMSK<a name='1753'>
V_PHY(I,K,J)=(V(I+IHE(J),K,J)*VTM(I+IHE(J),K,J) &<a name='1754'>
& +V(I+IHW(J),K,J)*VTM(I+IHW(J),K,J) &<a name='1755'>
& +V(I,K,J+1)*VTM(I,K,J+1) &<a name='1756'>
& +V(I,K,J-1)*VTM(I,K,J-1))*RWMSK<a name='1757'>
ELSE<a name='1758'>
U_PHY(I,K,J)=0.<a name='1759'>
V_PHY(I,K,J)=0.<a name='1760'>
ENDIF<a name='1761'>
ENDDO<a name='1762'>
ENDDO<a name='1763'>
<font color=#447700>!<a name='1764'></font>
ENDDO<a name='1765'>
<font color=#447700>!<a name='1766'></font>
ENDIF<a name='1767'>
<font color=#447700>!-----------------------------------------------------------------------<a name='1768'></font>
<font color=#447700>!<a name='1769'></font>
<font color=#447700>!*** SINGLE-COLUMN CONVECTION<a name='1770'></font>
<font color=#447700>!<a name='1771'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1772'></font>
<font color=#447700>!<a name='1773'></font>
CALL <A href='../../html_code/frame/module_tiles.F.html#SET_TILES'>SET_TILES</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#CUCNVC' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="SET_TILES_5">(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)<a name='1774'>
<font color=#447700>!<a name='1775'></font>
CALL <A href='../../html_code/phys/module_cumulus_driver.F.html#CUMULUS_DRIVER'>CUMULUS_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#CUCNVC' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="CUMULUS_DRIVER_2">( &<a name='1776'>
& IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &<a name='1777'>
& ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &<a name='1778'>
& ,I_START=GRID%I_START,I_END=GRID%I_END &<a name='1779'>
& ,J_START=GRID%J_START,J_END=GRID%J_END &<a name='1780'>
& ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &<a name='1781'>
<font color=#447700>! Prognostic<a name='1782'></font>
& ,U=U_PHY,V=V_PHY,TH=TH_PHY,T=T_PHY,W=WINT &<a name='1783'>
& ,P=P_PHY,PI=PI_PHY,RHO=RR,W0AVG=W0AVG &<a name='1784'>
<font color=#447700>! Others<a name='1785'></font>
& ,ITIMESTEP=NTSD,DT=DT,DX=GPS &<a name='1786'>
& ,RAINC=RAINC,RAINCV=RAINCV,NCA=NCA &<a name='1787'>
& ,DZ8W=DZ,P8W=P8W &<a name='1788'>
& ,CLDEFI=cldefi,LOWLYR=lowlyr,XLAND=xland &<a name='1789'>
& ,CU_ACT_FLAG=cu_act_flag,WARM_RAIN=warm_rain &<a name='1790'>
& ,STEPCU=NSTEP_CNV &<a name='1791'>
& ,HTOP=CUTOP,HBOT=CUBOT,KPBL=KPBL,HT=SFCZ & <a name='1792'>
& ,ENSDIM=ENSDIM,maxiens=1,maxens=1 &<a name='1793'>
& ,maxens2=1,maxens3=1 &<a name='1794'>
& ,RTHCUTEN=RTHCUTEN ,RQVCUTEN=RQVCUTEN &<a name='1795'>
& ,RQCCUTEN=RQCCUTEN ,RQRCUTEN=RQRCUTEN &<a name='1796'>
<font color=#447700>! Selection argument<a name='1797'></font>
& ,CU_PHYSICS=CONFIG_FLAGS%CU_PHYSICS &<a name='1798'>
<font color=#447700>! Moisture tracer arguments<a name='1799'></font>
& ,QV_CURR=WATER(IMS,KMS,JMS,P_QV),F_QV=F_QV &<a name='1800'>
& ,QC_CURR=WATER(IMS,KMS,JMS,P_QC),F_QC=F_QC &<a name='1801'>
& ,QR_CURR=WATER(IMS,KMS,JMS,P_QR),F_QR=F_QR &<a name='1802'>
& ,QI_CURR=WATER(IMS,KMS,JMS,P_QI),F_QI=F_QI &<a name='1803'>
& ,QS_CURR=WATER(IMS,KMS,JMS,P_QS),F_QS=F_QS &<a name='1804'>
& ,QG_CURR=WATER(IMS,KMS,JMS,P_QG),F_QG=F_QG )<a name='1805'>
<font color=#447700>!<a name='1806'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1807'></font>
<font color=#447700>!<a name='1808'></font>
<font color=#447700>!*** CNVTOP AND CNVBOT HOLD THE MAXIMUM VERTICAL LIMITS OF<a name='1809'></font>
<font color=#447700>!*** CONVECTIVE CLOUD BETWEEN HISTORY OUTPUT TIMES.<a name='1810'></font>
<font color=#447700>!*** IF WE HAVE JUST PASSED SUCH A TIME THEN REINITIALIZE THE ARRAYS.<a name='1811'></font>
<font color=#447700>!<a name='1812'></font>
CF_HI=CONFIG_FLAGS%HISTORY_INTERVAL<a name='1813'>
N_TIMSTPS_OUTPUT=NINT(60.*CF_HI/DT)<a name='1814'>
MNTO=MOD(NTSD,N_TIMSTPS_OUTPUT)<a name='1815'>
<font color=#447700>!<a name='1816'></font>
IF(MNTO>0.AND.MNTO<=NCNVC)THEN<a name='1817'>
DO J=MYJS2,MYJE2<a name='1818'>
IENDX=MYIE1<a name='1819'>
IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1<a name='1820'>
DO I=MYIS1,IENDX<a name='1821'>
CNVTOP(I,J)=0.<a name='1822'>
CNVBOT(I,J)=1000.<a name='1823'>
ENDDO<a name='1824'>
ENDDO<a name='1825'>
ENDIF<a name='1826'>
<font color=#447700>!<a name='1827'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1828'></font>
<font color=#447700>!<a name='1829'></font>
<font color=#447700>!$omp parallel do &<a name='1830'></font>
<font color=#447700>!$omp& private(dqdt,dtdt,i,iendx,j,k,ncubot,ncutop,pcpcol &<a name='1831'></font>
<font color=#447700>!$omp& ,tchange &<a name='1832'></font>
<font color=#447700>!$omp& )<a name='1833'></font>
DO J=MYJS2,MYJE2<a name='1834'>
IENDX=MYIE1<a name='1835'>
IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1<a name='1836'>
DO I=MYIS1,IENDX<a name='1837'>
<font color=#447700>!<a name='1838'></font>
<font color=#447700>!*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, AND HEATING.<a name='1839'></font>
<font color=#447700>!*** THE FLIP IS BECAUSE RTHCUTEN AND RQVCUTEN REACH THIS POINT<a name='1840'></font>
<font color=#447700>!*** WITH LAYER 1 AT THE BOTTOM.<a name='1841'></font>
<font color=#447700>!<a name='1842'></font>
DO K=KTS,KTE<a name='1843'>
<font color=#447700>!<a name='1844'></font>
<font color=#447700>!*** RQVCUTEN IN BMJDRV IS THE MIXING RATIO TENDENCY,<a name='1845'></font>
<font color=#447700>!*** SO RETRIEVE DQDT BY CONVERTING TO SPECIFIC HUMIDITY.<a name='1846'></font>
<font color=#447700>!<a name='1847'></font>
DQDT=RQVCUTEN(I,K,J)/(1.+WATER(I,K,J,P_QV))**2<a name='1848'>
<font color=#447700>!<a name='1849'></font>
<font color=#447700>!*** RTHCUTEN IN BMJDRV IS DTDT OVER PI.<a name='1850'></font>
<font color=#447700>!<a name='1851'></font>
DTDT=RTHCUTEN(I,K,J)*PI_PHY(I,K,J)<a name='1852'>
T(I,K,J)=T(I,K,J)+DTDT*DTCNVC<a name='1853'>
Q(I,K,J)=Q(I,K,J)+DQDT*DTCNVC<a name='1854'>
TCUCN(I,K,J)=TCUCN(I,K,J)+DTDT<a name='1855'>
<font color=#447700>!<a name='1856'></font>
TCHANGE=DTDT*DTCNVC<a name='1857'>
IF(ABS(TCHANGE)>DTEMP_CHECK)THEN<a name='1858'>
WRITE(0,*)'BIG T CHANGE BY CONVECTION:',TCHANGE<a name='1859'>
ENDIF<a name='1860'>
<font color=#447700>!<a name='1861'></font>
ENDDO<a name='1862'>
<font color=#447700>!<a name='1863'></font>
<font color=#447700>!*** UPDATE PRECIPITATION<a name='1864'></font>
<font color=#447700>!<a name='1865'></font>
PCPCOL=RAINCV(I,J)*1.E-3*NSTEP_CNV<a name='1866'>
PREC(I,J)=PREC(I,J)+PCPCOL<a name='1867'>
ACPREC(I,J)=ACPREC(I,J)+PCPCOL<a name='1868'>
CUPREC(I,J)=CUPREC(I,J)+PCPCOL<a name='1869'>
CUPPT(I,J)=CUPPT(I,J)+PCPCOL<a name='1870'>
CPRATE(I,J)=PCPCOL<a name='1871'>
<font color=#447700>!<a name='1872'></font>
<font color=#447700>!*** SAVE CLOUD TOP AND BOTTOM FOR RADIATION (HTOP, HBOT)<a name='1873'></font>
<font color=#447700>!*** AND FOR OUTPUT (CNVTOP, CNVBOT). THESE ARRAYS<a name='1874'></font>
<font color=#447700>!*** MUST BE TREATED SEPARATELY FROM EACH OTHER.<a name='1875'></font>
<font color=#447700>!<a name='1876'></font>
NCUTOP=NINT(CUTOP(I,J))<a name='1877'>
NCUBOT=NINT(CUBOT(I,J))<a name='1878'>
<font color=#447700>!<a name='1879'></font>
IF(NCUTOP>0.AND.NCUTOP<KTE+1)THEN<a name='1880'>
HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))<a name='1881'>
CNVTOP(I,J)=MAX(CUTOP(I,J),CNVTOP(I,J))<a name='1882'>
IF(PCPCOL>0.)THEN<a name='1883'>
HTOPD(I,J)=MAX(CUTOP(I,J),HTOPD(I,J))<a name='1884'>
ELSE<a name='1885'>
HTOPS(I,J)=MAX(CUTOP(I,J),HTOPS(I,J))<a name='1886'>
ENDIF<a name='1887'>
ENDIF<a name='1888'>
IF(NCUBOT>0.AND.NCUBOT<KTE+1)THEN<a name='1889'>
HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))<a name='1890'>
CNVBOT(I,J)=MIN(CUBOT(I,J),CNVBOT(I,J))<a name='1891'>
IF(PCPCOL>0.)THEN<a name='1892'>
HBOTD(I,J)=MIN(CUBOT(I,J),HBOTD(I,J))<a name='1893'>
ELSE<a name='1894'>
HBOTS(I,J)=MIN(CUBOT(I,J),HBOTS(I,J))<a name='1895'>
ENDIF<a name='1896'>
ENDIF<a name='1897'>
<font color=#447700>!<a name='1898'></font>
ENDDO<a name='1899'>
ENDDO<a name='1900'>
<font color=#447700>!<a name='1901'></font>
<font color=#447700>!$omp parallel do &<a name='1902'></font>
<font color=#447700>!$omp& private(i,j,k)<a name='1903'></font>
DO J=JMS,JME<a name='1904'>
DO K=KMS,KME<a name='1905'>
DO I=IMS,IME<a name='1906'>
ZERO_3D(I,K,J)=0.<a name='1907'>
ENDDO<a name='1908'>
ENDDO<a name='1909'>
ENDDO<a name='1910'>
<font color=#447700>!-----------------------------------------------------------------------<a name='1911'></font>
<font color=#447700>!<a name='1912'></font>
END SUBROUTINE CUCNVC<a name='1913'>
<font color=#447700>!<a name='1914'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1915'></font>
<font color=#447700>!***********************************************************************<a name='1916'></font>
<A NAME='GSMDRIVE'><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#GSMDRIVE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='1917'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>GSMDRIVE</font>(NTSD,DT,NPHS,N_MOIST & <A href='../../call_to/GSMDRIVE.html' TARGET='index'>1</A>,<A href='../../call_from/GSMDRIVE.html' TARGET='index'>3</A><a name='1918'>
& ,DX,DY,LMH,SM,HBM2,FIS &<a name='1919'>
& ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2 &<a name='1920'>
& ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TRAIN &<a name='1921'>
& ,F_ICE,F_RAIN,F_RIMEF,SR &<a name='1922'>
& ,PREC,ACPREC,AVRAIN,ZERO_3D &<a name='1923'>
& ,MP_RESTART_STATE &<a name='1924'>
& ,TBPVS_STATE &<a name='1925'>
& ,TBPVS0_STATE &<a name='1926'>
& ,GRID,CONFIG_FLAGS &<a name='1927'>
& ,IDS,IDE,JDS,JDE,KDS,KDE &<a name='1928'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='1929'>
& ,ITS,ITE,JTS,JTE,KTS,KTE)<a name='1930'>
<font color=#447700>!***********************************************************************<a name='1931'></font>
<font color=#447700>!$$$ SUBPROGRAM DOCUMENTATION BLOCK<a name='1932'></font>
<font color=#447700>! . . . <a name='1933'></font>
<font color=#447700>! SUBPROGRAM: GSMDRIVE MICROPHYSICS OUTER DRIVER<a name='1934'></font>
<font color=#447700>! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-03-26 <a name='1935'></font>
<font color=#447700>! <a name='1936'></font>
<font color=#447700>! ABSTRACT:<a name='1937'></font>
<font color=#447700>! GSMDRIVE DRIVES THE MICROPHYSICS SCHEMES<a name='1938'></font>
<font color=#447700>! <a name='1939'></font>
<font color=#447700>! PROGRAM HISTORY LOG:<a name='1940'></font>
<font color=#447700>! 02-03-26 BLACK - ORIGINATOR<a name='1941'></font>
<font color=#447700>! 04-11-18 BLACK - THREADED<a name='1942'></font>
<font color=#447700>! <a name='1943'></font>
<font color=#447700>! USAGE: CALL GSMDRIVE FROM SOLVE_NMM<a name='1944'></font>
<font color=#447700>!<a name='1945'></font>
<font color=#447700>! ATTRIBUTES:<a name='1946'></font>
<font color=#447700>! LANGUAGE: FORTRAN 90<a name='1947'></font>
<font color=#447700>! MACHINE : IBM<a name='1948'></font>
<font color=#447700>!$$$ <a name='1949'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1950'></font>
<font color=#447700>!<a name='1951'></font>
IMPLICIT NONE<a name='1952'>
<font color=#447700>!<a name='1953'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1954'></font>
<font color=#447700>!<a name='1955'></font>
INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &<a name='1956'>
& ,IMS,IME,JMS,JME,KMS,KME &<a name='1957'>
& ,ITS,ITE,JTS,JTE,KTS,KTE &<a name='1958'>
& ,N_MOIST,NPHS,NTSD<a name='1959'>
<font color=#447700>!<a name='1960'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH<a name='1961'>
<font color=#447700>!<a name='1962'></font>
REAL,INTENT(IN) :: DT,DX,DY,PDTOP,PT<a name='1963'>
<font color=#447700>!<a name='1964'></font>
REAL,INTENT(INOUT) :: AVRAIN<a name='1965'>
<font color=#447700>!<a name='1966'></font>
REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2<a name='1967'>
REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2<a name='1968'>
<font color=#447700>!<a name='1969'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PD,RES,SM<a name='1970'>
<font color=#447700>!<a name='1971'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT<a name='1972'>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D<a name='1973'>
<font color=#447700>!<a name='1974'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,PREC<a name='1975'>
<font color=#447700>!<a name='1976'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM,Q,T &<a name='1977'>
& ,TRAIN<a name='1978'>
<font color=#447700>!<a name='1979'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: F_ICE &<a name='1980'>
& ,F_RAIN &<a name='1981'>
& ,F_RIMEF<a name='1982'>
<font color=#447700>! state var for etampnew microphysics (JM, 2005 05 02)<a name='1983'></font>
REAL,DIMENSION(:),INTENT(INOUT) :: MP_RESTART_STATE &<a name='1984'>
& ,TBPVS_STATE &<a name='1985'>
& ,TBPVS0_STATE<a name='1986'>
<a name='1987'>
<font color=#447700>!<a name='1988'></font>
REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: SR<a name='1989'>
<font color=#447700>!<a name='1990'></font>
TYPE(DOMAIN),TARGET :: GRID<a name='1991'>
<font color=#447700>!<a name='1992'></font>
TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS<a name='1993'>
<font color=#447700>!<a name='1994'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1995'></font>
<font color=#447700>!***<a name='1996'></font>
<font color=#447700>!*** LOCAL VARIABLES<a name='1997'></font>
<font color=#447700>!***<a name='1998'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='1999'></font>
INTEGER :: I,IENDX,J,K,IJ<a name='2000'>
<font color=#447700>!<a name='2001'></font>
INTEGER,DIMENSION(IMS:IME,JMS:JME) :: LOWLYR<a name='2002'>
<font color=#447700>!<a name='2003'></font>
REAL :: CAPA,DPL,DTPHS,PCPCOL,PDSL,PLYR,RDTPHS,RG,TNEW<a name='2004'>
<font color=#447700>!<a name='2005'></font>
REAL,DIMENSION(KMS:KME-1) :: QL,TL<a name='2006'>
<font color=#447700>!<a name='2007'></font>
REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,RAINNC,RAINNCV,XLAND &<a name='2008'>
& ,ZERO_2D<a name='2009'>
<font color=#447700>!<a name='2010'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY &<a name='2011'>
& ,RR,T_PHY,TH_PHY<a name='2012'>
<font color=#447700>!<a name='2013'></font>
REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST) :: WATER<a name='2014'>
<font color=#447700>!<a name='2015'></font>
LOGICAL :: E_BDY,WARM_RAIN<a name='2016'>
<font color=#447700>!<a name='2017'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='2018'></font>
<font color=#447700>!***********************************************************************<a name='2019'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='2020'></font>
<font color=#447700>!<a name='2021'></font>
DTPHS=NPHS*DT<a name='2022'>
RDTPHS=1./DTPHS<a name='2023'>
CAPA=R_D/CP<a name='2024'>
RG=1./G<a name='2025'>
AVRAIN=AVRAIN+1.<a name='2026'>
<font color=#447700>!<a name='2027'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='2028'></font>
<font color=#447700>!<a name='2029'></font>
<font color=#447700>!*** PREPARE NEEDED ARRAYS<a name='2030'></font>
<font color=#447700>!<a name='2031'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='2032'></font>
<font color=#447700>!$omp parallel do &<a name='2033'></font>
<font color=#447700>!$omp& private(dpl,i,j,k,pdsl,plyr,ql,tl)<a name='2034'></font>
DO J=MYJS2,MYJE2<a name='2035'>
DO I=MYIS1,MYIE1<a name='2036'>
<font color=#447700>!<a name='2037'></font>
PDSL=PD(I,J)*RES(I,J)<a name='2038'>
P8W(I,KTE+1,J)=PT<a name='2039'>
LOWLYR(I,J)=KTE+1-LMH(I,J)<a name='2040'>
XLAND(I,J)=SM(I,J)+1.<a name='2041'>
ZERO_2D(I,J)=0.<a name='2042'>
<font color=#447700>! FILL RAINNC WITH ZERO (NORMALLY CONTAINS THE NONCONVECTIVE <a name='2043'></font>
<font color=#447700>! ACCUMULATED RAIN BUT NOT YET USED BY NMM)<a name='2044'></font>
<font color=#447700>! COULD BE OBTAINED FROM ACPREC AND CUPREC (ACPREC-CUPREC) <a name='2045'></font>
RAINNC(I,J)=0.<a name='2046'>
<font color=#447700>!<a name='2047'></font>
<font color=#447700>!*** FILL THE SINGLE-COLUMN INPUT<a name='2048'></font>
<font color=#447700>!<a name='2049'></font>
DO K=KTS,KTE<a name='2050'>
DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL<a name='2051'>
QL(K)=AMAX1(Q(I,K,J),EPSQ)<a name='2052'>
<font color=#447700>!!! PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT<a name='2053'></font>
PLYR=(PINT(I,K,J)+PINT(I,K+1,J))*0.5<a name='2054'>
TL(K)=T(I,K,J)<a name='2055'>
<font color=#447700>!<a name='2056'></font>
RR(I,K,J)=PLYR/(R_D*TL(K)*(P608*QL(K)+1.))<a name='2057'>
T_PHY(I,K,J)=TL(K)<a name='2058'>
WATER(I,K,J,P_QV)=QL(K)/(1.-QL(K)) <font color=#447700>!Convert to mixing ratio <a name='2059'></font>
WATER(I,K,J,P_QC)=CWM(I,K,J)<a name='2060'>
PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA<a name='2061'>
TH_PHY(I,K,J)=TL(K)/PI_PHY(I,K,J)<a name='2062'>
<font color=#447700>!!! P8W(I,KFLIP,J)=PINT(I,K+1,J)<a name='2063'></font>
P8W(I,K,J)=ETA1(K)*PDTOP+ETA2(K)*PDSL+PT<a name='2064'>
P_PHY(I,K,J)=PLYR<a name='2065'>
DZ(I,K,J)=DPL*RG/RR(I,K,J)<a name='2066'>
ENDDO<a name='2067'>
<font color=#447700>!<a name='2068'></font>
ENDDO<a name='2069'>
ENDDO<a name='2070'>
<font color=#447700>!-----------------------------------------------------------------------<a name='2071'></font>
<font color=#447700>!<a name='2072'></font>
<font color=#447700>!*** CALL MICROPHYSICS<a name='2073'></font>
<font color=#447700>!<a name='2074'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='2075'></font>
<font color=#447700>!<a name='2076'></font>
CALL <A href='../../html_code/frame/module_tiles.F.html#SET_TILES'>SET_TILES</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#GSMDRIVE' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="SET_TILES_6">(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)<a name='2077'>
<font color=#447700>!<a name='2078'></font>
CALL <A href='../../html_code/phys/module_microphysics_driver.F.html#MICROPHYSICS_DRIVER'>MICROPHYSICS_DRIVER</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#GSMDRIVE' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MICROPHYSICS_DRIVER_2">( &<a name='2079'>
& TH=TH_PHY &<a name='2080'>
& ,RHO=RR,PI_PHY=PI_PHY,P=P_PHY &<a name='2081'>
& ,RAINNC=RAINNC &<a name='2082'>
& ,RAINNCV=RAINNCV &<a name='2083'>
& ,DZ8W=DZ,P8W=P8W,DT=DTPHS,DX=DX,DY=DY &<a name='2084'>
& ,MP_PHYSICS=CONFIG_FLAGS%MP_PHYSICS &<a name='2085'>
& ,SPECIFIED=CONFIG_FLAGS%SPECIFIED &<a name='2086'>
& .OR.CONFIG_FLAGS%NESTED &<a name='2087'>
& ,SPEC_ZONE=0,WARM_RAIN=WARM_RAIN &<a name='2088'>
& ,XLAND=XLAND,ITIMESTEP=NTSD-1 &<a name='2089'>
& ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN &<a name='2090'>
& ,F_RIMEF_PHY=F_RIMEF &<a name='2091'>
& ,LOWLYR=LOWLYR,SR=SR &<a name='2092'>
& ,QV_CURR=WATER(IMS,KMS,JMS,P_QV),F_QV=F_QV &<a name='2093'>
& ,QC_CURR=WATER(IMS,KMS,JMS,P_QC),F_QC=F_QC &<a name='2094'>
& ,QR_CURR=WATER(IMS,KMS,JMS,P_QR),F_QR=F_QR &<a name='2095'>
& ,QI_CURR=WATER(IMS,KMS,JMS,P_QI),F_QI=F_QI &<a name='2096'>
& ,QS_CURR=WATER(IMS,KMS,JMS,P_QS),F_QS=F_QS &<a name='2097'>
& ,QG_CURR=WATER(IMS,KMS,JMS,P_QG),F_QG=F_QG &<a name='2098'>
& ,MP_RESTART_STATE=MP_RESTART_STATE &<a name='2099'>
& ,TBPVS_STATE=TBPVS_STATE &<a name='2100'>
& ,TBPVS0_STATE=TBPVS0_STATE &<a name='2101'>
& ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &<a name='2102'>
& ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &<a name='2103'>
& ,I_START=GRID%I_START,I_END=GRID%I_END &<a name='2104'>
& ,J_START=GRID%J_START,J_END=GRID%J_END &<a name='2105'>
& ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &<a name='2106'>
)<a name='2107'>
<a name='2108'>
<font color=#447700>!$omp parallel do &<a name='2109'></font>
<font color=#447700>!$omp& private(ij)<a name='2110'></font>
DO IJ=1,GRID%NUM_TILES<a name='2111'>
CALL <A href='../../html_code/phys/module_microphysics_zero_out.F.html#MICROPHYSICS_ZERO_OUT'>MICROPHYSICS_ZERO_OUT</A><A href='../../html_code/dyn_nmm/module_PHYSICS_CALLS.F.html#GSMDRIVE' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MICROPHYSICS_ZERO_OUT_2">( &<a name='2112'>
WATER,N_MOIST,CONFIG_FLAGS &<a name='2113'>
,IDS,IDE,JDS,JDE,KDS,KDE &<a name='2114'>
,IMS,IME,JMS,JME,KMS,KME &<a name='2115'>
,GRID%I_START(IJ),GRID%I_END(IJ) &<a name='2116'>
,GRID%J_START(IJ),GRID%J_END(IJ) &<a name='2117'>
,KTS,KTE )<a name='2118'>
ENDDO<a name='2119'>
<a name='2120'>
<a name='2121'>
<a name='2122'>
<font color=#447700>!<a name='2123'></font>
<font color=#447700>!-----------------------------------------------------------------------<a name='2124'></font>
<font color=#447700>!<a name='2125'></font>
E_BDY=(ITE>=IDE)<a name='2126'>
<font color=#447700>!<a name='2127'></font>
<font color=#447700>!$omp parallel do &<a name='2128'></font>
<font color=#447700>!$omp& private(i,iendx,j,k,pcpcol,tnew)<a name='2129'></font>
DO J=MYJS2,MYJE2<a name='2130'>
IENDX=MYIE1<a name='2131'>
IF(E_BDY.AND.MOD(J,2)==0)IENDX=IENDX-1<a name='2132'>
DO I=MYIS1,IENDX<a name='2133'>
<font color=#447700>!<a name='2134'></font>
<font color=#447700>!*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING.<a name='2135'></font>
<font color=#447700>!<a name='2136'></font>
DO K=KTS,KTE<a name='2137'>
TNEW=TH_PHY(I,K,J)*PI_PHY(I,K,J)<a name='2138'>
TRAIN(I,K,J)=(TNEW-T(I,K,J))*RDTPHS<a name='2139'>
T(I,K,J)=TNEW<a name='2140'>
Q(I,K,J)=WATER(I,K,J,P_QV)/(1.+WATER(I,K,J,P_QV)) <font color=#447700>!To s.h.<a name='2141'></font>
CWM(I,K,J)=WATER(I,K,J,P_QC)<a name='2142'>
ENDDO<a name='2143'>
<font color=#447700>!<a name='2144'></font>
<font color=#447700>!*** UPDATE PRECIPITATION<a name='2145'></font>
<font color=#447700>!<a name='2146'></font>
PCPCOL=RAINNCV(I,J)*1.E-3<a name='2147'>
PREC(I,J)=PREC(I,J)+PCPCOL<a name='2148'>
ACPREC(I,J)=ACPREC(I,J)+PCPCOL<a name='2149'>
<font color=#447700>! NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT OUT ABOVE<a name='2150'></font>
<font color=#447700>! SINCE IT IS ONLY A LOCAL ARRAY FOR NOW<a name='2151'></font>
<font color=#447700>!<a name='2152'></font>
ENDDO<a name='2153'>
ENDDO<a name='2154'>
<font color=#447700>!<a name='2155'></font>
<font color=#447700>!$omp parallel do &<a name='2156'></font>
<font color=#447700>!$omp& private(i,j,k)<a name='2157'></font>
DO J=JMS,JME<a name='2158'>
DO K=KMS,KME<a name='2159'>
DO I=IMS,IME<a name='2160'>
ZERO_3D(I,K,J)=0.<a name='2161'>
ENDDO<a name='2162'>
ENDDO<a name='2163'>
ENDDO<a name='2164'>
<font color=#447700>!-------------------------------------------------------------------<a name='2165'></font>
<font color=#447700>!<a name='2166'></font>
END SUBROUTINE GSMDRIVE<a name='2167'>
<font color=#447700>!<a name='2168'></font>
<font color=#447700>!-------------------------------------------------------------------<a name='2169'></font>
<font color=#447700>!<a name='2170'></font>
END MODULE MODULE_PHYSICS_CALLS<a name='2171'>
<font color=#447700>!<a name='2172'></font>
<font color=#447700>!-------------------------------------------------------------------<a name='2173'></font>
</pre></body></html>