PageRenderTime 36ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 1ms

/wrfv2_fire/dyn_em/module_em.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 2017 lines | 1324 code | 389 blank | 304 comment | 30 complexity | 422bdbd307c09316d16f8380bf354f8d MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. !WRF:MODEL_LAYER:DYNAMICS
    2. 

  2. !
    3. 

  3. 

  4. MODULE module_em
    5. 

  5. 

  6.    USE module_model_constants
    7. 

  7.    
    8. 

  8.    USE module_advect_em, only: advect_u, advect_v, advect_w, advect_scalar, advect_scalar_pd, advect_scalar_mono, &
    9. 

  9.         advect_weno_u, advect_weno_v, advect_weno_w, advect_scalar_weno,  advect_scalar_wenopd
    10. 

  10.    
    11. 

  11.    USE module_big_step_utilities_em, only: grid_config_rec_type, calculate_full, couple_momentum, calc_mu_uv, calc_ww_cp, calc_cq, calc_alt, calc_php, set_tend, rhs_ph, &
    12. 

  12.    	horizontal_pressure_gradient, pg_buoy_w, w_damp, perturbation_coriolis, coriolis, curvature, horizontal_diffusion, horizontal_diffusion_3dmp, vertical_diffusion_u, &
    13. 

  13. 	vertical_diffusion_v, vertical_diffusion, vertical_diffusion_3dmp, sixth_order_diffusion, rk_rayleigh_damp, theta_relaxation, vertical_diffusion_mp, zero_tend
    14. 

  14. 	
    15. 

  15.    USE module_state_description, only: param_first_scalar, p_qr, p_qv, p_qc, p_qg, p_qi, p_qs, tiedtkescheme, heldsuarez, positivedef, &
    16. 

  16.    	gdscheme, g3scheme, kfetascheme, monotonic, wenopd_scalar, weno_scalar, weno_mom
    17. 

  17. 	
    18. 

  18.    USE module_damping_em, only: held_suarez_damp
    19. 

  19. 

  20. CONTAINS
    21. 

  21. 

  22. !------------------------------------------------------------------------
    23. 

  23. 

  24. SUBROUTINE rk_step_prep  ( config_flags, rk_step,           &
    25. 

  25.                            u, v, w, t, ph, mu,              &
    26. 

  26.                            moist,                           &
    27. 

  27.                            ru, rv, rw, ww, php, alt,        &
    28. 

  28.                            muu, muv,                        &
    29. 

  29.                            mub, mut, phb, pb, p, al, alb,   &
    30. 

  30.                            cqu, cqv, cqw,                   &
    31. 

  31.                            msfux, msfuy,                    &
    32. 

  32.                            msfvx, msfvx_inv, msfvy,         &
    33. 

  33.                            msftx, msfty,                    &
    34. 

  34.                            fnm, fnp, dnw, rdx, rdy,         &
    35. 

  35.                            n_moist,                         &
    36. 

  36.                            ids, ide, jds, jde, kds, kde,    &
    37. 

  37.                            ims, ime, jms, jme, kms, kme,    &
    38. 

  38.                            its, ite, jts, jte, kts, kte    )
    39. 

  39. 

  40.    IMPLICIT NONE
    41. 

  41. 

  42. 

  43.    !  Input data.
    44. 

  44. 

  45.    TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
    46. 

  46. 

  47.    INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
    48. 

  48.                                     ims, ime, jms, jme, kms, kme, &
    49. 

  49.                                     its, ite, jts, jte, kts, kte
    50. 

  50. 

  51.    INTEGER ,       INTENT(IN   ) :: n_moist, rk_step
    52. 

  52. 

  53.    REAL ,          INTENT(IN   ) :: rdx, rdy
    54. 

  54. 

  55.    REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
    56. 

  56.                                                INTENT(IN   ) ::  u,       &
    57. 

  57.                                                                  v,       &
    58. 

  58.                                                                  w,       &
    59. 

  59.                                                                  t,       &
    60. 

  60.                                                                  ph,      &
    61. 

  61.                                                                  phb,     &
    62. 

  62.                                                                  pb,      &
    63. 

  63.                                                                  al,      &
    64. 

  64.                                                                  alb
    65. 

  65. 

  66.    REAL , DIMENSION( ims:ime , kms:kme , jms:jme  ) ,                     &
    67. 

  67.                                                INTENT(  OUT) ::  ru,      &
    68. 

  68.                                                                  rv,      &
    69. 

  69.                                                                  rw,      &
    70. 

  70.                                                                  ww,      &
    71. 

  71.                                                                  php,     &
    72. 

  72.                                                                  cqu,     &
    73. 

  73.                                                                  cqv,     &
    74. 

  74.                                                                  cqw,     &
    75. 

  75.                                                                  alt
    76. 

  76. 

  77.    REAL , DIMENSION(  ims:ime , kms:kme, jms:jme ) ,                      &
    78. 

  78.                                                INTENT(IN   ) ::  p
    79. 

  79.                                                                  
    80. 

  80. 

  81. 

  82. 

  83.    REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT(   IN) :: &
    84. 

  84.                                                            moist
    85. 

  85. 

  86.    REAL , DIMENSION( ims:ime , jms:jme ) ,    INTENT(IN   ) :: msftx,     &
    87. 

  87.                                                                msfty,     &
    88. 

  88.                                                                msfux,     &
    89. 

  89.                                                                msfuy,     &
    90. 

  90.                                                                msfvx,     &
    91. 

  91.                                                                msfvx_inv, &
    92. 

  92.                                                                msfvy,     &
    93. 

  93.                                                                mu,        &
    94. 

  94.                                                                mub
    95. 

  95. 

  96.    REAL , DIMENSION( ims:ime , jms:jme ) ,    INTENT(  OUT) :: muu,    &
    97. 

  97.                                                                muv,    &
    98. 

  98.                                                                mut
    99. 

  99. 

  100.    REAL , DIMENSION( kms:kme ) ,    INTENT(IN   ) :: fnm, fnp, dnw
    101. 

  101. 

  102.    integer :: k
    103. 

  103. 

  104. 

  105. !<DESCRIPTION>
    106. 

  106. !
    107. 

  107. !  rk_step_prep prepares a number of diagnostic quantities 
    108. 

  108. !  in preperation for a Runge-Kutta timestep.  subroutines called
    109. 

  109. !  by rk_step_prep calculate
    110. 

  110. !
    111. 

  111. !  (1) total column dry air mass (mut, call to calculate_full)
    112. 

  112. !
    113. 

  113. !  (2) total column dry air mass at u and v points 
    114. 

  114. !      (muu, muv, call to calculate_mu_uv)
    115. 

  115. !
    116. 

  116. !  (3) mass-coupled velocities for advection
    117. 

  117. !      (ru, rv, and rw, call to couple_momentum)
    118. 

  118. !
    119. 

  119. !  (4) omega (call to calc_ww_cp)
    120. 

  120. !
    121. 

  121. !  (5) moisture coefficients (cqu, cqv, cqw, call to calc_cq)
    122. 

  122. !
    123. 

  123. !  (6) inverse density (alt, call to calc_alt)
    124. 

  124. !
    125. 

  125. !  (7) geopotential at pressure points (php, call to calc_php)
    126. 

  126. !
    127. 

  127. !</DESCRIPTION>
    128. 

  128. 

  129.    CALL calculate_full( mut, mub, mu,             &
    130. 

  130.                         ids, ide, jds, jde, 1, 2, &
    131. 

  131.                         ims, ime, jms, jme, 1, 1, &
    132. 

  132.                         its, ite, jts, jte, 1, 1 )
    133. 

  133. 

  134.    CALL calc_mu_uv ( config_flags,                  &
    135. 

  135.                      mu, mub, muu, muv,             &
    136. 

  136.                      ids, ide, jds, jde, kds, kde,  &
    137. 

  137.                      ims, ime, jms, jme, kms, kme,  &
    138. 

  138.                      its, ite, jts, jte, kts, kte  )
    139. 

  139. 

  140.    CALL couple_momentum( muu, ru, u, msfuy,             &
    141. 

  141.                          muv, rv, v, msfvx, msfvx_inv,  &
    142. 

  142.                          mut, rw, w, msfty,             &
    143. 

  143.                          ids, ide, jds, jde, kds, kde,  &
    144. 

  144.                          ims, ime, jms, jme, kms, kme,  &
    145. 

  145.                          its, ite, jts, jte, kts, kte  )
    146. 

  146. 

  147. !  new call, couples V with mu, also has correct map factors.  WCS, 3 june 2001
    148. 

  148.    CALL calc_ww_cp ( u, v, mu, mub, ww,               &
    149. 

  149.                      rdx, rdy, msftx, msfty,          &
    150. 

  150.                      msfux, msfuy, msfvx, msfvx_inv,  &
    151. 

  151.                      msfvy, dnw,                      &
    152. 

  152.                      ids, ide, jds, jde, kds, kde,    &
    153. 

  153.                      ims, ime, jms, jme, kms, kme,    &
    154. 

  154.                      its, ite, jts, jte, kts, kte    )
    155. 

  155. 

  156.    CALL calc_cq ( moist, cqu, cqv, cqw, n_moist, &
    157. 

  157.                   ids, ide, jds, jde, kds, kde,  &
    158. 

  158.                   ims, ime, jms, jme, kms, kme,  &
    159. 

  159.                   its, ite, jts, jte, kts, kte  )
    160. 

  160. 

  161.    CALL calc_alt ( alt, al, alb,                 &
    162. 

  162.                    ids, ide, jds, jde, kds, kde, &
    163. 

  163.                    ims, ime, jms, jme, kms, kme, &
    164. 

  164.                    its, ite, jts, jte, kts, kte )
    165. 

  165. 

  166.    CALL calc_php ( php, ph, phb,                 &
    167. 

  167.                    ids, ide, jds, jde, kds, kde, &
    168. 

  168.                    ims, ime, jms, jme, kms, kme, &
    169. 

  169.                    its, ite, jts, jte, kts, kte )
    170. 

  170. 

  171. END SUBROUTINE rk_step_prep
    172. 

  172. 

  173. !-------------------------------------------------------------------------------
    174. 

  174. 

  175. SUBROUTINE rk_tendency ( config_flags, rk_step,                           &
    176. 

  176.                          ru_tend, rv_tend, rw_tend, ph_tend, t_tend,      &
    177. 

  177.                          ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
    178. 

  178.                          mu_tend, u_save, v_save, w_save, ph_save,        &
    179. 

  179.                          t_save, mu_save, RTHFTEN,                        &
    180. 

  180.                          ru, rv, rw, ww,                                  &
    181. 

  181.                          u, v, w, t, ph,                                  &
    182. 

  182.                          u_old, v_old, w_old, t_old, ph_old,              &
    183. 

  183.                          h_diabatic, phb,t_init,                          &
    184. 

  184.                          mu, mut, muu, muv, mub,                          &
    185. 

  185.                          al, alt, p, pb, php, cqu, cqv, cqw,              &
    186. 

  186.                          u_base, v_base, t_base, qv_base, z_base,         &
    187. 

  187.                          msfux, msfuy, msfvx, msfvx_inv,                  &
    188. 

  188.                          msfvy, msftx, msfty,                             &
    189. 

  189.                          clat, f, e, sina, cosa,                          &
    190. 

  190.                          fnm, fnp, rdn, rdnw,                             &
    191. 

  191.                          dt, rdx, rdy, khdif, kvdif, xkmhd, xkhh,         &
    192. 

  192.                          diff_6th_opt, diff_6th_factor,                   &
    193. 

  193.                          adv_opt,                                         &
    194. 

  194.                          dampcoef,zdamp,damp_opt,rad_nudge,               &
    195. 

  195.                          cf1, cf2, cf3, cfn, cfn1, n_moist,               &
    196. 

  196.                          non_hydrostatic, top_lid,                        &
    197. 

  197.                          u_frame, v_frame,                                &
    198. 

  198.                          ids, ide, jds, jde, kds, kde,                    &
    199. 

  199.                          ims, ime, jms, jme, kms, kme,                    &
    200. 

  200.                          its, ite, jts, jte, kts, kte,                    &
    201. 

  201.                          max_vert_cfl, max_horiz_cfl)
    202. 

  202. 

  203.    IMPLICIT NONE
    204. 

  204. 

  205.    !  Input data.
    206. 

  206. 

  207.    TYPE(grid_config_rec_type)    ,           INTENT(IN   ) :: config_flags
    208. 

  208. 

  209.    INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
    210. 

  210.                                             ims, ime, jms, jme, kms, kme, &
    211. 

  211.                                             its, ite, jts, jte, kts, kte
    212. 

  212. 

  213.    LOGICAL ,               INTENT(IN   ) :: non_hydrostatic, top_lid
    214. 

  214. 

  215.    INTEGER ,               INTENT(IN   ) :: n_moist, rk_step
    216. 

  216. 

  217.    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,              &
    218. 

  218.                                         INTENT(IN   ) :: ru,      &
    219. 

  219.                                                          rv,      &
    220. 

  220.                                                          rw,      &
    221. 

  221.                                                          ww,      & 
    222. 

  222.                                                          u,       &
    223. 

  223.                                                          v,       &
    224. 

  224.                                                          w,       &
    225. 

  225.                                                          t,       &
    226. 

  226.                                                          ph,      &
    227. 

  227.                                                          u_old,   &
    228. 

  228.                                                          v_old,   &
    229. 

  229.                                                          w_old,   &
    230. 

  230.                                                          t_old,   &
    231. 

  231.                                                          ph_old,  &
    232. 

  232.                                                          phb,     &
    233. 

  233.                                                          al,      &
    234. 

  234.                                                          alt,     &
    235. 

  235.                                                          p,       &
    236. 

  236.                                                          pb,      &
    237. 

  237.                                                          php,     &
    238. 

  238.                                                          cqu,     &
    239. 

  239.                                                          cqv,     &
    240. 

  240.                                                          t_init,  &
    241. 

  241.                                                          xkmhd,   &
    242. 

  242.                                                          xkhh,    &
    243. 

  243.                                                          h_diabatic
    244. 

  244. 

  245.    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,              &
    246. 

  246.                                         INTENT(OUT  ) :: ru_tend, &
    247. 

  247.                                                          rv_tend, &
    248. 

  248.                                                          rw_tend, &
    249. 

  249.                                                          t_tend,  &
    250. 

  250.                                                          ph_tend, &
    251. 

  251.                                                          RTHFTEN, &
    252. 

  252.                                                           u_save, &
    253. 

  253.                                                           v_save, &
    254. 

  254.                                                           w_save, &
    255. 

  255.                                                          ph_save, &
    256. 

  256.                                                           t_save
    257. 

  257. 

  258.    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,               &
    259. 

  259.                                         INTENT(INOUT) :: ru_tendf, &
    260. 

  260.                                                          rv_tendf, &
    261. 

  261.                                                          rw_tendf, &
    262. 

  262.                                                          t_tendf,  &
    263. 

  263.                                                          ph_tendf, &
    264. 

  264.                                                          cqw
    265. 

  265. 

  266.    REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(  OUT) :: mu_tend, &
    267. 

  267.                                                                     mu_save
    268. 

  268. 

  269.    REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: msfux,   &
    270. 

  270.                                                                     msfuy,   &
    271. 

  271.                                                                     msfvx,   &
    272. 

  272.                                                                     msfvx_inv,   &
    273. 

  273.                                                                     msfvy,   &
    274. 

  274.                                                                     msftx,   &
    275. 

  275.                                                                     msfty,   &
    276. 

  276.                                                                     clat,    & 
    277. 

  277.                                                                     f,       &
    278. 

  278.                                                                     e,       &
    279. 

  279.                                                                     sina,    &
    280. 

  280.                                                                     cosa,    &
    281. 

  281.                                                                     mu,      &
    282. 

  282.                                                                     mut,     &
    283. 

  283.                                                                     mub,     &
    284. 

  284.                                                                     muu,     &
    285. 

  285.                                                                     muv
    286. 

  286. 

  287.    REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnm,     &
    288. 

  288.                                                                   fnp,     &
    289. 

  289.                                                                   rdn,     &
    290. 

  290.                                                                   rdnw,    &
    291. 

  291.                                                                   u_base,  &
    292. 

  292.                                                                   v_base,  &
    293. 

  293.                                                                   t_base,  &
    294. 

  294.                                                                   qv_base, &
    295. 

  295.                                                                   z_base
    296. 

  296. 

  297.    REAL ,                                      INTENT(IN   ) :: rdx,     &
    298. 

  298.                                                                 rdy,     &
    299. 

  299.                                                                 dt,      &
    300. 

  300.                                                                 u_frame, &
    301. 

  301.                                                                 v_frame, &
    302. 

  302.                                                                 khdif,   &
    303. 

  303.                                                                 kvdif
    304. 

  304.    INTEGER, INTENT( IN ) :: diff_6th_opt
    305. 

  305.    REAL,    INTENT( IN ) :: diff_6th_factor
    306. 

  306.    INTEGER, INTENT( IN ) :: adv_opt
    307. 

  307. 

  308.    INTEGER, INTENT( IN ) :: damp_opt, rad_nudge
    309. 

  309. 

  310.    REAL, INTENT( IN ) :: zdamp, dampcoef
    311. 

  311. 

  312.    REAL, INTENT( OUT ) :: max_horiz_cfl
    313. 

  313.    REAL, INTENT( OUT ) :: max_vert_cfl
    314. 

  314. 

  315.    REAL    :: kdift, khdq, kvdq, cfn, cfn1, cf1, cf2, cf3
    316. 

  316.    INTEGER :: i,j,k
    317. 

  317.    INTEGER :: time_step
    318. 

  318. 

  319. !<DESCRIPTION>
    320. 

  320. !
    321. 

  321. !  rk_tendency computes the large-timestep tendency terms in the 
    322. 

  322. !  momentum, thermodynamic (theta), and geopotential equations.  
    323. 

  323. !  These terms include:
    324. 

  324. !
    325. 

  325. !  (1) advection (for u, v, w, theta - calls to advect_u, advect_v,
    326. 

  326. !                 advect_w, and advact_scalar).
    327. 

  327. !
    328. 

  328. !  (2) geopotential equation terms (advection and "gw" - call to rhs_ph).
    329. 

  329. !
    330. 

  330. !  (3) buoyancy term in vertical momentum equation (call to pg_buoy_w).
    331. 

  331. !
    332. 

  332. !  (4) Coriolis and curvature terms in u,v,w momentum equations
    333. 

  333. !      (calls to subroutines coriolis, curvature)
    334. 

  334. !
    335. 

  335. !  (5) 3D diffusion on coordinate surfaces.
    336. 

  336. !
    337. 

  337. !</DESCRIPTION>
    338. 

  338. 

  339.    CALL zero_tend ( ru_tend,                      &
    340. 

  340.                     ids, ide, jds, jde, kds, kde, &
    341. 

  341.                     ims, ime, jms, jme, kms, kme, &
    342. 

  342.                     its, ite, jts, jte, kts, kte )
    343. 

  343. 

  344.    CALL zero_tend ( rv_tend,                      &
    345. 

  345.                     ids, ide, jds, jde, kds, kde, &
    346. 

  346.                     ims, ime, jms, jme, kms, kme, &
    347. 

  347.                     its, ite, jts, jte, kts, kte )
    348. 

  348. 

  349.    CALL zero_tend ( rw_tend,                      &
    350. 

  350.                     ids, ide, jds, jde, kds, kde, &
    351. 

  351.                     ims, ime, jms, jme, kms, kme, &
    352. 

  352.                     its, ite, jts, jte, kts, kte )
    353. 

  353. 

  354.    CALL zero_tend ( t_tend,                       &
    355. 

  355.                     ids, ide, jds, jde, kds, kde, &
    356. 

  356.                     ims, ime, jms, jme, kms, kme, &
    357. 

  357.                     its, ite, jts, jte, kts, kte )
    358. 

  358. 

  359.    CALL zero_tend ( ph_tend,                      &
    360. 

  360.                     ids, ide, jds, jde, kds, kde, &
    361. 

  361.                     ims, ime, jms, jme, kms, kme, &
    362. 

  362.                     its, ite, jts, jte, kts, kte )
    363. 

  363. 

  364.    CALL zero_tend ( u_save,                       &
    365. 

  365.                     ids, ide, jds, jde, kds, kde, &
    366. 

  366.                     ims, ime, jms, jme, kms, kme, &
    367. 

  367.                     its, ite, jts, jte, kts, kte )
    368. 

  368. 

  369.    CALL zero_tend ( v_save,                       &
    370. 

  370.                     ids, ide, jds, jde, kds, kde, &
    371. 

  371.                     ims, ime, jms, jme, kms, kme, &
    372. 

  372.                     its, ite, jts, jte, kts, kte )
    373. 

  373. 

  374.    CALL zero_tend ( w_save,                       &
    375. 

  375.                     ids, ide, jds, jde, kds, kde, &
    376. 

  376.                     ims, ime, jms, jme, kms, kme, &
    377. 

  377.                     its, ite, jts, jte, kts, kte )
    378. 

  378. 

  379.    CALL zero_tend ( ph_save,                       &
    380. 

  380.                     ids, ide, jds, jde, kds, kde, &
    381. 

  381.                     ims, ime, jms, jme, kms, kme, &
    382. 

  382.                     its, ite, jts, jte, kts, kte )
    383. 

  383. 

  384.    CALL zero_tend ( t_save,                       &
    385. 

  385.                     ids, ide, jds, jde, kds, kde, &
    386. 

  386.                     ims, ime, jms, jme, kms, kme, &
    387. 

  387.                     its, ite, jts, jte, kts, kte )
    388. 

  388. 

  389.    CALL zero_tend ( mu_tend,                  &
    390. 

  390.                     ids, ide, jds, jde, 1, 1, &
    391. 

  391.                     ims, ime, jms, jme, 1, 1, &
    392. 

  392.                     its, ite, jts, jte, 1, 1 )
    393. 

  393. 

  394.    CALL zero_tend ( mu_save,                  &
    395. 

  395.                     ids, ide, jds, jde, 1, 1, &
    396. 

  396.                     ims, ime, jms, jme, 1, 1, &
    397. 

  397.                     its, ite, jts, jte, 1, 1 )
    398. 

  398. 

  399.    !  advection tendencies
    400. 

  400.    CALL nl_get_time_step ( 1, time_step )
    401. 

  401. 

  402. 

  403.     IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN
    404. 

  404. 

  405.      CALL advect_weno_u ( u, u , ru_tend, ru, rv, ww, &
    406. 

  406.                    mut, time_step, config_flags, &
    407. 

  407.                    msfux, msfuy, msfvx, msfvy,   &
    408. 

  408.                    msftx, msfty,                 &
    409. 

  409.                    fnm, fnp, rdx, rdy, rdnw,     &
    410. 

  410.                    ids, ide, jds, jde, kds, kde, &
    411. 

  411.                    ims, ime, jms, jme, kms, kme, &
    412. 

  412.                    its, ite, jts, jte, kts, kte )
    413. 

  413. 

  414.      ELSE
    415. 

  415.      
    416. 

  416.      CALL advect_u ( u, u , ru_tend, ru, rv, ww, &
    417. 

  417.                    mut, time_step, config_flags, &
    418. 

  418.                    msfux, msfuy, msfvx, msfvy,   &
    419. 

  419.                    msftx, msfty,                 &
    420. 

  420.                    fnm, fnp, rdx, rdy, rdnw,     &
    421. 

  421.                    ids, ide, jds, jde, kds, kde, &
    422. 

  422.                    ims, ime, jms, jme, kms, kme, &
    423. 

  423.                    its, ite, jts, jte, kts, kte )
    424. 

  424.       ENDIF
    425. 

  425. 

  426.      IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN
    427. 

  427. 

  428.      CALL advect_weno_v ( v, v , rv_tend, ru, rv, ww,  &
    429. 

  429.                    mut, time_step, config_flags, &
    430. 

  430.                    msfux, msfuy, msfvx, msfvy,   &
    431. 

  431.                    msftx, msfty,                 &
    432. 

  432.                    fnm, fnp, rdx, rdy, rdnw,     &
    433. 

  433.                    ids, ide, jds, jde, kds, kde, &
    434. 

  434.                    ims, ime, jms, jme, kms, kme, &
    435. 

  435.                    its, ite, jts, jte, kts, kte )
    436. 

  436. 

  437.     ELSE
    438. 

  438.      
    439. 

  439.      CALL advect_v ( v, v , rv_tend, ru, rv, ww,  &
    440. 

  440.                    mut, time_step, config_flags, &
    441. 

  441.                    msfux, msfuy, msfvx, msfvy,   &
    442. 

  442.                    msftx, msfty,                 &
    443. 

  443.                    fnm, fnp, rdx, rdy, rdnw,     &
    444. 

  444.                    ids, ide, jds, jde, kds, kde, &
    445. 

  445.                    ims, ime, jms, jme, kms, kme, &
    446. 

  446.                    its, ite, jts, jte, kts, kte )
    447. 

  447.     ENDIF
    448. 

  448. 

  449. 

  450.    IF (non_hydrostatic) THEN
    451. 

  451.      IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN
    452. 

  452.      CALL advect_weno_w ( w, w, rw_tend, ru, rv, ww,    &
    453. 

  453.                      mut, time_step, config_flags, &
    454. 

  454.                      msfux, msfuy, msfvx, msfvy,   &
    455. 

  455.                      msftx, msfty,                 &
    456. 

  456.                      fnm, fnp, rdx, rdy, rdn,      &
    457. 

  457.                      ids, ide, jds, jde, kds, kde, &
    458. 

  458.                      ims, ime, jms, jme, kms, kme, &
    459. 

  459.                      its, ite, jts, jte, kts, kte )
    460. 

  460. 

  461.      ELSE
    462. 

  462.      
    463. 

  463.      CALL advect_w ( w, w, rw_tend, ru, rv, ww,    &
    464. 

  464.                      mut, time_step, config_flags, &
    465. 

  465.                      msfux, msfuy, msfvx, msfvy,   &
    466. 

  466.                      msftx, msfty,                 &
    467. 

  467.                      fnm, fnp, rdx, rdy, rdn,      &
    468. 

  468.                      ids, ide, jds, jde, kds, kde, &
    469. 

  469.                      ims, ime, jms, jme, kms, kme, &
    470. 

  470.                      its, ite, jts, jte, kts, kte )
    471. 

  471.      ENDIF
    472. 

  472.    ENDIF
    473. 

  473. !  theta flux divergence
    474. 

  474. 

  475.      CALL advect_scalar ( t, t, t_tend, ru, rv, ww,     &
    476. 

  476.                           mut, time_step, config_flags, &
    477. 

  477.                           msfux, msfuy, msfvx, msfvy,   &
    478. 

  478.                           msftx, msfty, fnm, fnp,       &
    479. 

  479.                           rdx, rdy, rdnw,               &
    480. 

  480.                           ids, ide, jds, jde, kds, kde, &
    481. 

  481.                           ims, ime, jms, jme, kms, kme, &
    482. 

  482.                           its, ite, jts, jte, kts, kte ) 
    483. 

  483. 

  484.      IF ( config_flags%cu_physics == GDSCHEME  .OR.     &
    485. 

  485.           config_flags%cu_physics == G3SCHEME ) THEN
    486. 

  486. 

  487.      ! theta advection only:
    488. 

  488. 

  489.          CALL set_tend( RTHFTEN, t_tend, msfty,          &
    490. 

  490.                         ids, ide, jds, jde, kds, kde,    &
    491. 

  491.                         ims, ime, jms, jme, kms, kme,    &
    492. 

  492.                         its, ite, jts, jte, kts, kte     )
    493. 

  493. 

  494.      END IF
    495. 

  495. 

  496.      CALL rhs_ph( ph_tend, u, v, ww, ph, ph, phb, w, &
    497. 

  497.                   mut, muu, muv,                     &
    498. 

  498.                   fnm, fnp,                          &
    499. 

  499.                   rdnw, cfn, cfn1, rdx, rdy,         &
    500. 

  500.                   msfux, msfuy, msfvx,               &
    501. 

  501.                   msfvx_inv, msfvy,                  &
    502. 

  502.                   msftx, msfty,                      &
    503. 

  503.                   non_hydrostatic,                   &
    504. 

  504.                   config_flags,                      &
    505. 

  505.                   ids, ide, jds, jde, kds, kde,      &
    506. 

  506.                   ims, ime, jms, jme, kms, kme,      &
    507. 

  507.                   its, ite, jts, jte, kts, kte      )
    508. 

  508. 

  509.      CALL horizontal_pressure_gradient( ru_tend,rv_tend,                &
    510. 

  510.                                          ph,alt,p,pb,al,php,cqu,cqv,     &
    511. 

  511.                                          muu,muv,mu,fnm,fnp,rdnw,        &
    512. 

  512.                                          cf1,cf2,cf3,rdx,rdy,msfux,msfuy,&
    513. 

  513.                                          msfvx,msfvy,msftx,msfty,        &
    514. 

  514.                                          config_flags, non_hydrostatic,  &
    515. 

  515.                                          top_lid,                        &
    516. 

  516.                                          ids, ide, jds, jde, kds, kde,   &
    517. 

  517.                                          ims, ime, jms, jme, kms, kme,   &
    518. 

  518.                                          its, ite, jts, jte, kts, kte   )
    519. 

  519. 

  520.      IF (non_hydrostatic) THEN
    521. 

  521.           CALL pg_buoy_w( rw_tend, p, cqw, mu, mub,       &
    522. 

  522.                           rdnw, rdn, g, msftx, msfty,     &
    523. 

  523.                           ids, ide, jds, jde, kds, kde,   &
    524. 

  524.                           ims, ime, jms, jme, kms, kme,   &
    525. 

  525.                           its, ite, jts, jte, kts, kte   )
    526. 

  526.      ENDIF
    527. 

  527. 

  528.      CALL w_damp   ( rw_tend, max_vert_cfl,            &
    529. 

  529.                       max_horiz_cfl,                  &
    530. 

  530.                       u, v, ww, w, mut, rdnw,         &
    531. 

  531.                       rdx, rdy, msfux, msfuy, msfvx,  &
    532. 

  532.                       msfvy, dt, config_flags,        &
    533. 

  533.                       ids, ide, jds, jde, kds, kde,   &
    534. 

  534.                       ims, ime, jms, jme, kms, kme,   &
    535. 

  535.                       its, ite, jts, jte, kts, kte   )
    536. 

  536. 

  537.      IF(config_flags%pert_coriolis) THEN
    538. 

  538. 

  539.           CALL perturbation_coriolis ( ru, rv, rw,                   &
    540. 

  540.                                        ru_tend,  rv_tend,  rw_tend,  &
    541. 

  541.                                        config_flags,                 &
    542. 

  542.                                        u_base, v_base, z_base,       &
    543. 

  543.                                        muu, muv, phb, ph,            &
    544. 

  544.                                        msftx, msfty, msfux, msfuy,   &
    545. 

  545.                                        msfvx, msfvy,                 &
    546. 

  546.                                        f, e, sina, cosa, fnm, fnp,   &
    547. 

  547.                                        ids, ide, jds, jde, kds, kde, &
    548. 

  548.                                        ims, ime, jms, jme, kms, kme, &
    549. 

  549.                                        its, ite, jts, jte, kts, kte )
    550. 

  550.      ELSE
    551. 

  551.           CALL coriolis ( ru, rv, rw,                   &
    552. 

  552.                           ru_tend,  rv_tend,  rw_tend,  &
    553. 

  553.                           config_flags,                 &
    554. 

  554.                           msftx, msfty, msfux, msfuy,   &
    555. 

  555.                           msfvx, msfvy,                 &
    556. 

  556.                           f, e, sina, cosa, fnm, fnp,   &
    557. 

  557.                           ids, ide, jds, jde, kds, kde, &
    558. 

  558.                           ims, ime, jms, jme, kms, kme, &
    559. 

  559.                           its, ite, jts, jte, kts, kte )
    560. 

  560. 

  561.      END IF
    562. 

  562. 

  563.      CALL curvature ( ru, rv, rw, u, v, w,            &
    564. 

  564.                        ru_tend,  rv_tend,  rw_tend,    &
    565. 

  565.                        config_flags,                   &
    566. 

  566.                        msfux, msfuy, msfvx, msfvy,     &
    567. 

  567.                        msftx, msfty,                   &
    568. 

  568.                        clat, fnm, fnp, rdx, rdy,       &
    569. 

  569.                        ids, ide, jds, jde, kds, kde,   &
    570. 

  570.                        ims, ime, jms, jme, kms, kme,   &
    571. 

  571.                        its, ite, jts, jte, kts, kte   )
    572. 

  572. 

  573. ! Damping option added for Held-Suarez test (also uses lw option HELDSUAREZ)
    574. 

  574.       IF (config_flags%ra_lw_physics == HELDSUAREZ) THEN
    575. 

  575.          CALL held_suarez_damp ( ru_tend, rv_tend,               &   
    576. 

  576.                                  ru,rv,p,pb,                     &
    577. 

  577.                                  ids, ide, jds, jde, kds, kde,   &
    578. 

  578.                                  ims, ime, jms, jme, kms, kme,   &
    579. 

  579.                                  its, ite, jts, jte, kts, kte   )
    580. 

  580.       END IF
    581. 

  581. 

  582. !**************************************************************
    583. 

  583. !
    584. 

  584. !  Next, the terms that we integrate only with forward-in-time
    585. 

  585. !  (evaluate with time t variables).
    586. 

  586. !
    587. 

  587. !**************************************************************
    588. 

  588. 

  589.   forward_step: IF( rk_step == 1 ) THEN
    590. 

  590. 

  591.     diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
    592. 

  592.    
    593. 

  593.         CALL horizontal_diffusion ('u', u, ru_tendf, mut, config_flags, &
    594. 

  594.                                         msfux, msfuy, msfvx, msfvx_inv, &
    595. 

  595.                                         msfvy,msftx, msfty,             &
    596. 

  596.                                         khdif, xkmhd, rdx, rdy,         &
    597. 

  597.                                         ids, ide, jds, jde, kds, kde,   &
    598. 

  598.                                         ims, ime, jms, jme, kms, kme,   &
    599. 

  599.                                         its, ite, jts, jte, kts, kte   )
    600. 

  600. 

  601.         CALL horizontal_diffusion ('v', v, rv_tendf, mut, config_flags, &
    602. 

  602.                                         msfux, msfuy, msfvx, msfvx_inv, &
    603. 

  603.                                         msfvy,msftx, msfty,             &
    604. 

  604.                                         khdif, xkmhd, rdx, rdy,         &
    605. 

  605.                                         ids, ide, jds, jde, kds, kde,   &
    606. 

  606.                                         ims, ime, jms, jme, kms, kme,   &
    607. 

  607.                                         its, ite, jts, jte, kts, kte   )
    608. 

  608. 

  609.         CALL horizontal_diffusion ('w', w, rw_tendf, mut, config_flags, &
    610. 

  610.                                         msfux, msfuy, msfvx, msfvx_inv, &
    611. 

  611.                                         msfvy,msftx, msfty,             &
    612. 

  612.                                         khdif, xkmhd, rdx, rdy,         &
    613. 

  613.                                         ids, ide, jds, jde, kds, kde,   &
    614. 

  614.                                         ims, ime, jms, jme, kms, kme,   &
    615. 

  615.                                         its, ite, jts, jte, kts, kte   )
    616. 

  616. 

  617.         khdq = 3.*khdif
    618. 

  618.         CALL horizontal_diffusion_3dmp ( 'm', t, t_tendf, mut,            &
    619. 

  619.                                          config_flags, t_init,            &
    620. 

  620.                                          msfux, msfuy, msfvx, msfvx_inv,  &
    621. 

  621.                                          msfvy, msftx, msfty,             &
    622. 

  622.                                          khdq , xkhh, rdx, rdy,           &
    623. 

  623.                                          ids, ide, jds, jde, kds, kde,    &
    624. 

  624.                                          ims, ime, jms, jme, kms, kme,    &
    625. 

  625.                                          its, ite, jts, jte, kts, kte    )
    626. 

  626. 

  627.         pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN
    628. 

  628. 

  629.           CALL vertical_diffusion_u ( u, ru_tendf, config_flags,      &
    630. 

  630.                                       u_base,                         &
    631. 

  631.                                       alt, muu, rdn, rdnw, kvdif,     &
    632. 

  632.                                       ids, ide, jds, jde, kds, kde,   &
    633. 

  633.                                       ims, ime, jms, jme, kms, kme,   &
    634. 

  634.                                       its, ite, jts, jte, kts, kte   )
    635. 

  635. 

  636.           CALL vertical_diffusion_v ( v, rv_tendf, config_flags,      &
    637. 

  637.                                       v_base,                         &
    638. 

  638.                                       alt, muv, rdn, rdnw, kvdif,     &
    639. 

  639.                                       ids, ide, jds, jde, kds, kde,   &
    640. 

  640.                                       ims, ime, jms, jme, kms, kme,   &
    641. 

  641.                                       its, ite, jts, jte, kts, kte   )
    642. 

  642. 

  643.           IF (non_hydrostatic)                                           &
    644. 

  644.           CALL vertical_diffusion ( 'w', w, rw_tendf, config_flags,      &
    645. 

  645.                                     alt, mut, rdn, rdnw, kvdif,          &
    646. 

  646.                                     ids, ide, jds, jde, kds, kde,        &
    647. 

  647.                                     ims, ime, jms, jme, kms, kme,        &
    648. 

  648.                                     its, ite, jts, jte, kts, kte        )
    649. 

  649. 

  650.           kvdq = 3.*kvdif
    651. 

  651.           CALL vertical_diffusion_3dmp ( t, t_tendf, config_flags, t_init,     &
    652. 

  652.                                          alt, mut, rdn, rdnw, kvdq ,           &
    653. 

  653.                                          ids, ide, jds, jde, kds, kde,         &
    654. 

  654.                                          ims, ime, jms, jme, kms, kme,         &
    655. 

  655.                                          its, ite, jts, jte, kts, kte         )
    656. 

  656. 

  657.         ENDIF pbl_test
    658. 

  658. 

  659.    !  Theta tendency computations.
    660. 

  660. 

  661.     END IF diff_opt1
    662. 

  662. 

  663.     IF ( diff_6th_opt .NE. 0 ) THEN
    664. 

  664. 

  665.       CALL sixth_order_diffusion( 'u', u, ru_tendf, mut, dt,          &
    666. 

  666.                                        config_flags,                  &
    667. 

  667.                                        diff_6th_opt, diff_6th_factor, &
    668. 

  668.                                        ids, ide, jds, jde, kds, kde,  &
    669. 

  669.                                        ims, ime, jms, jme, kms, kme,  &
    670. 

  670.                                        its, ite, jts, jte, kts, kte )
    671. 

  671. 

  672.       CALL sixth_order_diffusion( 'v', v, rv_tendf, mut, dt,          &
    673. 

  673.                                        config_flags,                  &
    674. 

  674.                                        diff_6th_opt, diff_6th_factor, &
    675. 

  675.                                        ids, ide, jds, jde, kds, kde,  &
    676. 

  676.                                        ims, ime, jms, jme, kms, kme,  &
    677. 

  677.                                        its, ite, jts, jte, kts, kte )
    678. 

  678. 

  679.       IF (non_hydrostatic)                                            & 
    680. 

  680.       CALL sixth_order_diffusion( 'w', w, rw_tendf, mut, dt,          &
    681. 

  681.                                        config_flags,                  &
    682. 

  682.                                        diff_6th_opt, diff_6th_factor, &
    683. 

  683.                                        ids, ide, jds, jde, kds, kde,  &
    684. 

  684.                                        ims, ime, jms, jme, kms, kme,  &
    685. 

  685.                                        its, ite, jts, jte, kts, kte )
    686. 

  686. 

  687.       CALL sixth_order_diffusion( 'm', t,  t_tendf, mut, dt,          &
    688. 

  688.                                        config_flags,                  &
    689. 

  689.                                        diff_6th_opt, diff_6th_factor, &
    690. 

  690.                                        ids, ide, jds, jde, kds, kde,  &
    691. 

  691.                                        ims, ime, jms, jme, kms, kme,  &
    692. 

  692.                                        its, ite, jts, jte, kts, kte )
    693. 

  693. 

  694.     ENDIF
    695. 

  695. 

  696.     IF( damp_opt .eq. 2 )                                      &
    697. 

  697.        CALL rk_rayleigh_damp( ru_tendf, rv_tendf,              &
    698. 

  698.                               rw_tendf, t_tendf,               &
    699. 

  699.                               u, v, w, t, t_init,              &
    700. 

  700.                               mut, muu, muv, ph, phb,          &
    701. 

  701.                               u_base, v_base, t_base, z_base,  &
    702. 

  702.                               dampcoef, zdamp,                 &
    703. 

  703.                               ids, ide, jds, jde, kds, kde,    &
    704. 

  704.                               ims, ime, jms, jme, kms, kme,    &
    705. 

  705.                               its, ite, jts, jte, kts, kte   )
    706. 

  706. 

  707.     IF( rad_nudge .eq. 1 )                                     &
    708. 

  708.        CALL theta_relaxation( t_tendf, t, t_init,              &
    709. 

  709.                               mut, ph, phb,                    &
    710. 

  710.                               t_base, z_base,                  &
    711. 

  711.                               ids, ide, jds, jde, kds, kde,    &
    712. 

  712.                               ims, ime, jms, jme, kms, kme,    &
    713. 

  713.                               its, ite, jts, jte, kts, kte   )
    714. 

  714. 

  715.   END IF forward_step
    716. 

  716. 

  717. END SUBROUTINE rk_tendency
    718. 

  718. 

  719. !-------------------------------------------------------------------------------
    720. 

  720. 

  721. SUBROUTINE rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend,      &
    722. 

  722.                             ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
    723. 

  723.                             u_save, v_save, w_save, ph_save, t_save,         &
    724. 

  724.                             mu_tend, mu_tendf, rk_step,                      &
    725. 

  725.                             h_diabatic, mut, msftx, msfty, msfux, msfuy,     &
    726. 

  726.                             msfvx, msfvx_inv, msfvy,                         &
    727. 

  727.                             ids,ide, jds,jde, kds,kde,                       &
    728. 

  728.                             ims,ime, jms,jme, kms,kme,                       &
    729. 

  729.                             ips,ipe, jps,jpe, kps,kpe,                       &
    730. 

  730.                             its,ite, jts,jte, kts,kte                       )
    731. 

  731. 

  732.    IMPLICIT NONE
    733. 

  733. 

  734.    !  Input data.
    735. 

  735. 

  736.    INTEGER ,               INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
    737. 

  737.                                             ims, ime, jms, jme, kms, kme, &
    738. 

  738.                                             ips, ipe, jps, jpe, kps, kpe, &
    739. 

  739.                                             its, ite, jts, jte, kts, kte
    740. 

  740.    INTEGER ,               INTENT(IN   ) :: rk_step
    741. 

  741. 

  742.    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) :: ru_tend, &
    743. 

  743.                                                                       rv_tend, &
    744. 

  744.                                                                       rw_tend, &
    745. 

  745.                                                                       ph_tend, &
    746. 

  746.                                                                       t_tend,  &
    747. 

  747.                                                                       ru_tendf, &
    748. 

  748.                                                                       rv_tendf, &
    749. 

  749.                                                                       rw_tendf, &
    750. 

  750.                                                                       ph_tendf, &
    751. 

  751.                                                                       t_tendf
    752. 

  752. 

  753.    REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT) :: mu_tend, &
    754. 

  754.                                                              mu_tendf
    755. 

  755. 

  756.    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(IN   ) ::  u_save,  &
    757. 

  757.                                                                        v_save,  &
    758. 

  758.                                                                        w_save,  &
    759. 

  759.                                                                       ph_save,  &
    760. 

  760.                                                                        t_save,  &
    761. 

  761.                                                                       h_diabatic
    762. 

  762. 

  763.    REAL , DIMENSION( ims:ime , jms:jme ) ,         INTENT(IN   ) :: mut,       &
    764. 

  764.                                                                     msftx,     &
    765. 

  765.                                                                     msfty,     &
    766. 

  766.                                                                     msfux,     &
    767. 

  767.                                                                     msfuy,     &
    768. 

  768.                                                                     msfvx,     &
    769. 

  769.                                                                     msfvx_inv, &
    770. 

  770.                                                                     msfvy
    771. 

  771. 

  772. 

  773. ! Local
    774. 

  774.    INTEGER :: i, j, k
    775. 

  775. 

  776. !<DESCRIPTION>
    777. 

  777. !
    778. 

  778. ! rk_addtend_dry constructs the full large-timestep tendency terms for
    779. 

  779. ! momentum (u,v,w), theta and geopotential equations.   This is accomplished
    780. 

  780. ! by combining the physics tendencies (in *tendf; these are computed 
    781. 

  781. ! the first RK substep, held fixed thereafter) with the RK tendencies 
    782. 

  782. ! (in *tend, these include advection, pressure gradient, etc; 
    783. 

  783. ! these change each rk substep).  Output is in *tend.
    784. 

  784. !
    785. 

  785. !</DESCRIPTION>
    786. 

  786. 

  787. !  Finally, add the forward-step tendency to the rk_tendency
    788. 

  788. 

  789. ! u/v/w/save contain bc tendency that needs to be multiplied by msf
    790. 

  790. ! (u by msfuy, v by msfvx)
    791. 

  791. !  before adding it to physics tendency (*tendf)
    792. 

  792. ! For momentum we need the final tendency to include an inverse msf
    793. 

  793. ! physics/bc tendency needs to be divided, advection tendency already has it
    794. 

  794. 

  795. ! For scalars we need the final tendency to include an inverse msf (msfty)
    796. 

  796. ! advection tendency is OK, physics/bc tendency needs to be divided by msf
    797. 

  797. 

  798.    DO j = jts,MIN(jte,jde-1)
    799. 

  799.    DO k = kts,kte-1
    800. 

  800.    DO i = its,ite
    801. 

  801.      ! multiply by my to uncouple u
    802. 

  802.      IF(rk_step == 1)ru_tendf(i,k,j) = ru_tendf(i,k,j) +  u_save(i,k,j)*msfuy(i,j)
    803. 

  803.      ! divide by my to couple u
    804. 

  804.      ru_tend(i,k,j) = ru_tend(i,k,j) + ru_tendf(i,k,j)/msfuy(i,j)
    805. 

  805.    ENDDO
    806. 

  806.    ENDDO
    807. 

  807.    ENDDO
    808. 

  808. 

  809.    DO j = jts,jte
    810. 

  810.    DO k = kts,kte-1
    811. 

  811.    DO i = its,MIN(ite,ide-1)
    812. 

  812.      ! multiply by mx to uncouple v
    813. 

  813.      IF(rk_step == 1)rv_tendf(i,k,j) = rv_tendf(i,k,j) +  v_save(i,k,j)*msfvx(i,j)
    814. 

  814.      ! divide by mx to couple v
    815. 

  815.      rv_tend(i,k,j) = rv_tend(i,k,j) + rv_tendf(i,k,j)*msfvx_inv(i,j)
    816. 

  816.    ENDDO
    817. 

  817.    ENDDO
    818. 

  818.    ENDDO
    819. 

  819. 

  820.    DO j = jts,MIN(jte,jde-1)
    821. 

  821.    DO k = kts,kte
    822. 

  822.    DO i = its,MIN(ite,ide-1)
    823. 

  823.      ! multiply by my to uncouple w
    824. 

  824.      IF(rk_step == 1)rw_tendf(i,k,j) = rw_tendf(i,k,j) +  w_save(i,k,j)*msfty(i,j)
    825. 

  825.      ! divide by my to couple w
    826. 

  826.      rw_tend(i,k,j) = rw_tend(i,k,j) + rw_tendf(i,k,j)/msfty(i,j)
    827. 

  827.      IF(rk_step == 1)ph_tendf(i,k,j) = ph_tendf(i,k,j) +  ph_save(i,k,j)
    828. 

  828.      ! divide by my to couple scalar
    829. 

  829.      ph_tend(i,k,j) = ph_tend(i,k,j) + ph_tendf(i,k,j)/msfty(i,j)
    830. 

  830.    ENDDO
    831. 

  831.    ENDDO
    832. 

  832.    ENDDO
    833. 

  833. 

  834.    DO j = jts,MIN(jte,jde-1)
    835. 

  835.    DO k = kts,kte-1
    836. 

  836.    DO i = its,MIN(ite,ide-1)
    837. 

  837.      IF(rk_step == 1)t_tendf(i,k,j) = t_tendf(i,k,j) +  t_save(i,k,j)
    838. 

  838.      ! divide by my to couple theta
    839. 

  839.       t_tend(i,k,j) =  t_tend(i,k,j) +  t_tendf(i,k,j)/msfty(i,j)  &
    840. 

  840.                                      +  mut(i,j)*h_diabatic(i,k,j)/msfty(i,j)
    841. 

  841.      ! divide by my to couple heating
    842. 

  842.    ENDDO
    843. 

  843.    ENDDO
    844. 

  844.    ENDDO
    845. 

  845. 

  846.    DO j = jts,MIN(jte,jde-1)
    847. 

  847.    DO i = its,MIN(ite,ide-1)
    848. 

  848. ! mu tendencies not coupled with 1/msf
    849. 

  849.       mu_tend(i,j) =  mu_tend(i,j) +  mu_tendf(i,j)
    850. 

  850.    ENDDO
    851. 

  851.    ENDDO
    852. 

  852. 

  853. END SUBROUTINE rk_addtend_dry
    854. 

  854. 

  855. !-------------------------------------------------------------------------------
    856. 

  856. 

  857. SUBROUTINE rk_scalar_tend ( scs, sce, config_flags,          &
    858. 

  858.                             tenddec,                        & 
    859. 

  859.                             rk_step, dt,                     &
    860. 

  860.                             ru, rv, ww, mut, mub, mu_old,    &
    861. 

  861.                             alt,                             &
    862. 

  862.                             scalar_old, scalar,              &
    863. 

  863.                             scalar_tends, advect_tend,       &
    864. 

  864.                             h_tendency, z_tendency,          & 
    865. 

  865.                             RQVFTEN,                         &
    866. 

  866.                             base, moist_step, fnm, fnp,      &
    867. 

  867.                             msfux, msfuy, msfvx, msfvx_inv,  &
    868. 

  868.                             msfvy, msftx, msfty,             &
    869. 

  869.                             rdx, rdy, rdn, rdnw,             &
    870. 

  870.                             khdif, kvdif, xkmhd,             &
    871. 

  871.                             diff_6th_opt, diff_6th_factor,   &
    872. 

  872.                             adv_opt,                         &
    873. 

  873.                             ids, ide, jds, jde, kds, kde,    &
    874. 

  874.                             ims, ime, jms, jme, kms, kme,    &
    875. 

  875.                             its, ite, jts, jte, kts, kte    )
    876. 

  876. 

  877.    IMPLICIT NONE
    878. 

  878. 

  879.    !  Input data.
    880. 

  880. 

  881.    TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
    882. 

  882. 

  883.    LOGICAL ,                INTENT(IN   ) :: tenddec ! tendency term
    884. 

  884. 

  885.    INTEGER ,                INTENT(IN   ) :: rk_step, scs, sce
    886. 

  886.    INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
    887. 

  887.                                              ims, ime, jms, jme, kms, kme, &
    888. 

  888.                                              its, ite, jts, jte, kts, kte
    889. 

  889. 

  890.    LOGICAL , INTENT(IN   ) :: moist_step
    891. 

  891. 

  892.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ),                &
    893. 

  893.                                          INTENT(IN   )  :: scalar, scalar_old
    894. 

  894. 

  895.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ),                      &
    896. 

  896.                                          INTENT(INOUT)  :: scalar_tends
    897. 

  897.                                                     
    898. 

  898.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(INOUT) :: advect_tend
    899. 

  899.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(  OUT) :: h_tendency, z_tendency 
    900. 

  900. 

  901.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(OUT  ) :: RQVFTEN
    902. 

  902. 

  903.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme  ), INTENT(IN   ) ::     ru,  &
    904. 

  904.                                                                       rv,  &
    905. 

  905.                                                                       ww,  &
    906. 

  906.                                                                       xkmhd,  &
    907. 

  907.                                                                       alt
    908. 

  908. 

  909. 

  910.    REAL , DIMENSION( kms:kme ) ,                 INTENT(IN   ) :: fnm,  &
    911. 

  911.                                                                   fnp,  &
    912. 

  912.                                                                   rdn,  &
    913. 

  913.                                                                   rdnw, &
    914. 

  914.                                                                   base
    915. 

  915. 

  916.    REAL , DIMENSION( ims:ime , jms:jme ) ,       INTENT(IN   ) :: msfux,    &
    917. 

  917.                                                                   msfuy,    &
    918. 

  918.                                                                   msfvx,    &
    919. 

  919.                                                                   msfvx_inv,    &
    920. 

  920.                                                                   msfvy,    &
    921. 

  921.                                                                   msftx,    &
    922. 

  922.                                                                   msfty,    &
    923. 

  923.                                                                   mub,     &
    924. 

  924.                                                                   mut,     &
    925. 

  925.                                                                   mu_old
    926. 

  926. 

  927.    REAL ,                                        INTENT(IN   ) :: rdx,     &
    928. 

  928.                                                                   rdy,     &
    929. 

  929.                                                                   khdif,   &
    930. 

  930.                                                                   kvdif
    931. 

  931. 

  932.    INTEGER, INTENT( IN ) :: diff_6th_opt
    933. 

  933.    REAL,    INTENT( IN ) :: diff_6th_factor
    934. 

  934. 

  935.    REAL ,                                        INTENT(IN   ) :: dt
    936. 

  936. 

  937.    INTEGER, INTENT(IN   ) :: adv_opt          
    938. 

  938. 

  939.    ! Local data
    940. 

  940.   
    941. 

  941.    INTEGER :: im, i,j,k
    942. 

  942.    INTEGER :: time_step
    943. 

  943. 

  944.    REAL    :: khdq, kvdq, tendency
    945. 

  945. 

  946. !<DESCRIPTION>
    947. 

  947. !
    948. 

  948. ! rk_scalar_tend calls routines that computes scalar tendency from advection 
    949. 

  949. ! and 3D mixing (TKE or fixed eddy viscosities).
    950. 

  950. !
    951. 

  951. !</DESCRIPTION>
    952. 

  952. 

  953. 

  954.    khdq = khdif/prandtl
    955. 

  955.    kvdq = kvdif/prandtl
    956. 

  956. 

  957.    scalar_loop : DO im = scs, sce
    958. 

  958. 

  959.      CALL zero_tend ( advect_tend(ims,kms,jms),     &
    960. 

  960.                       ids, ide, jds, jde, kds, kde, &
    961. 

  961.                       ims, ime, jms, jme, kms, kme, &
    962. 

  962.                       its, ite, jts, jte, kts, kte )
    963. 

  963. 

  964.      CALL zero_tend ( h_tendency(ims,kms,jms),      &
    965. 

  965.                       ids, ide, jds, jde, kds, kde, &
    966. 

  966.                       ims, ime, jms, jme, kms, kme, &
    967. 

  967.                       its, ite, jts, jte, kts, kte )
    968. 

  968. 

  969.      CALL zero_tend ( z_tendency(ims,kms,jms),      &
    970. 

  970.                       ids, ide, jds, jde, kds, kde, &
    971. 

  971.                       ims, ime, jms, jme, kms, kme, &
    972. 

  972.                       its, ite, jts, jte, kts, kte )
    973. 

  973. 

  974.      CALL nl_get_time_step ( 1, time_step )
    975. 

  975. 

  976.       IF( (rk_step == 3) .and. (adv_opt == POSITIVEDEF) ) THEN
    977. 

  977. 

  978.         CALL advect_scalar_pd       ( scalar(ims,kms,jms,im),             &
    979. 

  979.                                       scalar_old(ims,kms,jms,im),         &
    980. 

  980.                                       advect_tend(ims,kms,jms),           &
    981. 

  981.                                       h_tendency(ims,kms,jms),            & 
    982. 

  982.                                       z_tendency(ims,kms,jms),            & 
    983. 

  983.                                       ru, rv, ww, mut, mub, mu_old,       &
    984. 

  984.                                       time_step, config_flags, tenddec,   & 
    985. 

  985.                                       msfux, msfuy, msfvx, msfvy,         &
    986. 

  986.                                       msftx, msfty, fnm, fnp,             &
    987. 

  987.                                       rdx, rdy, rdnw,dt,                  &
    988. 

  988.                                       ids, ide, jds, jde, kds, kde,       &
    989. 

  989.                                       ims, ime, jms, jme, kms, kme,       &
    990. 

  990.                                       its, ite, jts, jte, kts, kte     )
    991. 

  991. 

  992.       ELSE IF( (rk_step == 3) .and. (adv_opt == MONOTONIC) ) THEN
    993. 

  993. 

  994.         CALL advect_scalar_mono       ( scalar(ims,kms,jms,im),             &
    995. 

  995.                                         scalar_old(ims,kms,jms,im),         &
    996. 

  996.                                         advect_tend(ims,kms,jms),           &
    997. 

  997.                                         h_tendency(ims,kms,jms),            & 
    998. 

  998.                                         z_tendency(ims,kms,jms),            & 
    999. 

  999.                                         ru, rv, ww, mut, mub, mu_old,       &
    1000. 

  1000.                                         config_flags, tenddec,              & 
    1001. 

  1001.                                         msfux, msfuy, msfvx, msfvy,         &
    1002. 

  1002.                                         msftx, msfty, fnm, fnp,             &
    1003. 

  1003.                                         rdx, rdy, rdnw,dt,                  &
    1004. 

  1004.                                         ids, ide, jds, jde, kds, kde,       &
    1005. 

  1005.                                         ims, ime, jms, jme, kms, kme,       &
    1006. 

  1006.                                         its, ite, jts, jte, kts, kte     )
    1007. 

  1007. 

  1008.       ELSE IF( (rk_step == 3) .and. (adv_opt == WENO_SCALAR) ) THEN
    1009. 

  1009. 

  1010.         CALL advect_scalar_weno ( scalar(ims,kms,jms,im),        &
    1011. 

  1011.                                  scalar(ims,kms,jms,im),        &
    1012. 

  1012.                                  advect_tend(ims,kms,jms),      &
    1013. 

  1013.                                  ru, rv, ww, mut, time_step,    &
    1014. 

  1014.                                  config_flags,                  &
    1015. 

  1015.                                  msfux, msfuy, msfvx, msfvy,    &
    1016. 

  1016.                                  msftx, msfty, fnm, fnp,        &
    1017. 

  1017.                                  rdx, rdy, rdnw,                &
    1018. 

  1018.                                  ids, ide, jds, jde, kds, kde,  &
    1019. 

  1019.                                  ims, ime, jms, jme, kms, kme,  &
    1020. 

  1020.                                  its, ite, jts, jte, kts, kte  )
    1021. 

  1021. 

  1022.       ELSEIF( (rk_step == 3) .and. (adv_opt == WENOPD_SCALAR) ) THEN
    1023. 

  1023. 

  1024.         CALL advect_scalar_wenopd   ( scalar(ims,kms,jms,im),             &
    1025. 

  1025.                                       scalar_old(ims,kms,jms,im),         &
    1026. 

  1026.                                       advect_tend(ims,kms,jms),           &
    1027. 

  1027.                                       ru, rv, ww, mut, mub, mu_old,       &
    1028. 

  1028.                                       time_step, config_flags,            &
    1029. 

  1029.                                       msfux, msfuy, msfvx, msfvy,         &
    1030. 

  1030.                                       msftx, msfty, fnm, fnp,             &
    1031. 

  1031.                                       rdx, rdy, rdnw,dt,                  &
    1032. 

  1032.                                       ids, ide, jds, jde, kds, kde,       &
    1033. 

  1033.                                       ims, ime, jms, jme, kms, kme,       &
    1034. 

  1034.                                       its, ite, jts, jte, kts, kte     )
    1035. 

  1035. 

  1036.       ELSE
    1037. 

  1037. 

  1038.         CALL advect_scalar     ( scalar(ims,kms,jms,im),        &
    1039. 

  1039.                                  scalar(ims,kms,jms,im),        &
    1040. 

  1040.                                  advect_tend(ims,kms,jms),      &
    1041. 

  1041.                                  ru, rv, ww, mut, time_step,    &
    1042. 

  1042.                                  config_flags,                  &
    1043. 

  1043.                                  msfux, msfuy, msfvx, msfvy,    &
    1044. 

  1044.                                  msftx, msfty, fnm, fnp,        &
    1045. 

  1045.                                  rdx, rdy, rdnw,                &
    1046. 

  1046.                                  ids, ide, jds, jde, kds, kde,  &
    1047. 

  1047.                                  ims, ime, jms, jme, kms, kme,  &
    1048. 

  1048.                                  its, ite, jts, jte, kts, kte  )
    1049. 

  1049. 

  1050.       END IF
    1051. 

  1051. 

  1052.      IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME .OR. &
    1053. 

  1053.          config_flags%cu_physics == KFETASCHEME .OR. &      ! new trigger in KF
    1054. 

  1054.          config_flags%cu_physics == TIEDTKESCHEME  ) &      ! Tiedtke
    1055. 

  1055.                      .and. moist_step .and. ( im == P_QV) ) THEN
    1056. 

  1056. 

  1057.         CALL set_tend( RQVFTEN, advect_tend, msfty,    &
    1058. 

  1058.                        ids, ide, jds, jde, kds, kde,   &
    1059. 

  1059.                        ims, ime, jms, jme, kms, kme,   &
    1060. 

  1060.                        its, ite, jts, jte, kts, kte      )
    1061. 

  1061.      ENDIF
    1062. 

  1062. 

  1063.      rk_step_1: IF( rk_step == 1 ) THEN
    1064. 

  1064. 

  1065.        diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
    1066. 

  1066. 

  1067.        CALL horizontal_diffusion ( 'm', scalar(ims,kms,jms,im),            &
    1068. 

  1068.                                         scalar_tends(ims,kms,jms,im), mut, &
    1069. 

  1069.                                         config_flags,                      &
    1070. 

  1070.                                         msfux, msfuy, msfvx, msfvx_inv,    &
    1071. 

  1071.                                         msfvy, msftx, msfty,               &
    1072. 

  1072.                                         khdq , xkmhd, rdx, rdy,            &
    1073. 

  1073.                                         ids, ide, jds, jde, kds, kde,      &
    1074. 

  1074.                                         ims, ime, jms, jme, kms, kme,      &
    1075. 

  1075.                                         its, ite, jts, jte, kts, kte      )
    1076. 

  1076. 

  1077.        pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN
    1078. 

  1078. 

  1079.          IF( (moist_step) .and. ( im == P_QV)) THEN
    1080. 

  1080. 

  1081.             CALL vertical_diffusion_mp ( scalar(ims,kms,jms,im),       &
    1082. 

  1082.                                          scalar_tends(ims,kms,jms,im), &
    1083. 

  1083.                                          config_flags, base,           &
    1084. 

  1084.                                          alt, mut, rdn, rdnw, kvdq ,   &
    1085. 

  1085.                                          ids, ide, jds, jde, kds, kde, &
    1086. 

  1086.                                          ims, ime, jms, jme, kms, kme, &
    1087. 

  1087.                                          its, ite, jts, jte, kts, kte )
    1088. 

  1088. 

  1089.          ELSE 
    1090. 

  1090. 

  1091.             CALL vertical_diffusion (  'm', scalar(ims,kms,jms,im),       &
    1092. 

  1092.                                             scalar_tends(ims,kms,jms,im), &
    1093. 

  1093.                                             config_flags,                 &
    1094. 

  1094.                                             alt, mut, rdn, rdnw, kvdq,    &
    1095. 

  1095.                                             ids, ide, jds, jde, kds, kde, &
    1096. 

  1096.                                             ims, ime, jms, jme, kms, kme, &
    1097. 

  1097.                                             its, ite, jts, jte, kts, kte )
    1098. 

  1098. 

  1099.          END IF
    1100. 

  1100. 

  1101.       ENDIF pbl_test
    1102. 

  1102. 

  1103.     ENDIF diff_opt1
    1104. 

  1104. 

  1105.     IF ( diff_6th_opt .NE. 0 )                                        &
    1106. 

  1106.       CALL sixth_order_diffusion( 'm', scalar(ims,kms,jms,im),        &
    1107. 

  1107.                                        scalar_tends(ims,kms,jms,im),  &
    1108. 

  1108.                                        mut, dt, config_flags,         &
    1109. 

  1109.                                        diff_6th_opt, diff_6th_factor, &
    1110. 

  1110.                                        ids, ide, jds, jde, kds, kde,  &
    1111. 

  1111.                                        ims, ime, jms, jme, kms, kme,  &
    1112. 

  1112.                                        its, ite, jts, jte, kts, kte )
    1113. 

  1113. 

  1114.   ENDIF rk_step_1
    1115. 

  1115. 

  1116.  END DO scalar_loop
    1117. 

  1117. 

  1118. END SUBROUTINE rk_scalar_tend
    1119. 

  1119. 

  1120. !-------------------------------------------------------------------------------
    1121. 

  1121. 

  1122. SUBROUTINE rk_update_scalar( scs, sce,                      &
    1123. 

  1123.                              scalar_1, scalar_2, sc_tend,   &
    1124. 

  1124.                              advh_t, advz_t,                & 
    1125. 

  1125.                              advect_tend,                   &
    1126. 

  1126.                              h_tendency, z_tendency,        & 
    1127. 

  1127.                              msftx, msfty,                  &
    1128. 

  1128.                              mu_old, mu_new, mu_base,       &
    1129. 

  1129.                              rk_step, dt, spec_zone,        &
    1130. 

  1130.                              config_flags,                  &
    1131. 

  1131.                              tenddec,                      & 
    1132. 

  1132.                              ids, ide, jds, jde, kds, kde,  &
    1133. 

  1133.                              ims, ime, jms, jme, kms, kme,  &
    1134. 

  1134.                              its, ite, jts, jte, kts, kte  )
    1135. 

  1135. 

  1136.    IMPLICIT NONE
    1137. 

  1137. 

  1138.    !  Input data.
    1139. 

  1139. 

  1140.    TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
    1141. 

  1141. 

  1142.    LOGICAL ,                INTENT(IN   ) :: tenddec 
    1143. 

  1143. 

  1144.    INTEGER ,                INTENT(IN   ) :: scs, sce, rk_step, spec_zone
    1145. 

  1145.    INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
    1146. 

  1146.                                              ims, ime, jms, jme, kms, kme, &
    1147. 

  1147.                                              its, ite, jts, jte, kts, kte
    1148. 

  1148. 

  1149.    REAL,                    INTENT(IN   ) :: dt
    1150. 

  1150. 

  1151.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
    1152. 

  1152.          INTENT(INOUT)                                  :: scalar_1,    &
    1153. 

  1153.                                                            scalar_2
    1154. 

  1154. 

  1155.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
    1156. 

  1156.          INTENT(IN)                                     :: sc_tend
    1157. 

  1157. 

  1158.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ),                &
    1159. 

  1159.          INTENT(IN)                                  :: advect_tend
    1160. 

  1160. 

  1161.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(INOUT) , OPTIONAL :: advh_t,  advz_t ! accumulating for output
    1162. 

  1162.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(IN   ) :: h_tendency, z_tendency ! from rk_scalar_tend
    1163. 

  1163. 

  1164.    REAL, DIMENSION(ims:ime, jms:jme  ), INTENT(IN   ) ::  mu_old,  &
    1165. 

  1165.                                                           mu_new,  &
    1166. 

  1166.                                                           mu_base, &
    1167. 

  1167.                                                           msftx,   &
    1168. 

  1168.                                                           msfty
    1169. 

  1169. 

  1170.    INTEGER :: i,j,k,im
    1171. 

  1171.    REAL    :: sc_middle, msfsq
    1172. 

  1172.    REAL, DIMENSION(its:ite) :: muold, r_munew
    1173. 

  1173. 

  1174.    REAL, DIMENSION(its:ite, kts:kte, jts:jte  ) :: tendency
    1175. 

  1175. 

  1176.    INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
    1177. 

  1177.    INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
    1178. 

  1178. 

  1179. !<DESCRIPTION>
    1180. 

  1180. !
    1181. 

  1181. !  rk_scalar_update advances the scalar equation given the time t value
    1182. 

  1182. !  of the scalar and the scalar tendency.  
    1183. 

  1183. !
    1184. 

  1184. !</DESCRIPTION>
    1185. 

  1185. 

  1186. 

  1187. !
    1188. 

  1188. !  set loop limits.
    1189. 

  1189. 

  1190.       i_start = its
    1191. 

  1191.       i_end   = min(ite,ide-1)
    1192. 

  1192.       j_start = jts
    1193. 

  1193.       j_end   = min(jte,jde-1)
    1194. 

  1194.       k_start = kts
    1195. 

  1195.       k_end   = kte-1
    1196. 

  1196. 

  1197.       i_start_spc = i_start
    1198. 

  1198.       i_end_spc   = i_end
    1199. 

  1199.       j_start_spc = j_start
    1200. 

  1200.       j_end_spc   = j_end
    1201. 

  1201.       k_start_spc = k_start
    1202. 

  1202.       k_end_spc   = k_end
    1203. 

  1203. 

  1204.     IF( config_flags%nested .or. config_flags%specified ) THEN
    1205. 

  1205.       IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
    1206. 

  1206.       IF( .NOT. config_flags%periodic_x)i_end   = min( ite,ide-spec_zone-1 )
    1207. 

  1207.       j_start = max( jts,jds+spec_zone )
    1208. 

  1208.       j_end   = min( jte,jde-spec_zone-1 )
    1209. 

  1209.       k_start = kts
    1210. 

  1210.       k_end   = min( kte, kde-1 )
    1211. 

  1211.     ENDIF
    1212. 

  1212. 

  1213.     IF ( rk_step == 1 ) THEN
    1214. 

  1214. 

  1215.       !  replace t-dt values (in scalar_1) with t values scalar_2,
    1216. 

  1216.       !  then compute new values by adding tendency to values at t
    1217. 

  1217. 

  1218.       DO  im = scs,sce
    1219. 

  1219. 

  1220.        DO  j = jts, min(jte,jde-1)
    1221. 

  1221.        DO  k = kts, min(kte,kde-1)
    1222. 

  1222.        DO  i = its, min(ite,ide-1)
    1223. 

  1223.            tendency(i,k,j) = 0.
    1224. 

  1224.        ENDDO
    1225. 

  1225.        ENDDO
    1226. 

  1226.        ENDDO
    1227. 

  1227.    
    1228. 

  1228.        DO  j = j_start,j_end
    1229. 

  1229.        DO  k = k_start,k_end
    1230. 

  1230.        DO  i = i_start,i_end
    1231. 

  1231.           ! scalar was coupled with my
    1232. 

  1232.            tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j)
    1233. 

  1233.        ENDDO
    1234. 

  1234.        ENDDO
    1235. 

  1235.        ENDDO
    1236. 

  1236.    
    1237. 

  1237.        DO  j = j_start_spc,j_end_spc
    1238. 

  1238.        DO  k = k_start_spc,k_end_spc
    1239. 

  1239.        DO  i = i_start_spc,i_end_spc
    1240. 

  1240.            tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
    1241. 

  1241.        ENDDO
    1242. 

  1242.        ENDDO
    1243. 

  1243.        ENDDO
    1244. 

  1244.    
    1245. 

  1245.       DO  j = jts, min(jte,jde-1)
    1246. 

  1246. 

  1247.       DO  i = its, min(ite,ide-1)
    1248. 

  1248.         muold(i) = mu_old(i,j) + mu_base(i,j)
    1249. 

  1249.         r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
    1250. 

  1250.       ENDDO
    1251. 

  1251. 

  1252.       DO  k = kts, min(kte,kde-1)
    1253. 

  1253.       DO  i = its, min(ite,ide-1)
    1254. 

  1254. 

  1255.         scalar_1(i,k,j,im) = scalar_2(i,k,j,im)
    1256. 

  1256.         scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im)   &
    1257. 

  1257.                              + dt*tendency(i,k,j))*r_munew(i)
    1258. 

  1258. 

  1259.       ENDDO
    1260. 

  1260.       ENDDO
    1261. 

  1261.       ENDDO
    1262. 

  1262. 

  1263.       ENDDO
    1264. 

  1264. 

  1265.     ELSE
    1266. 

  1266. 

  1267.       !  just compute new values, scalar_1 already at time t.
    1268. 

  1268. 

  1269.       DO  im = scs, sce
    1270. 

  1270. 

  1271.        DO  j = jts, min(jte,jde-1)
    1272. 

  1272.        DO  k = kts, min(kte,kde-1)
    1273. 

  1273.        DO  i = its, min(ite,ide-1)
    1274. 

  1274.            tendency(i,k,j) = 0.
    1275. 

  1275.        ENDDO
    1276. 

  1276.        ENDDO
    1277. 

  1277.        ENDDO
    1278. 

  1278.    
    1279. 

  1279.        DO  j = j_start,j_end
    1280. 

  1280.        DO  k = k_start,k_end
    1281. 

  1281.        DO  i = i_start,i_end
    1282. 

  1282.            ! scalar was coupled with my
    1283. 

  1283.            tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j)
    1284. 

  1284.        ENDDO
    1285. 

  1285.        ENDDO
    1286. 

  1286.        ENDDO
    1287. 

  1287.    
    1288. 

  1288.        DO  j = j_start_spc,j_end_spc
    1289. 

  1289.        DO  k = k_start_spc,k_end_spc
    1290. 

  1290.        DO  i = i_start_spc,i_end_spc
    1291. 

  1291.            tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
    1292. 

  1292.        ENDDO
    1293. 

  1293.        ENDDO
    1294. 

  1294.        ENDDO
    1295. 

  1295. 

  1296.       DO  j = jts, min(jte,jde-1)
    1297. 

  1297. 

  1298.       DO  i = its, min(ite,ide-1)
    1299. 

  1299.         muold(i) = mu_old(i,j) + mu_base(i,j)
    1300. 

  1300.         r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
    1301. 

  1301.       ENDDO
    1302. 

  1302. 

  1303.       DO  k = kts, min(kte,kde-1)
    1304. 

  1304.       DO  i = its, min(ite,ide-1)
    1305. 

  1305. 

  1306.         scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im)   &
    1307. 

  1307.                              + dt*tendency(i,k,j))*r_munew(i)
    1308. 

  1308. 

  1309.       ENDDO
    1310. 

  1310.       ENDDO
    1311. 

  1311. 

  1312.       ! This is separated from the k/i-loop above for better performance
    1313. 

  1313.       IF ( PRESENT(advh_t) .AND. PRESENT(advz_t) ) THEN
    1314. 

  1314.         IF(tenddec.and.rk_step.eq.config_flags%rk_ord) THEN
    1315. 

  1315.           DO  k = kts, min(kte,kde-1)
    1316. 

  1316.           DO  i = its, min(ite,ide-1)
    1317. 

  1317. 

  1318.             advh_t(i,k,j) = advh_t(i,k,j) + (dt*h_tendency(i,k,j)* msfty(i,j))*r_munew(i)
    1319. 

  1319.             advz_t(i,k,j) = advz_t(i,k,j) + (dt*z_tendency(i,k,j)* msfty(i,j))*r_munew(i)
    1320. 

  1320. 

  1321.           ENDDO
    1322. 

  1322.           ENDDO
    1323. 

  1323.         END IF
    1324. 

  1324.       END IF
    1325. 

  1325.       
    1326. 

  1326.       ENDDO
    1327. 

  1327. 

  1328.       ENDDO
    1329. 

  1329. 

  1330.     END IF
    1331. 

  1331. 

  1332. END SUBROUTINE rk_update_scalar
    1333. 

  1333. 

  1334. !-------------------------------------------------------------------------------
    1335. 

  1335. 

  1336. SUBROUTINE rk_update_scalar_pd( scs, sce,                      &
    1337. 

  1337.                                 scalar, sc_tend,               &
    1338. 

  1338.                                 mu_old, mu_new, mu_base,       &
    1339. 

  1339.                                 rk_step, dt, spec_zone,        &
    1340. 

  1340.                                 config_flags,                  &
    1341. 

  1341.                                 ids, ide, jds, jde, kds, kde,  &
    1342. 

  1342.                                 ims, ime, jms, jme, kms, kme,  &
    1343. 

  1343.                                 its, ite, jts, jte, kts, kte  )
    1344. 

  1344. 

  1345.    IMPLICIT NONE
    1346. 

  1346. 

  1347.    !  Input data.
    1348. 

  1348. 

  1349.    TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
    1350. 

  1350. 

  1351.    INTEGER ,                INTENT(IN   ) :: scs, sce, rk_step, spec_zone
    1352. 

  1352.    INTEGER ,                INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
    1353. 

  1353.                                              ims, ime, jms, jme, kms, kme, &
    1354. 

  1354.                                              its, ite, jts, jte, kts, kte
    1355. 

  1355. 

  1356.    REAL,                    INTENT(IN   ) :: dt
    1357. 

  1357. 

  1358.    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
    1359. 

  1359.          INTENT(INOUT)                                  :: scalar,      &
    1360. 

  1360.                                                            sc_tend
    1361. 

  1361. 

  1362.    REAL, DIMENSION(ims:ime, jms:jme  ), INTENT(IN   ) ::  mu_old,  &
    1363. 

  1363.                                                           mu_new,  &
    1364. 

  1364.                                                           mu_base
    1365. 

  1365. 

  1366.    INTEGER :: i,j,k,im
    1367. 

  1367.    REAL    :: sc_middle, msfsq
    1368. 

  1368.    REAL, DIMENSION(its:ite) :: muold, r_munew
    1369. 

  1369. 

  1370.    REAL, DIMENSION(its:ite, kts:kte, jts:jte  ) :: tendency
    1371. 

  1371. 

  1372.    INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
    1373. 

  1373.    INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
    1374. 

  1374. 

  1375. !<DESCRIPTION>
    1376. 

  1376. !
    1377. 

  1377. !  rk_scalar_update advances the scalar equation given the time t value
    1378. 

  1378. !  of the scalar and the scalar tendency.  
    1379. 

  1379. !
    1380. 

  1380. !</DESCRIPTION>
    1381. 

  1381. 

  1382. 

  1383. !
    1384. 

  1384. !  set loop limits.
    1385. 

  1385. 

  1386.       i_start = its
    1387. 

  1387.       i_end   = min(ite,ide-1)
    1388. 

  1388.       j_start = jts
    1389. 

  1389.       j_end   = min(jte,jde-1)
    1390. 

  1390.       k_start = kts
    1391. 

  1391.       k_end   = kte-1
    1392. 

  1392. 

  1393.       i_start_spc = i_start
    1394. 

  1394.       i_end_spc   = i_end
    1395. 

  1395.       j_start_spc = j_start
    1396. 

  1396.       j_end_spc   = j_end
    1397. 

  1397.       k_start_spc = k_start
    1398. 

  1398.       k_end_spc   = k_end
    1399. 

  1399. 

  1400.     IF( config_flags%nested .or. config_flags%specified ) THEN
    1401. 

  1401.       IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
    1402. 

  1402.       IF( .NOT. config_flags%periodic_x)i_end   = min( ite,ide-spec_zone-1 )
    1403. 

  1403.       j_start = max( jts,jds+spec_zone )
    1404. 

  1404.       j_end   = min( jte,jde-spec_zone-1 )
    1405. 

  1405.       k_start = kts
    1406. 

  1406.       k_end   = min( kte, kde-1 )
    1407. 

  1407.     ENDIF
    1408. 

  1408. 

  1409.       DO  im = scs, sce
    1410. 

  1410. 

  1411.        DO  j = jts, min(jte,jde-1)
    1412. 

  1412.        DO  k = kts, min(kte,kde-1)
    1413. 

  1413.        DO  i = its, min(ite,ide-1)
    1414. 

  1414.            tendency(i,k,j) = 0.
    1415. 

  1415.        ENDDO
    1416. 

  1416.        ENDDO
    1417. 

  1417.        ENDDO
    1418. 

  1418.    
    1419. 

  1419.        DO  j = j_start_spc,j_end_spc
    1420. 

  1420.        DO  k = k_start_spc,k_end_spc
    1421. 

  1421.        DO  i = i_start_spc,i_end_spc
    1422. 

  1422.            tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
    1423. 

  1423.            sc_tend(i,k,j,im) = 0.
    1424. 

  1424.        ENDDO
    1425. 

  1425.        ENDDO
    1426. 

  1426.        ENDDO
    1427. 

  1427. 

  1428.       DO  j = jts, min(jte,jde-1)
    1429. 

  1429. 

  1430.       DO  i = its, min(ite,ide-1)
    1431. 

  1431.         muold(i) = mu_old(i,j) + mu_base(i,j)
    1432. 

  1432.         r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
    1433. 

  1433.       ENDDO
    1434. 

  1434. 

  1435.       DO  k = kts, min(kte,kde-1)
    1436. 

  1436.       DO  i = its, min(ite,ide-1)
    1437. 

  1437. 

  1438.         scalar(i,k,j,im) = (muold(i)*scalar(i,k,j,im)   &
    1439. 

  1439.                              + dt*tendency(i,k,j))*r_munew(i)
    1440. 

  1440.       ENDDO
    1441. 

  1441.       ENDDO
    1442. 

  1442.       ENDDO
    1443. 

  1443. 

  1444.       ENDDO
    1445. 

  1445. 

  1446. END SUBROUTINE rk_update_scalar_pd
    1447. 

  1447. 

  1448. !------------------------------------------------------------
    1449. 

  1449. 

  1450. SUBROUTINE init_zero_tendency(ru_tendf, rv_tendf, rw_tendf, ph_tendf,  &
    1451. 

  1451.                               t_tendf,  tke_tendf, mu_tendf,           &
    1452. 

  1452.                               moist_tendf,chem_tendf,scalar_tendf,     &
    1453. 

  1453.                               tracer_tendf,n_tracer,                   &
    1454. 

  1454.                               n_moist,n_chem,n_scalar,rk_step,         &
    1455. 

  1455.                               ids, ide, jds, jde, kds, kde,            &
    1456. 

  1456.                               ims, ime, jms, jme, kms, kme,            &
    1457. 

  1457.                               its, ite, jts, jte, kts, kte             )
    1458. 

  1458. !-----------------------------------------------------------------------
    1459. 

  1459.    IMPLICIT NONE
    1460. 

  1460. !-----------------------------------------------------------------------
    1461. 

  1461. 

  1462.    INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
    1463. 

  1463.                                     ims, ime, jms, jme, kms, kme, &
    1464. 

  1464.                                     its, ite, jts, jte, kts, kte
    1465. 

  1465. 

  1466.    INTEGER ,       INTENT(IN   ) :: n_moist,n_chem,n_scalar,n_tracer,rk_step
    1467. 

  1467. 

  1468.    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) ::  &
    1469. 

  1469.                                                              ru_tendf, &
    1470. 

  1470.                                                              rv_tendf, &
    1471. 

  1471.                                                              rw_tendf, &
    1472. 

  1472.                                                              ph_tendf, &
    1473. 

  1473.                                                               t_tendf, &
    1474. 

  1474.                                                             tke_tendf
    1475. 

  1475. 

  1476.    REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT) ::  mu_tendf
    1477. 

  1477. 

  1478.    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),INTENT(INOUT)::&
    1479. 

  1479.                                                           moist_tendf
    1480. 

  1480. 

  1481.    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem ),INTENT(INOUT)::&
    1482. 

  1482.                                                           chem_tendf
    1483. 

  1483.    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_tracer ),INTENT(INOUT)::&
    1484. 

  1484.                                                           tracer_tendf
    1485. 

  1485. 

  1486.    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar ),INTENT(INOUT)::&
    1487. 

  1487.                                                           scalar_tendf
    1488. 

  1488. 

  1489. ! LOCAL VARS
    1490. 

  1490. 

  1491.    INTEGER :: im, ic, is
    1492. 

  1492. 

  1493. !<DESCRIPTION>
    1494. 

  1494. !
    1495. 

  1495. ! init_zero_tendency 
    1496. 

  1496. ! sets tendency arrays to zero for all prognostic variables.
    1497. 

  1497. !
    1498. 

  1498. !</DESCRIPTION>
    1499. 

  1499. 

  1500. 

  1501.    CALL zero_tend ( ru_tendf,                        &
    1502. 

  1502.                     ids, ide, jds, jde, kds, kde,    &
    1503. 

  1503.                     ims, ime, jms, jme, kms, kme,    &
    1504. 

  1504.                     its, ite, jts, jte, kts, kte     )
    1505. 

  1505. 

  1506.    CALL zero_tend ( rv_tendf,                        &
    1507. 

  1507.                     ids, ide, jds, jde, kds, kde,    &
    1508. 

  1508.                     ims, ime, jms, jme, kms, kme,    &
    1509. 

  1509.                     its, ite, jts, jte, kts, kte     )
    1510. 

  1510. 

  1511.    CALL zero_tend ( rw_tendf,                        &
    1512. 

  1512.                     ids, ide, jds, jde, kds, kde,    &
    1513. 

  1513.                     ims, ime, jms, jme, kms, kme,    &
    1514. 

  1514.                     its, ite, jts, jte, kts, kte     )
    1515. 

  1515. 

  1516.    CALL zero_tend ( ph_tendf,                        &
    1517. 

  1517.                     ids, ide, jds, jde, kds, kde,    &
    1518. 

  1518.                     ims, ime, jms, jme, kms, kme,    &
    1519. 

  1519.                     its, ite, jts, jte, kts, kte     )
    1520. 

  1520. 

  1521.    CALL zero_tend ( t_tendf,                         &
    1522. 

  1522.                     ids, ide, jds, jde, kds, kde,    &
    1523. 

  1523.                     ims, ime, jms, jme, kms, kme,    &
    1524. 

  1524.                     its, ite, jts, jte, kts, kte     )
    1525. 

  1525. 

  1526.    CALL zero_tend ( tke_tendf,                       &
    1527. 

  1527.                     ids, ide, jds, jde, kds, kde,    &
    1528. 

  1528.                     ims, ime, jms, jme, kms, kme,    &
    1529. 

  1529.                     its, ite, jts, jte, kts, kte     )
    1530. 

  1530. 

  1531.    CALL zero_tend ( mu_tendf,                        &
    1532. 

  1532.                     ids, ide, jds, jde, kds, kds,    &
    1533. 

  1533.                     ims, ime, jms, jme, kms, kms,    &
    1534. 

  1534.                     its, ite, jts, jte, kts, kts     )
    1535. 

  1535. 

  1536. !   DO im=PARAM_FIRST_SCALAR,n_moist
    1537. 

  1537.    DO im=1,n_moist                      ! make sure first one is zero too
    1538. 

  1538.       CALL zero_tend ( moist_tendf(ims,kms,jms,im),  &
    1539. 

  1539.                        ids, ide, jds, jde, kds, kde, &
    1540. 

  1540.                        ims, ime, jms, jme, kms, kme, &
    1541. 

  1541.                        its, ite, jts, jte, kts, kte  )
    1542. 

  1542.    ENDDO
    1543. 

  1543. 

  1544. !   DO ic=PARAM_FIRST_SCALAR,n_chem
    1545. 

  1545.    DO ic=1,n_chem                       ! make sure first one is zero too
    1546. 

  1546.       CALL zero_tend ( chem_tendf(ims,kms,jms,ic),   &
    1547. 

  1547.                        ids, ide, jds, jde, kds, kde, &
    1548. 

  1548.                        ims, ime, jms, jme, kms, kme, &
    1549. 

  1549.                        its, ite, jts, jte, kts, kte  )
    1550. 

  1550.    ENDDO
    1551. 

  1551. 

  1552. !   DO ic=PARAM_FIRST_SCALAR,n_tracer
    1553. 

  1553.    DO ic=1,n_tracer                     ! make sure first one is zero too
    1554. 

  1554.       CALL zero_tend ( tracer_tendf(ims,kms,jms,ic), &
    1555. 

  1555.                        ids, ide, jds, jde, kds, kde, &
    1556. 

  1556.                        ims, ime, jms, jme, kms, kme, &
    1557. 

  1557.                        its, ite, jts, jte, kts, kte  )
    1558. 

  1558.    ENDDO
    1559. 

  1559. 

  1560. !   DO ic=PARAM_FIRST_SCALAR,n_scalar
    1561. 

  1561.    DO ic=1,n_scalar                       ! make sure first one is zero too
    1562. 

  1562.       CALL zero_tend ( scalar_tendf(ims,kms,jms,ic),   &
    1563. 

  1563.                        ids, ide, jds, jde, kds, kde, &
    1564. 

  1564.                        ims, ime, jms, jme, kms, kme, &
    1565. 

  1565.                        its, ite, jts, jte, kts, kte  )
    1566. 

  1566.    ENDDO
    1567. 

  1567. 

  1568. END SUBROUTINE init_zero_tendency
    1569. 

  1569. 

  1570. !===================================================================
    1571. 

  1571. 

  1572. 

  1573. SUBROUTINE dump_data( a, field, io_unit,            &
    1574. 

  1574.                       ims, ime, jms, jme, kms, kme, &
    1575. 

  1575.                       ids, ide, jds, jde, kds, kde )
    1576. 

  1576. implicit none
    1577. 

  1577. integer ::  ims, ime, jms, jme, kms, kme, &
    1578. 

  1578.             ids, ide, jds, jde, kds, kde 
    1579. 

  1579. real, dimension(ims:ime, kms:kme, jds:jde) :: a
    1580. 

  1580. character :: field
    1581. 

  1581. integer :: io_unit
    1582. 

  1582. 

  1583. integer :: is,ie,js,je,ks,ke
    1584. 

  1584. 

  1585. !<DESCRIPTION
    1586. 

  1586. !
    1587. 

  1587. ! quick and dirty debug io utility
    1588. 

  1588. !
    1589. 

  1589. !</DESCRIPTION
    1590. 

  1590. 

  1591. is = ids
    1592. 

  1592. ie = ide-1
    1593. 

  1593. js = jds
    1594. 

  1594. je = jde-1
    1595. 

  1595. ks = kds
    1596. 

  1596. ke = kde-1
    1597. 

  1597. 

  1598. if(field == 'u') ie = ide
    1599. 

  1599. if(field == 'v') je = jde
    1600. 

  1600. if(field == 'w') ke = kde
    1601. 

  1601. 

  1602. write(io_unit) is,ie,ks,ke,js,je
    1603. 

  1603. write(io_unit) a(is:ie, ks:ke, js:je)
    1604. 

  1604. 

  1605. end subroutine dump_data
    1606. 

  1606. 

  1607. !-----------------------------------------------------------------------
    1608. 

  1608. 

  1609. SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d,           &
    1610. 

  1610.                      RTHRATEN,                                         &
    1611. 

  1611.                      RUBLTEN,RVBLTEN,RTHBLTEN,                         &
    1612. 

  1612.                      RQVBLTEN,RQCBLTEN,RQIBLTEN,                       &
    1613. 

  1613.                      RUCUTEN,RVCUTEN,RTHCUTEN,                         &
    1614. 

  1614.                      RQVCUTEN,RQCCUTEN,RQRCUTEN,                       &
    1615. 

  1615.                      RQICUTEN,RQSCUTEN,                                &
    1616. 

  1616.                      RUSHTEN,RVSHTEN,RTHSHTEN,                         &
    1617. 

  1617.                      RQVSHTEN,RQCSHTEN,RQRSHTEN,                       &
    1618. 

  1618.                      RQISHTEN,RQSSHTEN,RQGSHTEN,                       &
    1619. 

  1619.                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,        &
    1620. 

  1620.                      RMUNDGDTEN,                                       &
    1621. 

  1621.                      ids,ide, jds,jde, kds,kde,                        &
    1622. 

  1622.                      ims,ime, jms,jme, kms,kme,                        &
    1623. 

  1623.                      its,ite, jts,jte, kts,kte                         )
    1624. 

  1624. !-----------------------------------------------------------------------
    1625. 

  1625.       IMPLICIT NONE
    1626. 

  1626. 

  1627.       TYPE(grid_config_rec_type), INTENT(IN)     ::      config_flags
    1628. 

  1628. 

  1629.       INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
    1630. 

  1630.                                             ims,ime, jms,jme, kms,kme, &
    1631. 

  1631.                                             its,ite, jts,jte, kts,kte
    1632. 

  1632. 

  1633.       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
    1634. 

  1634.                 INTENT(IN   )   ::                               pi3d
    1635. 

  1635.                                                                  
    1636. 

  1636.       REAL,     DIMENSION( ims:ime, jms:jme )                        , &
    1637. 

  1637.                 INTENT(IN   )   ::                                 mu, &
    1638. 

  1638.                                                                   muu, &
    1639. 

  1639.                                                                   muv
    1640. 

  1640.       
    1641. 

  1641.                                                            
    1642. 

  1642. ! radiation
    1643. 

  1643. 

  1644.       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme ),                &
    1645. 

  1645.                 INTENT(INOUT)   ::                           RTHRATEN
    1646. 

  1646. 

  1647. ! cumulus
    1648. 

  1648. 

  1649.       REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ),              &
    1650. 

  1650.                 INTENT(INOUT)   ::                                     &
    1651. 

  1651.                                                               RUCUTEN, &
    1652. 

  1652.                                                               RVCUTEN, &
    1653. 

  1653.                                                              RTHCUTEN, &
    1654. 

  1654.                                                              RQVCUTEN, &
    1655. 

  1655.                                                              RQCCUTEN, &
    1656. 

  1656.                                                              RQRCUTEN, &
    1657. 

  1657.                                                              RQICUTEN, &
    1658. 

  1658.                                                              RQSCUTEN, &
    1659. 

  1659.                                                               RUSHTEN, &
    1660. 

  1660.                                                               RVSHTEN, &
    1661. 

  1661.                                                              RTHSHTEN, &
    1662. 

  1662.                                                              RQVSHTEN, &
    1663. 

  1663.                                                              RQCSHTEN, &
    1664. 

  1664.                                                              RQRSHTEN, &
    1665. 

  1665.                                                              RQISHTEN, &
    1666. 

  1666.                                                              RQSSHTEN, &
    1667. 

  1667.                                                              RQGSHTEN
    1668. 

  1668. 

  1669. ! pbl
    1670. 

  1670. 

  1671.       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
    1672. 

  1672.                 INTENT(INOUT)   ::                            RUBLTEN, &
    1673. 

  1673.                                                               RVBLTEN, &
    1674. 

  1674.                                                              RTHBLTEN, &
    1675. 

  1675.                                                              RQVBLTEN, &
    1676. 

  1676.                                                              RQCBLTEN, &
    1677. 

  1677.                                                              RQIBLTEN
    1678. 

  1678. 

  1679. ! fdda
    1680. 

  1680. 

  1681.       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )               , &
    1682. 

  1682.                 INTENT(INOUT)   ::                            RUNDGDTEN, &
    1683. 

  1683.                                                               RVNDGDTEN, &
    1684. 

  1684.                                                              RTHNDGDTEN, &
    1685. 

  1685.                                                              RQVNDGDTEN
    1686. 

  1686.       REAL,     DIMENSION( ims:ime, jms:jme )               , &
    1687. 

  1687.                 INTENT(INOUT)   ::                           RMUNDGDTEN
    1688. 

  1688. 

  1689.       INTEGER :: i,k,j
    1690. 

  1690.       INTEGER :: itf,ktf,jtf,itsu,jtsv
    1691. 

  1691. 

  1692. !-----------------------------------------------------------------------
    1693. 

  1693. 

  1694. !<DESCRIPTION>
    1695. 

  1695. !
    1696. 

  1696. !  calculate_phy_tend couples the physics tendencies to the column mass (mu),
    1697. 

  1697. !  because prognostic equations are in flux form, but physics tendencies are
    1698. 

  1698. !  computed for uncoupled variables.
    1699. 

  1699. !
    1700. 

  1700. !</DESCRIPTION>
    1701. 

  1701. 

  1702.       itf=MIN(ite,ide-1)
    1703. 

  1703.       jtf=MIN(jte,jde-1)
    1704. 

  1704.       ktf=MIN(kte,kde-1)
    1705. 

  1705.       itsu=MAX(its,ids+1)
    1706. 

  1706.       jtsv=MAX(jts,jds+1)
    1707. 

  1707. 

  1708. ! radiation
    1709. 

  1709. 

  1710.    IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN
    1711. 

  1711. 

  1712.       DO J=jts,jtf
    1713. 

  1713.       DO K=kts,ktf
    1714. 

  1714.       DO I=its,itf
    1715. 

  1715.          RTHRATEN(I,K,J)=mu(I,J)*RTHRATEN(I,K,J)
    1716. 

  1716.       ENDDO
    1717. 

  1717.       ENDDO
    1718. 

  1718.       ENDDO
    1719. 

  1719. 

  1720.    ENDIF
    1721. 

  1721. 

  1722. ! cumulus
    1723. 

  1723. 

  1724.    IF (config_flags%cu_physics .gt. 0) THEN
    1725. 

  1725. 

  1726.       DO J=jts,jtf
    1727. 

  1727.       DO I=its,itf
    1728. 

  1728.       DO K=kts,ktf
    1729. 

  1729.          RUCUTEN(I,K,J) =mu(I,J)*RUCUTEN(I,K,J)
    1730. 

  1730.          RVCUTEN(I,K,J) =mu(I,J)*RVCUTEN(I,K,J)
    1731. 

  1731.          RTHCUTEN(I,K,J)=mu(I,J)*RTHCUTEN(I,K,J)
    1732. 

  1732.          RQVCUTEN(I,K,J)=mu(I,J)*RQVCUTEN(I,K,J)
    1733. 

  1733.       ENDDO
    1734. 

  1734.       ENDDO
    1735. 

  1735.       ENDDO
    1736. 

  1736. 

  1737.       IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
    1738. 

  1738.          DO J=jts,jtf
    1739. 

  1739.          DO I=its,itf
    1740. 

  1740.          DO K=kts,ktf
    1741. 

  1741.             RQCCUTEN(I,K,J)=mu(I,J)*RQCCUTEN(I,K,J)
    1742. 

  1742.          ENDDO
    1743. 

  1743.          ENDDO
    1744. 

  1744.          ENDDO
    1745. 

  1745.       ENDIF
    1746. 

  1746. 

  1747.       IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
    1748. 

  1748.          DO J=jts,jtf
    1749. 

  1749.          DO I=its,itf
    1750. 

  1750.          DO K=kts,ktf
    1751. 

  1751.             RQRCUTEN(I,K,J)=mu(I,J)*RQRCUTEN(I,K,J)
    1752. 

  1752.          ENDDO
    1753. 

  1753.          ENDDO
    1754. 

  1754.          ENDDO
    1755. 

  1755.       ENDIF
    1756. 

  1756. 

  1757.       IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
    1758. 

  1758.          DO J=jts,jtf
    1759. 

  1759.          DO I=its,itf
    1760. 

  1760.          DO K=kts,ktf
    1761. 

  1761.             RQICUTEN(I,K,J)=mu(I,J)*RQICUTEN(I,K,J)
    1762. 

  1762.          ENDDO
    1763. 

  1763.          ENDDO
    1764. 

  1764.          ENDDO
    1765. 

  1765.       ENDIF
    1766. 

  1766. 

  1767.       IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
    1768. 

  1768.          DO J=jts,jtf
    1769. 

  1769.          DO I=its,itf
    1770. 

  1770.          DO K=kts,ktf
    1771. 

  1771.             RQSCUTEN(I,K,J)=mu(I,J)*RQSCUTEN(I,K,J)
    1772. 

  1772.          ENDDO
    1773. 

  1773.          ENDDO
    1774. 

  1774.          ENDDO
    1775. 

  1775.       ENDIF
    1776. 

  1776. 

  1777.    ENDIF
    1778. 

  1778. 

  1779. ! shallow cumulus
    1780. 

  1780. 

  1781.    IF (config_flags%shcu_physics .gt. 0) THEN
    1782. 

  1782. 

  1783.       DO J=jts,jtf
    1784. 

  1784.       DO I=its,itf
    1785. 

  1785.       DO K=kts,ktf
    1786. 

  1786.          RUSHTEN(I,K,J) =mu(I,J)*RUSHTEN(I,K,J)
    1787. 

  1787.          RVSHTEN(I,K,J) =mu(I,J)*RVSHTEN(I,K,J)
    1788. 

  1788.          RTHSHTEN(I,K,J)=mu(I,J)*RTHSHTEN(I,K,J)
    1789. 

  1789.          RQVSHTEN(I,K,J)=mu(I,J)*RQVSHTEN(I,K,J)
    1790. 

  1790.       ENDDO
    1791. 

  1791.       ENDDO
    1792. 

  1792.       ENDDO
    1793. 

  1793. 

  1794.       IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
    1795. 

  1795.          DO J=jts,jtf
    1796. 

  1796.          DO I=its,itf
    1797. 

  1797.          DO K=kts,ktf
    1798. 

  1798.             RQCSHTEN(I,K,J)=mu(I,J)*RQCSHTEN(I,K,J)
    1799. 

  1799.          ENDDO
    1800. 

  1800.          ENDDO
    1801. 

  1801.          ENDDO
    1802. 

  1802.       ENDIF
    1803. 

  1803. 

  1804.       IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
    1805. 

  1805.          DO J=jts,jtf
    1806. 

  1806.          DO I=its,itf
    1807. 

  1807.          DO K=kts,ktf
    1808. 

  1808.             RQRSHTEN(I,K,J)=mu(I,J)*RQRSHTEN(I,K,J)
    1809. 

  1809.          ENDDO
    1810. 

  1810.          ENDDO
    1811. 

  1811.          ENDDO
    1812. 

  1812.       ENDIF
    1813. 

  1813. 

  1814.       IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
    1815. 

  1815.          DO J=jts,jtf
    1816. 

  1816.          DO I=its,itf
    1817. 

  1817.          DO K=kts,ktf
    1818. 

  1818.             RQISHTEN(I,K,J)=mu(I,J)*RQISHTEN(I,K,J)
    1819. 

  1819.          ENDDO
    1820. 

  1820.          ENDDO
    1821. 

  1821.          ENDDO
    1822. 

  1822.       ENDIF
    1823. 

  1823. 

  1824.       IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
    1825. 

  1825.          DO J=jts,jtf
    1826. 

  1826.          DO I=its,itf
    1827. 

  1827.          DO K=kts,ktf
    1828. 

  1828.             RQSSHTEN(I,K,J)=mu(I,J)*RQSSHTEN(I,K,J)
    1829. 

  1829.          ENDDO
    1830. 

  1830.          ENDDO
    1831. 

  1831.          ENDDO
    1832. 

  1832.       ENDIF
    1833. 

  1833. 

  1834.       IF(P_QG .ge. PARAM_FIRST_SCALAR)THEN
    1835. 

  1835.          DO J=jts,jtf
    1836. 

  1836.          DO I=its,itf
    1837. 

  1837.          DO K=kts,ktf
    1838. 

  1838.             RQGSHTEN(I,K,J)=mu(I,J)*RQGSHTEN(I,K,J)
    1839. 

  1839.          ENDDO
    1840. 

  1840.          ENDDO
    1841. 

  1841.          ENDDO
    1842. 

  1842.       ENDIF
    1843. 

  1843. 

  1844.    ENDIF
    1845. 

  1845. 

  1846. ! pbl
    1847. 

  1847. 

  1848.    IF (config_flags%bl_pbl_physics .gt. 0) THEN
    1849. 

  1849. 

  1850.       DO J=jts,jtf
    1851. 

  1851.       DO K=kts,ktf
    1852. 

  1852.       DO I=its,itf
    1853. 

  1853.          RUBLTEN(I,K,J) =mu(I,J)*RUBLTEN(I,K,J)
    1854. 

  1854.          RVBLTEN(I,K,J) =mu(I,J)*RVBLTEN(I,K,J)
    1855. 

  1855.          RTHBLTEN(I,K,J)=mu(I,J)*RTHBLTEN(I,K,J)
    1856. 

  1856.       ENDDO
    1857. 

  1857.       ENDDO
    1858. 

  1858.       ENDDO
    1859. 

  1859. 

  1860.       IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
    1861. 

  1861.          DO J=jts,jtf
    1862. 

  1862.          DO K=kts,ktf
    1863. 

  1863.          DO I=its,itf
    1864. 

  1864.             RQVBLTEN(I,K,J)=mu(I,J)*RQVBLTEN(I,K,J)
    1865. 

  1865.          ENDDO
    1866. 

  1866.          ENDDO
    1867. 

  1867.          ENDDO
    1868. 

  1868.       ENDIF
    1869. 

  1869. 

  1870.       IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN
    1871. 

  1871.          DO J=jts,jtf
    1872. 

  1872.          DO K=kts,ktf
    1873. 

  1873.          DO I=its,itf
    1874. 

  1874.            RQCBLTEN(I,K,J)=mu(I,J)*RQCBLTEN(I,K,J)
    1875. 

  1875.          ENDDO
    1876. 

  1876.          ENDDO
    1877. 

  1877.          ENDDO
    1878. 

  1878.       ENDIF
    1879. 

  1879. 

  1880.       IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN
    1881. 

  1881.          DO J=jts,jtf
    1882. 

  1882.          DO K=kts,ktf
    1883. 

  1883.          DO I=its,itf
    1884. 

  1884.             RQIBLTEN(I,K,J)=mu(I,J)*RQIBLTEN(I,K,J)
    1885. 

  1885.          ENDDO
    1886. 

  1886.          ENDDO
    1887. 

  1887.          ENDDO
    1888. 

  1888.       ENDIF
    1889. 

  1889. 

  1890.     ENDIF
    1891. 

  1891. 

  1892. ! fdda
    1893. 

  1893. ! note fdda u and v tendencies are staggered, also only interior points have muu/muv,
    1894. 

  1894. !   so only couple those
    1895. 

  1895. 

  1896.    IF (config_flags%grid_fdda .gt. 0) THEN
    1897. 

  1897. 

  1898.       DO J=jts,jtf
    1899. 

  1899.       DO K=kts,ktf
    1900. 

  1900.       DO I=itsu,itf
    1901. 

  1901. !     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
    1902. 

  1902. !     write(*,'(a,3i6,e15.5)') 'u_ten before=',i,k,j, RUNDGDTEN(i,k,j)
    1903. 

  1903.          RUNDGDTEN(I,K,J) =muu(I,J)*RUNDGDTEN(I,K,J)
    1904. 

  1904. !        if( i == itf/2 .AND. j == jtf/2 .AND. k==ktf/2 ) &
    1905. 

  1905. !          write(*,'(a,2f15.5)') 'mu, muu=',mu(i,j), muu(i,j)
    1906. 

  1906. !     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
    1907. 

  1907. !     write(*,'(a,3i6,e15.5)') 'u_ten after=',i,k,j, RUNDGDTEN(i,k,j)
    1908. 

  1908. !     if( RUNDGDTEN(i,k,j) > 30.0 ) write(*,*) 'IKJ=',i,k,j
    1909. 

  1909.       ENDDO
    1910. 

  1910.       ENDDO
    1911. 

  1911.       ENDDO
    1912. 

  1912. !     write(*,'(a,e15.5)') 'u_ten MAXIMUM after=', maxval(RUNDGDTEN)
    1913. 

  1913.       DO J=jtsv,jtf
    1914. 

  1914.       DO K=kts,ktf
    1915. 

  1915.       DO I=its,itf
    1916. 

  1916.          RVNDGDTEN(I,K,J) =muv(I,J)*RVNDGDTEN(I,K,J)
    1917. 

  1917.       ENDDO
    1918. 

  1918.       ENDDO
    1919. 

  1919.       ENDDO
    1920. 

  1920.       DO J=jts,jtf
    1921. 

  1921.       DO K=kts,ktf
    1922. 

  1922.       DO I=its,itf
    1923. 

  1923. !     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
    1924. 

  1924. !     write(*,'(a,3i6,e15.5)') 'th before=',i,k,j, RTHNDGDTEN(I,K,J)
    1925. 

  1925.          RTHNDGDTEN(I,K,J)=mu(I,J)*RTHNDGDTEN(I,K,J)
    1926. 

  1926. !        RMUNDGDTEN(I,J) - no coupling
    1927. 

  1927. !     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
    1928. 

  1928. !     write(*,'(a,3i6,e15.5)') 'th after=',i,k,j, RTHNDGDTEN(I,K,J)
    1929. 

  1929.       ENDDO
    1930. 

  1930.       ENDDO
    1931. 

  1931.       ENDDO
    1932. 

  1932. 

  1933.       IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN
    1934. 

  1934.          DO J=jts,jtf
    1935. 

  1935.          DO K=kts,ktf
    1936. 

  1936.          DO I=its,itf
    1937. 

  1937.             RQVNDGDTEN(I,K,J)=mu(I,J)*RQVNDGDTEN(I,K,J)
    1938. 

  1938.          ENDDO
    1939. 

  1939.          ENDDO
    1940. 

  1940.          ENDDO
    1941. 

  1941.       ENDIF
    1942. 

  1942. 

  1943.     ENDIF
    1944. 

  1944. 

  1945. END SUBROUTINE calculate_phy_tend
    1946. 

  1946. 

  1947. !-----------------------------------------------------------------------
    1948. 

  1948. 

  1949. SUBROUTINE positive_definite_filter ( a,                          &
    1950. 

  1950.                                       ids,ide, jds,jde, kds,kde,  &
    1951. 

  1951.                                       ims,ime, jms,jme, kms,kme,  &
    1952. 

  1952.                                       its,ite, jts,jte, kts,kte  )
    1953. 

  1953. 

  1954.   IMPLICIT NONE
    1955. 

  1955. 

  1956.   INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
    1957. 

  1957.                                         ims,ime, jms,jme, kms,kme, &
    1958. 

  1958.                                         its,ite, jts,jte, kts,kte
    1959. 

  1959. 

  1960.   REAL, DIMENSION( ims:ime , kms:kme , jms:jme  ), INTENT(INOUT) :: a
    1961. 

  1961. 

  1962.   INTEGER :: i,k,j
    1963. 

  1963. 

  1964. !<DESCRIPTION>
    1965. 

  1965. !
    1966. 

  1966. ! debug and testing code for bounding a variable
    1967. 

  1967. !
    1968. 

  1968. !</DESCRIPTION>
    1969. 

  1969. 

  1970.   DO j=jts,min(jte,jde-1)
    1971. 

  1971.   DO k=kts,kte-1
    1972. 

  1972.   DO i=its,min(ite,ide-1)
    1973. 

  1973. !    a(i,k,j) = max(a(i,k,j),0.)
    1974. 

  1974.     a(i,k,j) = min(1000.,max(a(i,k,j),0.))
    1975. 

  1975.   ENDDO
    1976. 

  1976.   ENDDO
    1977. 

  1977.   ENDDO
    1978. 

  1978. 

  1979.   END SUBROUTINE positive_definite_filter
    1980. 

  1980. 

  1981. !-----------------------------------------------------------------------
    1982. 

  1982. 

  1983. SUBROUTINE bound_tke ( tke, tke_upper_bound,       &
    1984. 

  1984.                        ids,ide, jds,jde, kds,kde,  &
    1985. 

  1985.                        ims,ime, jms,jme, kms,kme,  &
    1986. 

  1986.                        its,ite, jts,jte, kts,kte  )
    1987. 

  1987. 

  1988.   IMPLICIT NONE
    1989. 

  1989. 

  1990.   INTEGER,  INTENT(IN   )   ::          ids,ide, jds,jde, kds,kde, &
    1991. 

  1991.                                         ims,ime, jms,jme, kms,kme, &
    1992. 

  1992.                                         its,ite, jts,jte, kts,kte
    1993. 

  1993. 

  1994.   REAL, DIMENSION( ims:ime , kms:kme , jms:jme  ), INTENT(INOUT) :: tke
    1995. 

  1995.   REAL, INTENT(   IN) :: tke_upper_bound
    1996. 

  1996. 

  1997.   INTEGER :: i,k,j
    1998. 

  1998. 

  1999. !<DESCRIPTION>
    2000. 

  2000. !
    2001. 

  2001. ! bounds tke between zero and tke_upper_bound.
    2002. 

  2002. !
    2003. 

  2003. !</DESCRIPTION>
    2004. 

  2004. 

  2005.   DO j=jts,min(jte,jde-1)
    2006. 

  2006.   DO k=kts,kte-1
    2007. 

  2007.   DO i=its,min(ite,ide-1)
    2008. 

  2008.     tke(i,k,j) = min(tke_upper_bound,max(tke(i,k,j),0.))
    2009. 

  2009.   ENDDO
    2010. 

  2010.   ENDDO
    2011. 

  2011.   ENDDO
    2012. 

  2012. 

  2013.   END SUBROUTINE bound_tke
    2014. 

  2014. 

  2015. 

  2016. 

  2017. END MODULE module_em
    2018. 

  2018.