PageRenderTime 841ms CodeModel.GetById 44ms RepoModel.GetById 2ms app.codeStats 1ms

/wrfv2_fire/phys/module_cu_tiedtke.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 3558 lines | 2424 code | 127 blank | 1007 comment | 44 complexity | 8096b897f66f6a9493ad2bce5123e39f MD5 | raw file
Possible License(s): AGPL-1.0

Large files files are truncated, but you can click here to view the full file

    

  1. !-----------------------------------------------------------------------
    2. 

  2. !
    3. 

  3. !WRF:MODEL_LAYER:PHYSICS
    4. 

  4. !
    5. 

  5. !####################TIEDTKE SCHEME#########################
    6. 

  6. !   Taken from the IPRC iRAM - Yuqing Wang, University of Hawaii
    7. 

  7. !   Added by Chunxi Zhang and Yuqing Wang to WRF3.2, May, 2010
    8. 

  8. !   refenrence: Tiedtke (1989, MWR, 117, 1779-1800)
    9. 

  9. !               Nordeng, T.E., (1995), CAPE closure and organized entrainment/detrainment
    10. 

  10. !               Yuqing Wang et al. (2003,J. Climate, 16, 1721-1738) for improvements 
    11. 

  11. !                                                  for cloud top detrainment 
    12. 

  12. !                       (2004, Mon. Wea. Rev., 132, 274-296), improvements for PBL clouds
    13. 

  13. !                        (2007,Mon. Wea. Rev., 135, 567-585), diurnal cycle of precipitation
    14. 

  14. !   This scheme is on testing
    15. 

  15. !###########################################################
    16. 

  16. MODULE module_cu_tiedtke
    17. 

  17. !
    18. 

  18. !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    19. 

  19. ! epsl--- allowed minimum value for floating calculation
    20. 

  20. !---------------------------------------------------------------
    21. 

  21.       real,parameter ::  epsl  = 1.0e-20
    22. 

  22.       real,parameter ::  t000  = 273.15
    23. 

  23.       real,parameter ::  hgfr  = 233.15   ! defined in param.f in explct
    24. 

  24. !-------------------------------------------------------------    
    25. 

  25. !  Ends the parameters set
    26. 

  26. !++++++++++++++++++++++++++++
    27. 

  27.      REAL,PRIVATE :: G,CPV
    28. 

  28.      REAL :: API,A,EOMEGA,RD,RV,CPD,RCPD,VTMPC1,VTMPC2,   &
    29. 

  29.              RHOH2O,ALV,ALS,ALF,CLW,TMELT,SOLC,STBO,DAYL,YEARL, &
    30. 

  30.              C1ES,C2ES,C3LES,C3IES,C4LES,C4IES,C5LES,C5IES,ZRG 
    31. 

  31.     
    32. 

  32.      REAL :: ENTRPEN,ENTRSCV,ENTRMID,ENTRDD,CMFCTOP,RHM,RHC,    &
    33. 

  33.              CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON,CRIRH,ZBUO0,  &
    34. 

  34.              fdbk,ZTAU
    35. 

  35.  
    36. 

  36.      INTEGER :: orgen,nturben,cutrigger
    37. 

  37. 

  38.      REAL :: CVDIFTS, CEVAPCU1, CEVAPCU2,ZDNOPRC
    39. 

  39.     
    40. 

  40.   
    41. 

  41.      PARAMETER(A=6371.22E03,                                    &
    42. 

  42.       ALV=2.5008E6,                 &                  
    43. 

  43.       ALS=2.8345E6,                 &
    44. 

  44.       ALF=ALS-ALV,                  &
    45. 

  45.       CPD=1005.46,                  &
    46. 

  46.       CPV=1869.46,                  & ! CPV in module is 1846.4
    47. 

  47.       RCPD=1.0/CPD,                 &
    48. 

  48.       RHOH2O=1.0E03,                & 
    49. 

  49.       TMELT=273.16,                 &
    50. 

  50.       G=9.806,                      & ! G=9.806
    51. 

  51.       ZRG=1.0/G,                    &
    52. 

  52.       RD=287.05,                    &
    53. 

  53.       RV=461.51,                    &
    54. 

  54.       C1ES=610.78,                  &
    55. 

  55.       C2ES=C1ES*RD/RV,              &
    56. 

  56.       C3LES=17.269,                 &
    57. 

  57.       C4LES=35.86,                  &
    58. 

  58.       C5LES=C3LES*(TMELT-C4LES),    &
    59. 

  59.       C3IES=21.875,                 &
    60. 

  60.       C4IES=7.66,                   &
    61. 

  61.       C5IES=C3IES*(TMELT-C4IES),    &
    62. 

  62.       API=3.141593,                 & ! API=2.0*ASIN(1.)
    63. 

  63.       VTMPC1=RV/RD-1.0,             &
    64. 

  64.       VTMPC2=CPV/CPD-1.0,           &
    65. 

  65.       CVDIFTS=1.0,                  &
    66. 

  66.       CEVAPCU1=1.93E-6*261.0*0.5/G, & 
    67. 

  67.       CEVAPCU2=1.E3/(38.3*0.293) )
    68. 

  68. 

  69.      
    70. 

  70. !                SPECIFY PARAMETERS FOR MASSFLUX-SCHEME
    71. 

  71. !                  --------------------------------------
    72. 

  72. !                   These are tunable parameters
    73. 

  73. !
    74. 

  74. !     ENTRPEN: AVERAGE ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
    75. 

  75. !     -------
    76. 

  76. !
    77. 

  77.       PARAMETER(ENTRPEN=1.0E-4)
    78. 

  78. !
    79. 

  79. !     ENTRSCV: AVERAGE ENTRAINMENT RATE FOR SHALLOW CONVECTION
    80. 

  80. !     -------
    81. 

  81. !
    82. 

  82.       PARAMETER(ENTRSCV=1.2E-3)
    83. 

  83. !
    84. 

  84. !     ENTRMID: AVERAGE ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
    85. 

  85. !     -------
    86. 

  86. !
    87. 

  87.       PARAMETER(ENTRMID=1.0E-4)
    88. 

  88. !
    89. 

  89. !     ENTRDD: AVERAGE ENTRAINMENT RATE FOR DOWNDRAFTS
    90. 

  90. !     ------
    91. 

  91. !
    92. 

  92.       PARAMETER(ENTRDD =2.0E-4)
    93. 

  93. !
    94. 

  94. !     CMFCTOP:   RELATIVE CLOUD MASSFLUX AT LEVEL ABOVE NONBUOYANCY LEVEL
    95. 

  95. !     -------
    96. 

  96. !
    97. 

  97.       PARAMETER(CMFCTOP=0.30)
    98. 

  98. !
    99. 

  99. !     CMFCMAX:   MAXIMUM MASSFLUX VALUE ALLOWED FOR UPDRAFTS ETC
    100. 

  100. !     -------
    101. 

  101. !
    102. 

  102.       PARAMETER(CMFCMAX=1.0)
    103. 

  103. !
    104. 

  104. !     CMFCMIN:   MINIMUM MASSFLUX VALUE (FOR SAFETY)
    105. 

  105. !     -------
    106. 

  106. !
    107. 

  107.       PARAMETER(CMFCMIN=1.E-10)
    108. 

  108. !
    109. 

  109. !     CMFDEPS:   FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
    110. 

  110. !     -------
    111. 

  111. !
    112. 

  112.       PARAMETER(CMFDEPS=0.30)
    113. 

  113. !
    114. 

  114. !     CPRCON:  COEFFICIENTS FOR DETERMINING CONVERSION FROM CLOUD WATER
    115. 

  115. !
    116. 

  116.       PARAMETER(CPRCON = 1.1E-3/G)
    117. 

  117. !
    118. 

  118. !     ZDNOPRC: The pressure depth below which no precipitation
    119. 

  119. !
    120. 

  120.       PARAMETER(ZDNOPRC =1.5E4)
    121. 

  121. !--------------------
    122. 

  122.      PARAMETER(orgen=1)   ! Old organized entrainment rate
    123. 

  123. !      PARAMETER(orgen=2)   ! New organized entrainment rate
    124. 

  124. 

  125.      PARAMETER(nturben=1) ! old deep turburent entrainment/detrainment rate
    126. 

  126. !      PARAMETER(nturben=2) ! New deep turburent entrainment/detrainment rate
    127. 

  127. 

  128.      PARAMETER(cutrigger=1) ! Old trigger function
    129. 

  129. !      PARAMETER(cutrigger=2) ! New trigger function
    130. 

  130. !
    131. 

  131. !--------------------
    132. 

  132.       PARAMETER(RHC=0.80,RHM=1.0,ZBUO0=0.50)
    133. 

  133. !--------------------
    134. 

  134.       PARAMETER(CRIRH=0.70,fdbk = 1.0,ZTAU = 1800.0)
    135. 

  135. !--------------------
    136. 

  136.       LOGICAL :: LMFPEN,LMFMID,LMFSCV,LMFDD,LMFDUDV
    137. 

  137.       PARAMETER(LMFPEN=.TRUE.,LMFMID=.TRUE.,LMFSCV=.TRUE.,LMFDD=.TRUE.,LMFDUDV=.TRUE.)
    138. 

  138. !--------------------
    139. 

  139. !#################### END of Variables definition##########################
    140. 

  140. !-----------------------------------------------------------------------
    141. 

  141. !
    142. 

  142. CONTAINS
    143. 

  143. !-----------------------------------------------------------------------
    144. 

  144.      SUBROUTINE CU_TIEDTKE(                                    &
    145. 

  145.                  DT,ITIMESTEP,STEPCU                            &
    146. 

  146.                 ,RAINCV,PRATEC,QFX,HFX,ZNU                      &
    147. 

  147.                 ,U3D,V3D,W,T3D,QV3D,QC3D,QI3D,PI3D,RHO3D        &
    148. 

  148.                 ,QVFTEN,QVPBLTEN                                &
    149. 

  149.                 ,DZ8W,PCPS,P8W,XLAND,CU_ACT_FLAG                &
    150. 

  150.                 ,CUDT, CURR_SECS, ADAPT_STEP_FLAG               &
    151. 

  151.                 ,CUDTACTTIME                                    &
    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.                 ,RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN            &
    156. 

  156.                 ,RUCUTEN, RVCUTEN                               &
    157. 

  157.                 ,F_QV    ,F_QC    ,F_QR    ,F_QI    ,F_QS       &
    158. 

  158.                                                                 )
    159. 

  159. !-------------------------------------------------------------------
    160. 

  160.       IMPLICIT NONE
    161. 

  161. !-------------------------------------------------------------------
    162. 

  162. !-- U3D         3D u-velocity interpolated to theta points (m/s)
    163. 

  163. !-- V3D         3D v-velocity interpolated to theta points (m/s)
    164. 

  164. !-- TH3D        3D potential temperature (K)
    165. 

  165. !-- T3D         temperature (K)
    166. 

  166. !-- QV3D        3D water vapor mixing ratio (Kg/Kg)
    167. 

  167. !-- QC3D        3D cloud mixing ratio (Kg/Kg)
    168. 

  168. !-- QI3D        3D ice mixing ratio (Kg/Kg)
    169. 

  169. !-- RHO3D       3D air density (kg/m^3)
    170. 

  170. !-- P8w         3D hydrostatic pressure at full levels (Pa)
    171. 

  171. !-- Pcps        3D hydrostatic pressure at half levels (Pa)
    172. 

  172. !-- PI3D        3D exner function (dimensionless)
    173. 

  173. !-- RTHCUTEN      Theta tendency due to 
    174. 

  174. !                 cumulus scheme precipitation (K/s)
    175. 

  175. !-- RUCUTEN       U wind tendency due to 
    176. 

  176. !                 cumulus scheme precipitation (K/s)
    177. 

  177. !-- RVCUTEN       V wind tendency due to 
    178. 

  178. !                 cumulus scheme precipitation (K/s)
    179. 

  179. !-- RQVCUTEN      Qv tendency due to 
    180. 

  180. !                 cumulus scheme precipitation (kg/kg/s)
    181. 

  181. !-- RQRCUTEN      Qr tendency due to 
    182. 

  182. !                 cumulus scheme precipitation (kg/kg/s)
    183. 

  183. !-- RQCCUTEN      Qc tendency due to 
    184. 

  184. !                 cumulus scheme precipitation (kg/kg/s)
    185. 

  185. !-- RQSCUTEN      Qs tendency due to 
    186. 

  186. !                 cumulus scheme precipitation (kg/kg/s)
    187. 

  187. !-- RQICUTEN      Qi tendency due to 
    188. 

  188. !                 cumulus scheme precipitation (kg/kg/s)
    189. 

  189. !-- RAINC         accumulated total cumulus scheme precipitation (mm)
    190. 

  190. !-- RAINCV        cumulus scheme precipitation (mm)
    191. 

  191. !-- PRATEC        precipitiation rate from cumulus scheme (mm/s)
    192. 

  192. !-- dz8w        dz between full levels (m)
    193. 

  193. !-- QFX         upward moisture flux at the surface (kg/m^2/s)
    194. 

  194. !-- DT          time step (s)
    195. 

  195. !-- ids         start index for i in domain
    196. 

  196. !-- ide         end index for i in domain
    197. 

  197. !-- jds         start index for j in domain
    198. 

  198. !-- jde         end index for j in domain
    199. 

  199. !-- kds         start index for k in domain
    200. 

  200. !-- kde         end index for k in domain
    201. 

  201. !-- ims         start index for i in memory
    202. 

  202. !-- ime         end index for i in memory
    203. 

  203. !-- jms         start index for j in memory
    204. 

  204. !-- jme         end index for j in memory
    205. 

  205. !-- kms         start index for k in memory
    206. 

  206. !-- kme         end index for k in memory
    207. 

  207. !-- its         start index for i in tile
    208. 

  208. !-- ite         end index for i in tile
    209. 

  209. !-- jts         start index for j in tile
    210. 

  210. !-- jte         end index for j in tile
    211. 

  211. !-- kts         start index for k in tile
    212. 

  212. !-- kte         end index for k in tile
    213. 

  213. !-------------------------------------------------------------------
    214. 

  214.       INTEGER, INTENT(IN) ::            ids,ide, jds,jde, kds,kde,      &
    215. 

  215.                                         ims,ime, jms,jme, kms,kme,      &
    216. 

  216.                                         its,ite, jts,jte, kts,kte,      &
    217. 

  217.                                         ITIMESTEP,                      &
    218. 

  218.                                         STEPCU
    219. 

  219. 

  220.       REAL,    INTENT(IN) ::                                            &
    221. 

  221.                                         DT
    222. 

  222. 

  223. 

  224.       REAL,    DIMENSION(ims:ime, jms:jme), INTENT(IN) ::               &
    225. 

  225.                                         XLAND
    226. 

  226. 

  227.       REAL,    DIMENSION(ims:ime, jms:jme), INTENT(INOUT) ::            &
    228. 

  228.                                         RAINCV, PRATEC
    229. 

  229. 

  230.       LOGICAL, DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) ::             &
    231. 

  231.                                         CU_ACT_FLAG
    232. 

  232. 

  233. 

  234.       REAL,    DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) ::      &
    235. 

  235.                                         DZ8W,                           &
    236. 

  236.                                         P8w,                            &
    237. 

  237.                                         Pcps,                           &
    238. 

  238.                                         PI3D,                           &
    239. 

  239.                                         QC3D,                           &
    240. 

  240.                                         QVFTEN,                         &
    241. 

  241.                                         QVPBLTEN,                       &
    242. 

  242.                                         QI3D,                           &
    243. 

  243.                                         QV3D,                           &
    244. 

  244.                                         RHO3D,                          &
    245. 

  245.                                         T3D,                            &
    246. 

  246.                                         U3D,                            &
    247. 

  247.                                         V3D,                            &
    248. 

  248.                                         W                              
    249. 

  249. 

  250. !--------------------------- OPTIONAL VARS ----------------------------
    251. 

  251.                                                                                                       
    252. 

  252.       REAL, DIMENSION(ims:ime, kms:kme, jms:jme),                       &
    253. 

  253.                OPTIONAL, INTENT(INOUT) ::                               &
    254. 

  254.                                         RQCCUTEN,                       &
    255. 

  255.                                         RQICUTEN,                       &
    256. 

  256.                                         RQVCUTEN,                       &
    257. 

  257.                                         RTHCUTEN,                       &
    258. 

  258.                                         RUCUTEN,                        &
    259. 

  259.                                         RVCUTEN
    260. 

  260.                                                                                                       
    261. 

  261. !
    262. 

  262. ! Flags relating to the optional tendency arrays declared above
    263. 

  263. ! Models that carry the optional tendencies will provdide the
    264. 

  264. ! optional arguments at compile time; these flags all the model
    265. 

  265. ! to determine at run-time whether a particular tracer is in
    266. 

  266. ! use or not.
    267. 

  267. !
    268. 

  268.      LOGICAL, OPTIONAL ::                                      &
    269. 

  269.                                                    F_QV      &
    270. 

  270.                                                   ,F_QC      &
    271. 

  271.                                                   ,F_QR      &
    272. 

  272.                                                   ,F_QI      &
    273. 

  273.                                                   ,F_QS
    274. 

  274.  
    275. 

  275. ! Adaptive time-step variables
    276. 

  276.       REAL,  INTENT(IN   ) :: CUDT
    277. 

  277.       REAL,  INTENT(IN   ) :: CURR_SECS
    278. 

  278.       LOGICAL,INTENT(IN   ) , OPTIONAL :: ADAPT_STEP_FLAG
    279. 

  279.       REAL,  INTENT (INOUT) :: CUDTACTTIME
    280. 

  280. 

  281. !--------------------------- LOCAL VARS ------------------------------
    282. 

  282. 

  283.       REAL,    DIMENSION(ims:ime, jms:jme) ::                           &
    284. 

  284.                                         QFX,                            &
    285. 

  285.                                         HFX        
    286. 

  286. 

  287.       REAL      ::                                      &
    288. 

  288.                                         DELT,                           &
    289. 

  289.                                         RDELT                          
    290. 

  290. 

  291.       REAL     , DIMENSION(its:ite) ::                  &
    292. 

  292.                                         RCS,                            &
    293. 

  293.                                         RN,                             &
    294. 

  294.                                         EVAP,                           &
    295. 

  295.                                         heatflux,                       &
    296. 

  296.                                         rho2d                            
    297. 

  297.       INTEGER  , DIMENSION(its:ite) ::  SLIMSK                         
    298. 

  298.       
    299. 

  299. 

  300.       REAL     , DIMENSION(its:ite, kts:kte+1) ::       &
    301. 

  301.                                         PRSI                            
    302. 

  302. 

  303.       REAL     , DIMENSION(its:ite, kts:kte) ::         &
    304. 

  304.                                         DEL,                            &
    305. 

  305.                                         DOT,                            &
    306. 

  306.                                         PHIL,                           &
    307. 

  307.                                         PRSL,                           &
    308. 

  308.                                         Q1,                             & 
    309. 

  309.                                         Q2,                             &
    310. 

  310.                                         Q3,                             &
    311. 

  311.                                         Q1B,                            &
    312. 

  312.                                         Q1BL,                           &
    313. 

  313.                                         Q11,                            &
    314. 

  314.                                         Q12,                            &  
    315. 

  315.                                         T1,                             & 
    316. 

  316.                                         U1,                             & 
    317. 

  317.                                         V1,                             & 
    318. 

  318.                                         ZI,                             & 
    319. 

  319.                                         ZL,                             &
    320. 

  320.                                         OMG,                            &
    321. 

  321.                                         GHT 
    322. 

  322. 

  323.       INTEGER, DIMENSION(its:ite) ::                                    &
    324. 

  324.                                         KBOT,                           &
    325. 

  325.                                         KTOP                           
    326. 

  326. 

  327.       INTEGER ::                                                        &
    328. 

  328.                                         I,                              &
    329. 

  329.                                         IM,                             &
    330. 

  330.                                         J,                              &
    331. 

  331.                                         K,                              &
    332. 

  332.                                         KM,                             &
    333. 

  333.                                         KP,                             &
    334. 

  334.                                         KX
    335. 

  335. 

  336. 

  337.       LOGICAL :: run_param, doing_adapt_dt , decided
    338. 

  338. 

  339. !-------other local variables----
    340. 

  340.       INTEGER,DIMENSION( its:ite ) :: KTYPE
    341. 

  341.       REAL, DIMENSION( kts:kte )   :: sig1      ! half sigma levels
    342. 

  342.       REAL, DIMENSION( kms:kme )   :: ZNU
    343. 

  343.       INTEGER                      :: zz 
    344. 

  344. !-----------------------------------------------------------------------
    345. 

  345. !
    346. 

  346. !
    347. 

  347. !***  CHECK TO SEE IF THIS IS A CONVECTION TIMESTEP
    348. 

  348. !
    349. 

  349. 

  350. !  Initialization for adaptive time step.
    351. 

  351. 

  352.    doing_adapt_dt = .FALSE.
    353. 

  353.    IF ( PRESENT(adapt_step_flag) ) THEN
    354. 

  354.       IF ( adapt_step_flag ) THEN
    355. 

  355.          doing_adapt_dt = .TRUE.
    356. 

  356.          IF ( cudtacttime .EQ. 0. ) THEN
    357. 

  357.             cudtacttime = curr_secs + cudt*60.
    358. 

  358.          END IF
    359. 

  359.       END IF
    360. 

  360.    END IF
    361. 

  361. 

  362. !  Do we run through this scheme or not?
    363. 

  363. 

  364. !    Test 1:  If this is the initial model time, then yes.
    365. 

  365. !                ITIMESTEP=1
    366. 

  366. !    Test 2:  If the user asked for the cumulus to be run every time step, then yes.
    367. 

  367. !                CUDT=0 or STEPCU=1
    368. 

  368. !    Test 3:  If not adaptive dt, and this is on the requested cumulus frequency, then yes.
    369. 

  369. !                MOD(ITIMESTEP,STEPCU)=0
    370. 

  370. !    Test 4:  If using adaptive dt and the current time is past the last requested activate cumulus time, then yes.
    371. 

  371. !                CURR_SECS >= CUDTACTTIME
    372. 

  372. 

  373. !  If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
    374. 

  374. !  to TRUE.  The decided flag says that one of these tests was able to say "yes", run the scheme.
    375. 

  375. !  We only proceed to other tests if the previous tests all have left decided as FALSE.
    376. 

  376. 

  377. !  If we set run_param to TRUE and this is adaptive time stepping, we set the time to the next
    378. 

  378. !  cumulus run.
    379. 

  379. 

  380.    decided = .FALSE.
    381. 

  381.    run_param = .FALSE.
    382. 

  382.    IF ( ( .NOT. decided ) .AND. &
    383. 

  383.         ( itimestep .EQ. 1 ) ) THEN
    384. 

  384.       run_param   = .TRUE.
    385. 

  385.       decided     = .TRUE.
    386. 

  386.    END IF
    387. 

  387. 

  388.    IF ( ( .NOT. decided ) .AND. &
    389. 

  389.         ( ( cudt .EQ. 0. ) .OR. ( stepcu .EQ. 1 ) ) ) THEN
    390. 

  390.       run_param   = .TRUE.
    391. 

  391.       decided     = .TRUE.
    392. 

  392.    END IF
    393. 

  393. 

  394.    IF ( ( .NOT. decided ) .AND. &
    395. 

  395.         ( .NOT. doing_adapt_dt ) .AND. &
    396. 

  396.         ( MOD(itimestep,stepcu) .EQ. 0 ) ) THEN
    397. 

  397.       run_param   = .TRUE.
    398. 

  398.       decided     = .TRUE.
    399. 

  399.    END IF
    400. 

  400. 

  401.    IF ( ( .NOT. decided ) .AND. &
    402. 

  402.         ( doing_adapt_dt ) .AND. &
    403. 

  403.         ( curr_secs .GE. cudtacttime ) ) THEN
    404. 

  404.       run_param   = .TRUE.
    405. 

  405.       decided     = .TRUE.
    406. 

  406.       cudtacttime = curr_secs + cudt*60
    407. 

  407.    END IF
    408. 

  408. 

  409. !-----------------------------------------------------------------------
    410. 

  410.    IF(run_param) THEN
    411. 

  411. 

  412.       DO J=JTS,JTE
    413. 

  413.          DO I=ITS,ITE
    414. 

  414.             CU_ACT_FLAG(I,J)=.TRUE.
    415. 

  415.          ENDDO
    416. 

  416.       ENDDO
    417. 

  417.  
    418. 

  418.       IM=ITE-ITS+1
    419. 

  419.       KX=KTE-KTS+1
    420. 

  420.       DELT=DT*STEPCU
    421. 

  421.       RDELT=1./DELT
    422. 

  422. 

  423. !-------------  J LOOP (OUTER) --------------------------------------------------
    424. 

  424. 

  425.    DO J=jts,jte
    426. 

  426. 

  427. ! --------------- compute zi and zl -----------------------------------------
    428. 

  428.       DO i=its,ite
    429. 

  429.         ZI(I,KTS)=0.0
    430. 

  430.       ENDDO
    431. 

  431. 

  432.       DO k=kts+1,kte
    433. 

  433.         KM=k-1
    434. 

  434.         DO i=its,ite
    435. 

  435.           ZI(I,K)=ZI(I,KM)+dz8w(i,km,j)
    436. 

  436.         ENDDO
    437. 

  437.       ENDDO
    438. 

  438. 

  439.       DO k=kts+1,kte
    440. 

  440.         KM=k-1
    441. 

  441.         DO i=its,ite
    442. 

  442.           ZL(I,KM)=(ZI(I,K)+ZI(I,KM))*0.5
    443. 

  443.         ENDDO
    444. 

  444.       ENDDO
    445. 

  445. 

  446.       DO i=its,ite
    447. 

  447.         ZL(I,KTE)=2.*ZI(I,KTE)-ZL(I,KTE-1)
    448. 

  448.       ENDDO
    449. 

  449. 

  450. ! --------------- end compute zi and zl -------------------------------------
    451. 

  451.       DO i=its,ite
    452. 

  452.         SLIMSK(i)=int(ABS(XLAND(i,j)-2.))
    453. 

  453.       ENDDO
    454. 

  454. 

  455.       DO k=kts,kte
    456. 

  456.         kp=k+1
    457. 

  457.         DO i=its,ite
    458. 

  458.           DOT(i,k)=-0.5*g*rho3d(i,k,j)*(w(i,k,j)+w(i,kp,j))
    459. 

  459.         ENDDO
    460. 

  460.       ENDDO
    461. 

  461. 

  462.       DO k=kts,kte
    463. 

  463.         zz = kte+1-k        
    464. 

  464.         DO i=its,ite
    465. 

  465.           U1(i,zz)=U3D(i,k,j)
    466. 

  466.           V1(i,zz)=V3D(i,k,j)
    467. 

  467.           T1(i,zz)=T3D(i,k,j)
    468. 

  468.           Q1(i,zz)= QV3D(i,k,j)
    469. 

  469.           if(itimestep == 1) then
    470. 

  470.              Q1B(i,zz)=0.
    471. 

  471.              Q1BL(i,zz)=0.
    472. 

  472.           else
    473. 

  473.              Q1B(i,zz)=QVFTEN(i,k,j)
    474. 

  474.              Q1BL(i,zz)=QVPBLTEN(i,k,j)
    475. 

  475.           endif
    476. 

  476.           Q2(i,zz)=QC3D(i,k,j)
    477. 

  477.           Q3(i,zz)=QI3D(i,k,j)
    478. 

  478.           OMG(i,zz)=DOT(i,k)
    479. 

  479.           GHT(i,zz)=ZL(i,k)
    480. 

  480.           PRSL(i,zz) = Pcps(i,k,j)
    481. 

  481.         ENDDO
    482. 

  482.       ENDDO
    483. 

  483. 

  484.       DO k=kts,kte+1
    485. 

  485.         zz = kte+2-k
    486. 

  486.         DO i=its,ite
    487. 

  487.           PRSI(i,zz) = P8w(i,k,j)
    488. 

  488.         ENDDO
    489. 

  489.       ENDDO 
    490. 

  490. 

  491.       DO k=kts,kte
    492. 

  492.          zz = kte+1-k
    493. 

  493.          sig1(zz) = ZNU(k)
    494. 

  494.       ENDDO
    495. 

  495. 

  496. !###############before call TIECNV, we need EVAP########################
    497. 

  497. !       EVAP is the vapor flux at the surface
    498. 

  498. !########################################################################
    499. 

  499. !
    500. 

  500.       DO i=its,ite
    501. 

  501.         EVAP(i) = QFX(i,j)
    502. 

  502.         heatflux(i)=HFX(i,j)
    503. 

  503.         rho2d(i) = rho3d(i,1,j)
    504. 

  504.       ENDDO
    505. 

  505. !########################################################################
    506. 

  506.       CALL TIECNV(U1,V1,T1,Q1,Q2,Q3,Q1B,Q1BL,GHT,OMG,PRSL,PRSI,EVAP,heatflux,rho2d,             &
    507. 

  507.                   RN,SLIMSK,KTYPE,IM,KX,KX+1,sig1,DELT)      
    508. 

  508. 

  509.       DO I=ITS,ITE
    510. 

  510.          RAINCV(I,J)=RN(I)/STEPCU
    511. 

  511.          PRATEC(I,J)=RN(I)/(STEPCU * DT)
    512. 

  512.       ENDDO
    513. 

  513. 

  514.       DO K=KTS,KTE
    515. 

  515.         zz = kte+1-k
    516. 

  516.         DO I=ITS,ITE
    517. 

  517.           RTHCUTEN(I,K,J)=(T1(I,zz)-T3D(I,K,J))/PI3D(I,K,J)*RDELT
    518. 

  518.           RQVCUTEN(I,K,J)=(Q1(I,zz)-QV3D(I,K,J))*RDELT
    519. 

  519.           RUCUTEN(I,K,J) =(U1(I,zz)-U3D(I,K,J))*RDELT
    520. 

  520.           RVCUTEN(I,K,J) =(V1(I,zz)-V3D(I,K,J))*RDELT 
    521. 

  521.         ENDDO
    522. 

  522.       ENDDO
    523. 

  523. 

  524.       IF(PRESENT(RQCCUTEN))THEN
    525. 

  525.         IF ( F_QC ) THEN
    526. 

  526.           DO K=KTS,KTE
    527. 

  527.             zz = kte+1-k
    528. 

  528.             DO I=ITS,ITE
    529. 

  529.               RQCCUTEN(I,K,J)=(Q2(I,zz)-QC3D(I,K,J))*RDELT
    530. 

  530.             ENDDO
    531. 

  531.           ENDDO
    532. 

  532.         ENDIF
    533. 

  533.       ENDIF
    534. 

  534. 

  535.       IF(PRESENT(RQICUTEN))THEN
    536. 

  536.         IF ( F_QI ) THEN
    537. 

  537.           DO K=KTS,KTE
    538. 

  538.             zz = kte+1-k
    539. 

  539.             DO I=ITS,ITE
    540. 

  540.               RQICUTEN(I,K,J)=(Q3(I,zz)-QI3D(I,K,J))*RDELT
    541. 

  541.             ENDDO
    542. 

  542.           ENDDO
    543. 

  543.         ENDIF
    544. 

  544.       ENDIF
    545. 

  545. 

  546. 

  547.    ENDDO
    548. 

  548. 

  549.    ENDIF
    550. 

  550. 

  551.    END SUBROUTINE CU_TIEDTKE
    552. 

  552. 

  553. !====================================================================
    554. 

  554.    SUBROUTINE tiedtkeinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,          &
    555. 

  555.                      RUCUTEN,RVCUTEN,                                   &
    556. 

  556.                      RESTART,P_QC,P_QI,P_FIRST_SCALAR,                  &
    557. 

  557.                      allowed_to_read,                                   &
    558. 

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

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

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

  561. !--------------------------------------------------------------------
    562. 

  562.    IMPLICIT NONE
    563. 

  563. !--------------------------------------------------------------------
    564. 

  564.    LOGICAL , INTENT(IN)           ::  allowed_to_read,restart
    565. 

  565.    INTEGER , INTENT(IN)           ::  ids, ide, jds, jde, kds, kde, &
    566. 

  566.                                       ims, ime, jms, jme, kms, kme, &
    567. 

  567.                                       its, ite, jts, jte, kts, kte
    568. 

  568.    INTEGER , INTENT(IN)           ::  P_FIRST_SCALAR, P_QI, P_QC
    569. 

  569. 

  570.    REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::  &
    571. 

  571.                                                               RTHCUTEN, &
    572. 

  572.                                                               RQVCUTEN, &
    573. 

  573.                                                               RQCCUTEN, &
    574. 

  574.                                                               RQICUTEN, &
    575. 

  575.                                                               RUCUTEN,RVCUTEN 
    576. 

  576. 

  577.    INTEGER :: i, j, k, itf, jtf, ktf
    578. 

  578. 

  579.    jtf=min0(jte,jde-1)
    580. 

  580.    ktf=min0(kte,kde-1)
    581. 

  581.    itf=min0(ite,ide-1)
    582. 

  582. 

  583.    IF(.not.restart)THEN
    584. 

  584.      DO j=jts,jtf
    585. 

  585.      DO k=kts,ktf
    586. 

  586.      DO i=its,itf
    587. 

  587.        RTHCUTEN(i,k,j)=0.
    588. 

  588.        RQVCUTEN(i,k,j)=0.
    589. 

  589.        RUCUTEN(i,k,j)=0.
    590. 

  590.        RVCUTEN(i,k,j)=0.
    591. 

  591.      ENDDO
    592. 

  592.      ENDDO
    593. 

  593.      ENDDO
    594. 

  594. 

  595.      IF (P_QC .ge. P_FIRST_SCALAR) THEN
    596. 

  596.         DO j=jts,jtf
    597. 

  597.         DO k=kts,ktf
    598. 

  598.         DO i=its,itf
    599. 

  599.            RQCCUTEN(i,k,j)=0.
    600. 

  600.         ENDDO
    601. 

  601.         ENDDO
    602. 

  602.         ENDDO
    603. 

  603.      ENDIF
    604. 

  604. 

  605.      IF (P_QI .ge. P_FIRST_SCALAR) THEN
    606. 

  606.         DO j=jts,jtf
    607. 

  607.         DO k=kts,ktf
    608. 

  608.         DO i=its,itf
    609. 

  609.            RQICUTEN(i,k,j)=0.
    610. 

  610.         ENDDO
    611. 

  611.         ENDDO
    612. 

  612.         ENDDO
    613. 

  613.      ENDIF
    614. 

  614.    ENDIF
    615. 

  615. 

  616.       END SUBROUTINE tiedtkeinit
    617. 

  617. 

  618. ! ------------------------------------------------------------------------
    619. 

  619. 

  620. !------------This is the combined version for tiedtke---------------
    621. 

  621. !----------------------------------------------------------------
    622. 

  622. !  In this module only the mass flux convection scheme of the ECMWF is included
    623. 

  623. !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    624. 

  624. !#############################################################
    625. 

  625. !
    626. 

  626. !             LEVEL 1 SUBROUTINEs
    627. 

  627. !
    628. 

  628. !#############################################################
    629. 

  629. !********************************************************
    630. 

  630. !        subroutine TIECNV
    631. 

  631. !********************************************************
    632. 

  632.       SUBROUTINE TIECNV(pu,pv,pt,pqv,pqc,pqi,pqvf,pqvbl,poz,pomg,  &
    633. 

  633.            pap,paph,evap,hfx,rho,zprecc,lndj,KTYPE,lq,km,km1,sig1,dt)
    634. 

  634. !-----------------------------------------------------------------
    635. 

  635. !  This is the interface between the meso-scale model and the mass 
    636. 

  636. !  flux convection module
    637. 

  637. !-----------------------------------------------------------------
    638. 

  638.       implicit none
    639. 

  639. 

  640.       real pu(lq,km),pv(lq,km),pt(lq,km),pqv(lq,km),pqvf(lq,km)
    641. 

  641.       real poz(lq,km),pomg(lq,km),evap(lq),zprecc(lq),pqvbl(lq,km)
    642. 

  642.       real PHHFL(lq),RHO(lq),hfx(lq)
    643. 

  643.       REAL PUM1(lq,km),    PVM1(lq,km),                             &
    644. 

  644.           PTTE(lq,km),    PQTE(lq,km),  PVOM(lq,km),  PVOL(lq,km),  &
    645. 

  645.           PVERV(lq,km),   PGEO(lq,km),  PAP(lq,km),   PAPH(lq,km1)
    646. 

  646.       REAL PQHFL(lq),      ZQQ(lq,km),   PAPRC(lq),    PAPRS(lq),   &
    647. 

  647.           PRSFC(lq),      PSSFC(lq),    PAPRSM(lq),   PCTE(lq,km)
    648. 

  648.       REAL ZTP1(lq,km),    ZQP1(lq,km),  ZTU(lq,km),   ZQU(lq,km),  &
    649. 

  649.           ZLU(lq,km),     ZLUDE(lq,km), ZMFU(lq,km),  ZMFD(lq,km),  &
    650. 

  650.           ZQSAT(lq,km),   pqc(lq,km),   pqi(lq,km),   ZRAIN(lq)
    651. 

  651. 

  652.       REAL sig(km1),sig1(km)
    653. 

  653.       INTEGER ICBOT(lq),   ICTOP(lq),     KTYPE(lq),   lndj(lq)
    654. 

  654.       REAL  dt
    655. 

  655.       LOGICAL LOCUM(lq)
    656. 

  656. 

  657.       real PSHEAT,PSRAIN,PSEVAP,PSMELT,PSDISS,TT
    658. 

  658.       real ZTMST,ZTPP1,fliq,fice,ZTC,ZALF
    659. 

  659.       integer i,j,k,lq,lp,km,km1
    660. 

  660. !      real TLUCUA
    661. 

  661. !      external TLUCUA
    662. 

  662. 

  663.       ZTMST=dt
    664. 

  664. !  Masv flux diagnostics.
    665. 

  665. 

  666.       PSHEAT=0.0
    667. 

  667.       PSRAIN=0.0
    668. 

  668.       PSEVAP=0.0
    669. 

  669.       PSMELT=0.0
    670. 

  670.       PSDISS=0.0
    671. 

  671.       DO 8 j=1,lq
    672. 

  672.         ZRAIN(j)=0.0
    673. 

  673.         LOCUM(j)=.FALSE.
    674. 

  674.         PRSFC(j)=0.0
    675. 

  675.         PSSFC(j)=0.0
    676. 

  676.         PAPRC(j)=0.0
    677. 

  677.         PAPRS(j)=0.0
    678. 

  678.         PAPRSM(j)=0.0
    679. 

  679.         PQHFL(j)=evap(j)
    680. 

  680.         PHHFL(j)=hfx(j)
    681. 

  681.     8 CONTINUE
    682. 

  682. 

  683. !     CONVERT MODEL VARIABLES FOR MFLUX SCHEME
    684. 

  684. 

  685.       DO 10 k=1,km
    686. 

  686.         DO 10 j=1,lq
    687. 

  687.           PTTE(j,k)=0.0
    688. 

  688.           PCTE(j,k)=0.0
    689. 

  689.           PVOM(j,k)=0.0
    690. 

  690.           PVOL(j,k)=0.0
    691. 

  691.           ZTP1(j,k)=pt(j,k)
    692. 

  692.           ZQP1(j,k)=pqv(j,k)/(1.0+pqv(j,k))
    693. 

  693.           PUM1(j,k)=pu(j,k)
    694. 

  694.           PVM1(j,k)=pv(j,k)
    695. 

  695.           PVERV(j,k)=pomg(j,k)
    696. 

  696.           PGEO(j,k)=G*poz(j,k)
    697. 

  697.           TT=ZTP1(j,k)
    698. 

  698.           ZQSAT(j,k)=TLUCUA(TT)/PAP(j,k)
    699. 

  699.           ZQSAT(j,k)=MIN(0.5,ZQSAT(j,k))
    700. 

  700.           ZQSAT(j,k)=ZQSAT(j,k)/(1.-VTMPC1*ZQSAT(j,k))
    701. 

  701.           PQTE(j,k)=pqvf(j,k)+pqvbl(j,k)
    702. 

  702.           ZQQ(j,k)=PQTE(j,k)
    703. 

  703.    10 CONTINUE
    704. 

  704. !
    705. 

  705. !-----------------------------------------------------------------------
    706. 

  706. !*    2.     CALL 'CUMASTR'(MASTER-ROUTINE FOR CUMULUS PARAMETERIZATION)
    707. 

  707. !
    708. 

  708.       CALL CUMASTR_NEW &
    709. 

  709.          (lq,       km,       km1,      km-1,    ZTP1,   &
    710. 

  710.           ZQP1,     PUM1,     PVM1,     PVERV,   ZQSAT,  &
    711. 

  711.           PQHFL,    ZTMST,    PAP,      PAPH,    PGEO,   &
    712. 

  712.           PTTE,     PQTE,     PVOM,     PVOL,    PRSFC,  & 
    713. 

  713.           PSSFC,    PAPRC,    PAPRSM,   PAPRS,   LOCUM,  &
    714. 

  714.           KTYPE,    ICBOT,    ICTOP,    ZTU,     ZQU,    &
    715. 

  715.           ZLU,      ZLUDE,    ZMFU,     ZMFD,    ZRAIN,  &
    716. 

  716.           PSRAIN,   PSEVAP,   PSHEAT,   PSDISS,  PSMELT, &
    717. 

  717.           PCTE,     PHHFL,       RHO,    sig1,     lndj)
    718. 

  718. !
    719. 

  719. !     TO INCLUDE THE CLOUD WATER AND CLOUD ICE DETRAINED FROM CONVECTION
    720. 

  720. !
    721. 

  721.       IF(fdbk.ge.1.0e-9) THEN
    722. 

  722.       DO 20 K=1,km
    723. 

  723.       DO 20 j=1,lq
    724. 

  724.       If(PCTE(j,k).GT.0.0) then
    725. 

  725.         ZTPP1=pt(j,k)+PTTE(j,k)*ZTMST
    726. 

  726.         if(ZTPP1.ge.t000) then
    727. 

  727.            fliq=1.0
    728. 

  728.            ZALF=0.0
    729. 

  729.         else if(ZTPP1.le.hgfr) then
    730. 

  730.            fliq=0.0
    731. 

  731.            ZALF=ALF
    732. 

  732.         else
    733. 

  733.            ZTC=ZTPP1-t000
    734. 

  734.            fliq=0.0059+0.9941*exp(-0.003102*ZTC*ZTC)
    735. 

  735.            ZALF=ALF
    736. 

  736.         endif
    737. 

  737.         fice=1.0-fliq
    738. 

  738.         pqc(j,k)=pqc(j,k)+fliq*PCTE(j,k)*ZTMST
    739. 

  739.         pqi(j,k)=pqi(j,k)+fice*PCTE(j,k)*ZTMST
    740. 

  740.         PTTE(j,k)=PTTE(j,k)-ZALF*RCPD*fliq*PCTE(j,k)
    741. 

  741.       Endif
    742. 

  742.    20 CONTINUE
    743. 

  743.       ENDIF
    744. 

  744. !
    745. 

  745.       DO 75 k=1,km
    746. 

  746.         DO 75 j=1,lq
    747. 

  747.           pt(j,k)=ZTP1(j,k)+PTTE(j,k)*ZTMST
    748. 

  748.           ZQP1(j,k)=ZQP1(j,k)+(PQTE(j,k)-ZQQ(j,k))*ZTMST
    749. 

  749.           pqv(j,k)=ZQP1(j,k)/(1.0-ZQP1(j,k))
    750. 

  750.    75 CONTINUE
    751. 

  751.       DO 85 j=1,lq
    752. 

  752.         zprecc(j)=amax1(0.0,(PRSFC(j)+PSSFC(j))*ZTMST)
    753. 

  753.    85 CONTINUE
    754. 

  754.       IF (LMFDUDV) THEN
    755. 

  755.         DO 100 k=1,km
    756. 

  756.           DO 100 j=1,lq
    757. 

  757.             pu(j,k)=pu(j,k)+PVOM(j,k)*ZTMST
    758. 

  758.             pv(j,k)=pv(j,k)+PVOL(j,k)*ZTMST
    759. 

  759.   100   CONTINUE
    760. 

  760.       ENDIF
    761. 

  761. !
    762. 

  762.       RETURN
    763. 

  763.       END SUBROUTINE TIECNV
    764. 

  764. 

  765. !#############################################################
    766. 

  766. !
    767. 

  767. !             LEVEL 2 SUBROUTINEs
    768. 

  768. !
    769. 

  769. !#############################################################
    770. 

  770. !***********************************************************
    771. 

  771. !           SUBROUTINE CUMASTR_NEW
    772. 

  772. !***********************************************************
    773. 

  773.       SUBROUTINE CUMASTR_NEW                             &
    774. 

  774.          (KLON,     KLEV,     KLEVP1,   KLEVM1,   PTEN,  &
    775. 

  775.           PQEN,     PUEN,     PVEN,     PVERV,    PQSEN, &
    776. 

  776.           PQHFL,    ZTMST,    PAP,      PAPH,     PGEO,  &
    777. 

  777.           PTTE,     PQTE,     PVOM,     PVOL,     PRSFC, &
    778. 

  778.           PSSFC,    PAPRC,    PAPRSM,   PAPRS,    LDCUM, &
    779. 

  779.           KTYPE,    KCBOT,    KCTOP,    PTU,      PQU,   &
    780. 

  780.           PLU,      PLUDE,    PMFU,     PMFD,     PRAIN, &
    781. 

  781.           PSRAIN,   PSEVAP,   PSHEAT,   PSDISS,   PSMELT,& 
    782. 

  782.           PCTE,     PHHFL,       RHO,     sig1,     lndj)
    783. 

  783. !
    784. 

  784. !***CUMASTR*  MASTER ROUTINE FOR CUMULUS MASSFLUX-SCHEME
    785. 

  785. !     M.TIEDTKE      E.C.M.W.F.     1986/1987/1989
    786. 

  786. !***PURPOSE
    787. 

  787. !   -------
    788. 

  788. !          THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE
    789. 

  789. !     PROGNOSTIC VARIABLES T,Q,U AND V DUE TO CONVECTIVE PROCESSES.
    790. 

  790. !     PROCESSES CONSIDERED ARE: CONVECTIVE FLUXES, FORMATION OF
    791. 

  791. !     PRECIPITATION, EVAPORATION OF FALLING RAIN BELOW CLOUD BASE,
    792. 

  792. !     SATURATED CUMULUS DOWNDRAFTS.
    793. 

  793. !***INTERFACE.
    794. 

  794. !   ----------
    795. 

  795. !          *CUMASTR* IS CALLED FROM *MSSFLX*
    796. 

  796. !     THE ROUTINE TAKES ITS INPUT FROM THE LONG-TERM STORAGE
    797. 

  797. !     T,Q,U,V,PHI AND P AND MOISTURE TENDENCIES.
    798. 

  798. !     IT RETURNS ITS OUTPUT TO THE SAME SPACE
    799. 

  799. !      1.MODIFIED TENDENCIES OF MODEL VARIABLES
    800. 

  800. !      2.RATES OF CONVECTIVE PRECIPITATION
    801. 

  801. !        (USED IN SUBROUTINE SURF)
    802. 

  802. !      3.CLOUD BASE, CLOUD TOP AND PRECIP FOR RADIATION
    803. 

  803. !        (USED IN SUBROUTINE CLOUD)
    804. 

  804. !***METHOD
    805. 

  805. !   ------
    806. 

  806. !     PARAMETERIZATION IS DONE USING A MASSFLUX-SCHEME.
    807. 

  807. !        (1) DEFINE CONSTANTS AND PARAMETERS
    808. 

  808. !        (2) SPECIFY VALUES (T,Q,QS...) AT HALF LEVELS AND
    809. 

  809. !            INITIALIZE UPDRAFT- AND DOWNDRAFT-VALUES IN 'CUINI'
    810. 

  810. !        (3) CALCULATE CLOUD BASE IN 'CUBASE'
    811. 

  811. !            AND SPECIFY CLOUD BASE MASSFLUX FROM PBL MOISTURE BUDGET
    812. 

  812. !        (4) DO CLOUD ASCENT IN 'CUASC' IN ABSENCE OF DOWNDRAFTS
    813. 

  813. !        (5) DO DOWNDRAFT CALCULATIONS:
    814. 

  814. !              (A) DETERMINE VALUES AT LFS IN 'CUDLFS'
    815. 

  815. !              (B) DETERMINE MOIST DESCENT IN 'CUDDRAF'
    816. 

  816. !              (C) RECALCULATE CLOUD BASE MASSFLUX CONSIDERING THE
    817. 

  817. !                  EFFECT OF CU-DOWNDRAFTS
    818. 

  818. !        (6) DO FINAL CLOUD ASCENT IN 'CUASC'
    819. 

  819. !        (7) DO FINAL ADJUSMENTS TO CONVECTIVE FLUXES IN 'CUFLX',
    820. 

  820. !            DO EVAPORATION IN SUBCLOUD LAYER
    821. 

  821. !        (8) CALCULATE INCREMENTS OF T AND Q IN 'CUDTDQ'
    822. 

  822. !        (9) CALCULATE INCREMENTS OF U AND V IN 'CUDUDV'
    823. 

  823. !***EXTERNALS.
    824. 

  824. !   ----------
    825. 

  825. !       CUINI:  INITIALIZES VALUES AT VERTICAL GRID USED IN CU-PARAMETR.
    826. 

  826. !       CUBASE: CLOUD BASE CALCULATION FOR PENETR.AND SHALLOW CONVECTION
    827. 

  827. !       CUASC:  CLOUD ASCENT FOR ENTRAINING PLUME
    828. 

  828. !       CUDLFS: DETERMINES VALUES AT LFS FOR DOWNDRAFTS
    829. 

  829. !       CUDDRAF:DOES MOIST DESCENT FOR CUMULUS DOWNDRAFTS
    830. 

  830. !       CUFLX:  FINAL ADJUSTMENTS TO CONVECTIVE FLUXES (ALSO IN PBL)
    831. 

  831. !       CUDQDT: UPDATES TENDENCIES FOR T AND Q
    832. 

  832. !       CUDUDV: UPDATES TENDENCIES FOR U AND V
    833. 

  833. !***SWITCHES.
    834. 

  834. !   --------
    835. 

  835. !          LMFPEN=.T.   PENETRATIVE CONVECTION IS SWITCHED ON
    836. 

  836. !          LMFSCV=.T.   SHALLOW CONVECTION IS SWITCHED ON
    837. 

  837. !          LMFMID=.T.   MIDLEVEL CONVECTION IS SWITCHED ON
    838. 

  838. !          LMFDD=.T.    CUMULUS DOWNDRAFTS SWITCHED ON
    839. 

  839. !          LMFDUDV=.T.  CUMULUS FRICTION SWITCHED ON
    840. 

  840. !***
    841. 

  841. !     MODEL PARAMETERS (DEFINED IN SUBROUTINE CUPARAM)
    842. 

  842. !     ------------------------------------------------
    843. 

  843. !     ENTRPEN    ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
    844. 

  844. !     ENTRSCV    ENTRAINMENT RATE FOR SHALLOW CONVECTION
    845. 

  845. !     ENTRMID    ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
    846. 

  846. !     ENTRDD     ENTRAINMENT RATE FOR CUMULUS DOWNDRAFTS
    847. 

  847. !     CMFCTOP    RELATIVE CLOUD MASSFLUX AT LEVEL ABOVE NONBUOYANCY
    848. 

  848. !                LEVEL
    849. 

  849. !     CMFCMAX    MAXIMUM MASSFLUX VALUE ALLOWED FOR
    850. 

  850. !     CMFCMIN    MINIMUM MASSFLUX VALUE (FOR SAFETY)
    851. 

  851. !     CMFDEPS    FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
    852. 

  852. !     CPRCON     COEFFICIENT FOR CONVERSION FROM CLOUD WATER TO RAIN
    853. 

  853. !***REFERENCE.
    854. 

  854. !   ----------
    855. 

  855. !          PAPER ON MASSFLUX SCHEME (TIEDTKE,1989)
    856. 

  856. !-----------------------------------------------------------------
    857. 

  857. !-------------------------------------------------------------------
    858. 

  858.       IMPLICIT NONE
    859. 

  859. !-------------------------------------------------------------------
    860. 

  860.       INTEGER   KLON, KLEV, KLEVP1
    861. 

  861.       INTEGER   KLEVM1
    862. 

  862.       REAL      ZTMST
    863. 

  863.       REAL      PSRAIN, PSEVAP, PSHEAT, PSDISS, PSMELT, ZCONS2
    864. 

  864.       INTEGER   JK,JL,IKB
    865. 

  865.       REAL      ZQUMQE, ZDQMIN, ZMFMAX, ZALVDCP, ZQALV
    866. 

  866.       REAL      ZHSAT, ZGAM, ZZZ, ZHHAT, ZBI, ZRO, ZDZ, ZDHDZ, ZDEPTH
    867. 

  867.       REAL      ZFAC, ZRH, ZPBMPT, DEPT, ZHT, ZEPS
    868. 

  868.       INTEGER   ICUM, ITOPM2
    869. 

  869.       REAL     PTEN(KLON,KLEV),        PQEN(KLON,KLEV), &
    870. 

  870.               PUEN(KLON,KLEV),        PVEN(KLON,KLEV),  &
    871. 

  871.               PTTE(KLON,KLEV),        PQTE(KLON,KLEV),  &
    872. 

  872.               PVOM(KLON,KLEV),        PVOL(KLON,KLEV),  &
    873. 

  873.               PQSEN(KLON,KLEV),       PGEO(KLON,KLEV),  &
    874. 

  874.               PAP(KLON,KLEV),         PAPH(KLON,KLEVP1),& 
    875. 

  875.               PVERV(KLON,KLEV),       PQHFL(KLON),      &
    876. 

  876.               PHHFL(KLON),            RHO(KLON)
    877. 

  877.       REAL     PTU(KLON,KLEV),         PQU(KLON,KLEV),  &
    878. 

  878.               PLU(KLON,KLEV),         PLUDE(KLON,KLEV), &
    879. 

  879.               PMFU(KLON,KLEV),        PMFD(KLON,KLEV),  &
    880. 

  880.               PAPRC(KLON),            PAPRS(KLON),      &
    881. 

  881.               PAPRSM(KLON),           PRAIN(KLON),      &
    882. 

  882.               PRSFC(KLON),            PSSFC(KLON)
    883. 

  883.       REAL     ZTENH(KLON,KLEV),       ZQENH(KLON,KLEV),&
    884. 

  884.               ZGEOH(KLON,KLEV),       ZQSENH(KLON,KLEV),&
    885. 

  885.               ZTD(KLON,KLEV),         ZQD(KLON,KLEV),   &
    886. 

  886.               ZMFUS(KLON,KLEV),       ZMFDS(KLON,KLEV), &
    887. 

  887.               ZMFUQ(KLON,KLEV),       ZMFDQ(KLON,KLEV), &
    888. 

  888.               ZDMFUP(KLON,KLEV),      ZDMFDP(KLON,KLEV),& 
    889. 

  889.               ZMFUL(KLON,KLEV),       ZRFL(KLON),       &
    890. 

  890.               ZUU(KLON,KLEV),         ZVU(KLON,KLEV),   &
    891. 

  891.               ZUD(KLON,KLEV),         ZVD(KLON,KLEV)
    892. 

  892.       REAL     ZENTR(KLON),            ZHCBASE(KLON),   &
    893. 

  893.               ZMFUB(KLON),            ZMFUB1(KLON),     &
    894. 

  894.               ZDQPBL(KLON),           ZDQCV(KLON) 
    895. 

  895.       REAL     ZSFL(KLON),             ZDPMEL(KLON,KLEV), &
    896. 

  896.               PCTE(KLON,KLEV),        ZCAPE(KLON),        &
    897. 

  897.               ZHEAT(KLON),            ZHHATT(KLON,KLEV),  &
    898. 

  898.               ZHMIN(KLON),            ZRELH(KLON)
    899. 

  899.       REAL     sig1(KLEV)
    900. 

  900.       INTEGER  ILAB(KLON,KLEV),        IDTOP(KLON),   &
    901. 

  901.               ICTOP0(KLON),           ILWMIN(KLON)    
    902. 

  902.       INTEGER  KCBOT(KLON),            KCTOP(KLON),   &
    903. 

  903.               KTYPE(KLON),            IHMIN(KLON),    &
    904. 

  904.               KTOP0,                  lndj(KLON)
    905. 

  905.       LOGICAL  LDCUM(KLON)
    906. 

  906.       LOGICAL  LODDRAF(KLON),          LLO1
    907. 

  907.       REAL     CRIRH1
    908. 

  908. !-------------------------------------------
    909. 

  909. !     1.    SPECIFY CONSTANTS AND PARAMETERS
    910. 

  910. !-------------------------------------------
    911. 

  911.   100 CONTINUE
    912. 

  912.       ZCONS2=1./(G*ZTMST)
    913. 

  913. !--------------------------------------------------------------
    914. 

  914. !*    2.    INITIALIZE VALUES AT VERTICAL GRID POINTS IN 'CUINI'
    915. 

  915. !--------------------------------------------------------------
    916. 

  916.   200 CONTINUE
    917. 

  917.       CALL CUINI &
    918. 

  918.          (KLON,     KLEV,     KLEVP1,   KLEVM1,   PTEN,  &
    919. 

  919.           PQEN,     PQSEN,    PUEN,     PVEN,     PVERV, &
    920. 

  920.           PGEO,     PAPH,     ZGEOH,    ZTENH,    ZQENH,  &
    921. 

  921.           ZQSENH,   ILWMIN,   PTU,      PQU,      ZTD,   &
    922. 

  922.           ZQD,      ZUU,      ZVU,      ZUD,      ZVD,   &
    923. 

  923.           PMFU,     PMFD,     ZMFUS,    ZMFDS,    ZMFUQ, &
    924. 

  924.           ZMFDQ,    ZDMFUP,   ZDMFDP,   ZDPMEL,   PLU,  &
    925. 

  925.           PLUDE,    ILAB)
    926. 

  926. !----------------------------------
    927. 

  927. !*    3.0   CLOUD BASE CALCULATIONS
    928. 

  928. !----------------------------------
    929. 

  929.   300 CONTINUE
    930. 

  930. !*         (A) DETERMINE CLOUD BASE VALUES IN 'CUBASE'
    931. 

  931. !          -------------------------------------------
    932. 

  932.       CALL CUBASE &
    933. 

  933.          (KLON,     KLEV,     KLEVP1,   KLEVM1,   ZTENH, &
    934. 

  934.           ZQENH,    ZGEOH,    PAPH,     PTU,      PQU,   &
    935. 

  935.           PLU,      PUEN,     PVEN,     ZUU,      ZVU,   &
    936. 

  936.           LDCUM,    KCBOT,    ILAB)
    937. 

  937. !*          (B) DETERMINE TOTAL MOISTURE CONVERGENCE AND
    938. 

  938. !*              THEN DECIDE ON TYPE OF CUMULUS CONVECTION
    939. 

  939. !               -----------------------------------------
    940. 

  940.        JK=1
    941. 

  941.        DO 310 JL=1,KLON
    942. 

  942.        ZDQCV(JL) =PQTE(JL,JK)*(PAPH(JL,JK+1)-PAPH(JL,JK))
    943. 

  943.        ZDQPBL(JL)=0.0
    944. 

  944.        IDTOP(JL)=0
    945. 

  945.   310  CONTINUE
    946. 

  946.        DO 320 JK=2,KLEV
    947. 

  947.        DO 315 JL=1,KLON
    948. 

  948.        ZDQCV(JL)=ZDQCV(JL)+PQTE(JL,JK)*(PAPH(JL,JK+1)-PAPH(JL,JK))
    949. 

  949.        IF(JK.GE.KCBOT(JL)) ZDQPBL(JL)=ZDQPBL(JL)+PQTE(JL,JK)  &
    950. 

  950.                                     *(PAPH(JL,JK+1)-PAPH(JL,JK))
    951. 

  951.   315 CONTINUE
    952. 

  952.   320 CONTINUE
    953. 

  953. 

  954.       if(cutrigger .eq. 1) then
    955. 

  955.         DO JL=1,KLON
    956. 

  956.          KTYPE(JL)=0
    957. 

  957.         IF(ZDQCV(JL).GT.MAX(0.,1.1*PQHFL(JL)*G)) THEN
    958. 

  958.          KTYPE(JL)=1
    959. 

  959.         ELSE
    960. 

  960.          KTYPE(JL)=2
    961. 

  961.         ENDIF
    962. 

  962.         END DO
    963. 

  963.       else if(cutrigger .eq. 2) then
    964. 

  964.          CALL CUTYPE  &
    965. 

  965.           ( KLON,     KLEV,     KLEVP1,   KLEVM1,  &
    966. 

  966.           ZTENH,   ZQENH,       ZQSENH,    ZGEOH,     PAPH,  &
    967. 

  967.           RHO,     PHHFL,         PQHFL,    KTYPE,    lndj   )
    968. 

  968.       end if
    969. 

  969. !*         (C) DETERMINE MOISTURE SUPPLY FOR BOUNDARY LAYER
    970. 

  970. !*             AND DETERMINE CLOUD BASE MASSFLUX IGNORING
    971. 

  971. !*             THE EFFECTS OF DOWNDRAFTS AT THIS STAGE
    972. 

  972. !              ------------------------------------------
    973. 

  973. !      do jl=1,klon
    974. 

  974. !        if(ktype(jl) .ge. 1 ) then
    975. 

  975. !              write(6,*)"ktype=", KTYPE(jl)
    976. 

  976. !        end if
    977. 

  977. !      end do
    978. 

  978. 

  979.       DO 340 JL=1,KLON
    980. 

  980.       IKB=KCBOT(JL)
    981. 

  981.       ZQUMQE=PQU(JL,IKB)+PLU(JL,IKB)-ZQENH(JL,IKB)
    982. 

  982.       ZDQMIN=MAX(0.01*ZQENH(JL,IKB),1.E-10)
    983. 

  983.       IF(ZDQPBL(JL).GT.0..AND.ZQUMQE.GT.ZDQMIN.AND.LDCUM(JL)) THEN
    984. 

  984.          ZMFUB(JL)=ZDQPBL(JL)/(G*MAX(ZQUMQE,ZDQMIN))
    985. 

  985.       ELSE
    986. 

  986.          ZMFUB(JL)=0.01
    987. 

  987.          LDCUM(JL)=.FALSE.
    988. 

  988.       ENDIF
    989. 

  989.       ZMFMAX=(PAPH(JL,IKB)-PAPH(JL,IKB-1))*ZCONS2
    990. 

  990.       ZMFUB(JL)=MIN(ZMFUB(JL),ZMFMAX)
    991. 

  991. !------------------------------------------------------
    992. 

  992. !*    4.0   DETERMINE CLOUD ASCENT FOR ENTRAINING PLUME
    993. 

  993. !------------------------------------------------------
    994. 

  994.   400 CONTINUE
    995. 

  995. !*         (A) ESTIMATE CLOUD HEIGHT FOR ENTRAINMENT/DETRAINMENT
    996. 

  996. !*             CALCULATIONS IN CUASC (MAX.POSSIBLE CLOUD HEIGHT
    997. 

  997. !*             FOR NON-ENTRAINING PLUME, FOLLOWING A.-S.,1974)
    998. 

  998. ! -------------------------------------------------------------
    999. 

  999.       IKB=KCBOT(JL)
    1000. 

  1000.       ZHCBASE(JL)=CPD*PTU(JL,IKB)+ZGEOH(JL,IKB)+ALV*PQU(JL,IKB)
    1001. 

  1001.       ICTOP0(JL)=KCBOT(JL)-1
    1002. 

  1002.   340 CONTINUE
    1003. 

  1003.       ZALVDCP=ALV/CPD
    1004. 

  1004.       ZQALV=1./ALV
    1005. 

  1005.       DO 420 JK=KLEVM1,3,-1
    1006. 

  1006.       DO 420 JL=1,KLON
    1007. 

  1007.       ZHSAT=CPD*ZTENH(JL,JK)+ZGEOH(JL,JK)+ALV*ZQSENH(JL,JK)
    1008. 

  1008.       ZGAM=C5LES*ZALVDCP*ZQSENH(JL,JK)/  &
    1009. 

  1009.           ((1.-VTMPC1*ZQSENH(JL,JK))*(ZTENH(JL,JK)-C4LES)**2)
    1010. 

  1010.       ZZZ=CPD*ZTENH(JL,JK)*0.608
    1011. 

  1011.       ZHHAT=ZHSAT-(ZZZ+ZGAM*ZZZ)/(1.+ZGAM*ZZZ*ZQALV)* &
    1012. 

  1012.                  MAX(ZQSENH(JL,JK)-ZQENH(JL,JK),0.)
    1013. 

  1013.       ZHHATT(JL,JK)=ZHHAT
    1014. 

  1014.       IF(JK.LT.ICTOP0(JL).AND.ZHCBASE(JL).GT.ZHHAT) ICTOP0(JL)=JK
    1015. 

  1015.   420 CONTINUE
    1016. 

  1016.       DO 430 JL=1,KLON
    1017. 

  1017.       JK=KCBOT(JL)
    1018. 

  1018.       ZHSAT=CPD*ZTENH(JL,JK)+ZGEOH(JL,JK)+ALV*ZQSENH(JL,JK)
    1019. 

  1019.       ZGAM=C5LES*ZALVDCP*ZQSENH(JL,JK)/   &
    1020. 

  1020.           ((1.-VTMPC1*ZQSENH(JL,JK))*(ZTENH(JL,JK)-C4LES)**2)
    1021. 

  1021.       ZZZ=CPD*ZTENH(JL,JK)*0.608
    1022. 

  1022.       ZHHAT=ZHSAT-(ZZZ+ZGAM*ZZZ)/(1.+ZGAM*ZZZ*ZQALV)* &
    1023. 

  1023.                  MAX(ZQSENH(JL,JK)-ZQENH(JL,JK),0.)
    1024. 

  1024.       ZHHATT(JL,JK)=ZHHAT
    1025. 

  1025.   430 CONTINUE
    1026. 

  1026. !
    1027. 

  1027. ! Find lowest possible org. detrainment level
    1028. 

  1028. !
    1029. 

  1029.       DO 440 JL = 1, KLON
    1030. 

  1030.          ZHMIN(JL) = 0.
    1031. 

  1031.          IF( LDCUM(JL).AND.KTYPE(JL).EQ.1 ) THEN
    1032. 

  1032.             IHMIN(JL) = KCBOT(JL)
    1033. 

  1033.          ELSE
    1034. 

  1034.             IHMIN(JL) = -1
    1035. 

  1035.          END IF
    1036. 

  1036.  440  CONTINUE 
    1037. 

  1037. !
    1038. 

  1038.       ZBI = 1./(25.*G)
    1039. 

  1039.       DO 450 JK = KLEV, 1, -1
    1040. 

  1040.       DO 450 JL = 1, KLON
    1041. 

  1041.       LLO1 = LDCUM(JL).AND.KTYPE(JL).EQ.1.AND.IHMIN(JL).EQ.KCBOT(JL)
    1042. 

  1042.       IF (LLO1.AND.JK.LT.KCBOT(JL).AND.JK.GE.ICTOP0(JL)) THEN
    1043. 

  1043.         IKB = KCBOT(JL)
    1044. 

  1044.         ZRO = RD*ZTENH(JL,JK)/(G*PAPH(JL,JK))
    1045. 

  1045.         ZDZ = (PAPH(JL,JK)-PAPH(JL,JK-1))*ZRO
    1046. 

  1046.         ZDHDZ=(CPD*(PTEN(JL,JK-1)-PTEN(JL,JK))+ALV*(PQEN(JL,JK-1)-   &
    1047. 

  1047.           PQEN(JL,JK))+(PGEO(JL,JK-1)-PGEO(JL,JK)))*G/(PGEO(JL,      &
    1048. 

  1048.           JK-1)-PGEO(JL,JK))
    1049. 

  1049.         ZDEPTH = ZGEOH(JL,JK) - ZGEOH(JL,IKB)
    1050. 

  1050.         ZFAC = SQRT(1.+ZDEPTH*ZBI)
    1051. 

  1051.         ZHMIN(JL) = ZHMIN(JL) + ZDHDZ*ZFAC*ZDZ
    1052. 

  1052.         ZRH = -ALV*(ZQSENH(JL,JK)-ZQENH(JL,JK))*ZFAC
    1053. 

  1053.         IF (ZHMIN(JL).GT.ZRH) IHMIN(JL) = JK
    1054. 

  1054.       END IF
    1055. 

  1055.  450  CONTINUE 
    1056. 

  1056.       DO 460 JL = 1, KLON
    1057. 

  1057.       IF (LDCUM(JL).AND.KTYPE(JL).EQ.1) THEN
    1058. 

  1058.         IF (IHMIN(JL).LT.ICTOP0(JL)) IHMIN(JL) = ICTOP0(JL)
    1059. 

  1059.       END IF
    1060. 

  1060.       IF(KTYPE(JL).EQ.1) THEN
    1061. 

  1061.         ZENTR(JL)=ENTRPEN
    1062. 

  1062.       ELSE
    1063. 

  1063.         ZENTR(JL)=ENTRSCV
    1064. 

  1064.       ENDIF
    1065. 

  1065.       if(lndj(JL).eq.1) ZENTR(JL)=ZENTR(JL)*1.05
    1066. 

  1066.  460  CONTINUE 
    1067. 

  1067. !*         (B) DO ASCENT IN 'CUASC'IN ABSENCE OF DOWNDRAFTS
    1068. 

  1068. !----------------------------------------------------------
    1069. 

  1069.       CALL CUASC_NEW &
    1070. 

  1070.          (KLON,     KLEV,     KLEVP1,   KLEVM1,   ZTENH,   &
    1071. 

  1071.           ZQENH,    PUEN,     PVEN,     PTEN,     PQEN,    &
    1072. 

  1072.           PQSEN,    PGEO,     ZGEOH,    PAP,      PAPH,    &
    1073. 

  1073.           PQTE,     PVERV,    ILWMIN,   LDCUM,    ZHCBASE, &
    1074. 

  1074.           KTYPE,    ILAB,     PTU,      PQU,      PLU,     &
    1075. 

  1075.           ZUU,      ZVU,      PMFU,     ZMFUB,    ZENTR,   &
    1076. 

  1076.           ZMFUS,    ZMFUQ,    ZMFUL,    PLUDE,    ZDMFUP,  &
    1077. 

  1077.           KCBOT,    KCTOP,    ICTOP0,   ICUM,     ZTMST,   &
    1078. 

  1078.           IHMIN,    ZHHATT,   ZQSENH)
    1079. 

  1079.       IF(ICUM.EQ.0) GO TO 1000
    1080. 

  1080. !*     (C) CHECK CLOUD DEPTH AND CHANGE ENTRAINMENT RATE ACCORDINGLY
    1081. 

  1081. !          CALCULATE PRECIPITATION RATE (FOR DOWNDRAFT CALCULATION)
    1082. 

  1082. !------------------------------------------------------------------
    1083. 

  1083.       DO 480 JL=1,KLON
    1084. 

  1084.       ZPBMPT=PAPH(JL,KCBOT(JL))-PAPH(JL,KCTOP(JL))
    1085. 

  1085.       IF(LDCUM(JL)) ICTOP0(JL)=KCTOP(JL)
    1086. 

  1086.       IF(LDCUM(JL).AND.KTYPE(JL).EQ.1.AND.ZPBMPT.LT.ZDNOPRC) KTYPE(JL)=2
    1087. 

  1087.       IF(KTYPE(JL).EQ.2) then
    1088. 

  1088.         ZENTR(JL)=ENTRSCV
    1089. 

  1089.         if(lndj(JL).eq.1) ZENTR(JL)=ZENTR(JL)*1.05
    1090. 

  1090.       endif
    1091. 

  1091.       ZRFL(JL)=ZDMFUP(JL,1)
    1092. 

  1092.   480 CONTINUE
    1093. 

  1093.       DO 490 JK=2,KLEV
    1094. 

  1094.       DO 490 JL=1,KLON
    1095. 

  1095.           ZRFL(JL)=ZRFL(JL)+ZDMFUP(JL,JK)
    1096. 

  1096.   490 CONTINUE
    1097. 

  1097. !-----------------------------------------
    1098. 

  1098. !*    5.0   CUMULUS DOWNDRAFT CALCULATIONS
    1099. 

  1099. !-----------------------------------------
    1100. 

  1100.   500 CONTINUE
    1101. 

  1101.       IF(LMFDD) THEN
    1102. 

  1102. !*      (A) DETERMINE LFS IN 'CUDLFS'
    1103. 

  1103. !--------------------------------------
    1104. 

  1104.          CALL CUDLFS &
    1105. 

  1105.          (KLON,     KLEV,     KLEVP1,   ZTENH,    ZQENH,  &
    1106. 

  1106.           PUEN,     PVEN,     ZGEOH,    PAPH,     PTU,    &
    1107. 

  1107.           PQU,      ZUU,      ZVU,      LDCUM,    KCBOT,  &
    1108. 

  1108.           KCTOP,    ZMFUB,    ZRFL,     ZTD,      ZQD,    &
    1109. 

  1109.           ZUD,      ZVD,      PMFD,     ZMFDS,    ZMFDQ,  &
    1110. 

  1110.           ZDMFDP,   IDTOP,    LODDRAF)
    1111. 

  1111. !*     (B)  DETERMINE DOWNDRAFT T,Q AND FLUXES IN 'CUDDRAF'
    1112. 

  1112. !------------------------------------------------------------
    1113. 

  1113.          CALL CUDDRAF &
    1114. 

  1114.          (KLON,     KLEV,     KLEVP1,   ZTENH,    ZQENH,  &
    1115. 

  1115.           PUEN,     PVEN,     ZGEOH,    PAPH,     ZRFL,   &
    1116. 

  1116.           LODDRAF,  ZTD,      ZQD,      ZUD,      ZVD,    &
    1117. 

  1117.           PMFD,     ZMFDS,    ZMFDQ,    ZDMFDP)
    1118. 

  1118. !*     (C)  RECALCULATE CONVECTIVE FLUXES DUE TO EFFECT OF
    1119. 

  1119. !           DOWNDRAFTS ON BOUNDARY LAYER MOISTURE BUDGET
    1120. 

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

  1121.       END IF
    1122. 

  1122. !
    1123. 

  1123. !-- 5.1 Recalculate cloud base massflux from a cape closure
    1124. 

  1124. !       for deep convection (ktype=1) and by PBL equilibrium
    1125. 

  1125. !       taking downdrafts into account for shallow convection
    1126. 

  1126. !       (ktype=2)
    1127. 

  1127. !       implemented by Y. WANG based on ECHAM4 in Nov. 2001.
    1128. 

  1128. !
    1129. 

  1129.       DO 510 JL=1,KLON
    1130. 

  1130.         ZHEAT(JL)=0.0
    1131. 

  1131.         ZCAPE(JL)=0.0
    1132. 

  1132.         ZRELH(JL)=0.0
    1133. 

  1133.         ZMFUB1(JL)=ZMFUB(JL)
    1134. 

  1134.   510 CONTINUE
    1135. 

  1135. !
    1136. 

  1136.       DO 511 JL=1,KLON
    1137. 

  1137.       IF(LDCUM(JL).AND.KTYPE(JL).EQ.1) THEN
    1138. 

  1138.       do jk=KLEVM1,2,-1
    1139. 

  1139.       if(abs(paph(jl,jk)*0.01 - 300) .lt. 50.) then
    1140. 

  1140.         KTOP0=MAX(jk,KCTOP(JL))
    1141. 

  1141.         exit
    1142. 

  1142.       end if
    1143. 

  1143.       end do
    1144. 

  1144. !      KTOP0=MAX(12,KCTOP(JL))
    1145. 

  1145.        DO JK=2,KLEV
    1146. 

  1146.        IF(JK.LE.KCBOT(JL).AND.JK.GT.KCTOP(JL)) THEN
    1147. 

  1147.          ZRO=PAPH(JL,JK)/(RD*ZTENH(JL,JK))
    1148. 

  1148.          ZDZ=(PAPH(JL,JK)-PAPH(JL,JK-1))/(G*ZRO)
    1149. 

  1149.          ZHEAT(JL)=ZHEAT(JL)+((PTEN(JL,JK-1)-PTEN(JL,JK)   &
    1150. 

  1150.            +G*ZDZ/CPD)/ZTENH(JL,JK)+0.608*(PQEN(JL,JK-1)-  &
    1151. 

  1151.            PQEN(JL,JK)))*(PMFU(JL,JK)+PMFD(JL,JK))*G/ZRO
    1152. 

  1152.          ZCAPE(JL)=ZCAPE(JL)+G*((PTU(JL,JK)*(1.+.608*PQU(JL,JK) &
    1153. 

  1153.            -PLU(JL,JK)))/(ZTENH(JL,JK)*(1.+.608*ZQENH(JL,JK))) &
    1154. 

  1154.            -1.0)*ZDZ
    1155. 

  1155.        ENDIF
    1156. 

  1156.        IF(JK.LE.KCBOT(JL).AND.JK.GT.KTOP0) THEN
    1157. 

  1157.          dept=(PAPH(JL,JK)-PAPH(JL,JK-1))/(PAPH(JL,KCBOT(JL))-  &
    1158. 

  1158.             PAPH(JL,KTOP0))
    1159. 

  1159.          ZRELH(JL)=ZRELH(JL)+dept*PQEN(JL,JK)/PQSEN(JL,JK)
    1160. 

  1160.        ENDIF
    1161. 

  1161.        ENDDO
    1162. 

  1162. !
    1163. 

  1163.        
    1164. 

  1164.        if(cutrigger .eq. 1 ) then 
    1165. 

  1165.          IF(lndj(JL).EQ.1) then
    1166. 

  1166.            CRIRH1=CRIRH*0.8
    1167. 

  1167.          ELSE
    1168. 

  1168.            CRIRH1=CRIRH
    1169. 

  1169.          ENDIF
    1170. 

  1170.        else
    1171. 

  1171.           CRIRH1=0.
    1172. 

  1172.        end if
    1173. 

  1173. 

  1174.        IF(ZRELH(JL).GE.CRIRH1 .AND. ZCAPE(JL) .GT. 100.) THEN
    1175. 

  1175.          IKB=KCBOT(JL)
    1176. 

  1176.          ZHT=ZCAPE(JL)/(ZTAU*ZHEAT(JL))
    1177. 

  1177.          ZMFUB1(JL)=MAX(ZMFUB(JL)*ZHT,0.01)
    1178. 

  1178.          ZMFMAX=(PAPH(JL,IKB)-PAPH(JL,IKB-1))*ZCONS2
    1179. 

  1179.          ZMFUB1(JL)=MIN(ZMFUB1(JL),ZMFMAX)
    1180. 

  1180.        ELSE
    1181. 

  1181.          ZMFUB1(JL)=0.01
    1182. 

  1182.          ZMFUB(JL)=0.01
    1183. 

  1183.          LDCUM(JL)=.FALSE.
    1184. 

  1184.         ENDIF
    1185. 

  1185.        ENDIF
    1186. 

  1186.   511  CONTINUE
    1187. 

  1187. !
    1188. 

  1188. !*  5.2   RECALCULATE CONVECTIVE FLUXES DUE TO EFFECT OF
    1189. 

  1189. !         DOWNDRAFTS ON BOUNDARY LAYER MOISTURE BUDGET
    1190. 

  1190. !--------------------------------------------------------
    1191. 

  1191.        DO 512 JL=1,KLON
    1192. 

  1192.         IF(KTYPE(JL).NE.1) THEN
    1193. 

  1193.            IKB=KCBOT(JL)
    1194. 

  1194.            IF(PMFD(JL,IKB).LT.0.0.AND.LODDRAF(JL)) THEN
    1195. 

  1195.               ZEPS=CMFDEPS
    1196. 

  1196.            ELSE
    1197. 

  1197.               ZEPS=0.
    1198. 

  1198.            ENDIF
    1199. 

  1199.            ZQUMQE=PQU(JL,IKB)+PLU(JL,IKB)-          &
    1200. 

  1200.                  ZEPS*ZQD(JL,IKB)-(1.-ZEPS)*ZQENH(JL,IKB)
    1201. 

  1201.            ZDQMIN=MAX(0.01*ZQENH(JL,IKB),1.E-10)
    1202. 

  1202.            ZMFMAX=(PAPH(JL,IKB)-PAPH(JL,IKB-1))*ZCONS2
    1203. 

  1203.            IF(ZDQPBL(JL).GT.0..AND.ZQUMQE.GT.ZDQMIN.AND.LDCUM(JL) &
    1204. 

  1204.              .AND.ZMFUB(JL).LT.ZMFMAX) THEN
    1205. 

  1205.               ZMFUB1(JL)=ZDQPBL(JL)/(G*MAX(ZQUMQE,ZDQMIN))
    1206. 

  1206.            ELSE
    1207. 

  1207.               ZMFUB1(JL)=ZMFUB(JL)
    1208. 

  1208.            ENDIF
    1209. 

  1209.            LLO1=(KTYPE(JL).EQ.2).AND.ABS(ZMFUB1(JL)  &
    1210. 

  1210.                 -ZMFUB(JL)).LT.0.2*ZMFUB(JL)
    1211. 

  1211.            IF(.NOT.LLO1) ZMFUB1(JL)=ZMFUB(JL)
    1212. 

  1212.            ZMFUB1(JL)=MIN(ZMFUB1(JL),ZMFMAX)
    1213. 

  1213.         END IF
    1214. 

  1214.   512   CONTINUE
    1215. 

  1215.         DO 530 JK=1,KLEV
    1216. 

  1216.         DO 530 JL=1,KLON
    1217. 

  1217.         IF(LDCUM(JL)) THEN
    1218. 

  1218.            ZFAC=ZMFUB1(JL)/MAX(ZMFUB(JL),1.E-10)
    1219. 

  1219.            PMFD(JL,JK)=PMFD(JL,JK)*ZFAC
    1220. 

  1220.            ZMFDS(JL,JK)=ZMFDS(JL,JK)*ZFAC
    1221. 

  1221.            ZMFDQ(JL,JK)=ZMFDQ(JL,JK)*ZFAC
    1222. 

  1222.            ZDMFDP(JL,JK)=ZDMFDP(JL,JK)*ZFAC
    1223. 

  1223.         ELSE
    1224. 

  1224.            PMFD(JL,JK)=0.0
    1225. 

  1225.            ZMFDS(JL,JK)=0.0
    1226. 

  1226.            ZMFDQ(JL,JK)=0.0
    1227. 

  1227.            ZDMFDP(JL,JK)=0.0
    1228. 

  1228.         ENDIF
    1229. 

  1229.   530   CONTINUE
    1230. 

  1230.         DO 538 JL=1,KLON
    1231. 

  1231.            IF(LDCUM(JL)) THEN
    1232. 

  1232.               ZMFUB(JL)=ZMFUB1(JL)
    1233. 

  1233.            ELSE
    1234. 

  1234.               ZMFUB(JL)=0.0
    1235. 

  1235.            ENDIF
    1236. 

  1236.   538   CONTINUE
    1237. 

  1237. !
    1238. 

  1238. !---------------------------------------------------------------
    1239. 

  1239. !*    6.0      DETERMINE FINAL CLOUD ASCENT FOR ENTRAINING PLUME
    1240. 

  1240. !*             FOR PENETRATIVE CONVECTION (TYPE=1),
    1241. 

  1241. !*             FOR SHALLOW TO MEDIUM CONVECTION (TYPE=2)
    1242. 

  1242. !*             AND FOR MID-LEVEL CONVECTION (TYPE=3).
    1243. 

  1243. !---------------------------------------------------------------
    1244. 

  1244.   600 CONTINUE
    1245. 

  1245.       CALL CUASC_NEW &
    1246. 

  1246.          (KLON,     KLEV,     KLEVP1,   KLEVM1,   ZTENH,  &
    1247. 

  1247.           ZQENH,    PUEN,     PVEN,     PTEN,     PQEN,   &
    1248. 

  1248.           PQSEN,    PGEO,     ZGEOH,    PAP,      PAPH,   &
    1249. 

  1249.           PQTE,     PVERV,    ILWMIN,   LDCUM,    ZHCBASE,& 
    1250. 

  1250.           KTYPE,    ILAB,     PTU,      PQU,      PLU,    &
    1251. 

  1251.           ZUU,      ZVU,      PMFU,     ZMFUB,    ZENTR,  &
    1252. 

  1252.           ZMFUS,    ZMFUQ,    ZMFUL,    PLUDE,    ZDMFUP, &
    1253. 

  1253.           KCBOT,    KCTOP,    ICTOP0,   ICUM,     ZTMST,  &
    1254. 

  1254.           IHMIN,    ZHHATT,   ZQSENH)
    1255. 

  1255. !----------------------------------------------------------
    1256. 

  1256. !*    7.0      DETERMINE FINAL CONVECTIVE FLUXES IN 'CUFLX'
    1257. 

  1257. !----------------------------------------------------------
    1258. 

  1258.   700 CONTINUE
    1259. 

  1259.       CALL CUFLX &
    1260. 

  1260.          (KLON,     KLEV,     KLEVP1,   PQEN,     PQSEN,  &
    1261. 

  1261.           ZTENH,    ZQENH,    PAPH,     ZGEOH,    KCBOT,  &
    1262. 

  1262.           KCTOP,    IDTOP,    KTYPE,    LODDRAF,  LDCUM,  &
    1263. 

  1263.           PMFU,     PMFD,     ZMFUS,    ZMFDS,    ZMFUQ,  &
    1264. 

  1264.           ZMFDQ,    ZMFUL,    PLUDE,    ZDMFUP,   ZDMFDP, &
    1265. 

  1265.           ZRFL,     PRAIN,    PTEN,     ZSFL,     ZDPMEL, &
    1266. 

  1266.           ITOPM2,   ZTMST,    sig1)
    1267. 

  1267. !----------------------------------------------------------------
    1268. 

  1268. !*    8.0      UPDATE TENDENCIES FOR T AND Q IN SUBROUTINE CUDTDQ
    1269. 

  1269. !----------------------------------------------------------------
    1270. 

  1270.   800 CONTINUE
    1271. 

  1271.       CALL CUDTDQ                                          &
    1272. 

  1272.          (KLON,     KLEV,     KLEVP1,   ITOPM2,   PAPH,    &
    1273. 

  1273.           LDCUM,    PTEN,     PTTE,     PQTE,     ZMFUS,   &
    1274. 

  1274.           ZMFDS,    ZMFUQ,    ZMFDQ,    ZMFUL,    ZDMFUP,  &
    1275. 

  1275.           ZDMFDP,   ZTMST,    ZDPMEL,   PRAIN,    ZRFL,    &
    1276. 

  1276. …
    1277.

Large files files are truncated, but you can click here to view the full file