PageRenderTime 52ms CodeModel.GetById 16ms RepoModel.GetById 1ms app.codeStats 0ms

/wrfv2_fire/phys/module_bl_mfshconvpbl.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 2762 lines | 1452 code | 491 blank | 819 comment | 0 complexity | 73cea942faaa30204009a0d19e3208f1 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1.      MODULE MODULE_BL_MFSHCONVPBL
    2. 

  2. 

  3. 

  4. 

  5. 

  6. USE MODULE_MODEL_CONSTANTS
    7. 

  7. 

  8. REAL,PARAMETER :: XG      = 9.80665
    9. 

  9. 

  10. REAL,PARAMETER :: XP00= 1.E5               ! Reference pressure
    11. 

  11. !
    12. 

  12. !
    13. 

  13. REAL,PARAMETER :: XMD= 28.9644E-3
    14. 

  14. REAL,PARAMETER :: XMV= 18.0153E-3            ! Molar mass of dry air and molar mass of vapor
    15. 

  15. REAL,PARAMETER :: XRD=R_D
    16. 

  16. REAL,PARAMETER :: XRV=R_V        ! Gaz constant for dry air, gaz constant for vapor
    17. 

  17. REAL,PARAMETER :: XCPD=7.* XRD /2.
    18. 

  18. REAL,PARAMETER :: XCPV=4.* XRV          ! Cpd (dry air), Cpv (vapor)
    19. 

  19. REAL,PARAMETER :: XCL= 4.218E+3
    20. 

  20. REAL,PARAMETER :: XCI= 2.106E+3      ! Cl (liquid), Ci (ice)
    21. 

  21. REAL,PARAMETER :: XTT= 273.16        ! Triple point temperature
    22. 

  22. REAL,PARAMETER :: XLVTT=2.5008E+6              ! Vaporization heat constant
    23. 

  23. REAL,PARAMETER :: XLSTT=2.8345E+6   ! Sublimation heat constant
    24. 

  24.                                !  temperature
    25. 

  25. REAL,PARAMETER :: XGAMW = (XCL - XCPV) / XRV! Constants for saturation vapor
    26. 

  26. REAL,PARAMETER :: XBETAW= (XLVTT/XRV) + (XGAMW * XTT)
    27. 

  27. !The use of intrinsics in an initialization expressions is a F2003 feature.
    28. 

  28. !For backward compatibility, hard coded Log(644.11) & Log(XTT) here
    29. 

  29. !REAL,PARAMETER :: XALPW= LOG(611.14) + (XBETAW /XTT) + (XGAMW *LOG(XTT))
    30. 

  30. REAL,PARAMETER :: LOG_611_14 = 6.415326
    31. 

  31. REAL,PARAMETER :: LOG_XTT    = 5.610058
    32. 

  32. REAL,PARAMETER :: XALPW= LOG_611_14 + (XBETAW /XTT) + (XGAMW *LOG_XTT)
    33. 

  33.                                 !  pressure  function
    34. 

  34. REAL,PARAMETER :: XGAMI  = (XCI - XCPV) / XRV
    35. 

  35. REAL,PARAMETER :: XBETAI = (XLSTT/XRV) + (XGAMI * XTT)
    36. 

  36. !REAL,PARAMETER :: XALPI  = LOG(611.14) + (XBETAI /XTT) + (XGAMI *LOG(XTT))
    37. 

  37. REAL,PARAMETER :: XALPI  = LOG_611_14 + (XBETAI /XTT) + (XGAMI *LOG_XTT)
    38. 

  38. REAL,PARAMETER :: XLINI = 0.32
    39. 

  39. 

  40. 

  41. REAL, PARAMETER :: XALP_PERT   = 0.3  ! coefficient for the perturbation of
    42. 

  42.                    ! theta_l and r_t at the first level of
    43. 

  43.                    ! the updraft
    44. 

  44. REAL, PARAMETER ::XABUO       = 1.   ! coefficient of the buoyancy term in the w_up equation
    45. 

  45. REAL, PARAMETER ::XBENTR      = 1.   ! coefficient of the entrainment term in thew_up equation
    46. 

  46. REAL, PARAMETER ::XBDETR      = 0.   ! coefficient of the detrainment term in thew_up equation
    47. 

  47. 

  48. 

  49. REAL, PARAMETER ::XCMF        = 0.065! coefficient for the mass flux at the firstlevel 0.065
    50. 

  50.                                 ! of the updraft (closure) XCMF        = 0.065
    51. 

  51. REAL, PARAMETER ::XENTR_DRY   = 0.55 ! coefficient for entrainment in dry part XENTR_DRY   = 0.55
    52. 

  52. REAL, PARAMETER ::XDETR_DRY   = 10.  ! coefficient for detrainment in dry part XDETR_DRY   = 10.
    53. 

  53. REAL, PARAMETER ::XDETR_LUP   = 1.0   !  coefficient for detrainment in dry part XDETR_LUP   = 1.
    54. 

  54. 

  55. REAL, PARAMETER ::XENTR_MF    = 0.035! entrainment constant (m/Pa) = 0.2 (m)  XENTR_MF    = 0.035
    56. 

  56. REAL, PARAMETER ::XCRAD_MF    = 50.  ! cloud radius in cloudy part
    57. 

  57. REAL, PARAMETER ::XKCF_MF     = 2.75 ! coefficient for cloud fraction
    58. 

  58. REAL, PARAMETER ::XKRC_MF     = 1.   ! coefficient for convective rc
    59. 

  59. REAL, PARAMETER ::XTAUSIGMF   = 600.
    60. 

  60. REAL, PARAMETER ::XPRES_UV    = 0.5  ! coefficient for pressure term in wind mixing
    61. 

  61. !
    62. 

  62. REAL, PARAMETER ::XFRAC_UP_MAX= 0.33 ! maximum Updraft fraction
    63. 

  63. 

  64. 

  65. !
    66. 

  66. 

  67.      CONTAINS
    68. 

  68. 

  69. 

  70.       SUBROUTINE MFSHCONVPBL (DT,STEPBL,HT,DZ           &
    71. 

  71.                     ,RHO,PMID,PINT,TH,EXNER             &
    72. 

  72.                     ,QV, QC, U, V                       &
    73. 

  73.                     ,HFX, QFX, TKE                      &
    74. 

  74.                     ,RUBLTEN,RVBLTEN,RTHBLTEN           &
    75. 

  75.                     ,RQVBLTEN,RQCBLTEN                  &
    76. 

  76.                     ,IDS,IDE,JDS,JDE,KDS,KDE            &
    77. 

  77.                     ,IMS,IME,JMS,JME,KMS,KME            &
    78. 

  78.                     ,ITS,ITE,JTS,JTE,KTS,KTE,KRR        &
    79. 

  79.                     ,MASSFLUX_EDKF, ENTR_EDKF, DETR_EDKF & 
    80. 

  80.                     ,THL_UP, THV_UP, RT_UP, RV_UP       &
    81. 

  81.                     ,RC_UP, U_UP, V_UP, FRAC_UP, RC_MF  &
    82. 

  82.                     ,WTHV,PLM_BL89 )                   
    83. 

  83.  
    84. 

  84.       IMPLICIT NONE
    85. 

  85. !
    86. 

  86. !----------------------------------------------------------------------
    87. 

  87.       INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
    88. 

  88.      &                     ,IMS,IME,JMS,JME,KMS,KME                    &
    89. 

  89.      &                     ,ITS,ITE,JTS,JTE,KTS,KTE
    90. 

  90. !
    91. 

  91.       INTEGER,INTENT(IN) :: KRR
    92. 

  92. 

  93.       INTEGER,INTENT(IN) :: STEPBL
    94. 

  94. 

  95.       REAL,INTENT(IN) :: DT
    96. 

  96. !
    97. 

  97.       REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HT, HFX, QFX
    98. 

  98. !
    99. 

  99.       REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DZ          &
    100. 

  100.      &                                                     ,EXNER       &
    101. 

  101.      &                                                     ,PMID,PINT   &
    102. 

  102.      &                                                     ,QV,QC,RHO   &
    103. 

  103.      &                                                     ,TH,U,V,TKE   
    104. 

  104. !
    105. 

  105.       REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: RQCBLTEN,RQVBLTEN       &
    106. 

  106.      &                                        ,RTHBLTEN                                &
    107. 

  107.      &                                        ,RUBLTEN,RVBLTEN        
    108. 

  108.   
    109. 

  109.       REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),OPTIONAL,INTENT(OUT) ::              &
    110. 

  110.      &                                         MASSFLUX_EDKF, ENTR_EDKF, DETR_EDKF &
    111. 

  111.      &                                        ,THL_UP, THV_UP, RT_UP, RV_UP        &
    112. 

  112.      &                                        ,RC_UP, U_UP, V_UP, FRAC_UP
    113. 

  113. 

  114.       REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),OPTIONAL,INTENT(INOUT) ::            &
    115. 

  115.      &                                         RC_MF
    116. 

  116. 

  117.       REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) ::   WTHV
    118. 

  118.       REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) ::   PLM_BL89
    119. 

  119. 

  120. !
    121. 

  121. !Local declaration
    122. 

  122. 

  123. INTEGER   :: KRRL      ! number of liquid water var.
    124. 

  124. INTEGER   :: KRRI      ! number of ice water var.
    125. 

  125. LOGICAL   :: OMIXUV    ! True if mixing of momentum
    126. 

  126. 

  127. REAL   :: PIMPL_MF     ! degre of implicitness
    128. 

  128. REAL   ::  PTSTEP   ! Dynamical timestep 
    129. 

  129. REAL   ::  PTSTEP_MET! Timestep for meteorological variables                        
    130. 

  130. 

  131. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)   :: PZZ       !  Height at the flux point
    132. 

  132. 

  133. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)   :: PZZM      !  Height at the mass point
    134. 

  134. 

  135. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)   :: PDZZ      ! depth between mass levels 
    136. 

  136.  
    137. 

  137. REAL, DIMENSION(ITS:ITE,JTS:JTE)   ::  PSFTH,PSFRV
    138. 

  138.                                             ! normal surface fluxes of theta,rv
    139. 

  139. !
    140. 

  140. !    prognostic variables at t- deltat
    141. 

  141. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE) ::  PPABSM      ! Pressure at mass point
    142. 

  142. !REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE) ::  PPABSF    ! Pressure at flux point
    143. 

  143. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE) ::  PEXNM       ! Exner function at t-dt
    144. 

  144. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE) ::  PRHODREF    ! dry density of the
    145. 

  145.                                                      ! reference state
    146. 

  146. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE) ::  PRHODJ    ! dry density of the
    147. 

  147. 

  148. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE) ::  PTKEM       ! TKE
    149. 

  149. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE) ::  PUM,PVM     ! momentum
    150. 

  150. 

  151. !   thermodynamical variables which are transformed in conservative var.
    152. 

  152. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)     ::  PTHM       ! pot. temp. = PTHLM in turb.f90
    153. 

  153. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE,KRR) ::  PRM        ! water species 
    154. 

  154. 

  155. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)     ::  PRUS,PRVS,PRTHS 
    156. 

  156. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE,KRR) ::  PRRS
    157. 

  157. 

  158. ! For diagnostic output
    159. 

  159. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)     :: PEMF, PENTR, PDETR
    160. 

  160. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)     :: PTHL_UP, PRT_UP, PRV_UP, PRC_UP
    161. 

  161. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)     :: PU_UP, PV_UP, PTHV_UP, PFRAC_UP                   
    162. 

  162. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)     :: PRC_MF
    163. 

  163. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)     :: WTHV_MF
    164. 

  164. REAL, DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE)     :: PLM_MF
    165. 

  165. 

  166. INTEGER :: I,J,K  ! loop variables
    167. 

  167.       
    168. 

  168. ! Transform WRF Variable to input of mass flux scheme
    169. 

  169. 

  170. DO J=JTS,JTE
    171. 

  171.    DO K=KTS,KTE
    172. 

  172.       DO I=ITS,ITE
    173. 

  173.         IF (K==KTS) PZZ(I,J,K)=0.
    174. 

  174.         PEMF(I,J,K)=0.
    175. 

  175.         PENTR(I,J,K)=0.
    176. 

  176.         PDETR(I,J,K)=0.
    177. 

  177.         PTHL_UP(I,J,K)=0.
    178. 

  178.         PTHV_UP(I,J,K)=0.
    179. 

  179.         PRT_UP(I,J,K)=0.
    180. 

  180.         PRV_UP(I,J,K)=0.
    181. 

  181.         PRC_UP(I,J,K)=0.
    182. 

  182.         PU_UP(I,J,K)=0.
    183. 

  183.         PV_UP(I,J,K)=0.
    184. 

  184.         PFRAC_UP(I,J,K)=0.
    185. 

  185.         WTHV_MF(I,J,K)=0.
    186. 

  186.         PTHM(I,J,K)=TH(I,K,J)
    187. 

  187.         PTKEM(I,J,K)=TKE(I,K,J)
    188. 

  188.         PRM(I,J,K,1)=QV(I,K,J)-RC_MF(I,K,J)
    189. 

  189.         PRM(I,J,K,2)=RC_MF(I,K,J)
    190. 

  190.         PUM(I,J,K)=U(I,K,J)
    191. 

  191.         PVM(I,J,K)=V(I,K,J)
    192. 

  192.         PRHODREF(I,J,K)=RHO(I,K,J)/(1.+QV(I,K,J))
    193. 

  193.         PEXNM(I,J,K)=EXNER(I,K,J)
    194. 

  194.         PPABSM(I,J,K)=PMID(I,K,J)
    195. 

  195.         IF (K/=KTE) THEN
    196. 

  196.             PZZ(I,J,K+1)=PZZ(I,J,K)+DZ(I,K,J)
    197. 

  197.             PZZM(I,J,K)=0.5*(PZZ(I,J,K+1)+PZZ(I,J,K)) ! z at mass point
    198. 

  198.         ELSE
    199. 

  199.             PZZM(I,J,K)=PZZ(I,J,K)+0.5*DZ(I,J,K-1) ! z at mass point
    200. 

  200.         ENDIF
    201. 

  201.         IF (K==KTS) THEN
    202. 

  202.            PDZZ(I,J,K)=2*(PZZM(I,J,K))      
    203. 

  203.         ELSE
    204. 

  204.            PDZZ(I,J,K)=PZZM(I,J,K)-PZZM(I,J,K-1)      
    205. 

  205.         ENDIF
    206. 

  206.      
    207. 

  207.         PRHODJ(I,J,K)=PRHODREF(I,J,K)*DZ(I,K,J)
    208. 

  208.   
    209. 

  209. 

  210.       ENDDO
    211. 

  211.    ENDDO
    212. 

  212. ENDDO
    213. 

  213. 

  214. ! fill the kte+1 level
    215. 

  215. PTHM(:,:,KTE)=PTHM(:,:,KTE-1)
    216. 

  216. PTKEM(:,:,KTE)=PTKEM(:,:,KTE-1)
    217. 

  217. PRM(:,:,KTE,1)=PRM(:,:,KTE-1,1)
    218. 

  218. PRM(:,:,KTE,2)=PRM(:,:,KTE-1,2)
    219. 

  219. PUM(:,:,KTE)=PUM(:,:,KTE-1)
    220. 

  220. PVM(:,:,KTE)=PVM(:,:,KTE-1)
    221. 

  221. PRHODREF(:,:,KTE)=PRHODREF(:,:,KTE-1)
    222. 

  222. PEXNM(:,:,KTE)=PEXNM(:,:,KTE-1)
    223. 

  223. PPABSM(:,:,KTE)=PPABSM(:,:,KTE-1)
    224. 

  224. PRHODJ(:,:,KTE)=PRHODJ(:,:,KTE-1)
    225. 

  225. 

  226. PSFTH(:,:)=HFX(ITS:ITE,JTS:JTE)/(PRHODREF(:,:,KTS)*XCPD)
    227. 

  227. PSFRV(:,:)=QFX(ITS:ITE,JTS:JTE)/(PRHODREF(:,:,KTS))
    228. 

  228. 

  229. 

  230. 

  231. ! Assign some variables
    232. 

  232. 

  233. OMIXUV=.FALSE.
    234. 

  234. KRRL=1 !Qc is managed
    235. 

  235. KRRI=0 !Qi not
    236. 

  236. PIMPL_MF=0.
    237. 

  237. PTSTEP=DT*STEPBL
    238. 

  238. PTSTEP_MET=PTSTEP
    239. 

  239. 

  240.       CALL MFSHCONVPBL_CORE(KRR,KRRL,KRRI,                            &
    241. 

  241.                 OMIXUV,                                               &
    242. 

  242.                 PIMPL_MF,PTSTEP,PTSTEP_MET,                           &
    243. 

  243.                 PDZZ, PZZ,                                            &
    244. 

  244.                 PRHODJ, PRHODREF,                                     &
    245. 

  245.                 PPABSM, PEXNM,                                        &
    246. 

  246.                 PSFTH,PSFRV,                                          &
    247. 

  247.                 PTHM,PRM,PUM,PVM,PTKEM,                               &
    248. 

  248.                 PRTHS,PRRS,PRUS,PRVS,PEMF, PENTR, PDETR,              &
    249. 

  249.                 PTHL_UP, PRT_UP, PRV_UP, PRC_UP,                      &
    250. 

  250.                 PU_UP, PV_UP, PTHV_UP, PFRAC_UP, PRC_MF, WTHV_MF,PLM_MF  )
    251. 

  251. 

  252. 

  253. DO J=JTS,JTE
    254. 

  254.    DO K=KTS,KTE
    255. 

  255.       DO I=ITS,ITE
    256. 

  256.          RQCBLTEN(I,K,J)=PRRS(I,J,K,2)       
    257. 

  257.          RQVBLTEN(I,K,J)=PRRS(I,J,K,1)       
    258. 

  258.          RTHBLTEN(I,K,J)=PRTHS(I,J,K)                
    259. 

  259.          RUBLTEN(I,K,J)=PRUS(I,J,K)
    260. 

  260.          RVBLTEN(I,K,J)=PRVS(I,J,K)
    261. 

  261.          WTHV(I,K,J)=WTHV_MF(I,J,K)
    262. 

  262.          PLM_BL89(I,K,J)=PLM_MF(I,J,K)
    263. 

  263.       ENDDO
    264. 

  264.    ENDDO
    265. 

  265. ENDDO
    266. 

  266. 

  267.       IF ( PRESENT(MASSFLUX_EDKF) ) THEN
    268. 

  268.          DO J=JTS,JTE
    269. 

  269.             DO K=KTS,KTE
    270. 

  270.                DO I=ITS,ITE
    271. 

  271.                   MASSFLUX_EDKF(I,K,J)=PEMF(I,J,K)
    272. 

  272.                   ENTR_EDKF(I,K,J)=PENTR(I,J,K)
    273. 

  273.                   DETR_EDKF(I,K,J)=PDETR(I,J,K)
    274. 

  274.                   THL_UP(I,K,J)=PTHL_UP(I,J,K)
    275. 

  275.                   THV_UP(I,K,J)=PTHV_UP(I,J,K)
    276. 

  276.                   RT_UP(I,K,J)=PRT_UP(I,J,K)
    277. 

  277.                   RV_UP(I,K,J)=PRV_UP(I,J,K)
    278. 

  278.                   RC_UP(I,K,J)=PRC_UP(I,J,K)
    279. 

  279.                   U_UP(I,K,J)=PU_UP(I,J,K)
    280. 

  280.                   V_UP(I,K,J)=PV_UP(I,J,K)
    281. 

  281.                   FRAC_UP(I,K,J)=PFRAC_UP(I,J,K)
    282. 

  282.                   RC_MF(I,K,J)=PRC_MF(I,J,K)
    283. 

  283.                ENDDO
    284. 

  284.             ENDDO
    285. 

  285.          ENDDO
    286. 

  286.       ENDIF
    287. 

  287. 

  288. 

  289. END SUBROUTINE MFSHCONVPBL
    290. 

  290. 

  291. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    292. 

  292. !   WRAPPER from WRF to MASS FLUX SCHEME 
    293. 

  293. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!   
    294. 

  294.   
    295. 

  295.       SUBROUTINE MFSHCONVPBL_CORE(KRR,KRRL,KRRI,                            &
    296. 

  296.                 OMIXUV,                       &
    297. 

  297.                 PIMPL_MF,PTSTEP,PTSTEP_MET,                 &
    298. 

  298.                 PDZZ, PZZ,                                            &
    299. 

  299.                 PRHODJ, PRHODREF,                                     &
    300. 

  300.                 PPABSM, PEXNM,                                        &
    301. 

  301.                 PSFTH,PSFRV,                                          &
    302. 

  302.                 PTHM,PRM,PUM,PVM,PTKEM,                               &
    303. 

  303.                 PRTHS,PRRS,PRUS,PRVS,  PEMF, PENTR, PDETR,            &
    304. 

  304.                 PTHL_UP, PRT_UP, PRV_UP, PRC_UP,                      &
    305. 

  305.                 PU_UP, PV_UP, PTHV_UP, PFRAC_UP,  PRC_MF,             &
    306. 

  306.                 PFLXZTHVMF,PLM       )
    307. 

  307. !!
    308. 

  308. !!****  *MFSHCONVPBL_CORE* - Interfacing routine
    309. 

  309. !!
    310. 

  310. 

  311. !! --------------------------------------------------------------------------
    312. 

  312. !
    313. 

  313. 

  314. 

  315. IMPLICIT NONE
    316. 

  316. 

  317. INTEGER,                INTENT(IN)   :: KRR          ! number of moist var.
    318. 

  318. INTEGER,                INTENT(IN)   :: KRRL         ! number of liquid water var.
    319. 

  319. INTEGER,                INTENT(IN)   :: KRRI         ! number of ice water var.
    320. 

  320. LOGICAL,                INTENT(IN)   :: OMIXUV    ! True if mixing of momentum
    321. 

  321.              
    322. 

  322. REAL,                   INTENT(IN)   :: PIMPL_MF     ! degre of implicitness
    323. 

  323. REAL,                 INTENT(IN)     ::  PTSTEP   ! Dynamical timestep 
    324. 

  324. REAL,                 INTENT(IN)     ::  PTSTEP_MET! Timestep for meteorological variables                        
    325. 

  325. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PZZ         ! Height of flux point
    326. 

  326. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PDZZ        ! Metric coefficients
    327. 

  327. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PRHODJ      ! dry density * Grid size
    328. 

  328. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PRHODREF    ! dry density of the
    329. 

  329.                                                      ! reference state
    330. 

  330. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PPABSM      ! Pressure at time t-1
    331. 

  331. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PEXNM       ! Exner function at t-dt
    332. 

  332. 

  333. REAL, DIMENSION(:,:),   INTENT(IN)   ::  PSFTH,PSFRV ! normal surface fluxes of theta and Rv 
    334. 

  334. REAL, DIMENSION(:,:,:), INTENT(IN)   ::  PTHM        ! Theta at t-dt
    335. 

  335. REAL, DIMENSION(:,:,:,:), INTENT(IN) ::  PRM         ! water var. at t-dt
    336. 

  336. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PUM,PVM     ! wind components at t-dt
    337. 

  337. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PTKEM       ! tke at t-dt
    338. 

  338. 

  339. 

  340. REAL, DIMENSION(:,:,:),   INTENT(OUT) ::  PRUS,PRVS,PRTHS ! Meso-NH sources
    341. 

  341. REAL, DIMENSION(:,:,:,:), INTENT(OUT) ::  PRRS 
    342. 

  342. 

  343. REAL, DIMENSION(:,:,:), INTENT(OUT) ::  PEMF, PENTR, PDETR
    344. 

  344. REAL, DIMENSION(:,:,:), INTENT(OUT) ::  PTHL_UP, PRT_UP, PRV_UP, PRC_UP 
    345. 

  345. REAL, DIMENSION(:,:,:), INTENT(OUT) ::  PU_UP, PV_UP, PTHV_UP, PFRAC_UP
    346. 

  346. REAL, DIMENSION(:,:,:), INTENT(INOUT) ::  PRC_MF 
    347. 

  347. REAL, DIMENSION(:,:,:), INTENT(OUT) ::  PFLXZTHVMF 
    348. 

  348. REAL, DIMENSION(:,:,:), INTENT(OUT) ::  PLM
    349. 

  349.   
    350. 

  350. 

  351. !
    352. 

  352. !                     0.2  Declaration of local variables
    353. 

  353. !
    354. 

  354. REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) ::     &
    355. 

  355.           ZEXN,ZCPH,                                      &
    356. 

  356.           PRV,PRL,PTH,                                    &
    357. 

  357.           ZTM,                                            &  ! Temperature at t-dt
    358. 

  358.           ZLVOCPEXN,                                      &  !
    359. 

  359.           ZCF_MF,                                         & 
    360. 

  360.           ZLSOCPEXN,                                      &  !
    361. 

  361.           ZAMOIST,                                        &  !
    362. 

  362.           ZATHETA,                                        &  !
    363. 

  363.           ZTHLM,                                          &  !
    364. 

  364.           ZRTM,                                           &  !
    365. 

  365.           ZTHVM,ZTHVREF,ZUMM,ZVMM,                        &  !
    366. 

  366.           ZRI_UP,ZW_UP,                                   & ! 
    367. 

  367.           ZEMF_O_RHODREF,                                 & ! entrainment/detrainment
    368. 

  368.           ZTHLDT,ZRTDT,ZUDT,ZVDT,                         & ! tendencies
    369. 

  369.           ZFLXZTHMF,ZFLXZRMF,ZFLXZUMF,ZFLXZVMF   ! fluxes
    370. 

  370. 

  371. 

  372. INTEGER,DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2))  :: IKLCL,IKETL,IKCTL 
    373. 

  373.                     
    374. 

  374. INTEGER :: IKU, IKB, IKE  
    375. 

  375. INTEGER :: JI,JJ,JK,JSV                          ! Loop counters
    376. 

  376. INTEGER :: IRESP    ! error code
    377. 

  377. 

  378. 

  379. !------------------------------------------------------------------------
    380. 

  380. 

  381. !!! 1. Initialisation
    382. 

  382. 

  383. ! Internal Domain
    384. 

  384. IKU=SIZE(PTHM,3)
    385. 

  385. IKB=1              ! Modif WRF JP
    386. 

  386. IKE=IKU-1
    387. 

  387. 

  388. 

  389. ! number of scalar var
    390. 

  390. 

  391.   ZUMM=PUM   !Modif WRF JP
    392. 

  392.   ZVMM=PVM   !Modif WRF JP
    393. 

  393. 

  394. ! Thermodynamics functions
    395. 

  395. 

  396.   CALL COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI,                   &
    397. 

  397.                                    PTHM,PRM,PEXNM,PPABSM,           &
    398. 

  398.                                    ZTM,ZLVOCPEXN,ZLSOCPEXN,         &
    399. 

  399.                                    ZAMOIST,ZATHETA                  )
    400. 

  400. 

  401. 

  402. 

  403. ! Conservative variables at t-dt
    404. 

  404. 

  405.   CALL THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI,                         &
    406. 

  406.                                   PTHM, PRM, ZLVOCPEXN, ZLSOCPEXN,       &
    407. 

  407.                                   ZTHLM, ZRTM                            )
    408. 

  408. 

  409. 

  410. 

  411. ! Virtual potential temperature at t-dt
    412. 

  412. 

  413. ZTHVM(:,:,:) = PTHM(:,:,:)*((1.+XRV / XRD *PRM(:,:,:,1))/(1.+ZRTM(:,:,:))) 
    414. 

  414. 

  415. 

  416.        ZTHVREF=XG/ZTHVM
    417. 

  417.        CALL BL89(PZZ,PDZZ,ZTHVREF,ZTHLM,KRR, &
    418. 

  418.                  PRM,PTKEM,PLM)
    419. 

  419. 

  420. !!! 2. Compute updraft
    421. 

  421. 

  422. 

  423.       CALL UPDRAFT_SOPE (KRR,KRRL,KRRI,OMIXUV,                     &
    424. 

  424.                          PZZ,PDZZ,PSFTH,PSFRV,PPABSM,PRHODREF,     &
    425. 

  425.                          PTKEM,PTHM,PRM,ZTHLM,ZRTM,ZUMM,ZVMM,      &
    426. 

  426.                          PTHL_UP,PRT_UP,PRV_UP,PU_UP,PV_UP,        &
    427. 

  427.                          PRC_UP,ZRI_UP,PTHV_UP,ZW_UP,PFRAC_UP,PEMF,&
    428. 

  428.                          PDETR,PENTR,IKLCL,IKETL,IKCTL )
    429. 

  429. 

  430. !!! 3. Compute fluxes of conservative variables and their divergence = tendency
    431. 

  431. 

  432.        ZEMF_O_RHODREF=PEMF/PRHODREF
    433. 

  433.        CALL MF_TURB(OMIXUV, PIMPL_MF, PTSTEP,PTSTEP_MET,       &
    434. 

  434.                 PDZZ, PRHODJ, ZTHLM,ZTHVM,ZRTM,ZUMM,ZVMM,           &
    435. 

  435.                 ZTHLDT,ZRTDT,ZUDT,ZVDT,                            &
    436. 

  436.                 ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,&
    437. 

  437.                 ZFLXZTHMF,PFLXZTHVMF,ZFLXZRMF,ZFLXZUMF,ZFLXZVMF   )
    438. 

  438. 

  439.                
    440. 

  440. !!! 5. Compute diagnostic convective cloud fraction and content
    441. 

  441. ! ! !  ONLY liquid cloud implemented (yet)
    442. 

  442. 

  443.       CALL COMPUTE_MF_CLOUD(KRRL,ZTHLM,PRC_UP,PFRAC_UP,PDZZ,IKLCL,  &
    444. 

  444.                             PRC_MF,ZCF_MF                      )
    445. 

  445. 

  446. 

  447. !!! 6. Compute tendency terms for pronostic variables
    448. 

  448. 

  449. ZEXN(:,:,:)=(PPABSM(:,:,:)/XP00) ** (XRD/XCPD)
    450. 

  450. !
    451. 

  451. 

  452. 

  453. PRV(:,:,:)=PRM(:,:,:,1)-PRC_MF(:,:,:)
    454. 

  454. PRL(:,:,:)=PRC_MF(:,:,:)
    455. 

  455.       !       2.1 Cph
    456. 

  456. ZCPH(:,:,:)=XCPD+ XCPV * PRV(:,:,:)+ XCL * PRL(:,:,:) 
    457. 

  457.       
    458. 

  458. PTH(:,:,:)=(ZTHLM(:,:,:)+ZTHLDT(:,:,:))+(XLVTT/(ZCPH*ZEXN(:,:,:))*PRL(:,:,:))          
    459. 

  459. 

  460. PRTHS(:,:,:)  = ZTHLDT(:,:,:)
    461. 

  461. PRTHS(:,:,:)  = (PTH(:,:,:)-PTHM(:,:,:))/PTSTEP_MET
    462. 

  462. PRRS(:,:,:,2) = (PRC_MF-PRM(:,:,:,2))/PTSTEP_MET
    463. 

  463. PRRS(:,:,:,1) = ZRTDT(:,:,:)-PRRS(:,:,:,2)
    464. 

  464. 

  465. PRTHS(:,:,:)  = ZTHLDT(:,:,:)
    466. 

  466. PRRS(:,:,:,1) = ZRTDT(:,:,:)
    467. 

  467. PRRS(:,:,:,2) = 0
    468. 

  468. PRUS(:,:,:)   = ZUDT(:,:,:)
    469. 

  469. PRVS(:,:,:)   = ZVDT(:,:,:) 
    470. 

  470.   
    471. 

  471. 

  472. END SUBROUTINE MFSHCONVPBL_CORE 
    473. 

  473. 

  474. 

  475. !     ###################################################################
    476. 

  476.       SUBROUTINE COMPUTE_BL89_ML(PDZZ2D, &
    477. 

  477.              PTKEM2D,PG_O_THVREF2D,PVPT,KK,OUPORDN,PLWORK)
    478. 

  478. !     ###################################################################
    479. 

  479. !!
    480. 

  480. !!     COMPUTE_BL89_ML routine to:
    481. 

  481. !!
    482. 

  482. !-------------------------------------------------------------------------------
    483. 

  483. !
    484. 

  484. !*       0.    DECLARATIONS
    485. 

  485. !
    486. 

  486. !              ------------
    487. 

  487. !USE MODD_CST
    488. 

  488. !
    489. 

  489. !
    490. 

  490. IMPLICIT NONE
    491. 

  491. !
    492. 

  492. !          0.1 arguments
    493. 

  493. !
    494. 

  494. REAL, DIMENSION(:,:),   INTENT(IN)  :: PDZZ2D
    495. 

  495. REAL, DIMENSION(:,:),   INTENT(IN)  :: PTKEM2D
    496. 

  496. REAL, DIMENSION(:,:),   INTENT(IN)  :: PG_O_THVREF2D
    497. 

  497. REAL, DIMENSION(:,:),   INTENT(IN)  :: PVPT
    498. 

  498. INTEGER,                INTENT(IN)  :: KK
    499. 

  499. LOGICAL,                INTENT(IN)  :: OUPORDN
    500. 

  500. REAL, DIMENSION(:),     INTENT(OUT) :: PLWORK
    501. 

  501. 

  502. !          0.2 Local variable
    503. 

  503. !
    504. 

  504. REAL, DIMENSION(SIZE(PTKEM2D,1)) :: ZLWORK1,ZLWORK2 ! Temporary mixing length
    505. 

  505. REAL, DIMENSION(SIZE(PTKEM2D,1)) :: ZINTE,ZPOTE     ! TKE and potential energy
    506. 

  506.                                                     ! between 2 levels
    507. 

  507. INTEGER :: IKB,IKE
    508. 

  508. !
    509. 

  509. REAL, DIMENSION(SIZE(PTKEM2D,1),SIZE(PTKEM2D,2)) :: ZDELTVPT,ZHLVPT                                
    510. 

  510.                       !Virtual Potential Temp at Half level and DeltaThv between
    511. 

  511.                       !2 levels
    512. 

  512. REAL, DIMENSION(SIZE(PTKEM2D,1)) :: ZTH! Potential Temp 
    513. 

  513. 

  514. INTEGER :: IIJU,IKU             !Internal Domain
    515. 

  515. INTEGER :: J1D                  !horizontal loop counter
    516. 

  516. INTEGER :: JKK                  !loop counters
    517. 

  517. INTEGER :: JRR                  !moist loop counter
    518. 

  518. INTEGER :: JIJK                 !loop counters 
    519. 

  519. REAL    :: ZTEST,ZTEST0,ZTESTM  !test for vectorization
    520. 

  520. !-------------------------------------------------------------------------------------
    521. 

  521. !
    522. 

  522. !*       1.    INITIALISATION
    523. 

  523. !              --------------
    524. 

  524. IIJU=SIZE(PTKEM2D,1)
    525. 

  525. !
    526. 

  526. IKB = 1 !Modif WRF JP
    527. 

  527. IKE = SIZE(PTKEM2D,2)-1 !Modif WRF JP
    528. 

  528. IKU = SIZE(PTKEM2D,2)
    529. 

  529. 

  530. ZDELTVPT(:,2:IKU)=PVPT(:,2:IKU)-PVPT(:,1:IKU-1)
    531. 

  531. ZDELTVPT(:,1)=0.
    532. 

  532. 

  533. ! to prevent division by zero
    534. 

  534. WHERE (ABS(ZDELTVPT(:,:))<1.E-10)
    535. 

  535.   ZDELTVPT(:,:)=1.E-10
    536. 

  536. END WHERE
    537. 

  537. !
    538. 

  538. ZHLVPT(:,2:IKU)= 0.5 * ( PVPT(:,2:IKU)+PVPT(:,1:IKU-1) )
    539. 

  539. ZHLVPT(:,1)    = PVPT(:,1)
    540. 

  540. 

  541. !
    542. 

  542. !
    543. 

  543. !
    544. 

  544. !*       2.    CALCULATION OF THE UPWARD MIXING LENGTH
    545. 

  545. !              ---------------------------------------
    546. 

  546. !
    547. 

  547. 

  548. IF (OUPORDN.EQV..TRUE.) THEN 
    549. 

  549.  ZINTE(:)=PTKEM2D(:,KK)
    550. 

  550.  PLWORK=0.
    551. 

  551.  ZLWORK1=0.
    552. 

  552.  ZLWORK2=0.
    553. 

  553.  ZTESTM=1.
    554. 

  554.  ZTH(:)=PVPT(:,KK)
    555. 

  555.  DO JKK=KK+1,IKE
    556. 

  556.     IF(ZTESTM > 0.) THEN
    557. 

  557.       ZTESTM=0
    558. 

  558.       DO J1D=1,IIJU
    559. 

  559.         ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
    560. 

  560.         ZPOTE(J1D) = ZTEST0*(PG_O_THVREF2D(J1D,KK)      *      &
    561. 

  561.             (ZHLVPT(J1D,JKK) - ZTH(J1D)))  * PDZZ2D(J1D,JKK) !particle keeps its temperature
    562. 

  562.         ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
    563. 

  563.         ZTESTM=ZTESTM+ZTEST0
    564. 

  564.         ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
    565. 

  565.         !ZLWORK2 jump of the last reached level
    566. 

  566.         ZLWORK2(J1D)=        ( - PG_O_THVREF2D(J1D,KK) *                     &
    567. 

  567.             (  PVPT(J1D,JKK-1) - ZTH(J1D) )                              &
    568. 

  568.           + SQRT (ABS(                                                       &
    569. 

  569.             ( PG_O_THVREF2D(J1D,KK) * (PVPT(J1D,JKK-1) - ZTH(J1D)) )**2  &
    570. 

  570.             + 2. * ZINTE(J1D) * PG_O_THVREF2D(J1D,KK)                        &
    571. 

  571.                  * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) ))    ) /             &
    572. 

  572.         ( PG_O_THVREF2D(J1D,KK) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) ) 
    573. 

  573.       !
    574. 

  574.         PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+  &
    575. 

  575.                                     (1-ZTEST)*ZLWORK2(J1D))
    576. 

  576.         ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
    577. 

  577.       END DO 
    578. 

  578.     ENDIF
    579. 

  579.   END DO 
    580. 

  580. ENDIF
    581. 

  581. !!
    582. 

  582. !*       2.    CALCULATION OF THE DOWNWARD MIXING LENGTH
    583. 

  583. !              ---------------------------------------
    584. 

  584. !
    585. 

  585. 

  586. IF (OUPORDN.EQV..FALSE.) THEN 
    587. 

  587.  ZINTE(:)=PTKEM2D(:,KK)
    588. 

  588.  PLWORK=0.
    589. 

  589.  ZLWORK1=0.
    590. 

  590.  ZLWORK2=0.
    591. 

  591.  ZTESTM=1.
    592. 

  592.  ZTH(:)=PVPT(:,KK)
    593. 

  593.  DO JKK=KK,IKB,-1 
    594. 

  594.     IF(ZTESTM > 0.) THEN
    595. 

  595.       ZTESTM=0
    596. 

  596.       DO J1D=1,IIJU
    597. 

  597.         ZTEST0=0.5+SIGN(0.5,ZINTE(J1D))
    598. 

  598.         ZPOTE(J1D) = -ZTEST0*(PG_O_THVREF2D(J1D,KK)      *      &
    599. 

  599.             (ZHLVPT(J1D,JKK) - ZTH(J1D)))  * PDZZ2D(J1D,JKK) !particle keeps its temperature
    600. 

  600.         ZTEST =0.5+SIGN(0.5,ZINTE(J1D)-ZPOTE(J1D))
    601. 

  601.         ZTESTM=ZTESTM+ZTEST0
    602. 

  602.         ZLWORK1(J1D)=PDZZ2D(J1D,JKK)
    603. 

  603.         ZLWORK2(J1D)=        ( + PG_O_THVREF2D(J1D,KK) *                     &
    604. 

  604.             (  PVPT(J1D,JKK) - ZTH(J1D) )                              &
    605. 

  605.           + SQRT (ABS(                                                       &
    606. 

  606.             ( PG_O_THVREF2D(J1D,KK) * (PVPT(J1D,JKK) - ZTH(J1D)) )**2  &
    607. 

  607.             + 2. * ZINTE(J1D) * PG_O_THVREF2D(J1D,KK)                        &
    608. 

  608.                  * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) ))    ) /             &
    609. 

  609.         ( PG_O_THVREF2D(J1D,KK) * ZDELTVPT(J1D,JKK) / PDZZ2D(J1D,JKK) ) 
    610. 

  610.       !
    611. 

  611.         PLWORK(J1D)=PLWORK(J1D)+ZTEST0*(ZTEST*ZLWORK1(J1D)+  &
    612. 

  612.                                     (1-ZTEST)*ZLWORK2(J1D)) 
    613. 

  613.         ZINTE(J1D) = ZINTE(J1D) - ZPOTE(J1D)
    614. 

  614.       END DO 
    615. 

  615.     ENDIF
    616. 

  616.   END DO 
    617. 

  617. ENDIF
    618. 

  618.   
    619. 

  619. END SUBROUTINE COMPUTE_BL89_ML
    620. 

  620. !
    621. 

  621. 

  622. !
    623. 

  623. !         #############################################################
    624. 

  624.           SUBROUTINE COMPUTE_ENTR_DETR(OTEST,OTESTLCL,&
    625. 

  625.                             HFRAC_ICE,PFRAC_ICE,KK,PPABSM,PZZ,PDZZ,&
    626. 

  626.                             PTHVM,PTHLM,PRTM,PW_UP2,&
    627. 

  627.                             PTHL_UP,PRT_UP,PLUP,&
    628. 

  628.                             PENTR,PDETR,PBUO_INTEG)
    629. 

  629. !         #############################################################
    630. 

  630. 

  631. !!
    632. 

  632. !!***COMPUTE_ENTR_DETR* - calculates caracteristics of the updraft or downdraft
    633. 

  633. !!                       using model of the EDMF scheme 
    634. 

  634. !!
    635. 

  635. !!
    636. 

  636. !! --------------------------------------------------------------------------
    637. 

  637. !
    638. 

  638. 

  639. 

  640. 

  641. IMPLICIT NONE
    642. 

  642. !
    643. 

  643. !                         
    644. 

  644. !*                    1.1  Declaration of Arguments
    645. 

  645. !
    646. 

  646. !
    647. 

  647. 

  648. LOGICAL,DIMENSION(:),INTENT(INOUT)  :: OTEST ! test to see if updraft is running
    649. 

  649. LOGICAL,DIMENSION(:),INTENT(INOUT)  :: OTESTLCL !test of condensation 
    650. 

  650. CHARACTER*1                         :: HFRAC_ICE ! frac_ice can be compute using
    651. 

  651.                                               ! Temperature (T) or prescribed
    652. 

  652.                                               ! (Y)
    653. 

  653. REAL, DIMENSION(:), INTENT(INOUT)   :: PFRAC_ICE ! if frac_ice is prescribed
    654. 

  654. INTEGER,            INTENT(IN)      :: KK  ! level where E and D are computed     
    655. 

  655. !
    656. 

  656. !    prognostic variables at t- deltat
    657. 

  657. !
    658. 

  658. REAL, DIMENSION(:,:),   INTENT(IN) ::  PPABSM      ! Pressure at time t-1
    659. 

  659. REAL, DIMENSION(:,:),   INTENT(IN) ::  PZZ       !  Height at the flux point
    660. 

  660. REAL, DIMENSION(:,:),   INTENT(IN) ::  PDZZ       !  metrics coefficient
    661. 

  661. REAL, DIMENSION(:,:),   INTENT(IN) ::  PTHVM      ! ThetaV environment 
    662. 

  662. 

  663. !
    664. 

  664. !   thermodynamical variables which are transformed in conservative var.
    665. 

  665. !
    666. 

  666. REAL, DIMENSION(:),   INTENT(IN)     ::  PTHLM     ! Thetal
    667. 

  667. REAL, DIMENSION(:),   INTENT(IN)     ::  PRTM      ! total mixing ratio 
    668. 

  668. REAL, DIMENSION(:,:), INTENT(INOUT)  ::  PW_UP2    ! Vertical velocity^2
    669. 

  669. REAL, DIMENSION(:),   INTENT(IN)     ::  PTHL_UP,PRT_UP  ! updraft properties
    670. 

  670. REAL, DIMENSION(:),   INTENT(IN)     ::  PLUP      ! LUP compute from the ground
    671. 

  671. REAL, DIMENSION(:),   INTENT(INOUT)  ::  PENTR     ! Mass flux entrainment of the updraft
    672. 

  672. REAL, DIMENSION(:),   INTENT(INOUT)  ::  PDETR     ! Mass flux detrainment of the updraft
    673. 

  673. REAL, DIMENSION(:),   INTENT(INOUT)  ::  PBUO_INTEG! Integral Buoyancy
    674. 

  674. !
    675. 

  675. !
    676. 

  676. !                       1.2  Declaration of local variables
    677. 

  677. !
    678. 

  678. !
    679. 

  679. 

  680. ! Variables for cloudy part
    681. 

  681. 

  682. REAL, DIMENSION(SIZE(PTHLM))   :: ZKIC           ! fraction of env. mass in the muxtures
    683. 

  683. REAL, DIMENSION(SIZE(PTHLM))   :: ZEPSI,ZDELTA   ! factor entrainment detrainment
    684. 

  684. REAL, DIMENSION(SIZE(PTHLM))   :: ZEPSI_CLOUD    ! factor entrainment detrainment
    685. 

  685. REAL, DIMENSION(SIZE(PTHLM))   :: ZCOEFFMF_CLOUD ! factor for compputing entr. detr.
    686. 

  686. 

  687. REAL, DIMENSION(SIZE(PTHLM))   :: ZMIXTHL,ZMIXRT ! Thetal and rt in the mixtures
    688. 

  688. !
    689. 

  689. REAL, DIMENSION(SIZE(PTHLM))   :: ZTHMIX,ZTHVMIX ! Theta and Thetav  of mixtures
    690. 

  690. REAL, DIMENSION(SIZE(PTHLM))   :: ZRVMIX,ZRCMIX,ZRIMIX ! mixing ratios in mixtures
    691. 

  691. 

  692. REAL, DIMENSION(SIZE(PTHLM))   :: ZTHMIX_F2     ! Theta and Thetav  of mixtures
    693. 

  693. REAL, DIMENSION(SIZE(PTHLM))   :: ZRVMIX_F2,ZRCMIX_F2,ZRIMIX_F2 ! mixing ratios in mixtures
    694. 

  694. 

  695. REAL, DIMENSION(SIZE(PTHLM))   :: ZTHV_UP       ! thvup at mass point kk
    696. 

  696. 

  697. 

  698. REAL, DIMENSION(SIZE(PTHLM))   :: ZTHVMIX_1,ZTHVMIX_2 ! Theta and Thetav  of mixtures
    699. 

  699. 

  700. 

  701. ! Variables for dry part
    702. 

  702. 

  703. REAL, DIMENSION(SIZE(PTHLM))   :: ZBUO_INTEG,&         ! Temporary integral Buoyancy
    704. 

  704.                                   ZDZ_HALF,&           ! half-DeltaZ between 2 flux points
    705. 

  705.                                   ZDZ_STOP,&           ! Exact Height of the LCL 
    706. 

  706.                                   ZTHV_MINUS_HALF,&    ! Thv at flux point(kk)  
    707. 

  707.                                   ZTHV_PLUS_HALF,&     ! Thv at flux point(kk+1)
    708. 

  708.                                   ZCOEFF_MINUS_HALF,&  ! Variation of Thv between mass points kk-1 and kk
    709. 

  709.                                   ZCOEFF_PLUS_HALF,&   ! Variation of Thv between mass points kk and kk+1
    710. 

  710.                                   ZCOTHVU_MINUS_HALF,& ! Variation of Thvup between flux point kk and mass point kk
    711. 

  711.                                   ZCOTHVU_PLUS_HALF,&  ! Variation of Thvup between mass point kk and flux point kk+1    
    712. 

  712.                                   ZW2_HALF             ! w**2 at mass point KK  
    713. 

  713. 

  714. REAL, DIMENSION(SIZE(PTHLM))   :: ZCOPRE_MINUS_HALF,&  ! Variation of pressure between mass points kk-1 and kk
    715. 

  715.                                   ZCOPRE_PLUS_HALF,&   ! Variation of pressure between mass points kk and kk+1
    716. 

  716.                                   ZPRE_MINUS_HALF,&    ! pressure at flux point kk
    717. 

  717.                                   ZPRE_PLUS_HALF,&     ! pressure at flux point kk+1
    718. 

  718.                                   ZTHV_UP_F1,&         ! thv_up at flux point kk
    719. 

  719.                                   ZTHV_UP_F2           ! thv_up at flux point kk+1
    720. 

  720. REAL, DIMENSION(SIZE(PTHLM))   :: ZCOEFF_QSAT,&        ! variation of Qsat at the transition between dry part and cloudy part
    721. 

  721.                                   ZRC_ORD,&            ! 
    722. 

  722.                                   ZPART_DRY            ! part of dry part at the transition level
    723. 

  723. !
    724. 

  724. REAL, DIMENSION(SIZE(PTHLM))   :: ZQVSAT ! QV at saturation
    725. 

  725. 

  726. REAL, DIMENSION(SIZE(PTHLM))   :: PT ! temperature to compute saturation vapour mixing ratio 
    727. 

  727. 

  728. REAL, DIMENSION(SIZE(PTHVM,1),SIZE(PTHVM,2))   ::ZG_O_THVREF
    729. 

  729. !
    730. 

  730. LOGICAL, DIMENSION(SIZE(OTEST,1)) :: GTEST_LOCAL_LCL,& ! true if LCL found between flux point KK and mass point KK  
    731. 

  731.                                      GTEST_LOCAL_LCL2  ! true if LCL found between mass point KK and flux point KK+1
    732. 

  732. !
    733. 

  733. REAL     :: ZRDORV       ! RD/RV
    734. 

  734. REAL     :: ZRVORD       ! RV/RD
    735. 

  735. INTEGER  :: ILON, ITEST, IKB         !
    736. 

  736. 

  737. 

  738. !----------------------------------------------------------------------------------
    739. 

  739.                         
    740. 

  740. !                1.3 Initialisation
    741. 

  741. !                ------------------
    742. 

  742.   IKB=1 ! modif WRF JP    
    743. 

  743. 

  744.   
    745. 

  745.   ZRDORV   = XRD / XRV   !=0.622
    746. 

  746.   ZRVORD   = XRV / XRD   !=1.607
    747. 

  747.   ZG_O_THVREF=XG/PTHVM
    748. 

  748.   
    749. 

  749.   ZCOEFF_QSAT=0.
    750. 

  750.   ZRC_ORD=0.
    751. 

  751.   ZPART_DRY=1.
    752. 

  752.   GTEST_LOCAL_LCL=.FALSE.
    753. 

  753.   ZDZ_HALF(:) = (PZZ(:,KK+1)-PZZ(:,KK))/2.
    754. 

  754.   ZDZ_STOP(:) = ZDZ_HALF(:)
    755. 

  755.  
    756. 

  756.   ZKIC(:)=0.1  ! starting value for critical mixed fraction for CLoudy Part
    757. 

  757. 

  758. 

  759. !                Computation of KIC
    760. 

  760. !                ---------------------
    761. 

  761. 

  762. !        2.1    Compute critical mixed fraction by estimating unknown  
    763. 

  763. !               T^mix r_c^mix and r_i^mix from thl^mix and r_t^mix
    764. 

  764. !               We determine the zero crossing of the linear curve
    765. 

  765. !               evaluating the derivative using ZMIXF=0.1.
    766. 

  766. !               -----------------------------------------------------
    767. 

  767. 

  768.   ZMIXTHL(:) = ZKIC(:) * PTHLM(:)+(1. - ZKIC(:))*PTHL_UP(:)
    769. 

  769.   ZMIXRT(:)  = ZKIC(:) * PRTM(:)+(1. - ZKIC(:))*PRT_UP(:)
    770. 

  770. 

  771. ! MIXTURE FOR CLOUDY PART
    772. 

  772.   !  Compute pressure at flux level KK and at flux Level KK+1  
    773. 

  773. 

  774. 

  775. IF (KK==IKB) THEN !MODIF WRF JP
    776. 

  776.   ZCOPRE_MINUS_HALF(:) = 0. !MODIF WRF JP
    777. 

  777. ELSE!MODIF WRF JP
    778. 

  778.   ZCOPRE_MINUS_HALF(:) = ((PPABSM(:,KK)-PPABSM(:,KK-1))/PDZZ(:,KK))
    779. 

  779. ENDIF!MODIF WRF JP   
    780. 

  780.   ZCOPRE_PLUS_HALF(:) = ((PPABSM(:,KK+1)-PPABSM(:,KK))/PDZZ(:,KK+1))
    781. 

  781.   
    782. 

  782. IF (KK==IKB) THEN !MODIF WRF JP   
    783. 

  783.   ZPRE_MINUS_HALF(:)= PPABSM(:,KK)
    784. 

  784. ELSE!MODIF WRF JP
    785. 

  785.   ZPRE_MINUS_HALF(:)= ZCOPRE_MINUS_HALF*0.5*(PZZ(:,KK)-PZZ(:,KK-1))+PPABSM(:,KK-1)
    786. 

  786. ENDIF!MODIF WRF JP   
    787. 

  787.   ZPRE_PLUS_HALF(:) = ZCOPRE_PLUS_HALF*0.5*(PZZ(:,KK+1)-PZZ(:,KK))+PPABSM(:,KK)  
    788. 

  788. 

  789. 

  790.   !  Compute non cons. var. of mixture at the mass level
    791. 

  791.   CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,&
    792. 

  792.                PPABSM(:,KK),ZMIXTHL,ZMIXRT,&
    793. 

  793.                ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX)
    794. 

  794.              
    795. 

  795. 

  796.   ! Compute theta_v of mixture at mass level KK for KF90        
    797. 

  797.   ZTHVMIX_1(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
    798. 

  798. 

  799.   !  Compute non cons. var. of mixture at the flux level KK+1
    800. 

  800.   CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,&
    801. 

  801.                ZPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
    802. 

  802.                ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX)
    803. 

  803.              
    804. 

  804. 

  805.   ! compute theta_v of mixture at the flux level KK+1 for KF90       
    806. 

  806.   ZTHVMIX_2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
    807. 

  807. 

  808. 

  809. !        2.1    Compute critical mixed fraction by estimating unknown  
    810. 

  810. !               T^mix r_c^mix and r_i^mix from thl^mix and r_t^mix
    811. 

  811. !               We determine the zero crossing of the linear curve
    812. 

  812. !               evaluating the derivative using ZMIXF=0.1.
    813. 

  813. !               -----------------------------------------------------
    814. 

  814. 

  815. 

  816. ! THV_UP FOR DRY PART
    817. 

  817.   ! Compute theta_v of updraft at flux level KK                 
    818. 

  818.   CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,&
    819. 

  819.                ZPRE_MINUS_HALF,PTHL_UP,PRT_UP,&
    820. 

  820.                ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX)
    821. 

  821.   ZTHV_UP_F1(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:))
    822. 

  822.  
    823. 

  823.   ! Compute theta_v of updraft at mass level KK                 
    824. 

  824.   CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,&
    825. 

  825.                PPABSM(:,KK),PTHL_UP,PRT_UP,&
    826. 

  826.                ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX)            
    827. 

  827.   ZTHV_UP(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:))
    828. 

  828. 

  829.   ! Compute theta_v of updraft at flux level KK+1                   
    830. 

  830.   CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,&
    831. 

  831.                ZPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
    832. 

  832.                ZTHMIX_F2,ZRVMIX_F2,ZRCMIX_F2,ZRIMIX_F2)
    833. 

  833.   ZTHV_UP_F2(:) = ZTHMIX_F2(:)*(1.+ZRVORD*ZRVMIX_F2(:))/(1.+PRT_UP(:))
    834. 

  834.  
    835. 

  835.    
    836. 

  836. !
    837. 

  837. !*   2.2     Compute final values for entr. and detr. 
    838. 

  838. !            ----------------------------------------
    839. 

  839. !
    840. 

  840. ! Dry PART  
    841. 

  841. 

  842.  ! Computation of integral entrainment and detrainment between flux level KK
    843. 

  843.  ! and mass level KK 
    844. 

  844. 

  845.   WHERE ((ZRCMIX(:)>0.).AND.(.NOT.OTESTLCL)) 
    846. 

  846. ! If rc is found between flux level KK and mass level KK
    847. 

  847. ! a part of dry entrainment/detrainment is defined
    848. 

  848. ! the exact height of LCL is also determined
    849. 

  849.      ZCOEFF_QSAT(:) = (ZRCMIX_F2(:) - ZRCMIX(:))/ ZDZ_HALF(:)
    850. 

  850.      ZRC_ORD(:) = ZRCMIX(:) - ZCOEFF_QSAT(:) * ZDZ_HALF(:)
    851. 

  851.      ZDZ_STOP = (- ZRC_ORD(:)/ZCOEFF_QSAT(:))     
    852. 

  852.      ZPART_DRY(:) = ZDZ_STOP / (PZZ(:,KK+1)-PZZ(:,KK))
    853. 

  853.      GTEST_LOCAL_LCL(:)=.TRUE.
    854. 

  854.   
    855. 

  855.   ENDWHERE
    856. 

  856. 

  857. IF (KK==IKB) THEN !MODIF WRF JP   
    858. 

  858.   ZCOEFF_MINUS_HALF = 0.
    859. 

  859. ELSE!MODIF WRF JP
    860. 

  860.   ZCOEFF_MINUS_HALF = ((PTHVM(:,KK)-PTHVM(:,KK-1))/PDZZ(:,KK))
    861. 

  861. ENDIF!MODIF WRF JP   
    862. 

  862. 

  863.   ZCOEFF_PLUS_HALF  = ((PTHVM(:,KK+1)-PTHVM(:,KK))/PDZZ(:,KK+1))
    864. 

  864.   
    865. 

  865.   ZCOTHVU_MINUS_HALF = (ZTHV_UP(:)-ZTHV_UP_F1(:))/ZDZ_HALF(:)
    866. 

  866.   ZCOTHVU_PLUS_HALF  = (ZTHV_UP_F2(:)-ZTHV_UP(:))/ZDZ_HALF(:)
    867. 

  867. 

  868. IF (KK==IKB) THEN !MODIF WRF JP   
    869. 

  869.   ZTHV_MINUS_HALF = PTHVM(:,KK)
    870. 

  870. ELSE!MODIF WRF JP
    871. 

  871.   ZTHV_MINUS_HALF = ZCOEFF_MINUS_HALF*0.5*(PZZ(:,KK)-PZZ(:,KK-1))+PTHVM(:,KK-1)
    872. 

  872. ENDIF!MODIF WRF JP   
    873. 

  873. 

  874.   ZTHV_PLUS_HALF  = ZCOEFF_PLUS_HALF*0.5*(PZZ(:,KK+1)-PZZ(:,KK))+ ZTHV_MINUS_HALF  ! BUG JP 16082010
    875. 

  875.  
    876. 

  876.   ! Integral Buoyancy between flux level KK and mass level KK 
    877. 

  877.           
    878. 

  878.   PBUO_INTEG = ZG_O_THVREF(:,KK)*ZDZ_HALF(:)*&
    879. 

  879.               (0.5*( ZCOTHVU_MINUS_HALF - ZCOEFF_MINUS_HALF)*ZDZ_HALF(:) &
    880. 

  880.                 - ZTHV_MINUS_HALF + ZTHV_UP_F1(:) ) 
    881. 

  881. 

  882. 

  883.  
    884. 

  884.   WHERE ((OTEST).AND.(.NOT.OTESTLCL))
    885. 

  885.      PENTR=0.
    886. 

  886.      PDETR=0.
    887. 

  887. 

  888.  
    889. 

  889.      ZBUO_INTEG = ZG_O_THVREF(:,KK)*ZDZ_STOP(:)*&
    890. 

  890.                 (0.5 * (  - ZCOEFF_MINUS_HALF)* ZDZ_STOP(:) &
    891. 

  891.                   - ZTHV_MINUS_HALF + ZTHV_UP_F1(:) ) 
    892. 

  892.            
    893. 

  893.   
    894. 

  894.      WHERE (ZBUO_INTEG(:)>=0.)
    895. 

  895.          PENTR = 0.5/(XABUO-XBENTR*XENTR_DRY)*&
    896. 

  896.                  LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/PW_UP2(:,KK))* &
    897. 

  897.                  ZBUO_INTEG)
    898. 

  898.          PDETR = 0.
    899. 

  899.     
    900. 

  900.          ZW2_HALF = PW_UP2(:,KK) +  2*(XABUO-XBENTR*XENTR_DRY)*(ZBUO_INTEG)
    901. 

  901.      ELSEWHERE
    902. 

  902.          PENTR = 0.
    903. 

  903.          PDETR = 0.5/(XABUO)*&
    904. 

  904.                  LOG(1.+ (2.*(XABUO)/PW_UP2(:,KK))* &
    905. 

  905.                  MAX(0.,-ZBUO_INTEG))
    906. 

  906. 

  907.          ZW2_HALF = PW_UP2(:,KK) +  2*(XABUO)*(ZBUO_INTEG)
    908. 

  908.      ENDWHERE
    909. 

  909.      
    910. 

  910.  ENDWHERE
    911. 

  911. 

  912.  
    913. 

  913.  ZDZ_STOP(:) = ZDZ_HALF(:)
    914. 

  914.   
    915. 

  915. ! total Integral Buoyancy between flux level KK and flux level KK+1 
    916. 

  916. 

  917.  PBUO_INTEG = PBUO_INTEG + ZG_O_THVREF(:,KK)*ZDZ_HALF(:)*&
    918. 

  918.                 (0.5*(ZCOTHVU_PLUS_HALF - ZCOEFF_PLUS_HALF)* ZDZ_HALF(:) - & 
    919. 

  919.                 PTHVM(:,KK) + ZTHV_UP(:) ) 
    920. 

  920.               
    921. 

  921.                
    922. 

  922.  WHERE ((((ZRCMIX_F2(:)>0.).AND.(ZRCMIX(:)<=0.)).AND.(.NOT.OTESTLCL)).AND.(.NOT.GTEST_LOCAL_LCL(:)))
    923. 

  923.  ! If rc is found between mass level KK and flux level KK+1
    924. 

  924.  ! a part of dry entrainment is defined
    925. 

  925.  ! the exact height of LCL is also determined
    926. 

  926.      PT(:)=ZTHMIX_F2(:)*((PPABSM(:,KK+1)/XP00)**(XRD/XCPD)) 
    927. 

  927.      ZQVSAT(:)=EXP( XALPW - XBETAW/PT(:) - XGAMW*LOG(PT(:))  )
    928. 

  928.      ZQVSAT(:)=XRD/XRV*ZQVSAT(:)/PPABSM(:,KK+1)   &
    929. 

  929.                    / (1.+(XRD/XRV-1.)*ZQVSAT(:)/PPABSM(:,KK+1))   
    930. 

  930.      ZCOEFF_QSAT(:) = (PRT_UP(:) - ZQVSAT(:) - &
    931. 

  931.                 ZRCMIX(:))/ (0.5* (PZZ(:,KK+2)-PZZ(:,KK+1)))
    932. 

  932.      ZRC_ORD(:) = ZRCMIX_F2(:) - ZCOEFF_QSAT(:) * ZDZ_HALF(:)
    933. 

  933.      ZDZ_STOP = (- ZRC_ORD(:)/ZCOEFF_QSAT(:))     
    934. 

  934.      ZPART_DRY(:) = 0.5+ZDZ_STOP  / (PZZ(:,KK+1)-PZZ(:,KK))
    935. 

  935.      GTEST_LOCAL_LCL2(:)=.TRUE.     
    936. 

  936.  ENDWHERE
    937. 

  937. 

  938. 

  939.  WHERE (((OTEST).AND.(.NOT.OTESTLCL)).AND.(.NOT.GTEST_LOCAL_LCL(:)))
    940. 

  940.    
    941. 

  941.      ZBUO_INTEG = ZG_O_THVREF(:,KK)*ZDZ_STOP(:)*&
    942. 

  942.                 (0.5*( - ZCOEFF_PLUS_HALF)* ZDZ_STOP(:)&
    943. 

  943.                 - PTHVM(:,KK) + ZTHV_UP(:) )
    944. 

  944. 

  945.              
    946. 

  946. 

  947.      WHERE (ZW2_HALF>0.)
    948. 

  948.         WHERE (ZBUO_INTEG(:)>=0.)
    949. 

  949.            PENTR = PENTR + 0.5/(XABUO-XBENTR*XENTR_DRY)* &
    950. 

  950.                 LOG(1.+ (2.*(XABUO-XBENTR*XENTR_DRY)/ZW2_HALF(:)) * ZBUO_INTEG)
    951. 

  951.           
    952. 

  952.            PDETR = PDETR
    953. 

  953.               
    954. 

  954.         ELSEWHERE
    955. 

  955.           PENTR = PENTR
    956. 

  956.           
    957. 

  957.           PDETR = PDETR + 0.5/(XABUO)* &
    958. 

  958.                 LOG(1.+ (2.*(XABUO)/ZW2_HALF(:)) * &
    959. 

  959.                 MAX(-ZBUO_INTEG,0.))
    960. 

  960.         ENDWHERE     
    961. 

  961.      ELSEWHERE
    962. 

  962.         ! if w**2<0 the updraft is stopped 
    963. 

  963.            OTEST=.FALSE.
    964. 

  964.            PENTR = PENTR 
    965. 

  965.            PDETR = PDETR 
    966. 

  966.      ENDWHERE
    967. 

  967.               
    968. 

  968.  ENDWHERE
    969. 

  969.  PENTR = XENTR_DRY*PENTR/(PZZ(:,KK+1)-PZZ(:,KK))    
    970. 

  970.  PDETR = XDETR_DRY*PDETR/(PZZ(:,KK+1)-PZZ(:,KK))
    971. 

  971.  PDETR = MAX(ZPART_DRY(:)*XDETR_LUP/(PLUP-0.5*(PZZ(:,KK)+PZZ(:,KK+1))),PDETR)
    972. 

  972. 

  973. 

  974.   
    975. 

  975. 

  976. ! compute final value of critical mixed fraction using theta_v
    977. 

  977. ! of mixture, grid-scale and updraft in cloud
    978. 

  978. 

  979.  WHERE ((OTEST).AND.(OTESTLCL))
    980. 

  980.      ZKIC(:) = MAX(0.,ZTHV_UP(:)-PTHVM(:,KK))*ZKIC(:) /  &  
    981. 

  981.                  (ZTHV_UP(:)-ZTHVMIX_1(:)+1.E-10)
    982. 

  982.                        
    983. 

  983.      ZKIC(:) = MAX(0., MIN(1., ZKIC(:)))
    984. 

  984.     
    985. 

  985.      ZEPSI(:) = ZKIC(:) **2.
    986. 

  986.      ZDELTA(:) = (1.-ZKIC(:))**2.
    987. 

  987.      ZEPSI_CLOUD=MIN(ZDELTA,ZEPSI)
    988. 

  988.      ZCOEFFMF_CLOUD(:)=XENTR_MF * XG / XCRAD_MF         
    989. 

  989.      PENTR(:) = ZCOEFFMF_CLOUD(:)*ZEPSI_CLOUD(:)
    990. 

  990.      PDETR(:) = ZCOEFFMF_CLOUD(:)*ZDELTA(:)
    991. 

  991.  ENDWHERE
    992. 

  992.  
    993. 

  993. ! compute final value of critical mixed fraction using theta_v
    994. 

  994. ! of mixture, grid-scale and updraft in cloud
    995. 

  995. 

  996. 

  997.  WHERE (((OTEST).AND.(.NOT.(OTESTLCL))).AND.((GTEST_LOCAL_LCL(:).OR.GTEST_LOCAL_LCL2(:))))
    998. 

  998.      ZKIC(:) = MAX(0.,ZTHV_UP_F2(:)-ZTHV_PLUS_HALF)*ZKIC(:) /  &  
    999. 

  999.                        (ZTHV_UP_F2(:)-ZTHVMIX_2(:)+1.E-10)                      
    1000. 

  1000.      ZKIC(:) = MAX(0., MIN(1., ZKIC(:)))
    1001. 

  1001.      ZEPSI(:) = ZKIC(:) **2.
    1002. 

  1002.      ZDELTA(:) = (1.-ZKIC(:))**2.
    1003. 

  1003.      ZEPSI_CLOUD=MIN(ZDELTA,ZEPSI)
    1004. 

  1004.      ZCOEFFMF_CLOUD(:)=XENTR_MF * XG / XCRAD_MF     
    1005. 

  1005.      PENTR(:) = PENTR+(1.-ZPART_DRY(:))*ZCOEFFMF_CLOUD(:)*ZEPSI_CLOUD(:)
    1006. 

  1006.      PDETR(:) = PDETR+(1.-ZPART_DRY(:))*ZCOEFFMF_CLOUD(:)*ZDELTA(:)
    1007. 

  1007.  ENDWHERE
    1008. 

  1008.  
    1009. 

  1009. 

  1010. 

  1011. END SUBROUTINE COMPUTE_ENTR_DETR  
    1012. 

  1012. 

  1013.                                        
    1014. 

  1014. !     #################################################################
    1015. 

  1015.       SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI,                  &
    1016. 

  1016.                                        PTH, PR, PEXN, PPABS,                 &
    1017. 

  1017.                                        PT,PLVOCPEXN,PLSOCPEXN,               &
    1018. 

  1018.                                        PAMOIST,PATHETA                       )
    1019. 

  1019. !     #################################################################
    1020. 

  1020. !
    1021. 

  1021. !!
    1022. 

  1022. !!****  *COMPUTE_FUNCTION_THERMO_MF* - 
    1023. 

  1023. !!
    1024. 

  1024. !!
    1025. 

  1025. !! --------------------------------------------------------------------------
    1026. 

  1026. !       
    1027. 

  1027. 

  1028. !
    1029. 

  1029. IMPLICIT NONE
    1030. 

  1030. !
    1031. 

  1031. !
    1032. 

  1032. !*      0.1  declarations of arguments
    1033. 

  1033. !
    1034. 

  1034. INTEGER,                INTENT(IN)   :: KRR           ! number of moist var.
    1035. 

  1035. INTEGER,                INTENT(IN)   :: KRRL          ! number of liquid water var.
    1036. 

  1036. INTEGER,                INTENT(IN)   :: KRRI          ! number of ice water var.
    1037. 

  1037. 

  1038. REAL, DIMENSION(:,:,:), INTENT(IN)   :: PTH      ! theta
    1039. 

  1039. REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR       ! water species
    1040. 

  1040. REAL, DIMENSION(:,:,:)  , INTENT(IN) :: PPABS,PEXN    ! pressure, Exner funct.
    1041. 

  1041. 

  1042. REAL, DIMENSION(:,:,:), INTENT(OUT)   :: PT      ! temperature
    1043. 

  1043. REAL, DIMENSION(:,:,:), INTENT(OUT)   :: PLVOCPEXN,PLSOCPEXN     ! L/(cp*Pi)
    1044. 

  1044. 

  1045. REAL, DIMENSION(:,:,:), INTENT(OUT)  ::  PAMOIST,PATHETA
    1046. 

  1046. !
    1047. 

  1047. !-------------------------------------------------------------------------------
    1048. 

  1048. ! 
    1049. 

  1049. !*       0.2   Declarations of local variables
    1050. 

  1050. !
    1051. 

  1051. REAL                :: ZEPS         ! XMV / XMD
    1052. 

  1052. REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) ::     &
    1053. 

  1053.           ZCP,                        &  ! Cp 
    1054. 

  1054.           ZE,                         &  ! Saturation mixing ratio
    1055. 

  1055.           ZDEDT,                      &  ! Saturation mixing ratio derivative
    1056. 

  1056.           ZFRAC_ICE,                  &  ! Ice fraction
    1057. 

  1057.           ZAMOIST_W,                  &  ! Coefficients for s = f (Thetal,Rnp)
    1058. 

  1058.           ZATHETA_W,                  &  !
    1059. 

  1059.           ZAMOIST_I,                  &  !
    1060. 

  1060.           ZATHETA_I                      !
    1061. 

  1061. 

  1062. INTEGER             :: JRR
    1063. 

  1063. !
    1064. 

  1064. !-------------------------------------------------------------------------------
    1065. 

  1065. !
    1066. 

  1066.   ZEPS = XMV / XMD
    1067. 

  1067. 

  1068.   PLVOCPEXN(:,:,:) = 0.
    1069. 

  1069.   PLSOCPEXN(:,:,:) = 0.
    1070. 

  1070.   PAMOIST(:,:,:) = 0.
    1071. 

  1071.   PATHETA(:,:,:) = 0.
    1072. 

  1072.   ZFRAC_ICE(:,:,:) = 0.0
    1073. 

  1073. 

  1074. !
    1075. 

  1075. !*       Cph
    1076. 

  1076. !
    1077. 

  1077. ZCP=XCPD
    1078. 

  1078. 

  1079. IF (KRR > 0) ZCP(:,:,:) = ZCP(:,:,:) + XCPV * PR(:,:,:,1)
    1080. 

  1080. 

  1081. DO JRR = 2,1+KRRL  ! loop on the liquid components  
    1082. 

  1082.    ZCP(:,:,:)  = ZCP(:,:,:) + XCL * PR(:,:,:,JRR)
    1083. 

  1083. END DO
    1084. 

  1084. 

  1085. DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components   
    1086. 

  1086.   ZCP(:,:,:)  = ZCP(:,:,:)  + XCI * PR(:,:,:,JRR)
    1087. 

  1087. END DO
    1088. 

  1088. 

  1089. !*      Temperature
    1090. 

  1090. !
    1091. 

  1091. PT(:,:,:) =  PTH(:,:,:) * PEXN(:,:,:)
    1092. 

  1092. !
    1093. 

  1093. !
    1094. 

  1094. !! Liquid water
    1095. 

  1095. !
    1096. 

  1096. IF ( KRRL >= 1 ) THEN 
    1097. 

  1097. !
    1098. 

  1098. !*       Lv/Cph 
    1099. 

  1099. !
    1100. 

  1100.   PLVOCPEXN(:,:,:) = (XLVTT + (XCPV-XCL) *  (PT(:,:,:)-XTT) ) / ZCP(:,:,:)
    1101. 

  1101. !
    1102. 

  1102. !*      Saturation vapor pressure with respect to water
    1103. 

  1103. !
    1104. 

  1104.   ZE(:,:,:) =  EXP( XALPW - XBETAW/PT(:,:,:) - XGAMW*ALOG( PT(:,:,:) ) )
    1105. 

  1105. !
    1106. 

  1106. !*      Saturation  mixing ratio with respect to water
    1107. 

  1107. !
    1108. 

  1108.   ZE(:,:,:) =  ZE(:,:,:) * ZEPS / ( PPABS(:,:,:) - ZE(:,:,:) )
    1109. 

  1109. !
    1110. 

  1110. !*      Compute the saturation mixing ratio derivative (rvs')
    1111. 

  1111. !
    1112. 

  1112.   ZDEDT(:,:,:) = ( XBETAW / PT(:,:,:)  - XGAMW ) / PT(:,:,:)   &
    1113. 

  1113.                  * ZE(:,:,:) * ( 1. + ZE(:,:,:) / ZEPS )
    1114. 

  1114. !
    1115. 

  1115. !*      Compute Amoist
    1116. 

  1116. !
    1117. 

  1117.   ZAMOIST_W(:,:,:)=  0.5 / ( 1.0 + ZDEDT(:,:,:) * PLVOCPEXN(:,:,:) )
    1118. 

  1118. !
    1119. 

  1119. !*      Compute Atheta
    1120. 

  1120. !
    1121. 

  1121.   ZATHETA_W(:,:,:)= ZAMOIST_W(:,:,:) * PEXN(:,:,:) *                       &
    1122. 

  1122.         ( ( ZE(:,:,:) - PR(:,:,:,1) ) * PLVOCPEXN(:,:,:) /                  &
    1123. 

  1123.           ( 1. + ZDEDT(:,:,:) * PLVOCPEXN(:,:,:) )           *              &
    1124. 

  1124.           (                                                                 &
    1125. 

  1125.            ZE(:,:,:) * (1. + ZE(:,:,:)/ZEPS)                                &
    1126. 

  1126.                         * ( -2.*XBETAW/PT(:,:,:) + XGAMW ) / PT(:,:,:)**2   &
    1127. 

  1127.           +ZDEDT(:,:,:) * (1. + 2. * ZE(:,:,:)/ZEPS)                        &
    1128. 

  1128.                         * ( XBETAW/PT(:,:,:) - XGAMW ) / PT(:,:,:)          &
    1129. 

  1129.           )                                                                 &
    1130. 

  1130.          - ZDEDT(:,:,:)                                                     &
    1131. 

  1131.         )
    1132. 

  1132. 

  1133. !
    1134. 

  1134. !! Solid water
    1135. 

  1135. !
    1136. 

  1136.   IF ( KRRI >= 1 ) THEN 
    1137. 

  1137. 

  1138. !
    1139. 

  1139. !*       Fraction of ice
    1140. 

  1140. !
    1141. 

  1141.     WHERE(PR(:,:,:,2)+PR(:,:,:,4)>0.0)
    1142. 

  1142.       ZFRAC_ICE(:,:,:) = PR(:,:,:,4) / ( PR(:,:,:,2)+PR(:,:,:,4) )
    1143. 

  1143.     END WHERE
    1144. 

  1144. !
    1145. 

  1145. !*       Ls/Cph 
    1146. 

  1146. !
    1147. 

  1147.     PLSOCPEXN(:,:,:) = (XLSTT + (XCPV-XCI) *  (PT(:,:,:)-XTT) ) / ZCP(:,:,:)
    1148. 

  1148. !
    1149. 

  1149. !*      Saturation vapor pressure with respect to ice
    1150. 

  1150. !
    1151. 

  1151.     ZE(:,:,:) =  EXP( XALPI - XBETAI/PT(:,:,:) - XGAMI*ALOG( PT(:,:,:) ) )
    1152. 

  1152. !
    1153. 

  1153. !*      Saturation  mixing ratio with respect to ice
    1154. 

  1154. !
    1155. 

  1155.     ZE(:,:,:) =  ZE(:,:,:) * ZEPS / ( PPABS(:,:,:) - ZE(:,:,:) )
    1156. 

  1156. !
    1157. 

  1157. !*      Compute the saturation mixing ratio derivative (rvs')
    1158. 

  1158. !
    1159. 

  1159.     ZDEDT(:,:,:) = ( XBETAI / PT(:,:,:)  - XGAMI ) / PT(:,:,:)   &
    1160. 

  1160.                    * ZE(:,:,:) * ( 1. + ZE(:,:,:) / ZEPS )
    1161. 

  1161. !
    1162. 

  1162. !*      Compute Amoist
    1163. 

  1163. !
    1164. 

  1164.     ZAMOIST_I(:,:,:)=  0.5 / ( 1.0 + ZDEDT(:,:,:) * PLSOCPEXN(:,:,:) )
    1165. 

  1165. !
    1166. 

  1166. !*      Compute Atheta
    1167. 

  1167. !
    1168. 

  1168.     ZATHETA_I(:,:,:)= ZAMOIST_I(:,:,:) * PEXN(:,:,:) *                     &
    1169. 

  1169.         ( ( ZE(:,:,:) - PR(:,:,:,1) ) * PLSOCPEXN(:,:,:) /                  &
    1170. 

  1170.           ( 1. + ZDEDT(:,:,:) * PLSOCPEXN(:,:,:) )           *              &
    1171. 

  1171.           (                                                                 &
    1172. 

  1172.            ZE(:,:,:) * (1. + ZE(:,:,:)/ZEPS)                                &
    1173. 

  1173.                         * ( -2.*XBETAI/PT(:,:,:) + XGAMI ) / PT(:,:,:)**2   &
    1174. 

  1174.           +ZDEDT(:,:,:) * (1. + 2. * ZE(:,:,:)/ZEPS)                        &
    1175. 

  1175.                         * ( XBETAI/PT(:,:,:) - XGAMI ) / PT(:,:,:)          &
    1176. 

  1176.           )                                                                 &
    1177. 

  1177.          - ZDEDT(:,:,:)                                                     &
    1178. 

  1178.         )
    1179. 

  1179. 

  1180. 

  1181.   ENDIF
    1182. 

  1182. 

  1183.   PAMOIST(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZAMOIST_W(:,:,:) &
    1184. 

  1184.                          +ZFRAC_ICE(:,:,:) *ZAMOIST_I(:,:,:)
    1185. 

  1185.   PATHETA(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZATHETA_W(:,:,:) &
    1186. 

  1186.                          +ZFRAC_ICE(:,:,:) *ZATHETA_I(:,:,:)
    1187. 

  1187. 

  1188. !
    1189. 

  1189. !*      Lv/Cph/Exner and  Ls/Cph/Exner
    1190. 

  1190. !
    1191. 

  1191.   PLVOCPEXN(:,:,:) = PLVOCPEXN(:,:,:) / PEXN(:,:,:)
    1192. 

  1192.   PLSOCPEXN(:,:,:) = PLSOCPEXN(:,:,:) / PEXN(:,:,:)
    1193. 

  1193. !
    1194. 

  1194. ENDIF
    1195. 

  1195. 

  1196. END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF
    1197. 

  1197. !
    1198. 

  1198. !     #################################################################
    1199. 

  1199.       SUBROUTINE COMPUTE_UPDRAFT(OMIXUV,PZZ,PDZZ,KK,              &
    1200. 

  1200.                                  PSFTH,PSFRV,                     &
    1201. 

  1201.                                  PPABSM,PRHODREF,PUM,PVM, PTKEM,  &
    1202. 

  1202.                                  PTHM,PRVM,PRCM,PRIM,PTHLM,PRTM,  &
    1203. 

  1203.                                  PTHL_UP,PRT_UP,                  &
    1204. 

  1204.                                  PRV_UP,PRC_UP,PRI_UP,PTHV_UP,    &
    1205. 

  1205.                                  PW_UP,PU_UP, PV_UP,              &
    1206. 

  1206.                                  PFRAC_UP,PEMF,PDETR,PENTR,       &
    1207. 

  1207.                                  KKLCL,KKETL,KKCTL)
    1208. 

  1208. !     #################################################################
    1209. 

  1209. !!
    1210. 

  1210. !!****  *COMPUTE_UPDRAFT* - calculates caracteristics of the updraft 
    1211. 

  1211. !!                         
    1212. 

  1212. !! --------------------------------------------------------------------------
    1213. 

  1213. 

  1214. 

  1215. 

  1216. IMPLICIT NONE
    1217. 

  1217. 

  1218. !*                    1.1  Declaration of Arguments
    1219. 

  1219. !
    1220. 

  1220. !
    1221. 

  1221. !
    1222. 

  1222. LOGICAL,                INTENT(IN) :: OMIXUV    ! True if mixing of momentum
    1223. 

  1223. REAL, DIMENSION(:,:), INTENT(IN)   :: PZZ       !  Height at the flux point
    1224. 

  1224. REAL, DIMENSION(:,:), INTENT(IN)   :: PDZZ      !  Metrics coefficient
    1225. 

  1225.  
    1226. 

  1226. INTEGER,              INTENT(IN)   ::  KK        
    1227. 

  1227. REAL, DIMENSION(:),   INTENT(IN)   ::  PSFTH,PSFRV
    1228. 

  1228. ! normal surface fluxes of theta,rv,(u,v) parallel to the orography
    1229. 

  1229. !
    1230. 

  1230. REAL, DIMENSION(:,:),   INTENT(IN) ::  PPABSM     ! Pressure at t-dt
    1231. 

  1231. REAL, DIMENSION(:,:),   INTENT(IN) ::  PRHODREF   ! dry density of the
    1232. 

  1232.                                                   ! reference state
    1233. 

  1233. REAL, DIMENSION(:,:),   INTENT(IN) ::  PUM        ! u mean wind
    1234. 

  1234. REAL, DIMENSION(:,:),   INTENT(IN) ::  PVM        ! v mean wind
    1235. 

  1235. REAL, DIMENSION(:,:),   INTENT(IN) ::  PTKEM      ! TKE at t-dt
    1236. 

  1236. !
    1237. 

  1237. REAL, DIMENSION(:,:),   INTENT(IN)   ::  PTHM           ! liquid pot. temp. at t-dt
    1238. 

  1238. REAL, DIMENSION(:,:),   INTENT(IN)   ::  PRVM,PRCM,PRIM ! vapor mixing ratio at t-dt
    1239. 

  1239. REAL, DIMENSION(:,:),   INTENT(IN)   ::  PTHLM,PRTM     ! cons. var. at t-dt
    1240. 

  1240. 

  1241. 

  1242. REAL, DIMENSION(:,:),   INTENT(OUT)  ::  PTHL_UP,PRT_UP   ! updraft properties
    1243. 

  1243. REAL, DIMENSION(:,:),   INTENT(OUT)  ::  PU_UP, PV_UP     ! updraft wind components
    1244. 

  1244. REAL, DIMENSION(:,:),   INTENT(OUT)  ::  PRV_UP,PRC_UP, & ! updraft rv, rc
    1245. 

  1245.                                          PRI_UP,PTHV_UP,& ! updraft ri, THv
    1246. 

  1246.                                          PW_UP,PFRAC_UP   ! updraft w, fraction
    1247. 

  1247. 

  1248.                                          
    1249. 

  1249. REAL, DIMENSION(:,:),   INTENT(OUT)  ::  PEMF,PDETR,PENTR ! Mass_flux,
    1250. 

  1250.                                                           ! detrainment,entrainment
    1251. 

  1251. INTEGER, DIMENSION(:),  INTENT(OUT)  ::  KKLCL,KKETL,KKCTL! LCL, ETL, CTL                                     
    1252. 

  1252. !                       1.2  Declaration of local variables
    1253. 

  1253. !
    1254. 

  1254. !
    1255. 

  1255. ! Mean environment variables at t-dt at flux point
    1256. 

  1256. REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) ::    &
    1257. 

  1257.                         ZTHM_F,ZRVM_F,ZRCM_F,ZRIM_F   ! Theta,rv,rl,ri of
    1258. 

  1258.                                                       ! updraft environnement
    1259. 

  1259. REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) ::    &
    1260. 

  1260.                         ZRTM_F, ZTHLM_F, ZTKEM_F,&    ! rt, thetal,TKE,pressure,
    1261. 

  1261.                         ZUM_F,ZVM_F,ZRHO_F,      &    ! density,momentum
    1262. 

  1262.                         ZPRES_F,ZTHVM_F,ZTHVM,   &    ! interpolated at the flux point
    1263. 

  1263.                         ZG_O_THVREF,             &    ! g*ThetaV ref
    1264. 

  1264.                         ZW_UP2                        ! w**2  of the updraft
    1265. 

  1265. 

  1266.                         
    1267. 

  1267. REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) ::  &
    1268. 

  1268.                         ZTH_UP,                  &    ! updraft THETA 
    1269. 

  1269.                         ZFRAC_ICE                     ! Ice fraction
    1270. 

  1270. 

  1271. REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) ::  ZCOEF  ! diminution coefficient for too high clouds 
    1272. 

  1272.                         
    1273. 

  1273. REAL, DIMENSION(SIZE(PSFTH,1) )            ::  ZWTHVSURF  ! Surface w'thetav'
    1274. 

  1274. CHARACTER(LEN=1)                           ::  YFRAC_ICE  ! Ice Fraction
    1275. 

  1275.                                                           ! precribed or computed 
    1276. 

  1276. 

  1277. REAL  :: ZRDORV       ! RD/RV
    1278. 

  1278. REAL  :: ZRVORD       ! RV/RD
    1279. 

  1279. 

  1280. 

  1281. REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2,ZMIX3
    1282. 

  1282. REAL, DIMENSION(SIZE(PTHM,1)) :: ZBUO_INTEG           ! Integrated Buoyancy 
    1283. 

  1283. 

  1284. REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP         ! Upward Mixing length from the ground
    1285. 

  1285. REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH       ! Deepness limit for cloud
    1286. 

  1286. 

  1287. INTEGER  :: IKB,IKE            ! index value for the Beginning and the End
    1288. 

  1288.                                ! of the physical domain for the mass points
    1289. 

  1289. INTEGER  :: IKU           ! array size in k
    1290. 

  1290. INTEGER  :: JK,JI,JSV          ! loop counters
    1291. 

  1291. 

  1292. LOGICAL, DIMENSION(SIZE(PTHM,1)) ::  GTEST,GTESTLCL,GTESTETL
    1293. 

  1293.                                ! Test if the ascent continue, if LCL or ETL is reached
    1294. 

  1294. LOGICAL                          ::  GLMIX 
    1295. 

  1295.                                ! To choose upward or downward mixing length
    1296. 

  1296. LOGICAL, DIMENSION(SIZE(PTHM,1))              :: GWORK1
    1297. 

  1297. LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
    1298. 

  1298. 

  1299. INTEGER  :: ITEST
    1300. 

  1300. REAL  :: ZTMAX,ZRMAX  ! control value
    1301. 

  1301. ! Thresholds for the  perturbation of
    1302. 

  1302. ! theta_l and r_t at the first level of the updraft
    1303. 

  1303. ZTMAX=2.0
    1304. 

  1304. ZRMAX=1.E-3
    1305. 

  1305. !------------------------------------------------------------------------
    1306. 

  1306. 

  1307. !                     INITIALISATION
    1308. 

  1308. 

  1309. !                 Local variables, internal domain
    1310. 

  1310. ! Internal Domain
    1311. 

  1311. IKU=SIZE(PTHM,2)
    1312. 

  1312. IKB=1        ! modif WRF JP
    1313. 

  1313. IKE=IKU-1      ! modif WRF JP
    1314. 

  1314. 

  1315. ! Initialisation of intersesting Level :LCL,ETL,CTL
    1316. 

  1316. KKLCL(:)=IKE
    1317. 

  1317. KKETL(:)=IKE
    1318. 

  1318. KKCTL(:)=IKE
    1319. 

  1319. 

  1320. ! 
    1321. 

  1321. ! Initialisation
    1322. 

  1322. PRV_UP(:,:)=0.
    1323. 

  1323. PRC_UP(:,:)=0.
    1324. 

  1324. 

  1325. PW_UP(:,:)=0.
    1326. 

  1326. PEMF(:,:)=0.
    1327. 

  1327. PDETR(:,:)=0.
    1328. 

  1328. PENTR(:,:)=0.
    1329. 

  1329. ZTH_UP(:,:)=0.
    1330. 

  1330. PFRAC_UP(:,:)=0.
    1331. 

  1331. PTHV_UP(:,:)=0.
    1332. 

  1332. 

  1333. !no ice cloud coded yet 
    1334. 

  1334. PRI_UP(:,:)=0.
    1335. 

  1335. ZFRAC_ICE(:,:)=0.
    1336. 

  1336. YFRAC_ICE='T'
    1337. 

  1337. 

  1338. ZBUO_INTEG=0.
    1339. 

  1339. ! Initialisation of the constants   
    1340. 

  1340. ZRDORV   = XRD / XRV   !=0.622
    1341. 

  1341. ZRVORD   = (XRV / XRD) 
    1342. 

  1342. 

  1343. 

  1344. ! Initialisation of environment variables at t-dt
    1345. 

  1345. 

  1346. ! variables at flux level
    1347. 

  1347. 

  1348. 

  1349. ZTHM_F (:,IKB+1:IKU) = 0.5*(PTHM(:,IKB:IKU-1)+PTHM(:,IKB+1:IKU))
    1350. 

  1350. ZTHLM_F(:,IKB+1:IKU) = 0.5*(PTHLM(:,IKB:IKU-1)+PTHLM(:,IKB+1:IKU))
    1351. 

  1351. ZRTM_F (:,IKB+1:IKU) = 0.5*(PRTM(:,IKB:IKU-1)+PRTM(:,IKB+1:IKU))
    1352. 

  1352. ZTKEM_F(:,IKB+1:IKU) = 0.5*(PTKEM(:,IKB:IKU-1)+PTKEM(:,IKB+1:IKU))
    1353. 

  1353. ZPRES_F(:,IKB+1:IKU) = 0.5*(PPABSM(:,IKB:IKU-1)+PPABSM(:,IKB+1:IKU))
    1354. 

  1354. ZRHO_F (:,IKB+1:IKU) = 0.5*(PRHODREF(:,IKB:IKU-1)+PRHODREF(:,IKB+1:IKU))
    1355. 

  1355. ZRVM_F (:,IKB+1:IKU) = 0.5*(PRVM(:,IKB:IKU-1)+PRVM(:,IKB+1:IKU))
    1356. 

  1356. ZUM_F  (:,IKB+1:IKU) = 0.5*(PUM(:,IKB:IKU-1)+PUM(:,IKB+1:IKU))
    1357. 

  1357. ZVM_F  (:,IKB+1:IKU) = 0.5*(PVM(:,IKB:IKU-1)+PVM(:,IKB+1:IKU))
    1358. 

  1358. 

  1359. 

  1360. 

  1361. ZTHM_F (:,IKB) = PTHM(:,IKB) 
    1362. 

  1362. ZTHLM_F(:,IKB) = PTHLM(:,IKB)
    1363. 

  1363. ZRTM_F (:,IKB) = PRTM (:,IKB)
    1364. 

  1364. ZTKEM_F(:,IKB) = PTKEM(:,IKB)
    1365. 

  1365. ZPRES_F(:,IKB) = PPABSM(:,IKB)
    1366. 

  1366. ZRHO_F(:,IKB)  = PRHODREF(:,IKB)
    1367. 

  1367. ZRVM_F(:,IKB)  = PRVM(:,IKB)
    1368. 

  1368. ZUM_F(:,IKB)   = PUM(:,IKB)
    1369. 

  1369. ZVM_F(:,IKB)   = PVM(:,IKB)
    1370. 

  1370. 

  1371. 

  1372. ! thetav at mass and flux levels 
    1373. 

  1373. ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
    1374. 

  1374. ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
    1375. 

  1375. 

  1376. 

  1377. !                     
    1378. 

  1378. !          Initialisation of updraft characteristics 
    1379. 

  1379. PTHL_UP(:,:)=ZTHLM_F(:,:)
    1380. 

  1380. PRT_UP(:,:)=ZRTM_F(:,:)
    1381. 

  1381. ZW_UP2(:,:)=0.
    1382. 

  1382. PTHV_UP(:,:)=ZTHVM_F(:,:)
    1383. 

  1383. PU_UP(:,:)=ZUM_F(:,:)
    1384. 

  1384. PV_UP(:,:)=ZVM_F(:,:)
    1385. 

  1385. 

  1386. 

  1387. ! Computation or initialisation of updraft characteristics at the KK level
    1388. 

  1388. ! thetal_up,rt_up,thetaV_up, w²,Buoyancy term and mass flux (PEMF)
    1389. 

  1389. 

  1390. ! 03/2009
    1391. 

  1391. !PTHL_UP(:,KK)= ZTHLM_F(:,KK)+(PSFTH(:)/SQRT(ZTKEM_F(:,KK)))*XALP_PERT
    1392. 

  1392. !PRT_UP(:,KK) = ZRTM_F(:,KK)+(PSFRV(:)/SQRT(ZTKEM_F(:,KK)))*XALP_PERT
    1393. 

  1393. PTHL_UP(:,KK)= ZTHLM_F(:,KK)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KK)))*XALP_PERT))
    1394. 

  1394. PRT_UP(:,KK) = ZRTM_F(:,KK)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KK)))*XALP_PERT)) 
    1395. 

  1395. 

  1396. 

  1397. 

  1398. ZW_UP2(:,KK) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KK))
    1399. 

  1399. 

  1400. 

  1401. ! Computation of non conservative variable for the KK level of the updraft
    1402. 

  1402. ! (all or nothing ajustement)
    1403. 

  1403. CALL TH_R_FROM_THL_RT_2D(YFRAC_ICE,ZFRAC_ICE(:,KK:KK),ZPRES_F(:,KK:KK), &
    1404. 

  1404.              PTHL_UP(:,KK:KK),PRT_UP(:,KK:KK),ZTH_UP(:,KK:KK), &
    1405. 

  1405.              PRV_UP(:,KK:KK),PRC_UP(:,KK:KK),PRI_UP(:,KK:KK))
    1406. 

  1406. 

  1407. ! compute updraft thevav and buoyancy term at KK level             
    1408. 

  1408. PTHV_UP(:,KK) = ZTH_UP(:,KK)*((1+ZRVORD*PRV_UP(:,KK))/(1+PRT_UP(:,KK))) 
    1409. 

  1409.                                                             
    1410. 

  1410. ! Closure assumption for mass flux at KK level                                                  
    1411. 

  1411. ZG_O_THVREF=XG/ZTHVM_F
    1412. 

  1412. 

  1413. ! compute L_up
    1414. 

  1414. GLMIX=.TRUE.
    1415. 

  1415. ZTKEM_F(:,KK)=0.
    1416. 

  1416. 

  1417. CALL COMPUTE_BL89_ML(PDZZ,ZTKEM_F,ZG_O_THVREF,ZTHVM_F,KK,GLMIX,ZLUP)
    1418. 

  1418. ZLUP(:)=MAX(ZLUP(:),1.E-10)
    1419. 

  1419. 

  1420. ! Compute Buoyancy flux at the ground
    1421. 

  1421. ZWTHVSURF(:) = (ZTHVM_F(:,IKB)/ZTHM_F(:,IKB))*PSFTH(:)+     &
    1422. 

  1422.                 (0.61*ZTHM_F(:,IKB))*PSFRV(:)
    1423. 

  1423. 

  1424. ! Mass flux at KK level (updraft triggered if PSFTH>0.)
    1425. 

  1425. WHERE (ZWTHVSURF(:)>0.)
    1426. 

  1426.   PEMF(:,KK) = XCMF * ZRHO_F(:,KK) * ((ZG_O_THVREF(:,KK))*ZWTHVSURF*ZLUP)**(1./3.)
    1427. 

  1427.   PFRAC_UP(:,KK)=MIN(PEMF(:,KK)/(SQRT(ZW_UP2(:,KK))*ZRHO_F(:,KK)),XFRAC_UP_MAX)
    1428. 

  1428.   ZW_UP2(:,KK)=(PEMF(:,KK)/(PFRAC_UP(:,KK)*ZRHO_F(:,KK)))**2
    1429. 

  1429.   GTEST(:)=.TRUE.
    1430. 

  1430. ELSEWHERE
    1431. 

  1431.   PEMF(:,KK) =0.
    1432. 

  1432.   GTEST(:)=.FALSE.
    1433. 

  1433. ENDWHERE
    1434. 

  1434. 

  1435. 

  1436. !--------------------------------------------------------------------------
    1437. 

  1437. 

  1438. !                        3. Iteration
    1439. 

  1439. !                           ---------
    1440. 

  1440. !
    1441. 

  1441. ! If GTEST = T the updraft starts from the KK level and stops when GTEST becomes F
    1442. 

  1442. !
    1443. 

  1443. !
    1444. 

  1444. GTESTLCL(:)=.FALSE.
    1445. 

  1445. GTESTETL(:)=.FALSE.
    1446. 

  1446. 

  1447. !       Loop on vertical level
    1448. 

  1448. 

  1449. DO JK=KK,IKE-1
    1450. 

  1450. ! IF the updraft top is reached for all column, stop the loop on levels
    1451. 

  1451. ITEST=COUNT(GTEST)
    1452. 

  1452. IF (ITEST==0) CYCLE
    1453. 

  1453. !       Computation of entrainment and detrainment with KF90
    1454. 

  1454. !       parameterization in clouds and LR01 in subcloud layer
    1455. 

  1455. 

  1456. 

  1457. ! to find the LCL (check if JK is LCL or not)
    1458. 

  1458. 

  1459.   WHERE(GTEST)
    1460. 

  1460.   WHERE ((PRC_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
    1461. 

  1461.       KKLCL(:) = JK           
    1462. 

  1462.       GTESTLCL(:)=.TRUE.
    1463. 

  1463.   ENDWHERE
    1464. 

  1464.   ENDWHERE
    1465. 

  1465. 

  1466. 

  1467. ! COMPUTE PENTR and PDETR at mass level JK
    1468. 

  1468. 

  1469.  CALL COMPUTE_ENTR_DETR(GTEST,GTESTLCL,YFRAC_ICE,ZFRAC_ICE(:,JK),JK,&
    1470. 

  1470.                        PPABSM(:,:),PZZ(:,:),PDZZ(:,:),ZTHVM(:,:),&
    1471. 

  1471.                        PTHLM(:,JK),PRTM(:,JK),ZW_UP2(:,:),   &
    1472. 

  1472.                        PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), &
    1473. 

  1473.                        PENTR(:,JK),PDETR(:,JK),ZBUO_INTEG)
    1474. 

  1474.   
    1475. 

  1475. 

  1476.   IF (JK==KK) THEN
    1477. 

  1477.        PDETR(:,JK)=0.
    1478. 

  1478.   ENDIF   
    1479. 

  1479. 

  1480.  
    1481. 

  1481. !       Computation of updraft characteristics at level JK+1
    1482. 

  1482.   WHERE(GTEST)
    1483. 

  1483.     ZMIX1(:)=0.5*(PZZ(:,JK+1)-PZZ(:,JK))*(PENTR(:,JK)-PDETR(:,JK))
    1484. 

  1484.     PEMF(:,JK+1)=PEMF(:,JK)*EXP(2*ZMIX1(:))
    1485. 

  1485.   ENDWHERE
    1486. 

  1486.   
    1487. 

  1487.   
    1488. 

  1488. 

  1489. ! stop the updraft if MF becomes negative
    1490. 

  1490.   WHERE (GTEST.AND.(PEMF(:,JK+1)<=0.))
    1491. 

  1491.     PEMF(:,JK+1)=0.
    1492. 

  1492.     GTEST(:)=.FALSE.
    1493. 

  1493.     KKCTL(:) = JK+1         
    1494. 

  1494.   ENDWHERE
    1495. 

  1495. 

  1496. 

  1497. ! If the updraft did not stop, compute cons updraft characteritics at jk+1
    1498. 

  1498.   WHERE(GTEST)     
    1499. 

  1499.     ZMIX2(:) = (PZZ(:,JK+1)-PZZ(:,JK))*PENTR(:,JK) !&
    1500. 

  1500.     ZMIX3(:) = (PZZ(:,JK+1)-PZZ(:,JK))*PDETR(:,JK) !&                   
    1501. 

  1501.                 
    1502. 

  1502.     PTHL_UP(:,JK+1) = (PTHL_UP(:,JK)*(1.-0.5*ZMIX2(:)) + PTHLM(:,JK)*ZMIX2(:)) &
    1503. 

  1503.                           /(1.+0.5*ZMIX2(:))   
    1504. 

  1504.     PRT_UP(:,JK+1) = (PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:))   &
    1505. 

  1505.                           /(1.+0.5*ZMIX2(:))
    1506. 

  1506.   ENDWHERE
    1507. 

  1507.   
    1508. 

  1508. 

  1509.   IF(OMIXUV) THEN
    1510. 

  1510.     WHERE(GTEST) 
    1511. 

  1511.       PU_UP(:,JK+1) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
    1512. 

  1512.                         0.5*XPRES_UV*(PZZ(:,JK+1)-PZZ(:,JK))*&
    1513. 

  1513.                         ((PUM(:,JK+1)-PUM(:,JK))/PDZZ(:,JK+1)+&
    1514. 

  1514.                          (PUM(:,JK)-PUM(:,JK-1))/PDZZ(:,JK))        )   &
    1515. 

  1515.                         /(1+0.5*ZMIX2(:))
    1516. 

  1516.       PV_UP(:,JK+1) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
    1517. 

  1517.                         0.5*XPRES_UV*(PZZ(:,JK+1)-PZZ(:,JK))*&
    1518. 

  1518.                         ((PVM(:,JK+1)-PVM(:,JK))/PDZZ(:,JK+1)+&
    1519. 

  1519.                          (PVM(:,JK)-PVM(:,JK-1))/PDZZ(:,JK))    )   &
    1520. 

  1520.                         /(1+0.5*ZMIX2(:))
    1521. 

  1521.     ENDWHERE
    1522. 

  1522.   ENDIF
    1523. 

  1523.   
    1524. 

  1524. ! Compute non cons. var. at level JK+1
    1525. 

  1525.   CALL TH_R_FROM_THL_RT_2D(YFRAC_ICE,ZFRAC_ICE(:,JK+1:JK+1),ZPRES_F(:,JK+1:JK+1), &
    1526. 

  1526.           PTHL_UP(:,JK+1:JK+1),PRT_UP(:,JK+1:JK+1),ZTH_UP(:,JK+1:JK+1), &
    1527. 

  1527.           PRV_UP(:,JK+1:JK+1),PRC_UP(:,JK+1:JK+1),PRI_UP(:,JK+1:JK+1))
    1528. 

  1528.   
    1529. 

  1529. 

  1530. ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1   
    1531. 

  1531.   WHERE(GTEST)
    1532. 

  1532.       PTHV_UP(:,JK+1) = ZTH_UP(:,JK+1)*((1+ZRVORD*PRV_UP(:,JK+1))/(1+PRT_UP(:,JK+1)))
    1533. 

  1533.    WHERE (.NOT.(GTESTLCL)) 
    1534. 

  1534.       WHERE (ZBUO_INTEG(:)>0.)
    1535. 

  1535.         ZW_UP2(:,JK+1)  = ZW_UP2(:,JK) + 2.*(XABUO-XBENTR*XENTR_DRY)* ZBUO_INTEG(:)              
    1536. 

  1536.       ENDWHERE
    1537. 

  1537.       WHERE (ZBUO_INTEG(:)<=0.)
    1538. 

  1538.         ZW_UP2(:,JK+1)  = ZW_UP2(:,JK) + 2.*XABUO* ZBUO_INTEG(:)
    1539. 

  1539.       ENDWHERE      
    1540. 

  1540.    ENDWHERE      
    1541. 

  1541.    WHERE (GTESTLCL)
    1542. 

  1542.       ZW_UP2(:,JK+1)  = ZW_UP2(:,JK)*(1.-(XBDETR*ZMIX3(:)+XBENTR*ZMIX2(:)))&
    1543. 

  1543.             /(1.+(XBDETR*ZMIX3(:)+XBENTR*ZMIX2(:))) &
    1544. 

  1544.             +2.*(XABUO)*ZBUO_INTEG/(1.+(XBDETR*ZMIX3(:)+XBENTR*ZMIX2(:)))
    1545. 

  1545.    ENDWHERE
    1546. 

  1546.  ENDWHERE
    1547. 

  1547. 

  1548. 

  1549. ! Test if the updraft has reach the ETL
    1550. 

  1550.   GTESTETL(:)=.FALSE.
    1551. 

  1551.   WHERE (GTEST.AND.(ZBUO_INTEG(:)<=0.))
    1552. 

  1552.       KKETL(:) = JK+1           
    1553. 

  1553.       GTESTETL(:)=.TRUE.
    1554. 

  1554.   ENDWHERE
    1555. 

  1555. 

  1556. ! Test is we have reached the top of the updraft
    1557. 

  1557.   WHERE (GTEST.AND.((ZW_UP2(:,JK+1)<=0.).OR.(PEMF(:,JK+1)<=0.)))
    1558. 

  1558.       ZW_UP2(:,JK+1)=0.
    1559. 

  1559.       PEMF(:,JK+1)=0.
    1560. 

  1560.       GTEST(:)=.FALSE.
    1561. 

  1561.       PTHL_UP(:,JK+1)=ZTHLM_F(:,JK+1)
    1562. 

  1562.       PRT_UP(:,JK+1)=ZRTM_F(:,JK+1)
    1563. 

  1563.       PRC_UP(:,JK+1)=0.
    1564. 

  1564.       PRV_UP(:,JK+1)=0.
    1565. 

  1565.       PTHV_UP(:,JK+1)=ZTHVM_F(:,JK+1)
    1566. 

  1566.       PFRAC_UP(:,JK+1)=0.
    1567. 

  1567.       KKCTL(:)=JK+1
    1568. 

  1568.   ENDWHERE
    1569. 

  1569.  
    1570. 

  1570. ! compute frac_up at JK+1
    1571. 

  1571.   WHERE (GTEST)
    1572. 

  1572.       PFRAC_UP(:,JK+1)=PEMF(:,JK+1)/(SQRT(ZW_UP2(:,JK+1))*ZRHO_F(:,JK+1))
    1573. 

  1573.   ENDWHERE
    1574. 

  1574. 

  1575. ! Updraft fraction must be smaller than XFRAC_UP_MAX
    1576. 

  1576.   WHERE (GTEST)
    1577. 

  1577.       PFRAC_UP(:,JK+1)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+1))
    1578. 

  1578.   ENDWHERE
    1579. 

  1579. 

  1580. 

  1581. ! When cloudy and non-buoyant, updraft fraction must decrease
    1582. 

  1582.   
    1583. 

  1583.   WHERE ((GTEST.AND.GTESTETL).AND.GTESTLCL)
    1584. 

  1584.     PFRAC_UP(:,JK+1)=MIN(PFRAC_UP(:,JK+1),PFRAC_UP(:,JK))
    1585. 

  1585.   ENDWHERE
    1586. 

  1586. 

  1587. ! Mass flux is updated with the new updraft fraction
    1588. 

  1588.   
    1589. 

  1589.   PEMF(:,JK+1)=PFRAC_UP(:,JK+1)*SQRT(ZW_UP2(:,JK+1))*ZRHO_F(:,JK+1)
    1590. 

  1590. 

  1591. ENDDO
    1592. 

  1592. 

  1593. 

  1594. PW_UP(:,:)=SQRT(ZW_UP2(:,:))
    1595. 

  1595. 

  1596. PEMF(:,KK) =0.
    1597. 

  1597. PEMF(:,IKU)=0. ! modif WRF JP
    1598. 

  1598. PFRAC_UP(:,IKU)=0.
    1599. 

  1599. 

  1600. 

  1601. DO JI=1,SIZE(PTHM,1) 
    1602. 

  1602.    ZDEPTH(JI) = (PZZ(JI,KKCTL(JI)) -  PZZ(JI,KKLCL(JI)) )
    1603. 

  1603. END DO
    1604. 

  1604. 

  1605. GWORK1(:)= (GTESTLCL(:) .AND. (ZDEPTH(:) > 3000.) )
    1606. 

  1606. GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
    1607. 

  1607. ZCOEF(:,:) = SPREAD( (1.-(ZDEPTH(:)-3000.)/1000.), DIM=2, NCOPIES=IKU)
    1608. 

  1608. ZCOEF=MIN(MAX(ZCOEF,0.),1.)
    1609. 

  1609. 

  1610. WHERE (GWORK2) 
    1611. 

  1611.    PEMF(:,:)     = PEMF(:,:)     * ZCOEF(:,:)
    1612. 

  1612.    PFRAC_UP(:,:) = PFRAC_UP(:,:) * ZCOEF(:,:)
    1613. 

  1613. ENDWHERE
    1614. 

  1614. 

  1615. 

  1616. END SUBROUTINE COMPUTE_UPDRAFT
    1617. 

  1617. 

  1618. 

  1619.                 
    1620. 

  1620. !     #################################################################
    1621. 

  1621.       SUBROUTINE MF_TURB(OMIXUV, PIMPL, PTSTEP,                       &
    1622. 

  1622.                 PTSTEP_MET,  PDZZ,                          &
    1623. 

  1623.                 PRHODJ,                                               &
    1624. 

  1624.                 PTHLM,PTHVM,PRTM,PUM,PVM,                             &
    1625. 

  1625.                 PTHLDT,PRTDT,PUDT,PVDT,                               &
    1626. 

  1626.                 PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,              &
    1627. 

  1627.                 PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF       )
    1628. 

  1628. 

  1629. !     #################################################################
    1630. 

  1630. !
    1631. 

  1631. !
    1632. 

  1632. !!****  *MF_TURB* - computes the MF_turbulent source terms for the prognostic
    1633. 

  1633. !!                  variables. 
    1634. 

  1634. !!
    1635. 

  1635. 

  1636. !! --------------------------------------------------------------------------
    1637. 

  1637. 

  1638. !
    1639. 

  1639. !
    1640. 

  1640. IMPLICIT NONE
    1641. 

  1641. !
    1642. 

  1642. !
    1643. 

  1643. !*      0.1  declarations of arguments
    1644. 

  1644. !
    1645. 

  1645. !
    1646. 

  1646. LOGICAL,                INTENT(IN)   :: OMIXUV      ! True if mixing of momentum
    1647. 

  1647. REAL,                   INTENT(IN)   :: PIMPL       ! degree of implicitness
    1648. 

  1648. REAL,                 INTENT(IN)     ::  PTSTEP   ! Dynamical timestep 
    1649. 

  1649. REAL,                 INTENT(IN)     ::  PTSTEP_MET! Timestep for meteorological variables                        
    1650. 

  1650. !
    1651. 

  1651. REAL, DIMENSION(:,:,:), INTENT(IN)   :: PDZZ        ! metric coefficients
    1652. 

  1652. 

  1653. REAL, DIMENSION(:,:,:), INTENT(IN)   :: PRHODJ      ! dry density * Grid size
    1654. 

  1654. 

  1655. !   Conservative var. at t-dt
    1656. 

  1656. REAL, DIMENSION(:,:,:), INTENT(IN) ::  PTHLM        ! conservative pot. temp.
    1657. 

  1657. REAL, DIMENSION(:,:,:), INTENT(IN) ::  PRTM         ! water var.  where 
    1658. 

  1658. !  Virtual potential temperature at t-dt
    1659. 

  1659. REAL, DIMENSION(:,:,:), INTENT(IN) ::  PTHVM 
    1660. 

  1660. !  Momentum at t-dt
    1661. 

  1661. REAL, DIMENSION(:,:,:), INTENT(IN) ::  PUM
    1662. 

  1662. REAL, DIMENSION(:,:,:), INTENT(IN) ::  PVM
    1663. 

  1663. !
    1664. 

  1664. ! Tendencies of conservative variables
    1665. 

  1665. REAL, DIMENSION(:,:,:),   INTENT(OUT) ::  PTHLDT
    1666. 

  1666. 

  1667. REAL, DIMENSION(:,:,:),   INTENT(OUT) ::  PRTDT 
    1668. 

  1668. ! Tendencies of momentum
    1669. 

  1669. REAL, DIMENSION(:,:,:),   INTENT(OUT) ::  PUDT
    1670. 

  1670. REAL, DIMENSION(:,:,:),   INTENT(OUT) ::  PVDT
    1671. 

  1671. ! Tendencies of scalar variables
    1672. 

  1672. 

  1673. 

  1674. ! Updraft characteritics
    1675. 

  1675. REAL, DIMENSION(:,:,:), INTENT(IN)   ::  PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
    1676. 

  1676. ! Fluxes
    1677. 

  1677. REAL, DIMENSION(:,:,:), INTENT(OUT)  ::  PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
    1678. 

  1678. 

  1679. !
    1680. 

  1680. !
    1681. 

  1681. !
    1682. 

  1682. !-------------------------------------------------------------------------------
    1683. 

  1683. !
    1684. 

  1684. !       0.2  declaration of local variables
    1685. 

  1685. !
    1686. 

  1686. 

  1687. REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZVARS
    1688. 

  1688. 

  1689. !
    1690. 

  1690. !----------------------------------------------------------------------------
    1691. 

  1691. !
    1692. 

  1692. !*      1.PRELIMINARIES
    1693. 

  1693. !         -------------
    1694. 

  1694. !
    1695. 

  1695. !
    1696. 

  1696. 

  1697. !
    1698. 

  1698. PFLXZTHMF = 0.
    1699. 

  1699. PFLXZRMF = 0.
    1700. 

  1700. PFLXZTHVMF = 0.
    1701. 

  1701. PFLXZUMF = 0.
    1702. 

  1702. PFLXZVMF = 0.
    1703. 

  1703. PTHLDT = 0.
    1704. 

  1704. PRTDT = 0.
    1705. 

  1705. PUDT = 0.
    1706. 

  1706. PVDT = 0.
    1707. 

  1707. 

  1708. !
    1709. 

  1709. !----------------------------------------------------------------------------
    1710. 

  1710. !
    1711. 

  1711. !*      2. COMPUTE THE MEAN FLUX OF CONSERVATIVE VARIABLES at time t-dt
    1712. 

  1712. !          (equation (3) of Soares et al)
    1713. 

  1713. !          + THE MEAN FLUX OF THETA_V (buoyancy flux)
    1714. 

  1714. !          -----------------------------------------------
    1715. 

  1715. !   ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
    1716. 

  1716. !
    1717. 

  1717. 

  1718. PFLXZTHMF(:,:,:) = PEMF(:,:,:)*(PTHL_UP(:,:,:)-MZM(PTHLM(:,:,:)))
    1719. 

  1719. 

  1720. PFLXZRMF(:,:,:) =  PEMF(:,:,:)*(PRT_UP(:,:,:)-MZM(PRTM(:,:,:)))
    1721. 

  1721. 

  1722. PFLXZTHVMF(:,:,:) = PEMF(:,:,:)*(PTHV_UP(:,:,:)-MZM(PTHVM(:,:,:)))
    1723. 

  1723. 

  1724. PFLXZTHVMF(:,:,:) = 9.81/PTHVM(:,:,:)* PEMF(:,:,:)*(PTHV_UP(:,:,:)-MZM(PTHVM(:,:,:))) !JP
    1725. 

  1725. 

  1726. IF (OMIXUV) THEN
    1727. 

  1727.   PFLXZUMF(:,:,:) =  PEMF(:,:,:)*(PU_UP(:,:,:)-MZM(PUM(:,:,:)))
    1728. 

  1728.   PFLXZVMF(:,:,:) =  PEMF(:,:,:)*(PV_UP(:,:,:)-MZM(PVM(:,:,:)))
    1729. 

  1729. ENDIF
    1730. 

  1730. !
    1731. 

  1731. !
    1732. 

  1732. !----------------------------------------------------------------------------
    1733. 

  1733. !
    1734. 

  1734. !*      3. COMPUTE TENDENCIES OF CONSERVATIVE VARIABLES (or treated as such...)
    1735. 

  1735. !          (implicit formulation)
    1736. 

  1736. !          --------------------------------------------
    1737. 

  1737. !
    1738. 

  1738. 

  1739. !
    1740. 

  1740. !
    1741. 

  1741. ! 3.1 Compute the tendency for the conservative potential temperature
    1742. 

  1742. !     (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
    1743. 

  1743. !
    1744. 

  1744. CALL TRIDIAG_MASSFLUX(PTHLM,PFLXZTHMF,-PEMF,PTSTEP_MET,PIMPL,  &
    1745. 

  1745.                       PDZZ,PRHODJ,ZVARS )
    1746. 

  1746. ! compute new flux
    1747. 

  1747. PFLXZTHMF(:,:,:) = PEMF(:,:,:)*(PTHL_UP(:,:,:)-MZM(ZVARS(:,:,:)))
    1748. 

  1748. 

  1749. !!! compute THL tendency
    1750. 

  1750. !
    1751. 

  1751. PTHLDT(:,:,:)= (ZVARS(:,:,:)-PTHLM(:,:,:))/PTSTEP_MET
    1752. 

  1752. 

  1753. !
    1754. 

  1754. ! 3.2 Compute the tendency for the conservative mixing ratio
    1755. 

  1755. !
    1756. 

  1756. CALL TRIDIAG_MASSFLUX(PRTM(:,:,:),PFLXZRMF,-PEMF,PTSTEP_MET,PIMPL,  &
    1757. 

  1757.                                  PDZZ,PRHODJ,ZVARS )
    1758. 

  1758. ! compute new flux
    1759. 

  1759. PFLXZRMF(:,:,:) =  PEMF(:,:,:)*(PRT_UP(:,:,:)-MZM(ZVARS(:,:,:)))
    1760. 

  1760. 

  1761. !!! compute RT tendency
    1762. 

  1762. PRTDT(:,:,:) = (ZVARS(:,:,:)-PRTM(:,:,:))/PTSTEP_MET
    1763. 

  1763. !
    1764. 

  1764. ! 3.3 Compute the tendency for the (non conservative but treated as it)  mixing ratio
    1765. 

  1765. !
    1766. 

  1766. !CALL TRIDIAG_MASSFLUX(PTHVM(:,:,:),PFLXZTHVMF,-PEMF,PTSTEP,PIMPL,  &
    1767. 

  1767. !                                PDZZ,PRHODJ,ZVARS )
    1768. 

  1768. ! compute new flux
    1769. 

  1769. !PFLXZTHVMF(:,:,:) =  PEMF(:,:,:)*(PTHV_UP(:,:,:)-MZM(ZVARS(:,:,:)))
    1770. 

  1770. 

  1771. 

  1772. 

  1773. IF (OMIXUV) THEN
    1774. 

  1774. !
    1775. 

  1775. ! 3.3 Compute the tendency for the (non conservative but treated as it) zonal momentum
    1776. 

  1776. !     (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
    1777. 

  1777. !
    1778. 

  1778. 

  1779.  CALL TRIDIAG_MASSFLUX(PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL,  &
    1780. 

  1780.                                  PDZZ,PRHODJ,ZVARS )
    1781. 

  1781. ! compute new flux
    1782. 

  1782. PFLXZUMF(:,:,:) = PEMF(:,:,:)*(PU_UP(:,:,:)-MZM(ZVARS(:,:,:)))
    1783. 

  1783. 

  1784. ! compute U tendency
    1785. 

  1785.   PUDT(:,:,:)= (ZVARS(:,:,:)-PUM(:,:,:))/PTSTEP_MET
    1786. 

  1786. 

  1787. !
    1788. 

  1788. !
    1789. 

  1789. ! 3.4 Compute the tendency for the (non conservative but treated as it for the time beiing) 
    1790. 

  1790. !                                  meridian momentum
    1791. 

  1791. !     (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
    1792. 

  1792. !
    1793. 

  1793.   CALL TRIDIAG_MASSFLUX(PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL,  &
    1794. 

  1794.                                  PDZZ,PRHODJ,ZVARS )
    1795. 

  1795. ! compute new flux
    1796. 

  1796. PFLXZVMF(:,:,:) = PEMF(:,:,:)*(PV_UP(:,:,:)-MZM(ZVARS(:,:,:)))
    1797. 

  1797. 

  1798. ! compute V tendency
    1799. 

  1799.   PVDT(:,:,:)= (ZVARS(:,:,:)-PVM(:,:,:))/PTSTEP_MET
    1800. 

  1800. 

  1801. ENDIF
    1802. 

  1802. 

  1803. 

  1804. 

  1805. !
    1806. 

  1806. END SUBROUTINE MF_TURB   
    1807. 

  1807. 

  1808. FUNCTION MZM(PA)  RESULT(PMZM)
    1809. 

  1809. 

  1810. 

  1811. !
    1812. 

  1812. IMPLICIT NONE
    1813. 

  1813. !
    1814. 

  1814. !*       0.1   Declarations of argument and result
    1815. 

  1815. !              ------------------------------------
    1816. 

  1816. !
    1817. 

  1817. 

  1818. REAL, DIMENSION(:,:,:), INTENT(IN)                :: PA     ! variable at mass localization
    1819. 

  1819. REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM   ! result at flux localization
    1820. 

  1820. 

  1821. !        0.2   Declarations of local variables
    1822. 

  1822. !              -------------------------------
    1823. 

  1823. !
    1824. 

  1824. 

  1825. INTEGER :: JK             ! Loop index in z direction
    1826. 

  1826. INTEGER :: IKU            ! upper bound in z direction of PA
    1827. 

  1827. !
    1828. 

  1828. IKU = SIZE(PA,3)
    1829. 

  1829. 

  1830. !DO JK=2,IKU MODIF WRF JP
    1831. 

  1831. DO JK=2,IKU
    1832. 

  1832.    PMZM(:,:,JK)=0.5*(PA(:,:,JK)+PA(:,:,JK-1))
    1833. 

  1833. ENDDO
    1834. 

  1834. 

  1835. PMZM(:,:,1)=PA(:,:,2)
    1836. 

  1836. 

  1837. 

  1838. END FUNCTION MZM
    1839. 

  1839. 

  1840. 

  1841. !
    1842. 

  1842. !
    1843. 

  1843. !     #################################################################
    1844. 

  1844.       SUBROUTINE TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,PP,             &
    1845. 

  1845.                                   PTHL, PRT, PTH, PRV, PRL, PRI       )
    1846. 

  1846. !     #################################################################
    1847. 

  1847. !
    1848. 

  1848. !
    1849. 

  1849. !!****  *TH_R_FROM_THL_RT_1D* - computes the non-conservative variables
    1850. 

  1850. !!                          from conservative variables
    1851. 

  1851. !!
    1852. 

  1852. 

  1853. !!
    1854. 

  1854. !! --------------------------------------------------------------------------
    1855. 

  1855. !       
    1856. 

  1856. 

  1857. !
    1858. 

  1858. IMPLICIT NONE
    1859. 

  1859. !
    1860. 

  1860. !
    1861. 

  1861. !*      0.1  declarations of arguments
    1862. 

  1862. !
    1863. 

  1863. CHARACTER*1           , INTENT(IN) :: HFRAC_ICE
    1864. 

  1864. REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
    1865. 

  1865. REAL, DIMENSION(:), INTENT(IN) :: PP          ! Pressure
    1866. 

  1866. REAL, DIMENSION(:), INTENT(IN) :: PTHL    ! thetal (or thetal tendency) to
    1867. 

  1867.                                              ! transform into th (or tendency)
    1868. 

  1868. REAL, DIMENSION(:),INTENT(IN)  :: PRT    ! Total mixing ratios (or tendency) to
    1869. 

  1869.                                              ! transform into rv,rc and ri
    1870. 

  1870.                                              ! (or its tendency)
    1871. 

  1871. REAL, DIMENSION(:), INTENT(OUT):: PTH    ! th (or th_l tendency)
    1872. 

  1872. REAL, DIMENSION(:), INTENT(OUT):: PRV    ! vapor mixing ratio (or its tendency)
    1873. 

  1873. REAL, DIMENSION(:), INTENT(OUT):: PRL    ! vapor mixing ratio (or its tendency)
    1874. 

  1874. REAL, DIMENSION(:), INTENT(OUT):: PRI    ! vapor mixing ratio (or its tendency)
    1875. 

  1875. 

  1876. !
    1877. 

  1877. !-------------------------------------------------------------------------------
    1878. 

  1878. !
    1879. 

  1879. !       0.2  declaration of local variables
    1880. 

  1880. !
    1881. 

  1881. INTEGER                       :: II
    1882. 

  1882. ! Loop control
    1883. 

  1883. REAL                          :: ZCOEF
    1884. 

  1884. REAL, DIMENSION(SIZE(PP,1))   :: ZEXN,ZFOES,ZQVSAT
    1885. 

  1885. REAL, DIMENSION(SIZE(PTHL,1)) :: ZRVSAT,ZCPH,ZRLTEMP  
    1886. 

  1886. REAL, DIMENSION(SIZE(PTHL,1)) :: ZT,ZLOVCPEXN,ZLOSCPEXN
    1887. 

  1887. !----------------------------------------------------------------------------
    1888. 

  1888. !
    1889. 

  1889. !*      1 Initialisation 
    1890. 

  1890. !         --------------
    1891. 

  1891. !
    1892. 

  1892. !
    1893. 

  1893. ZCOEF = 0.8
    1894. 

  1894. PRL(:)=0.
    1895. 

  1895. PRI(:)=0.
    1896. 

  1896. ZRLTEMP(:)=0.
    1897. 

  1897. PRV(:)=PRT(:)
    1898. 

  1898. PTH(:)=PTHL(:)
    1899. 

  1899. ZEXN(:)=(PP(:)/XP00) ** (XRD/XCPD)
    1900. 

  1900. !
    1901. 

  1901. !       2 Iteration
    1902. 

  1902. !         ---------
    1903. 

  1903. 

  1904.     DO II=1,20
    1905. 

  1905.       ZT(:)=PTH(:)*ZEXN(:)
    1906. 

  1906. 

  1907.       WHERE (ZT(:) > 273.15)
    1908. 

  1908. ! warm cloud
    1909. 

  1909.       ZFOES(:) = EXP( XALPW - XBETAW/ZT(:) - XGAMW*LOG(ZT(:))  )
    1910. 

  1910.       ZQVSAT(:) = XRD/XRV*ZFOES(:)/PP(:)   &
    1911. 

  1911.                    / (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:))
    1912. 

  1912. 

  1913.       ZRVSAT(:) = (1-ZCOEF)*ZQVSAT(:)*(1+PRT(:))+(ZCOEF)*PRV(:)
    1914. 

  1914. !      CALL COMPUTE_FRAC_ICE_1D(HFRAC_ICE,PFRAC_ICE,PP,ZT) 
    1915. 

  1915.       PFRAC_ICE(:)=0.
    1916. 

  1916.       ZRLTEMP(:)=MAX(0.,PRV(:)-ZRVSAT(:))
    1917. 

  1917.       PRV(:)=PRV(:)-ZRLTEMP(:)
    1918. 

  1918.       PRL(:)=PRL(:)+PRI(:)+ZRLTEMP(:)
    1919. 

  1919.       PRI(:)    = PFRAC_ICE(:)    * (PRL(:))
    1920. 

  1920.       PRL(:)    = (1-PFRAC_ICE(:))* (PRT(:) - PRV(:))
    1921. 

  1921.       !       2.1 Cph
    1922. 

  1922.       ZCPH(:)=XCPD+ XCPV * PRV(:)+ XCL * PRL(:) + XCI * PRI(:)
    1923. 

  1923.       
    1924. 

  1924.       !       2.2 L/Cp/EXN
    1925. 

  1925.       ZLOVCPEXN(:) = (XLVTT + (XCPV-XCL) * (ZT(:)-XTT)) &
    1926. 

  1926.                         /(ZCPH*ZEXN(:))
    1927. 

  1927.       ZLOSCPEXN(:) = (XLSTT + (XCPV-XCI) * (ZT(:)-XTT)) &
    1928. 

  1928.                         /(ZCPH*ZEXN(:))
    1929. 

  1929.       PTH(:)=PTHL(:)+ZLOVCPEXN*PRL(:)+ZLOSCPEXN(:)*PRI(:)          
    1930. 

  1930. 

  1931.       ELSEWHERE
    1932. 

  1932.              ! cold shallow cloud not yet coded 
    1933. 

  1933.              ! probleme also for the highest level of fire case
    1934. 

  1934.         PRL(:)=0.
    1935. 

  1935.         PRI(:)=0.
    1936. 

  1936.         PRV(:)=PRT(:)
    1937. 

  1937.         PTH(:)=PTHL(:)
    1938. 

  1938.       ENDWHERE 
    1939. 

  1939.     ENDDO
    1940. 

  1940.    
    1941. 

  1941. END SUBROUTINE TH_R_FROM_THL_RT_1D
    1942. 

  1942. 

  1943.               
    1944. 

  1944. !     #################################################################
    1945. 

  1945.       SUBROUTINE TH_R_FROM_THL_RT_2D(HFRAC_ICE,PFRAC_ICE,PP,             &
    1946. 

  1946.                                   PTHL, PRT, PTH, PRV, PRL, PRI       )
    1947. 

  1947. !     #################################################################
    1948. 

  1948. !
    1949. 

  1949. !
    1950. 

  1950. !!****  *TH_R_FROM_THL_RT_2D* - computes the non-conservative variables
    1951. 

  1951. !!                          from conservative variables
    1952. 

  1952. !!
    1953. 

  1953. !!
    1954. 

  1954. !!
    1955. 

  1955. !! --------------------------------------------------------------------------
    1956. 

  1956. 

  1957. 

  1958. !
    1959. 

  1959. IMPLICIT NONE
    1960. 

  1960. !
    1961. 

  1961. !
    1962. 

  1962. !*      0.1  declarations of arguments
    1963. 

  1963. !
    1964. 

  1964. CHARACTER*1         , INTENT(IN) :: HFRAC_ICE
    1965. 

  1965. REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE
    1966. 

  1966. REAL, DIMENSION(:,:), INTENT(IN) :: PP          ! Pressure
    1967. 

  1967. REAL, DIMENSION(:,:), INTENT(IN) :: PTHL    ! thetal (or thetal tendency) to
    1968. 

  1968.                                              ! transform into th (or tendency)
    1969. 

  1969. REAL, DIMENSION(:,:),INTENT(IN)  :: PRT    ! Total mixing ratios (or tendency) to
    1970. 

  1970.                                              ! transform into rv,rc and ri
    1971. 

  1971.                                              ! (or its tendency)
    1972. 

  1972. REAL, DIMENSION(:,:), INTENT(OUT):: PTH    ! th (or th_l tendency)
    1973. 

  1973. REAL, DIMENSION(:,:), INTENT(OUT):: PRV    ! vapor mixing ratio (or its tendency)
    1974. 

  1974. REAL, DIMENSION(:,:), INTENT(OUT):: PRL    ! vapor mixing ratio (or its tendency)
    1975. 

  1975. REAL, DIMENSION(:,:), INTENT(OUT):: PRI    ! vapor mixing ratio (or its tendency)
    1976. 

  1976. 

  1977. !
    1978. 

  1978. !-------------------------------------------------------------------------------
    1979. 

  1979. !
    1980. 

  1980. !       0.2  declaration of local variables
    1981. 

  1981. !
    1982. 

  1982. INTEGER                :: II
    1983. 

  1983. ! Loop control
    1984. 

  1984. REAL                                         :: ZCOEF
    1985. 

  1985. REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2))       :: ZEXN,ZFOES,ZQVSAT
    1986. 

  1986. REAL, DIMENSION(SIZE(PTHL,1),SIZE(PTHL,2))   :: ZRVSAT,ZCPH,ZRLTEMP  
    1987. 

  1987. REAL, DIMENSION(SIZE(PTHL,1),SIZE(PTHL,2))   :: ZT,ZLOVCPEXN,ZLOSCPEXN
    1988. 

  1988. !----------------------------------------------------------------------------
    1989. 

  1989. !
    1990. 

  1990. !*      1 Initialisation 
    1991. 

  1991. !         --------------
    1992. 

  1992. !
    1993. 

  1993. !
    1994. 

  1994. ZCOEF = 0.8
    1995. 

  1995. PRL(:,:)=0.
    1996. 

  1996. PRI(:,:)=0.
    1997. 

  1997. ZRLTEMP(:,:)=0.
    1998. 

  1998. PRV(:,:)=PRT(:,:)
    1999. 

  1999. PTH(:,:)=PTHL(:,:)
    2000. 

  2000. ZEXN(:,:)=(PP(:,:)/XP00) ** (XRD/XCPD)
    2001. 

  2001. !
    2002. 

  2002. !       2 Iteration
    2003. 

  2003. !         ---------
    2004. 

  2004. 

  2005.     DO II=1,20
    2006. 

  2006.       ZT(:,:)=PTH(:,:)*ZEXN(:,:)
    2007. 

  2007.       WHERE (ZT(:,:) > 273.15)
    2008. 

  2008. ! warm cloud
    2009. 

  2009. 

  2010.       ZFOES(:,:) = EXP( XALPW - XBETAW/ZT(:,:) - XGAMW*LOG(ZT(:,:))  )
    2011. 

  2011.       ZQVSAT(:,:) = XRD/XRV*ZFOES(:,:)/PP(:,:)   &
    2012. 

  2012.                    / (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:))
    2013. 

  2013.       ZRVSAT(:,:) = (1-ZCOEF)*ZQVSAT(:,:)*(1+PRT(:,:))+(ZCOEF)*PRV(:,:)
    2014. 

  2014. 

  2015. !      CALL COMPUTE_FRAC_ICE_2D(HFRAC_ICE,PFRAC_ICE,PP,ZT) 
    2016. 

  2016.       PFRAC_ICE(:,:) = 0.
    2017. 

  2017.       ZRLTEMP(:,:)=MAX(0.,PRV(:,:)-ZRVSAT(:,:))
    2018. 

  2018.       PRV(:,:)=PRV(:,:)-ZRLTEMP(:,:)
    2019. 

  2019.       PRL(:,:)=PRL(:,:)+PRI(:,:)+ZRLTEMP(:,:)
    2020. 

  2020.       PRI(:,:)    = PFRAC_ICE(:,:)    * (PRL(:,:))
    2021. 

  2021.       PRL(:,:)    = (1-PFRAC_ICE(:,:))* (PRT(:,:) - PRV(:,:))
    2022. 

  2022.       !       2.1 Cph
    2023. 

  2023.         ZCPH(:,:)=XCPD+ XCPV * PRV(:,:)+ XCL * PRL(:,:) + XCI * PRI(:,:)
    2024. 

  2024.       
    2025. 

  2025.         !       2.2 L/Cp/EXN
    2026. 

  2026.         ZLOVCPEXN(:,:) = (XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT)) &
    2027. 

  2027.                         /(ZCPH*ZEXN(:,:))
    2028. 

  2028.         ZLOSCPEXN(:,:) = (XLSTT + (XCPV-XCI) * (ZT(:,:)-XTT)) &
    2029. 

  2029.                         /(ZCPH*ZEXN(:,:))
    2030. 

  2030.         PTH(:,:)=PTHL(:,:)+ZLOVCPEXN*PRL(:,:)+ZLOSCPEXN(:,:)*PRI(:,:)          
    2031. 

  2031.       ELSEWHERE
    2032. 

  2032.         ! cold shallow cloud not yet coded 
    2033. 

  2033.         ! probleme also for the highest level of fire case
    2034. 

  2034.         PRL(:,:)=0.
    2035. 

  2035.         PRI(:,:)=0.
    2036. 

  2036.         PRV(:,:)=PRT(:,:)
    2037. 

  2037.         PTH(:,:)=PTHL(:,:)
    2038. 

  2038.        ENDWHERE   
    2039. 

  2039.     ENDDO
    2040. 

  2040.    
    2041. 

  2041. END SUBROUTINE TH_R_FROM_THL_RT_2D
    2042. 

  2042. 

  2043. 

  2044.                                        
    2045. 

  2045. !     #################################################################
    2046. 

  2046.       SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI,                  &
    2047. 

  2047.                                        PTH, PR, PLVOCPEXN, PLSOCPEXN, &
    2048. 

  2048.                                        PTHL, PRT                      )
    2049. 

  2049. !     #################################################################
    2050. 

  2050. !
    2051. 

  2051. !!
    2052. 

  2052. !!****  *THL_RT_FROM_TH_R* - computes the conservative variables THL and RT
    2053. 

  2053. !!                           from TH and the non precipitating water species
    2054. 

  2054. !!
    2055. 

  2055. !! --------------------------------------------------------------------------
    2056. 

  2056. !       
    2057. 

  2057. !*      0. DECLARATIONS
    2058. 

  2058. !          ------------
    2059. 

  2059. !
    2060. 

  2060. !USE MODD_CST
    2061. 

  2061. !
    2062. 

  2062. IMPLICIT NONE
    2063. 

  2063. !
    2064. 

  2064. !
    2065. 

  2065. !*      0.1  declarations of arguments
    2066. 

  2066. !
    2067. 

  2067. INTEGER,                INTENT(IN)   :: KRR           ! number of moist var.
    2068. 

  2068. INTEGER,                INTENT(IN)   :: KRRL          ! number of liquid water var.
    2069. 

  2069. INTEGER,                INTENT(IN)   :: KRRI          ! number of ice water var.
    2070. 

  2070. 

  2071. REAL, DIMENSION(:,:,:), INTENT(IN)   :: PTH      ! theta
    2072. 

  2072. REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR       ! water species
    2073. 

  2073. REAL, DIMENSION(:,:,:), INTENT(IN)   :: PLVOCPEXN, PLSOCPEXN      ! L/(cp*Pi)
    2074. 

  2074. 

  2075. REAL, DIMENSION(:,:,:), INTENT(OUT)  :: PTHL     ! th_l
    2076. 

  2076. REAL, DIMENSION(:,:,:), INTENT(OUT)  :: PRT      ! total non precip. water
    2077. 

  2077. !
    2078. 

  2078. !-------------------------------------------------------------------------------
    2079. 

  2079. !
    2080. 

  2080. !       0.2  declaration of local variables
    2081. 

  2081. !
    2082. 

  2082. 

  2083. !----------------------------------------------------------------------------
    2084. 

  2084. 

  2085. !----------------------------------------------------------------------------
    2086. 

  2086. !
    2087. 

  2087. !
    2088. 

  2088. 

  2089. IF ( KRRL >= 1 ) THEN
    2090. 

  2090.   IF ( KRRI >= 1 ) THEN 
    2091. 

  2091.     ! Rnp 
    2092. 

  2092.     PRT(:,:,:)  = PR(:,:,:,1)  + PR(:,:,:,2)  + PR(:,:,:,4)
    2093. 

  2093.     ! Theta_l 
    2094. 

  2094.     PTHL(:,:,:)  = PTH(:,:,:)  - PLVOCPEXN(:,:,:) * PR(:,:,:,2) &
    2095. 

  2095.                                - PLSOCPEXN(:,:,:) * PR(:,:,:,4)
    2096. 

  2096.   ELSE
    2097. 

  2097.     ! Rnp
    2098. 

  2098.     PRT(:,:,:)  = PR(:,:,:,1)  + PR(:,:,:,2) 
    2099. 

  2099.     ! Theta_l
    2100. 

  2100.     PTHL(:,:,:) = PTH(:,:,:)  - PLVOCPEXN(:,:,:) * PR(:,:,:,2)
    2101. 

  2101.   END IF
    2102. 

  2102. ELSE
    2103. 

  2103.     ! Rnp = rv
    2104. 

  2104. PRT(:,:,:)  = PR(:,:,:,1)
    2105. 

  2105.     ! Theta_l = Theta
    2106. 

  2106. PTHL(:,:,:) = PTH(:,:,:)
    2107. 

  2107. END IF
    2108. 

  2108. 

  2109. END SUBROUTINE THL_RT_FROM_TH_R_MF
    2110. 

  2110. 

  2111. 

  2112. !      #################################################
    2113. 

  2113.        SUBROUTINE TRIDIAG_MASSFLUX(PVARM,PF,PDFDT,PTSTEP,PIMPL,  &
    2114. 

  2114.                                  PDZZ,PRHODJ,PVARP             )
    2115. 

  2115. !      #################################################
    2116. 

  2116. !
    2117. 

  2117. !
    2118. 

  2118. !!****   *TRIDIAG_MASSFLUX* - routine to solve a time implicit scheme
    2119. 

  2119. !!
    2120. 

  2120. !!
    2121. 

  2121. !! ---------------------------------------------------------------------
    2122. 

  2122. !
    2123. 

  2123. !*       0. DECLARATIONS
    2124. 

  2124. !
    2125. 

  2125. !
    2126. 

  2126. !
    2127. 

  2127. IMPLICIT NONE
    2128. 

  2128. !
    2129. 

  2129. !
    2130. 

  2130. !*       0.1 declarations of arguments
    2131. 

  2131. !
    2132. 

  2132. REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM   ! variable at t-1      at mass point
    2133. 

  2133. REAL, DIMENSION(:,:,:), INTENT(IN) :: PF      ! flux in dT/dt=-dF/dz at flux point
    2134. 

  2134. REAL, DIMENSION(:,:,:), INTENT(IN) :: PDFDT   ! dF/dT                at flux point
    2135. 

  2135. REAL,                   INTENT(IN) :: PTSTEP  ! Double time step
    2136. 

  2136. REAL,                   INTENT(IN) :: PIMPL   ! implicit weight
    2137. 

  2137. REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ    ! Dz                   at flux point
    2138. 

  2138. REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ  ! (dry rho)*J          at mass point
    2139. 

  2139. !
    2140. 

  2140. REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP   ! variable at t+1      at mass point
    2141. 

  2141. !
    2142. 

  2142. !
    2143. 

  2143. !*       0.2 declarations of local variables
    2144. 

  2144. !
    2145. 

  2145. REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3))  :: ZRHODJ_DFDT_O_DZ
    2146. 

  2146. REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3))  :: ZMZM_RHODJ
    2147. 

  2147. REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3))  :: ZA, ZB, ZC
    2148. 

  2148. REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3))  :: ZY ,ZGAM 
    2149. 

  2149.                                          ! RHS of the equation, 3D work array
    2150. 

  2150. REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2))                :: ZBET
    2151. 

  2151.                                          ! 2D work array
    2152. 

  2152. INTEGER                              :: JK            ! loop counter
    2153. 

  2153. INTEGER                              :: IKB,IKE       ! inner vertical limits
    2154. 

  2154. !
    2155. 

  2155. ! ---------------------------------------------------------------------------
    2156. 

  2156. !                                              
    2157. 

  2157. !*      1.  Preliminaries
    2158. 

  2158. !           -------------
    2159. 

  2159. !
    2160. 

  2160. IKB=1
    2161. 

  2161. IKE=SIZE(PVARM,3)-1 
    2162. 

  2162. !
    2163. 

  2163. ZMZM_RHODJ  = MZM(PRHODJ)
    2164. 

  2164. ZRHODJ_DFDT_O_DZ = ZMZM_RHODJ*PDFDT/PDZZ
    2165. 

  2165. !
    2166. 

  2166. ZA=0.
    2167. 

  2167. ZB=0.
    2168. 

  2168. ZC=0.
    2169. 

  2169. ZY=0.
    2170. 

  2170. !
    2171. 

  2171. !
    2172. 

  2172. !*      2.  COMPUTE THE RIGHT HAND SIDE
    2173. 

  2173. !           ---------------------------
    2174. 

  2174. !
    2175. 

  2175. ZY(:,:,IKB) = PRHODJ(:,:,IKB)*PVARM(:,:,IKB)/PTSTEP             &
    2176. 

  2176.     - ZMZM_RHODJ(:,:,IKB+1) * PF(:,:,IKB+1)/PDZZ(:,:,IKB+1)     &
    2177. 

  2177.     + ZMZM_RHODJ(:,:,IKB  ) * PF(:,:,IKB  )/PDZZ(:,:,IKB  )     &
    2178. 

  2178.     + ZRHODJ_DFDT_O_DZ(:,:,IKB+1) * 0.5*PIMPL * PVARM(:,:,IKB+1)    &
    2179. 

  2179.     + ZRHODJ_DFDT_O_DZ(:,:,IKB+1) * 0.5*PIMPL * PVARM(:,:,IKB  )
    2180. 

  2180. !
    2181. 

  2181. DO JK=IKB+1,IKE-1
    2182. 

  2182.   ZY(:,:,JK) = PRHODJ(:,:,JK)*PVARM(:,:,JK)/PTSTEP          &
    2183. 

  2183.     - ZMZM_RHODJ(:,:,JK+1) * PF(:,:,JK+1)/PDZZ(:,:,JK+1)    &
    2184. 

  2184.     + ZMZM_RHODJ(:,:,JK  ) * PF(:,:,JK  )/PDZZ(:,:,JK  )    &
    2185. 

  2185.     + ZRHODJ_DFDT_O_DZ(:,:,JK+1) * 0.5*PIMPL * PVARM(:,:,JK+1)  &
    2186. 

  2186.     + ZRHODJ_DFDT_O_DZ(:,:,JK+1) * 0.5*PIMPL * PVARM(:,:,JK  )  &
    2187. 

  2187.     - ZRHODJ_DFDT_O_DZ(:,:,JK  ) * 0.5*PIMPL * PVARM(:,:,JK  )  &
    2188. 

  2188.     - ZRHODJ_DFDT_O_DZ(:,:,JK  ) * 0.5*PIMPL * PVARM(:,:,JK-1)
    2189. 

  2189. END DO
    2190. 

  2190. ! 
    2191. 

  2191. ZY(:,:,IKE) = PRHODJ(:,:,IKE)*PVARM(:,:,IKE)/PTSTEP         &
    2192. 

  2192.     - ZMZM_RHODJ(:,:,IKE+1) * PF(:,:,IKE+1)/PDZZ(:,:,IKE+1) &
    2193. 

  2193.     + ZMZM_RHODJ(:,:,IKE  ) * PF(:,:,IKE  )/PDZZ(:,:,IKE  ) &
    2194. 

  2194.     - ZRHODJ_DFDT_O_DZ(:,:,IKE ) * 0.5*PIMPL * PVARM(:,:,IKE  ) &
    2195. 

  2195.     - ZRHODJ_DFDT_O_DZ(:,:,IKE ) * 0.5*PIMPL * PVARM(:,:,IKE-1)
    2196. 

  2196. !
    2197. 

  2197. !
    2198. 

  2198. !*       3.  INVERSION OF THE TRIDIAGONAL SYSTEM
    2199. 

  2199. !            -----------------------------------
    2200. 

  2200. !
    2201. 

  2201. IF ( PIMPL > 1.E-10 ) THEN
    2202. 

  2202. !
    2203. 

  2203. !*       3.1 arrays A, B, C
    2204. 

  2204. !            --------------
    2205. 

  2205. !
    2206. 

  2206.   ZB(:,:,IKB) =   PRHODJ(:,:,IKB)/PTSTEP                   &
    2207. 

  2207.                 + ZRHODJ_DFDT_O_DZ(:,:,IKB+1) * 0.5*PIMPL
    2208. 

  2208.   ZC(:,:,IKB) =   ZRHODJ_DFDT_O_DZ(:,:,IKB+1) * 0.5*PIMPL
    2209. 

  2209. 

  2210.   DO JK=IKB+1,IKE-1
    2211. 

  2211.     ZA(:,:,JK) = - ZRHODJ_DFDT_O_DZ(:,:,JK  ) * 0.5*PIMPL
    2212. 

  2212.     ZB(:,:,JK) =   PRHODJ(:,:,JK)/PTSTEP                   &
    2213. 

  2213.                  + ZRHODJ_DFDT_O_DZ(:,:,JK+1) * 0.5*PIMPL &
    2214. 

  2214.                  - ZRHODJ_DFDT_O_DZ(:,:,JK  ) * 0.5*PIMPL
    2215. 

  2215.     ZC(:,:,JK) =   ZRHODJ_DFDT_O_DZ(:,:,JK+1) * 0.5*PIMPL
    2216. 

  2216.   END DO
    2217. 

  2217. 

  2218.   ZA(:,:,IKE) = - ZRHODJ_DFDT_O_DZ(:,:,IKE  ) * 0.5*PIMPL
    2219. 

  2219.   ZB(:,:,IKE) =   PRHODJ(:,:,IKE)/PTSTEP                   &
    2220. 

  2220.                 - ZRHODJ_DFDT_O_DZ(:,:,IKE  ) * 0.5*PIMPL
    2221. 

  2221. !
    2222. 

  2222. !*       3.2 going up
    2223. 

  2223. !            --------
    2224. 

  2224. !
    2225. 

  2225.   ZBET(:,:) = ZB(:,:,IKB)  ! bet = b(ikb)
    2226. 

  2226.   PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
    2227. 

  2227. 

  2228.   !
    2229. 

  2229.   DO JK = IKB+1,IKE-1
    2230. 

  2230.     ZGAM(:,:,JK) = ZC(:,:,JK-1) / ZBET(:,:)  
    2231. 

  2231.                                                     ! gam(k) = c(k-1) / bet
    2232. 

  2232.     ZBET(:,:)    = ZB(:,:,JK) - ZA(:,:,JK) * ZGAM(:,:,JK)
    2233. 

  2233.                                                     ! bet = b(k) - a(k)* gam(k)  
    2234. 

  2234.     PVARP(:,:,JK)= ( ZY(:,:,JK) - ZA(:,:,JK) * PVARP(:,:,JK-1) ) / ZBET(:,:)
    2235. 

  2235.                                         ! res(k) = (y(k) -a(k)*res(k-1))/ bet 
    2236. 

  2236.   END DO 
    2237. 

  2237.   ! special treatment for the last level
    2238. 

  2238.   ZGAM(:,:,IKE) = ZC(:,:,IKE-1) / ZBET(:,:) 
    2239. 

  2239.                                                     ! gam(k) = c(k-1) / bet
    2240. 

  2240.   ZBET(:,:)     = ZB(:,:,IKE) - ZA(:,:,IKE) * ZGAM(:,:,IKE)
    2241. 

  2241.                                                     ! bet = b(k) - a(k)* gam(k)  
    2242. 

  2242.   PVARP(:,:,IKE)= ( ZY(:,:,IKE) - ZA(:,:,IKE) * PVARP(:,:,IKE-1) ) / ZBET(:,:)
    2243. 

  2243.                                        ! res(k) = (y(k) -a(k)*res(k-1))/ bet 
    2244. 

  2244. !
    2245. 

  2245. !*       3.3 going down
    2246. 

  2246. !            ----------
    2247. 

  2247. !
    2248. 

  2248.   DO JK = IKE-1,IKB,-1
    2249. 

  2249.     PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+1) * PVARP(:,:,JK+1)
    2250. 

  2250.   END DO
    2251. 

  2251. !
    2252. 

  2252. !
    2253. 

  2253. ELSE
    2254. 

  2254. !!! EXPLICIT FORMULATION
    2255. 

  2255. ! 
    2256. 

  2256.   PVARP(:,:,IKB:IKE) = ZY(:,:,IKB:IKE) * PTSTEP / PRHODJ(:,:,IKB:IKE)
    2257. 

  2257. !
    2258. 

  2258. END IF 
    2259. 

  2259. !
    2260. 

  2260. !
    2261. 

  2261. !*       4.  FILL THE UPPER AND LOWER EXTERNAL VALUES
    2262. 

  2262. !            ----------------------------------------
    2263. 

  2263. !
    2264. 

  2264. !PVARP(:,:,IKB-1)=PVARP(:,:,IKB) MODIF WRF JP
    2265. 

  2265. PVARP(:,:,IKE+1)=PVARP(:,:,IKE)
    2266. 

  2266. !
    2267. 

  2267. !-------------------------------------------------------------------------------
    2268. 

  2268. !
    2269. 

  2269. END SUBROUTINE TRIDIAG_MASSFLUX
    2270. 

  2270. 

  2271. !     
    2272. 

  2272. !     #################################################################
    2273. 

  2273.       SUBROUTINE UPDRAFT_SOPE(KRR,KRRL,KRRI,OMIXUV,                   & 
    2274. 

  2274.                          PZZ,PDZZ,PSFTH,PSFRV,PPABSM,PRHODREF,        &
    2275. 

  2275.                          PTKEM,PTHM,PRM,PTHLM,PRTM,PUM,PVM,           &
    2276. 

  2276.                          PTHL_UP,PRT_UP,PRV_UP,PU_UP,PV_UP,           &
    2277. 

  2277.                          PRC_UP,PRI_UP,PTHV_UP,PW_UP,PFRAC_UP,PEMF,   &
    2278. 

  2278.                          PDETR,PENTR,KKLCL,KKETL,KKCTL )
    2279. 

  2279. !     #################################################################
    2280. 

  2280. !!
    2281. 

  2281. !!****  *UPDRAFT_SOPE* - Interfacing routine
    2282. 

  2282. !!
    2283. 

  2283. !! --------------------------------------------------------------------------
    2284. 

  2284. !
    2285. 

  2285. !*      0. DECLARATIONS
    2286. 

  2286. !          ------------
    2287. 

  2287. !
    2288. 

  2288. 

  2289. IMPLICIT NONE
    2290. 

  2290. 

  2291. !*                    1.1  Declaration of Arguments
    2292. 

  2292. !
    2293. 

  2293. !
    2294. 

  2294. INTEGER,                INTENT(IN)   :: KRR       ! number of moist var.
    2295. 

  2295. INTEGER,                INTENT(IN)   :: KRRL      ! number of liquid water var.
    2296. 

  2296. INTEGER,                INTENT(IN)   :: KRRI      ! number of ice water var.
    2297. 

  2297. LOGICAL,                INTENT(IN)   :: OMIXUV    ! True if mixing of momentum
    2298. 

  2298. 

  2299. REAL, DIMENSION(:,:,:), INTENT(IN)   :: PZZ       !  Height at the flux point
    2300. 

  2300. 

  2301. REAL, DIMENSION(:,:,:), INTENT(IN)   :: PDZZ      ! depth between mass levels 
    2302. 

  2302.  
    2303. 

  2303. REAL, DIMENSION(:,:),   INTENT(IN)   ::  PSFTH,PSFRV
    2304. 

  2304.                                             ! normal surface fluxes of theta,rv
    2305. 

  2305. !
    2306. 

  2306. !    prognostic variables at t- deltat
    2307. 

  2307. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PPABSM      ! Pressure at time t-1
    2308. 

  2308. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PRHODREF    ! dry density of the
    2309. 

  2309.                                                      ! reference state
    2310. 

  2310. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PTKEM       ! TKE
    2311. 

  2311. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PUM,PVM     ! momentum
    2312. 

  2312. 

  2313. !
    2314. 

  2314. !   thermodynamical variables which are transformed in conservative var.
    2315. 

  2315. REAL, DIMENSION(:,:,:),   INTENT(IN)   ::  PTHM       ! pot. temp. = PTHLM in turb.f90
    2316. 

  2316. REAL, DIMENSION(:,:,:,:), INTENT(IN)   ::  PRM        ! water species 
    2317. 

  2317. REAL, DIMENSION(:,:,:),   INTENT(IN)   ::  PTHLM,PRTM !cons. var.  
    2318. 

  2318. REAL, DIMENSION(:,:,:),   INTENT(OUT)  ::  PTHL_UP,PRT_UP  ! updraft properties
    2319. 

  2319. REAL, DIMENSION(:,:,:),   INTENT(OUT)  ::  PRV_UP,PRC_UP,PRI_UP,&!Thl,Rt,Rv,Rc,Ri
    2320. 

  2320.                                            PW_UP,PFRAC_UP,PEMF, &!w,Updraft Fraction, Mass Flux
    2321. 

  2321.                                            PDETR,PENTR,PTHV_UP, &!entrainment, detrainment, ThV
    2322. 

  2322.                                            PU_UP, PV_UP          !updraft wind component
    2323. 

  2323.                                            
    2324. 

  2324. INTEGER, DIMENSION(:,:),  INTENT(OUT)  ::  KKLCL,KKETL,KKCTL     !index for LCL,ETL,CTL       
    2325. 

  2325. !
    2326. 

  2326. !
    2327. 

  2327. !
    2328. 

  2328. !                       1.2  Declaration of local variables
    2329. 

  2329. 

  2330. INTEGER :: IKB
    2331. 

  2331. 

  2332. !
    2333. 

  2333. ! Variables to transform 3D fields in 2D fields
    2334. 

  2334. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZPABSM,ZRHODREF
    2335. 

  2335.        
    2336. 

  2336. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZZZ,ZDZZ
    2337. 

  2337. 

  2338. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZTHLM,ZRTM,&
    2339. 

  2339.                                                               ZTHM,ZTKEM,&
    2340. 

  2340.                                                               ZUM,ZVM
    2341. 

  2341.                                                               
    2342. 

  2342. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZRVM,ZRCM,ZRIM
    2343. 

  2343. 

  2344. REAL, DIMENSION(SIZE(PSFTH,1)*SIZE(PSFTH,2))    ::  ZSFTH,ZSFRV
    2345. 

  2345. 

  2346. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3))  :: ZTHL_UP,ZRT_UP,&
    2347. 

  2347.                                       ZRV_UP,ZRC_UP, ZRI_UP, &
    2348. 

  2348.                                       ZW_UP,ZU_UP,ZV_UP,ZTHV_UP,           &
    2349. 

  2349.                                       ZFRAC_UP,ZEMF_UP,ZENTR_UP,ZDETR_UP
    2350. 

  2350. 

  2351. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2))    :: ZFRAC_GRID
    2352. 

  2352. INTEGER, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2)) :: JKETL,JKCTL,JKLCL
    2353. 

  2353. 

  2354. INTEGER :: IIU,IJU,IKU! Limit of the grid
    2355. 

  2355. INTEGER :: J1D        ! horizontal loop counter
    2356. 

  2356. INTEGER :: JK,JKK,JSV ! loop counters
    2357. 

  2357. INTEGER :: JRR        ! moist loop counter
    2358. 

  2358. REAL    :: ZRVORD     ! Rv/Rd (=1/0.622 cf glossaire)
    2359. 

  2359. 

  2360. !------------------------------------------------------------------------
    2361. 

  2361. 

  2362. !                     2. INITIALISATION
    2363. 

  2363. 

  2364. !                     2.1 Local variables, internal domain
    2365. 

  2365. 

  2366. IIU=SIZE(PTKEM,1)
    2367. 

  2367. IJU=SIZE(PTKEM,2)
    2368. 

  2368. !
    2369. 

  2369. IKB = 1              ! Modif WRF JP
    2370. 

  2370. IKU = SIZE(PTKEM,3)
    2371. 

  2371. 

  2372. ZRVORD = XRV / XRD
    2373. 

  2373. 

  2374. 

  2375. DO JK=IKB,IKU
    2376. 

  2376.   ZZZ    (:,JK) = RESHAPE(PZZ    (:,:,JK),(/ IIU*IJU /) )
    2377. 

  2377.   ZDZZ   (:,JK) = RESHAPE(PDZZ    (:,:,JK),(/ IIU*IJU /) )  
    2378. 

  2378.   ZTHM   (:,JK) = RESHAPE(PTHM   (:,:,JK),(/ IIU*IJU /) )
    2379. 

  2379.   ZTKEM  (:,JK) = RESHAPE(PTKEM  (:,:,JK),(/ IIU*IJU /) )
    2380. 

  2380.   ZPABSM (:,JK) = RESHAPE(PPABSM (:,:,JK),(/ IIU*IJU /) )
    2381. 

  2381.   ZRHODREF(:,JK) = RESHAPE(PRHODREF(:,:,JK),(/ IIU*IJU /) )  
    2382. 

  2382.   ZRVM   (:,JK) = RESHAPE(PRM    (:,:,JK,1),(/ IIU*IJU /) ) 
    2383. 

  2383.   ZTHLM  (:,JK) = RESHAPE(PTHLM   (:,:,JK),(/ IIU*IJU /) )
    2384. 

  2384.   ZRTM   (:,JK) = RESHAPE(PRTM    (:,:,JK),(/ IIU*IJU /) )
    2385. 

  2385.   ZUM    (:,JK) = RESHAPE(PUM    (:,:,JK),(/ IIU*IJU /) )
    2386. 

  2386.   ZVM    (:,JK) = RESHAPE(PVM    (:,:,JK),(/ IIU*IJU /) )
    2387. 

  2387. END DO
    2388. 

  2388. 

  2389. IF (KRRL>1) THEN
    2390. 

  2390. DO JK=1,IKU
    2391. 

  2391.   ZRCM   (:,JK) = RESHAPE(PRM    (:,:,JK,2),(/ IIU*IJU /) ) 
    2392. 

  2392. END DO
    2393. 

  2393. ELSE
    2394. 

  2394.   ZRCM   (:,:) =0.
    2395. 

  2395. ENDIF
    2396. 

  2396. IF (KRRI>1) THEN
    2397. 

  2397. DO JK=1,IKU
    2398. 

  2398.   ZRIM   (:,JK) = RESHAPE(PRM    (:,:,JK,4),(/ IIU*IJU /) ) 
    2399. 

  2399. END DO
    2400. 

  2400. ELSE
    2401. 

  2401.   ZRIM   (:,:) =0.
    2402. 

  2402. ENDIF
    2403. 

  2403. 

  2404. ZSFTH(:)=RESHAPE(PSFTH(:,:),(/ IIU*IJU /) )
    2405. 

  2405. ZSFRV(:)=RESHAPE(PSFRV(:,:),(/ IIU*IJU /) )
    2406. 

  2406. 

  2407. !Updraft begins at level 1 (Modif WRF)
    2408. 

  2408. JK=IKB 
    2409. 

  2409. 

  2410. !        6.2 compute properties of the updraft
    2411. 

  2411. CALL COMPUTE_UPDRAFT(OMIXUV,ZZZ,ZDZZ,JK,      &
    2412. 

  2412.                      ZSFTH,ZSFRV,ZPABSM,ZRHODREF,ZUM,ZVM,ZTKEM, &
    2413. 

  2413.                      ZTHM,ZRVM,ZRCM,ZRIM,ZTHLM,ZRTM,       &
    2414. 

  2414.                      ZTHL_UP,ZRT_UP,ZRV_UP,ZRC_UP,ZRI_UP,&
    2415. 

  2415.                      ZTHV_UP,ZW_UP,ZU_UP,ZV_UP, &
    2416. 

  2416.                      ZFRAC_UP,ZEMF_UP,&
    2417. 

  2417.                      ZDETR_UP,ZENTR_UP,&
    2418. 

  2418.                      JKLCL,JKETL,JKCTL)
    2419. 

  2419. 

  2420. 

  2421. PTHL_UP(:,:,:)= RESHAPE(ZTHL_UP(:,:), (/ IIU,IJU,IKU /))
    2422. 

  2422. PRT_UP(:,:,:)=RESHAPE(ZRT_UP(:,:), (/ IIU,IJU,IKU /) )
    2423. 

  2423. PRV_UP(:,:,:)=RESHAPE(ZRV_UP(:,:), (/ IIU,IJU,IKU /) )
    2424. 

  2424. PRC_UP(:,:,:)=RESHAPE(ZRC_UP(:,:), (/ IIU,IJU,IKU /) )
    2425. 

  2425. PRI_UP(:,:,:)=RESHAPE(ZRI_UP(:,:), (/ IIU,IJU,IKU /) )
    2426. 

  2426. PW_UP(:,:,:)=RESHAPE(ZW_UP(:,:), (/ IIU,IJU,IKU /) )
    2427. 

  2427. PU_UP(:,:,:)=RESHAPE(ZU_UP(:,:), (/ IIU,IJU,IKU /) )
    2428. 

  2428. PV_UP(:,:,:)=RESHAPE(ZV_UP(:,:), (/ IIU,IJU,IKU /) )
    2429. 

  2429. PEMF(:,:,:)=RESHAPE(ZEMF_UP(:,:), (/ IIU,IJU,IKU /) )
    2430. 

  2430. PDETR(:,:,:)=RESHAPE(ZDETR_UP(:,:), (/ IIU,IJU,IKU /) )
    2431. 

  2431. PENTR(:,:,:)=RESHAPE(ZENTR_UP(:,:), (/ IIU,IJU,IKU /) )
    2432. 

  2432. PTHV_UP(:,:,:)=RESHAPE(ZTHV_UP(:,:), (/ IIU,IJU,IKU /) )
    2433. 

  2433. KKETL(:,:)=RESHAPE(JKETL(:),(/ IIU,IJU/) )
    2434. 

  2434. KKCTL(:,:)=RESHAPE(JKCTL(:),(/ IIU,IJU/) )
    2435. 

  2435. KKLCL(:,:)=RESHAPE(JKLCL(:),(/ IIU,IJU/) )
    2436. 

  2436. PFRAC_UP(:,:,:)=RESHAPE(ZFRAC_UP(:,:),(/ IIU,IJU,IKU /) )
    2437. 

  2437. 

  2438. END SUBROUTINE UPDRAFT_SOPE
    2439. 

  2439. 

  2440. !     #################################################################
    2441. 

  2441.       SUBROUTINE COMPUTE_MF_CLOUD(KRRL, PTHLM,PRC_UP, PFRAC_UP, PDZZ, KKLCL,&
    2442. 

  2442.                                   PRC_MF,PCF_MF                     )
    2443. 

  2443. !     #################################################################
    2444. 

  2444. !!
    2445. 

  2445. !!****  *COMPUTE_MF_CLOUD* - 
    2446. 

  2446. !!       compute diagnostic subgrid cumulus cloud caracteristics
    2447. 

  2447. !!
    2448. 

  2448. !!    PURPOSE
    2449. 

  2449. !!    -------
    2450. 

  2450. !!****  The purpose of this routine is to compute the cloud fraction and 
    2451. 

  2451. !!      the mean cloud content associated with clouds described by the 
    2452. 

  2452. !!      mass flux scheme
    2453. 

  2453. !!
    2454. 

  2454. !
    2455. 

  2455. !!**  METHOD
    2456. 

  2456. !!    ------
    2457. 

  2457. !!
    2458. 

  2458. !!    EXTERNAL
    2459. 

  2459. !!    --------
    2460. 

  2460. !!      
    2461. 

  2461. !!    IMPLICIT ARGUMENTS
    2462. 

  2462. !!    ------------------
    2463. 

  2463. !!
    2464. 

  2464. !!     REFERENCE
    2465. 

  2465. !!     ---------
    2466. 

  2466. !!
    2467. 

  2467. !!
    2468. 

  2468. !!     AUTHOR
    2469. 

  2469. !!     ------
    2470. 

  2470. !! --------------------------------------------------------------------------
    2471. 

  2471. !
    2472. 

  2472. !*      0. DECLARATIONS
    2473. 

  2473. !          ------------
    2474. 

  2474. !
    2475. 

  2475. 

  2476. 

  2477. IMPLICIT NONE
    2478. 

  2478. 

  2479. !*                    1.1  Declaration of Arguments
    2480. 

  2480. !
    2481. 

  2481. !
    2482. 

  2482. !
    2483. 

  2483. INTEGER,                  INTENT(IN)   ::  KRRL         ! number of liquid water var.
    2484. 

  2484.                                                         ! scheme
    2485. 

  2485. REAL, DIMENSION(:,:,:),   INTENT(IN)   ::  PTHLM ! updraft characteritics
    2486. 

  2486. 

  2487. REAL, DIMENSION(:,:,:),   INTENT(IN)   ::  PRC_UP ! updraft characteritics
    2488. 

  2488. REAL, DIMENSION(:,:,:),   INTENT(IN)   ::  PFRAC_UP          ! Updraft Fraction
    2489. 

  2489. 

  2490. REAL, DIMENSION(:,:,:),   INTENT(IN)   ::  PDZZ
    2491. 

  2491. INTEGER, DIMENSION(:,:),  INTENT(IN)   ::  KKLCL          ! index of updraft condensation level
    2492. 

  2492. REAL, DIMENSION(:,:,:),   INTENT(OUT)  ::  PRC_MF, PCF_MF ! cloud content and
    2493. 

  2493.                                                           ! cloud fraction for MF scheme
    2494. 

  2494. 

  2495. !
    2496. 

  2496. !                       1.2  Declaration of local variables
    2497. 

  2497. !
    2498. 

  2498. REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ::  ZFLXZ
    2499. 

  2499. INTEGER  :: IKU, IKB, IKE, JI,JJ,JK
    2500. 

  2500. !------------------------------------------------------------------------
    2501. 

  2501. 

  2502. !                     1. INITIALISATION
    2503. 

  2503. 

  2504. !                     2.1 Internal domain
    2505. 

  2505. 

  2506. ! Internal Domain
    2507. 

  2507. IKU=SIZE(PTHLM,3)
    2508. 

  2508. IKB=1
    2509. 

  2509. IKE=IKU-1
    2510. 

  2510. 

  2511. PCF_MF = 0.
    2512. 

  2512. PRC_MF = 0.
    2513. 

  2513. 

  2514. 

  2515. !
    2516. 

  2516. !                    Direct cloud scheme
    2517. 

  2517. !        This scheme may be activated only if the selected updraft model
    2518. 

  2518. !        gives the updraft fraction as an output
    2519. 

  2519. !        
    2520. 

  2520. 

  2521. ! attention, les variables de l'updraft sont en niveaux flux
    2522. 

  2522. ! ils faut les passer aux niveaux masse pour calculer PRC_MF et PCF_MF
    2523. 

  2523. DO JI=1,SIZE(PCF_MF,1)
    2524. 

  2524. DO JJ=1,SIZE(PCF_MF,2)
    2525. 

  2525. 

  2526. DO JK=KKLCL(JI,JJ),IKE
    2527. 

  2527. 

  2528. PCF_MF(JI,JJ,JK ) = XKCF_MF *0.5* (       &
    2529. 

  2529.   &    PFRAC_UP(JI,JJ,JK) +  PFRAC_UP(JI,JJ,JK+1) )
    2530. 

  2530. PRC_MF(JI,JJ,JK)  = 0.5* XKCF_MF * ( PFRAC_UP(JI,JJ,JK)*PRC_UP(JI,JJ,JK)  &
    2531. 

  2531.                          + PFRAC_UP(JI,JJ,JK+1)*PRC_UP(JI,JJ,JK+1) )
    2532. 

  2532. 

  2533. 

  2534. END DO
    2535. 

  2535. END DO
    2536. 

  2536. END DO
    2537. 

  2537. 

  2538. 

  2539. END SUBROUTINE COMPUTE_MF_CLOUD
    2540. 

  2540. 

  2541. 

  2542. !     #################################################################
    2543. 

  2543.       SUBROUTINE mfshconvpblinit(massflux_EDKF, entr_EDKF, detr_EDKF & 
    2544. 

  2544.                                      ,thl_up, thv_up, rt_up       &
    2545. 

  2545.                                      ,rv_up, rc_up, u_up, v_up    &
    2546. 

  2546.                                      ,frac_up,RESTART,ALLOWED_TO_READ,     &
    2547. 

  2547.      &                      IDS,IDE,JDS,JDE,KDS,KDE,                    &
    2548. 

  2548.      &                      IMS,IME,JMS,JME,KMS,KME,                    &
    2549. 

  2549.      &                      ITS,ITE,JTS,JTE,KTS,KTE                 )
    2550. 

  2550. !     #################################################################
    2551. 

  2551. 

  2552.       IMPLICIT NONE
    2553. 

  2553. 

  2554.       LOGICAL,INTENT(IN) :: ALLOWED_TO_READ,RESTART
    2555. 

  2555.       INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE,                    &
    2556. 

  2556.      &                      IMS,IME,JMS,JME,KMS,KME,                    &
    2557. 

  2557.      &                      ITS,ITE,JTS,JTE,KTS,KTE
    2558. 

  2558. 

  2559.       REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT),OPTIONAL ::             &
    2560. 

  2560.      &                                        MASSFLUX_EDKF, ENTR_EDKF, DETR_EDKF &
    2561. 

  2561.      &                                       ,THL_UP, THV_UP, RT_UP, RV_UP        &
    2562. 

  2562.      &                                       ,RC_UP, U_UP, V_UP, FRAC_UP 
    2563. 

  2563. 

  2564.       INTEGER :: I,J,K,ITF,JTF,KTF
    2565. 

  2565. 

  2566. !---------------------------------------------
    2567. 

  2567.       JTF=MIN0(JTE,JDE-1)
    2568. 

  2568.       KTF=MIN0(KTE,KDE-1)
    2569. 

  2569.       ITF=MIN0(ITE,IDE-1)
    2570. 

  2570. 

  2571. !     IF(.NOT.RESTART)THEN
    2572. 

  2572.       IF( PRESENT (MASSFLUX_EDKF) ) THEN
    2573. 

  2573.         DO J=JTS,JTF
    2574. 

  2574.         DO K=KTS,KTF
    2575. 

  2575.         DO I=ITS,ITF
    2576. 

  2576.           MASSFLUX_EDKF(I,K,J)=0.
    2577. 

  2577.           ENTR_EDKF(I,K,J)=0.
    2578. 

  2578.           DETR_EDKF(I,K,J)=0.
    2579. 

  2579.           THL_UP(I,K,J)=0.
    2580. 

  2580.           THV_UP(I,K,J)=0.
    2581. 

  2581.           RT_UP(I,K,J)=0.
    2582. 

  2582.           RV_UP(I,K,J)=0.
    2583. 

  2583.           RC_UP(I,K,J)=0.
    2584. 

  2584.           U_UP(I,K,J)=0.
    2585. 

  2585.           V_UP(I,K,J)=0.
    2586. 

  2586.           FRAC_UP(I,K,J)=0.
    2587. 

  2587.         ENDDO
    2588. 

  2588.         ENDDO
    2589. 

  2589.         ENDDO
    2590. 

  2590.       ENDIF
    2591. 

  2591. 

  2592. END SUBROUTINE mfshconvpblinit
    2593. 

  2593. 

  2594. 

  2595. !     #########################################################
    2596. 

  2596.       SUBROUTINE BL89(PZZ,PDZZ,PTHVREF,PTHLM,KRR, &
    2597. 

  2597.                  PRM,PTKEM,PLM)
    2598. 

  2598. !     #########################################################
    2599. 

  2599. !
    2600. 

  2600. !!****  *BL89* -
    2601. 

  2601. !!
    2602. 

  2602. !!    PURPOSE
    2603. 

  2603. !!    -------
    2604. 

  2604. !!    This routine computes the mixing length from Bougeault-Lacarrere 89
    2605. 

  2605. !!    formula.
    2606. 

  2606. !!
    2607. 

  2607. !!**  METHOD
    2608. 

  2608. !!    ------
    2609. 

  2609. !!
    2610. 

  2610. !*       0.1   Declaration of arguments
    2611. 

  2611. !              ------------------------
    2612. 

  2612. !
    2613. 

  2613. INTEGER,                INTENT(IN)   :: KRR
    2614. 

  2614. 

  2615. REAL, DIMENSION(:,:,:),   INTENT(IN)  :: PZZ
    2616. 

  2616. REAL, DIMENSION(:,:,:),   INTENT(IN)  :: PDZZ
    2617. 

  2617. REAL, DIMENSION(:,:,:),   INTENT(IN)  :: PTHVREF
    2618. 

  2618. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PTKEM       ! TKE
    2619. 

  2619. !   thermodynamical variables PTHLM=Theta at the begining
    2620. 

  2620. REAL, DIMENSION(:,:,:),   INTENT(IN) ::  PTHLM     ! conservative pot. temp.
    2621. 

  2621. REAL, DIMENSION(:,:,:,:), INTENT(IN) ::  PRM       ! water var.                 
    2622. 

  2622. REAL, DIMENSION(:,:,:),   INTENT(OUT) :: PLM       ! Mixing length
    2623. 

  2623. 

  2624. !*       0.2   Declaration of local variables
    2625. 

  2625. !              ------------------------------
    2626. 

  2626. !
    2627. 

  2627. INTEGER :: IKB,IKE
    2628. 

  2628. 

  2629. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZRTM
    2630. 

  2630. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) ::ZVPT  ! Virtual Potential Temp at half levels
    2631. 

  2631. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2)) ::  ZLWORK
    2632. 

  2632. !           ! downwards then upwards vertical displacement,
    2633. 

  2633. REAL, DIMENSION(SIZE(PTKEM,1)*SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZZZ,ZDZZ,&
    2634. 

  2634.                                                               ZG_O_THVREF, &
    2635. 

  2635.                                                               ZTHM,ZTKEM,ZLM,&
    2636. 

  2636.                                                               ZLMUP,ZLMDN,&
    2637. 

  2637.                                                               ZLMTEST
    2638. 

  2638. !           ! input and output arrays packed according one horizontal coord.
    2639. 

  2639. REAL, DIMENSION(SIZE(PRM,1)*SIZE(PRM,2),SIZE(PRM,3),SIZE(PRM,4)) :: ZRM
    2640. 

  2640. !           ! input array packed according one horizontal coord.
    2641. 

  2641. REAL, DIMENSION(SIZE(PRM,1)*SIZE(PRM,2),SIZE(PRM,3)) :: ZSUM ! to replace SUM function
    2642. 

  2642. 

  2643. REAL   :: ZPOTE,ZLWORK1,ZLWORK2
    2644. 

  2644. 

  2645. INTEGER :: IIU,IJU,IKU,IICE
    2646. 

  2646. INTEGER :: J1D        ! horizontal loop counter
    2647. 

  2647. INTEGER :: JK,JKK     ! loop counters
    2648. 

  2648. INTEGER :: JRR        ! moist loop counter
    2649. 

  2649. REAL    :: ZRVORD     ! Rv/Rd (=1/0.622 cf glossaire)
    2650. 

  2650. LOGICAL :: GUPORDN    !Test for computation of upward or downward mixing length
    2651. 

  2651. REAL    :: Z2SQRT2
    2652. 

  2652. !-------------------------------------------------------------------------------
    2653. 

  2653. !
    2654. 

  2654. Z2SQRT2=2.*SQRT(2.)
    2655. 

  2655. IIU=SIZE(PTKEM,1)
    2656. 

  2656. IJU=SIZE(PTKEM,2)
    2657. 

  2657. !
    2658. 

  2658. IKB =  1
    2659. 

  2659. IKE = SIZE(PTKEM,3)-1
    2660. 

  2660. IKU = SIZE(PTKEM,3)
    2661. 

  2661. ZRVORD = XRV / XRD
    2662. 

  2662. !-------------------------------------------------------------------------------
    2663. 

  2663. !
    2664. 

  2664. !*       1.    pack the horizontal dimensions into one
    2665. 

  2665. !              ---------------------------------------
    2666. 

  2666. !
    2667. 

  2667. DO JK=1,IKU
    2668. 

  2668.   ZZZ    (:,JK)   = RESHAPE(PZZ    (:,:,JK),(/ IIU*IJU /) )
    2669. 

  2669.   ZDZZ   (:,JK)   = RESHAPE(PDZZ   (:,:,JK),(/ IIU*IJU /) )
    2670. 

  2670.   ZTHM   (:,JK)   = RESHAPE(PTHLM  (:,:,JK),(/ IIU*IJU /) )
    2671. 

  2671.   ZTKEM  (:,JK)   = RESHAPE(PTKEM  (:,:,JK),(/ IIU*IJU /) )
    2672. 

  2672.   ZG_O_THVREF(:,JK)   = RESHAPE(XG/PTHVREF(:,:,JK),(/ IIU*IJU /) )
    2673. 

  2673.   DO JRR=1,KRR
    2674. 

  2674.     ZRM  (:,JK,JRR) = RESHAPE(PRM    (:,:,JK,JRR),(/ IIU*IJU /) )
    2675. 

  2675.   END DO
    2676. 

  2676. END DO
    2677. 

  2677. !-------------------------------------------------------------------------------
    2678. 

  2678. !
    2679. 

  2679. !*       2.    Virtual potential temperature on the model grid
    2680. 

  2680. !              -----------------------------------------------
    2681. 

  2681. !
    2682. 

  2682. IF(KRR /= 0) THEN
    2683. 

  2683.   ZSUM(:,:) = 0.
    2684. 

  2684.   DO JRR=1,KRR
    2685. 

  2685.     ZSUM(:,:) = ZSUM(:,:)+ZRM(:,:,JRR)
    2686. 

  2686.   ENDDO
    2687. 

  2687.   ZVPT(:,1:)=ZTHM(:,:) * ( 1. + ZRVORD*ZRM(:,:,1) )  &
    2688. 

  2688.                            / ( 1. + ZSUM(:,:) )
    2689. 

  2689. ELSE
    2690. 

  2690.   ZVPT(:,1:)=ZTHM(:,:)
    2691. 

  2691. END IF
    2692. 

  2692. !
    2693. 

  2693. !-------------------------------------------------------------------------------
    2694. 

  2694. !
    2695. 

  2695. !*       3.  loop on model levels
    2696. 

  2696. !            --------------------
    2697. 

  2697. !
    2698. 

  2698. DO JK=IKB,IKE
    2699. 

  2699. !-------------------------------------------------------------------------------
    2700. 

  2700. !
    2701. 

  2701. !*       4.  mixing length for a downwards displacement
    2702. 

  2702. !            ------------------------------------------
    2703. 

  2703.    GUPORDN=.FALSE.
    2704. 

  2704.    CALL COMPUTE_BL89_ML(ZDZZ,ZTKEM,ZG_O_THVREF,ZVPT,JK,GUPORDN,ZLWORK)
    2705. 

  2705. 

  2706. 

  2707. 

  2708. !-------------------------------------------------------------------------------
    2709. 

  2709. !
    2710. 

  2710. !*       5.  intermediate storage of the final mixing length
    2711. 

  2711. !            -----------------------------------------------
    2712. 

  2712. !
    2713. 

  2713.    ZLMDN(:,JK)=MIN(ZLWORK(:),0.5*(ZZZ(:,JK)+ZZZ(:,JK+1))-ZZZ(:,IKB))
    2714. 

  2714. !
    2715. 

  2715. !-------------------------------------------------------------------------------
    2716. 

  2716. !
    2717. 

  2717. !*       6.  mixing length for an upwards displacement
    2718. 

  2718. !            -----------------------------------------
    2719. 

  2719.  
    2720. 

  2720.    GUPORDN=.TRUE.
    2721. 

  2721.    CALL COMPUTE_BL89_ML(ZDZZ,ZTKEM,ZG_O_THVREF,ZVPT,JK,GUPORDN,ZLWORK)
    2722. 

  2722. 

  2723.    ZLMUP(:,JK)=ZLWORK(:)
    2724. 

  2724. 

  2725. !-------------------------------------------------------------------------------
    2726. 

  2726. ! 
    2727. 

  2727.   DO J1D=1,IIU*IJU
    2728. 

  2728.     ZLWORK1=MAX(ZLMDN(J1D,JK),1.E-10)
    2729. 

  2729.     ZLWORK2=MAX(ZLMUP(J1D,JK),1.E-10)
    2730. 

  2730.     ZPOTE = ZLWORK1 / ZLWORK2
    2731. 

  2731.     ZLWORK2=1.d0 + ZPOTE**(2./3.)
    2732. 

  2732.     ZLM(J1D,JK) = Z2SQRT2*ZLWORK1/(ZLWORK2*SQRT(ZLWORK2))
    2733. 

  2733.   END DO
    2734. 

  2734. 

  2735. ZLM(:,JK)=( 0.5* (MAX(ZLMDN(:,JK),1.E-10)**(-2./3.)+MAX(ZLMUP(:,JK),1.E-10)**(-2./3.)) )**(-1.5)
    2736. 

  2736. ZLM(:,JK)=MAX(ZLM(:,JK),XLINI)
    2737. 

  2737. 

  2738. !*       8.  end of the loop on the vertical levels
    2739. 

  2739. !            --------------------------------------
    2740. 

  2740. !
    2741. 

  2741. END DO
    2742. 

  2742. !
    2743. 

  2743. !-------------------------------------------------------------------------------
    2744. 

  2744. !
    2745. 

  2745. !*       9.  boundaries
    2746. 

  2746. !            ----------
    2747. 

  2747. !
    2748. 

  2748. ZLM(:,IKE)  =ZLM(:,IKE-1)
    2749. 

  2749. ZLM(:,IKE+1)=ZLM(:,IKE-1)
    2750. 

  2750. ZLMUP(:,IKE)  =ZLMUP(:,IKE-1)
    2751. 

  2751. ZLMUP(:,IKE+1)=ZLMUP(:,IKE-1)
    2752. 

  2752. ZLMDN(:,IKE)  =ZLMDN(:,IKE-1)
    2753. 

  2753. ZLMDN(:,IKE+1)=ZLMDN(:,IKE-1)
    2754. 

  2754. !
    2755. 

  2755.   DO JK=1,IKU
    2756. 

  2756.     PLM  (:,:,JK)   = RESHAPE(ZLM  (:,JK), (/ IIU,IJU /) )
    2757. 

  2757.   END DO
    2758. 

  2758. 

  2759. END SUBROUTINE BL89
    2760. 

  2760.                         
    2761. 

  2761. END  MODULE MODULE_BL_MFSHCONVPBL
    2762. 

  2762. 

  2763.