PageRenderTime 60ms CodeModel.GetById 25ms RepoModel.GetById 0ms app.codeStats 1ms

/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

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

    

  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          …
    1291.

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