| 1 | MODULE wx_pbl_mod |
|---|
| 2 | ! |
|---|
| 3 | ! Planetary Boundary Layer and Surface module |
|---|
| 4 | ! |
|---|
| 5 | ! This module manage the calculation of turbulent diffusion in the boundary layer |
|---|
| 6 | ! and all interactions towards the differents sub-surfaces. |
|---|
| 7 | ! |
|---|
| 8 | ! |
|---|
| 9 | USE dimphy |
|---|
| 10 | |
|---|
| 11 | IMPLICIT NONE |
|---|
| 12 | |
|---|
| 13 | REAL, ALLOCATABLE, DIMENSION(:), SAVE :: Kech_Tp, Kech_T_xp, Kech_T_wp |
|---|
| 14 | REAL, ALLOCATABLE, DIMENSION(:), SAVE :: dd_KTp, KxKwTp, dd_AT, dd_BT |
|---|
| 15 | !$OMP THREADPRIVATE(Kech_Tp, Kech_T_xp, Kech_T_wp, dd_KTp, KxKwTp, dd_AT, dd_BT) |
|---|
| 16 | REAL, ALLOCATABLE, DIMENSION(:), SAVE :: Kech_Qp, Kech_Q_xp, Kech_Q_wp |
|---|
| 17 | REAL, ALLOCATABLE, DIMENSION(:), SAVE :: dd_KQp, KxKwQp, dd_AQ, dd_BQ |
|---|
| 18 | !$OMP THREADPRIVATE(Kech_Qp, Kech_Q_xp, Kech_Q_wp, dd_KQp, KxKwQp, dd_AQ, dd_BQ) |
|---|
| 19 | REAL, ALLOCATABLE, DIMENSION(:), SAVE :: Kech_Up, Kech_U_xp, Kech_U_wp |
|---|
| 20 | REAL, ALLOCATABLE, DIMENSION(:), SAVE :: dd_KUp, KxKwUp, dd_AU, dd_BU |
|---|
| 21 | !$OMP THREADPRIVATE(Kech_Up, Kech_U_xp, Kech_U_wp, dd_KUp, KxKwUp, dd_AU, dd_BU) |
|---|
| 22 | REAL, ALLOCATABLE, DIMENSION(:), SAVE :: Kech_Vp, Kech_V_xp, Kech_V_wp |
|---|
| 23 | REAL, ALLOCATABLE, DIMENSION(:), SAVE :: dd_KVp, KxKwVp, dd_AV, dd_BV |
|---|
| 24 | !$OMP THREADPRIVATE(Kech_Vp, Kech_V_xp, Kech_V_wp, dd_KVp, KxKwVp, dd_AV, dd_BV) |
|---|
| 25 | |
|---|
| 26 | CONTAINS |
|---|
| 27 | ! |
|---|
| 28 | !**************************************************************************************** |
|---|
| 29 | ! |
|---|
| 30 | SUBROUTINE wx_pbl_init |
|---|
| 31 | |
|---|
| 32 | ! Local variables |
|---|
| 33 | !**************************************************************************************** |
|---|
| 34 | INTEGER :: ierr |
|---|
| 35 | |
|---|
| 36 | |
|---|
| 37 | !**************************************************************************************** |
|---|
| 38 | ! Allocate module variables |
|---|
| 39 | ! |
|---|
| 40 | !**************************************************************************************** |
|---|
| 41 | |
|---|
| 42 | ierr = 0 |
|---|
| 43 | |
|---|
| 44 | ALLOCATE(Kech_Tp(klon), stat=ierr) |
|---|
| 45 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 46 | |
|---|
| 47 | ALLOCATE(Kech_T_xp(klon), stat=ierr) |
|---|
| 48 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 49 | |
|---|
| 50 | ALLOCATE(Kech_T_wp(klon), stat=ierr) |
|---|
| 51 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 52 | |
|---|
| 53 | ALLOCATE(dd_KTp(klon), stat=ierr) |
|---|
| 54 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 55 | |
|---|
| 56 | ALLOCATE(KxKwTp(klon), stat=ierr) |
|---|
| 57 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 58 | |
|---|
| 59 | ALLOCATE(dd_AT(klon), stat=ierr) |
|---|
| 60 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 61 | |
|---|
| 62 | ALLOCATE(dd_BT(klon), stat=ierr) |
|---|
| 63 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 64 | |
|---|
| 65 | !---------------------------------------------------------------------------- |
|---|
| 66 | ALLOCATE(Kech_Qp(klon), stat=ierr) |
|---|
| 67 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 68 | |
|---|
| 69 | ALLOCATE(Kech_Q_xp(klon), stat=ierr) |
|---|
| 70 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 71 | |
|---|
| 72 | ALLOCATE(Kech_Q_wp(klon), stat=ierr) |
|---|
| 73 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 74 | |
|---|
| 75 | ALLOCATE(dd_KQp(klon), stat=ierr) |
|---|
| 76 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 77 | |
|---|
| 78 | ALLOCATE(KxKwQp(klon), stat=ierr) |
|---|
| 79 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 80 | |
|---|
| 81 | ALLOCATE(dd_AQ(klon), stat=ierr) |
|---|
| 82 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 83 | |
|---|
| 84 | ALLOCATE(dd_BQ(klon), stat=ierr) |
|---|
| 85 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 86 | |
|---|
| 87 | !---------------------------------------------------------------------------- |
|---|
| 88 | ALLOCATE(Kech_Up(klon), stat=ierr) |
|---|
| 89 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 90 | |
|---|
| 91 | ALLOCATE(Kech_U_xp(klon), stat=ierr) |
|---|
| 92 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 93 | |
|---|
| 94 | ALLOCATE(Kech_U_wp(klon), stat=ierr) |
|---|
| 95 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 96 | |
|---|
| 97 | ALLOCATE(dd_KUp(klon), stat=ierr) |
|---|
| 98 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 99 | |
|---|
| 100 | ALLOCATE(KxKwUp(klon), stat=ierr) |
|---|
| 101 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 102 | |
|---|
| 103 | ALLOCATE(dd_AU(klon), stat=ierr) |
|---|
| 104 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 105 | |
|---|
| 106 | ALLOCATE(dd_BU(klon), stat=ierr) |
|---|
| 107 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 108 | |
|---|
| 109 | !---------------------------------------------------------------------------- |
|---|
| 110 | ALLOCATE(Kech_Vp(klon), stat=ierr) |
|---|
| 111 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 112 | |
|---|
| 113 | ALLOCATE(Kech_V_xp(klon), stat=ierr) |
|---|
| 114 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 115 | |
|---|
| 116 | ALLOCATE(Kech_V_wp(klon), stat=ierr) |
|---|
| 117 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 118 | |
|---|
| 119 | ALLOCATE(dd_KVp(klon), stat=ierr) |
|---|
| 120 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 121 | |
|---|
| 122 | ALLOCATE(KxKwVp(klon), stat=ierr) |
|---|
| 123 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 124 | |
|---|
| 125 | ALLOCATE(dd_AV(klon), stat=ierr) |
|---|
| 126 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 127 | |
|---|
| 128 | ALLOCATE(dd_BV(klon), stat=ierr) |
|---|
| 129 | IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1) |
|---|
| 130 | |
|---|
| 131 | !---------------------------------------------------------------------------- |
|---|
| 132 | |
|---|
| 133 | END SUBROUTINE wx_pbl_init |
|---|
| 134 | |
|---|
| 135 | SUBROUTINE wx_pbl0_fuse(knon, dtime, ypplay, ywake_s, & |
|---|
| 136 | yt_x, yt_w, yq_x, yq_w, & |
|---|
| 137 | yu_x, yu_w, yv_x, yv_w, & |
|---|
| 138 | ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, & |
|---|
| 139 | AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w, & |
|---|
| 140 | AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, & |
|---|
| 141 | BcoefT_x, BcoefT_w, BcoefQ_x, BcoefQ_w, & |
|---|
| 142 | BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, & |
|---|
| 143 | AcoefT, AcoefQ, AcoefU, AcoefV, & |
|---|
| 144 | BcoefT, BcoefQ, BcoefU, BcoefV, & |
|---|
| 145 | ycdragh, ycdragm, & |
|---|
| 146 | yt1, yq1, yu1, yv1 & |
|---|
| 147 | ) |
|---|
| 148 | ! |
|---|
| 149 | USE print_control_mod, ONLY: prt_level,lunout |
|---|
| 150 | ! |
|---|
| 151 | INCLUDE "YOMCST.h" |
|---|
| 152 | ! |
|---|
| 153 | INTEGER, INTENT(IN) :: knon ! number of grid cells |
|---|
| 154 | REAL, INTENT(IN) :: dtime ! time step size (s) |
|---|
| 155 | REAL, DIMENSION(knon,klev), INTENT(IN) :: ypplay ! mid-layer pressure (Pa) |
|---|
| 156 | REAL, DIMENSION(knon), INTENT(IN) :: ywake_s ! cold pools fractional area |
|---|
| 157 | REAL, DIMENSION(knon,klev), INTENT(IN) :: yt_x, yt_w, yq_x, yq_w |
|---|
| 158 | REAL, DIMENSION(knon,klev), INTENT(IN) :: yu_x, yu_w, yv_x, yv_w |
|---|
| 159 | REAL, DIMENSION(knon), INTENT(IN) :: ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w |
|---|
| 160 | REAL, DIMENSION(knon), INTENT(IN) :: AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w |
|---|
| 161 | REAL, DIMENSION(knon), INTENT(IN) :: AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w |
|---|
| 162 | REAL, DIMENSION(knon), INTENT(IN) :: BcoefT_x, BcoefT_w, BcoefQ_x, BcoefQ_w |
|---|
| 163 | REAL, DIMENSION(knon), INTENT(IN) :: BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w |
|---|
| 164 | REAL, DIMENSION(knon), INTENT(OUT) :: AcoefT, AcoefQ, AcoefU, AcoefV |
|---|
| 165 | REAL, DIMENSION(knon), INTENT(OUT) :: BcoefT, BcoefQ, BcoefU, BcoefV |
|---|
| 166 | REAL, DIMENSION(knon), INTENT(OUT) :: ycdragh, ycdragm |
|---|
| 167 | REAL, DIMENSION(knon), INTENT(OUT) :: yt1, yq1, yu1, yv1 ! Apparent T, q, u, v at first level, as |
|---|
| 168 | !seen by surface modules |
|---|
| 169 | ! |
|---|
| 170 | ! Local variables |
|---|
| 171 | INTEGER :: j |
|---|
| 172 | REAL :: rho1 |
|---|
| 173 | REAL :: mod_wind_x |
|---|
| 174 | REAL :: mod_wind_w |
|---|
| 175 | REAL :: dd_Cdragh |
|---|
| 176 | REAL :: dd_Cdragm |
|---|
| 177 | REAL :: dd_Kh |
|---|
| 178 | REAL :: dd_Km |
|---|
| 179 | REAL :: dd_u |
|---|
| 180 | REAL :: dd_v |
|---|
| 181 | REAL :: dd_t |
|---|
| 182 | REAL :: dd_q |
|---|
| 183 | ! |
|---|
| 184 | REAL :: KCT, KCQ, KCU, KCV |
|---|
| 185 | ! |
|---|
| 186 | REAL :: BBT, BBQ, BBU, BBV |
|---|
| 187 | REAL :: DDT, DDQ, DDU, DDV |
|---|
| 188 | REAL :: LambdaT, LambdaQ, LambdaU, LambdaV |
|---|
| 189 | REAL :: LambdaTs, LambdaQs, LambdaUs, LambdaVs |
|---|
| 190 | ! |
|---|
| 191 | REAL, DIMENSION(knon) :: sigx ! fractional area of (x) region |
|---|
| 192 | |
|---|
| 193 | REAL, DIMENSION(knon) :: Kech_h ! Energy exchange coefficient |
|---|
| 194 | REAL, DIMENSION(knon) :: Kech_h_x, Kech_h_w |
|---|
| 195 | REAL, DIMENSION(knon) :: Kech_m ! Momentum exchange coefficient |
|---|
| 196 | REAL, DIMENSION(knon) :: Kech_m_x, Kech_m_w |
|---|
| 197 | |
|---|
| 198 | !!! |
|---|
| 199 | !!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences |
|---|
| 200 | |
|---|
| 201 | sigx(:) = 1.-ywake_s(:) |
|---|
| 202 | |
|---|
| 203 | DO j=1,knon |
|---|
| 204 | ! |
|---|
| 205 | ! Calcul des coefficients d echange |
|---|
| 206 | mod_wind_x = 1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2) |
|---|
| 207 | mod_wind_w = 1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2) |
|---|
| 208 | !! rho1 = ypplay(j,1)/(RD*yt(j,1)) |
|---|
| 209 | rho1 = ypplay(j,1)/(RD*(yt_x(j,1) + ywake_s(j)*(yt_w(j,1)-yt_x(j,1)))) |
|---|
| 210 | Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1 |
|---|
| 211 | Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1 |
|---|
| 212 | Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1 |
|---|
| 213 | Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1 |
|---|
| 214 | ! |
|---|
| 215 | dd_Kh = Kech_h_w(j) - Kech_h_x(j) |
|---|
| 216 | dd_Km = Kech_m_w(j) - Kech_m_x(j) |
|---|
| 217 | IF (prt_level >=10) THEN |
|---|
| 218 | print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w |
|---|
| 219 | print *,' rho1 ',rho1 |
|---|
| 220 | print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j) |
|---|
| 221 | print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j) |
|---|
| 222 | print *,' dd_Kh: ',dd_Kh |
|---|
| 223 | ENDIF |
|---|
| 224 | ! |
|---|
| 225 | Kech_h(j) = Kech_h_x(j) + ywake_s(j)*dd_Kh |
|---|
| 226 | Kech_m(j) = Kech_m_x(j) + ywake_s(j)*dd_Km |
|---|
| 227 | ! |
|---|
| 228 | ! Calcul des coefficients d echange corriges des retroactions |
|---|
| 229 | Kech_T_xp(j) = Kech_h_x(j)/(1.-BcoefT_x(j)*Kech_h_x(j)*dtime) |
|---|
| 230 | Kech_T_wp(j) = Kech_h_w(j)/(1.-BcoefT_w(j)*Kech_h_w(j)*dtime) |
|---|
| 231 | Kech_Q_xp(j) = Kech_h_x(j)/(1.-BcoefQ_x(j)*Kech_h_x(j)*dtime) |
|---|
| 232 | Kech_Q_wp(j) = Kech_h_w(j)/(1.-BcoefQ_w(j)*Kech_h_w(j)*dtime) |
|---|
| 233 | Kech_U_xp(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime) |
|---|
| 234 | Kech_U_wp(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime) |
|---|
| 235 | Kech_V_xp(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime) |
|---|
| 236 | Kech_V_wp(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime) |
|---|
| 237 | ! |
|---|
| 238 | dd_KTp(j) = Kech_T_wp(j) - Kech_T_xp(j) |
|---|
| 239 | dd_KQp(j) = Kech_Q_wp(j) - Kech_Q_xp(j) |
|---|
| 240 | dd_KUp(j) = Kech_U_wp(j) - Kech_U_xp(j) |
|---|
| 241 | dd_KVp(j) = Kech_V_wp(j) - Kech_V_xp(j) |
|---|
| 242 | ! |
|---|
| 243 | Kech_Tp(j) = Kech_T_xp(j) + ywake_s(j)*dd_KTp(j) |
|---|
| 244 | Kech_Qp(j) = Kech_Q_xp(j) + ywake_s(j)*dd_KQp(j) |
|---|
| 245 | Kech_Up(j) = Kech_U_xp(j) + ywake_s(j)*dd_KUp(j) |
|---|
| 246 | Kech_Vp(j) = Kech_V_xp(j) + ywake_s(j)*dd_KVp(j) |
|---|
| 247 | ! |
|---|
| 248 | ! Calcul des differences w-x |
|---|
| 249 | dd_Cdragm = ycdragm_w(j) - ycdragm_x(j) |
|---|
| 250 | dd_Cdragh = ycdragh_w(j) - ycdragh_x(j) |
|---|
| 251 | dd_u = yu_w(j,1) - yu_x(j,1) |
|---|
| 252 | dd_v = yv_w(j,1) - yv_x(j,1) |
|---|
| 253 | dd_t = yt_w(j,1) - yt_x(j,1) |
|---|
| 254 | dd_q = yq_w(j,1) - yq_x(j,1) |
|---|
| 255 | dd_AT(j) = AcoefT_w(j) - AcoefT_x(j) |
|---|
| 256 | dd_AQ(j) = AcoefQ_w(j) - AcoefQ_x(j) |
|---|
| 257 | dd_AU(j) = AcoefU_w(j) - AcoefU_x(j) |
|---|
| 258 | dd_AV(j) = AcoefV_w(j) - AcoefV_x(j) |
|---|
| 259 | dd_BT(j) = BcoefT_w(j) - BcoefT_x(j) |
|---|
| 260 | dd_BQ(j) = BcoefQ_w(j) - BcoefQ_x(j) |
|---|
| 261 | dd_BU(j) = BcoefU_w(j) - BcoefU_x(j) |
|---|
| 262 | dd_BV(j) = BcoefV_w(j) - BcoefV_x(j) |
|---|
| 263 | ! |
|---|
| 264 | KxKwTp(j) = Kech_T_xp(j)*Kech_T_wp(j) |
|---|
| 265 | KxKwQp(j) = Kech_Q_xp(j)*Kech_Q_wp(j) |
|---|
| 266 | KxKwUp(j) = Kech_U_xp(j)*Kech_U_wp(j) |
|---|
| 267 | KxKwVp(j) = Kech_V_xp(j)*Kech_V_wp(j) |
|---|
| 268 | BBT = (BcoefT_x(j) + sigx(j)*dd_BT(j))*dtime |
|---|
| 269 | BBQ = (BcoefQ_x(j) + sigx(j)*dd_BQ(j))*dtime |
|---|
| 270 | BBU = (BcoefU_x(j) + sigx(j)*dd_BU(j))*dtime |
|---|
| 271 | BBV = (BcoefV_x(j) + sigx(j)*dd_BV(j))*dtime |
|---|
| 272 | KCT = Kech_h(j) |
|---|
| 273 | KCQ = Kech_h(j) |
|---|
| 274 | KCU = Kech_m(j) |
|---|
| 275 | KCV = Kech_m(j) |
|---|
| 276 | DDT = Kech_Tp(j) |
|---|
| 277 | DDQ = Kech_Qp(j) |
|---|
| 278 | DDU = Kech_Up(j) |
|---|
| 279 | DDV = Kech_Vp(j) |
|---|
| 280 | LambdaT = dd_Kh/KCT |
|---|
| 281 | LambdaQ = dd_Kh/KCQ |
|---|
| 282 | LambdaU = dd_Km/KCU |
|---|
| 283 | LambdaV = dd_Km/KCV |
|---|
| 284 | LambdaTs = dd_KTp(j)/DDT |
|---|
| 285 | LambdaQs = dd_KQp(j)/DDQ |
|---|
| 286 | LambdaUs = dd_KUp(j)/DDU |
|---|
| 287 | LambdaVs = dd_KVp(j)/DDV |
|---|
| 288 | ! |
|---|
| 289 | IF (prt_level >=10) THEN |
|---|
| 290 | print *,'Variables pour la fusion : Kech_T_xp(j)' ,Kech_T_xp(j) |
|---|
| 291 | print *,'Variables pour la fusion : Kech_T_wp(j)' ,Kech_T_wp(j) |
|---|
| 292 | print *,'Variables pour la fusion : Kech_Tp(j)' ,Kech_Tp(j) |
|---|
| 293 | print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j) |
|---|
| 294 | ENDIF |
|---|
| 295 | ! |
|---|
| 296 | ! Calcul des coef A, B \'equivalents dans la couche 1 |
|---|
| 297 | ! |
|---|
| 298 | AcoefT(j) = AcoefT_x(j) + ywake_s(j)*dd_AT(j)*(1.+sigx(j)*LambdaTs) |
|---|
| 299 | AcoefQ(j) = AcoefQ_x(j) + ywake_s(j)*dd_AQ(j)*(1.+sigx(j)*LambdaQs) |
|---|
| 300 | AcoefU(j) = AcoefU_x(j) + ywake_s(j)*dd_AU(j)*(1.+sigx(j)*LambdaUs) |
|---|
| 301 | AcoefV(j) = AcoefV_x(j) + ywake_s(j)*dd_AV(j)*(1.+sigx(j)*LambdaVs) |
|---|
| 302 | ! |
|---|
| 303 | BcoefT(j) = BcoefT_x(j) + ywake_s(j)*BcoefT_x(j)*sigx(j)*LambdaT*LambdaTs & |
|---|
| 304 | + ywake_s(j)*dd_BT(j)*(1.+sigx(j)*LambdaT)*(1.+sigx(j)*LambdaTs) |
|---|
| 305 | |
|---|
| 306 | BcoefQ(j) = BcoefQ_x(j) + ywake_s(j)*BcoefQ_x(j)*sigx(j)*LambdaQ*LambdaQs & |
|---|
| 307 | + ywake_s(j)*dd_BQ(j)*(1.+sigx(j)*LambdaQ)*(1.+sigx(j)*LambdaQs) |
|---|
| 308 | |
|---|
| 309 | BcoefU(j) = BcoefU_x(j) + ywake_s(j)*BcoefU_x(j)*sigx(j)*LambdaU*LambdaUs & |
|---|
| 310 | + ywake_s(j)*dd_BU(j)*(1.+sigx(j)*LambdaU)*(1.+sigx(j)*LambdaUs) |
|---|
| 311 | |
|---|
| 312 | BcoefV(j) = BcoefV_x(j) + ywake_s(j)*BcoefV_x(j)*sigx(j)*LambdaV*LambdaVs & |
|---|
| 313 | + ywake_s(j)*dd_BV(j)*(1.+sigx(j)*LambdaV)*(1.+sigx(j)*LambdaVs) |
|---|
| 314 | |
|---|
| 315 | ! |
|---|
| 316 | ! Calcul des cdrag \'equivalents dans la couche |
|---|
| 317 | ! |
|---|
| 318 | ycdragm(j) = ycdragm_x(j) + ywake_s(j)*dd_Cdragm |
|---|
| 319 | ycdragh(j) = ycdragh_x(j) + ywake_s(j)*dd_Cdragh |
|---|
| 320 | ! |
|---|
| 321 | ! Calcul de T, q, u et v \'equivalents dans la couche 1 |
|---|
| 322 | !! yt1(j) = yt_x(j,1) + ywake_s(j)*dd_t*(1.+sigx(j)*dd_Kh/KCT) |
|---|
| 323 | !! yq1(j) = yq_x(j,1) + ywake_s(j)*dd_q*(1.+sigx(j)*dd_Kh/KCQ) |
|---|
| 324 | !! yu1(j) = yu_x(j,1) + ywake_s(j)*dd_u*(1.+sigx(j)*dd_Km/KCU) |
|---|
| 325 | !! yv1(j) = yv_x(j,1) + ywake_s(j)*dd_v*(1.+sigx(j)*dd_Km/KCV) |
|---|
| 326 | yt1(j) = yt_x(j,1) + ywake_s(j)*dd_t |
|---|
| 327 | yq1(j) = yq_x(j,1) + ywake_s(j)*dd_q |
|---|
| 328 | yu1(j) = yu_x(j,1) + ywake_s(j)*dd_u |
|---|
| 329 | yv1(j) = yv_x(j,1) + ywake_s(j)*dd_v |
|---|
| 330 | |
|---|
| 331 | |
|---|
| 332 | ENDDO |
|---|
| 333 | |
|---|
| 334 | RETURN |
|---|
| 335 | |
|---|
| 336 | END SUBROUTINE wx_pbl0_fuse |
|---|
| 337 | |
|---|
| 338 | SUBROUTINE wx_pbl0_split(knon, dtime, ywake_s, & |
|---|
| 339 | y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, & |
|---|
| 340 | y_flux_t1_x, y_flux_t1_w, & |
|---|
| 341 | y_flux_q1_x, y_flux_q1_w, & |
|---|
| 342 | y_flux_u1_x, y_flux_u1_w, & |
|---|
| 343 | y_flux_v1_x, y_flux_v1_w, & |
|---|
| 344 | yfluxlat_x, yfluxlat_w, & |
|---|
| 345 | y_delta_tsurf & |
|---|
| 346 | ) |
|---|
| 347 | ! |
|---|
| 348 | USE print_control_mod, ONLY: prt_level,lunout |
|---|
| 349 | ! |
|---|
| 350 | INCLUDE "YOMCST.h" |
|---|
| 351 | ! |
|---|
| 352 | INTEGER, INTENT(IN) :: knon ! number of grid cells |
|---|
| 353 | REAL, INTENT(IN) :: dtime ! time step size (s) |
|---|
| 354 | REAL, DIMENSION(knon), INTENT(IN) :: ywake_s ! cold pools fractional area |
|---|
| 355 | REAL, DIMENSION(knon), INTENT(IN) :: y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1 |
|---|
| 356 | ! |
|---|
| 357 | REAL, DIMENSION(knon), INTENT(OUT) :: y_flux_t1_x, y_flux_t1_w |
|---|
| 358 | REAL, DIMENSION(knon), INTENT(OUT) :: y_flux_q1_x, y_flux_q1_w |
|---|
| 359 | REAL, DIMENSION(knon), INTENT(OUT) :: y_flux_u1_x, y_flux_u1_w |
|---|
| 360 | REAL, DIMENSION(knon), INTENT(OUT) :: y_flux_v1_x, y_flux_v1_w |
|---|
| 361 | REAL, DIMENSION(knon), INTENT(OUT) :: yfluxlat_x, yfluxlat_w |
|---|
| 362 | REAL, DIMENSION(knon), INTENT(OUT) :: y_delta_tsurf |
|---|
| 363 | ! |
|---|
| 364 | !! Local variables |
|---|
| 365 | INTEGER :: j |
|---|
| 366 | REAL, DIMENSION(knon) :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1 |
|---|
| 367 | ! |
|---|
| 368 | REAL :: DDT, DDQ, DDU, DDV |
|---|
| 369 | REAL :: LambdaTs, LambdaQs, LambdaUs, LambdaVs |
|---|
| 370 | ! |
|---|
| 371 | REAL, DIMENSION(knon) :: sigx ! fractional area of (x) region |
|---|
| 372 | !! |
|---|
| 373 | sigx(:) = 1.-ywake_s(:) |
|---|
| 374 | |
|---|
| 375 | DO j=1,knon |
|---|
| 376 | ! |
|---|
| 377 | DDT = Kech_Tp(j) |
|---|
| 378 | DDQ = Kech_Qp(j) |
|---|
| 379 | DDU = Kech_Up(j) |
|---|
| 380 | DDV = Kech_Vp(j) |
|---|
| 381 | ! |
|---|
| 382 | LambdaTs = dd_KTp(j)/DDT |
|---|
| 383 | LambdaQs = dd_KQp(j)/DDQ |
|---|
| 384 | LambdaUs = dd_KUp(j)/DDU |
|---|
| 385 | LambdaVs = dd_KVp(j)/DDV |
|---|
| 386 | ! |
|---|
| 387 | y_delta_flux_t1(j) = y_flux_t1(j)*LambdaTs + dd_AT(j)*KxKwTp(j)/DDT |
|---|
| 388 | y_delta_flux_q1(j) = y_flux_q1(j)*LambdaQs + dd_AQ(j)*KxKwQp(j)/DDQ |
|---|
| 389 | y_delta_flux_u1(j) = y_flux_u1(j)*LambdaUs + dd_AU(j)*KxKwUp(j)/DDU |
|---|
| 390 | y_delta_flux_v1(j) = y_flux_v1(j)*LambdaVs + dd_AV(j)*KxKwVp(j)/DDV |
|---|
| 391 | ! |
|---|
| 392 | y_flux_t1_x(j)=y_flux_t1(j) - ywake_s(j)*y_delta_flux_t1(j) |
|---|
| 393 | y_flux_t1_w(j)=y_flux_t1(j) + (1.-ywake_s(j))*y_delta_flux_t1(j) |
|---|
| 394 | y_flux_q1_x(j)=y_flux_q1(j) - ywake_s(j)*y_delta_flux_q1(j) |
|---|
| 395 | y_flux_q1_w(j)=y_flux_q1(j) + (1.-ywake_s(j))*y_delta_flux_q1(j) |
|---|
| 396 | y_flux_u1_x(j)=y_flux_u1(j) - ywake_s(j)*y_delta_flux_u1(j) |
|---|
| 397 | y_flux_u1_w(j)=y_flux_u1(j) + (1.-ywake_s(j))*y_delta_flux_u1(j) |
|---|
| 398 | y_flux_v1_x(j)=y_flux_v1(j) - ywake_s(j)*y_delta_flux_v1(j) |
|---|
| 399 | y_flux_v1_w(j)=y_flux_v1(j) + (1.-ywake_s(j))*y_delta_flux_v1(j) |
|---|
| 400 | ! |
|---|
| 401 | yfluxlat_x(j)=y_flux_q1_x(j)*RLVTT |
|---|
| 402 | yfluxlat_w(j)=y_flux_q1_w(j)*RLVTT |
|---|
| 403 | ! |
|---|
| 404 | ! Delta_tsurf computation |
|---|
| 405 | !! y_delta_tsurf(j) = (1./RCPD)*(ah(j)*dd_AT(j) + & |
|---|
| 406 | !! ah(j)*y_flux_t1(j)*dd_BT(j)*dtime + & |
|---|
| 407 | !! y_delta_flux_t1(j)*(ah(j)*BBT+bh(j)) ) |
|---|
| 408 | ! |
|---|
| 409 | y_delta_tsurf(j) = 0. |
|---|
| 410 | ! |
|---|
| 411 | ENDDO |
|---|
| 412 | ! |
|---|
| 413 | RETURN |
|---|
| 414 | |
|---|
| 415 | END SUBROUTINE wx_pbl0_split |
|---|
| 416 | |
|---|
| 417 | SUBROUTINE wx_pbl_final |
|---|
| 418 | ! |
|---|
| 419 | !**************************************************************************************** |
|---|
| 420 | ! Deallocate module variables |
|---|
| 421 | ! |
|---|
| 422 | !**************************************************************************************** |
|---|
| 423 | ! |
|---|
| 424 | IF (ALLOCATED(Kech_Tp)) DEALLOCATE(Kech_Tp) |
|---|
| 425 | IF (ALLOCATED(Kech_T_xp)) DEALLOCATE(Kech_T_xp) |
|---|
| 426 | IF (ALLOCATED(Kech_T_wp)) DEALLOCATE(Kech_T_wp) |
|---|
| 427 | IF (ALLOCATED(dd_KTp)) DEALLOCATE(dd_KTp) |
|---|
| 428 | IF (ALLOCATED(KxKwTp)) DEALLOCATE(KxKwTp) |
|---|
| 429 | IF (ALLOCATED(dd_AT)) DEALLOCATE(dd_AT) |
|---|
| 430 | IF (ALLOCATED(dd_BT)) DEALLOCATE(dd_BT) |
|---|
| 431 | IF (ALLOCATED(Kech_Qp)) DEALLOCATE(Kech_Qp) |
|---|
| 432 | IF (ALLOCATED(Kech_Q_xp)) DEALLOCATE(Kech_Q_xp) |
|---|
| 433 | IF (ALLOCATED(Kech_Q_wp)) DEALLOCATE(Kech_Q_wp) |
|---|
| 434 | IF (ALLOCATED(dd_KQp)) DEALLOCATE(dd_KQp) |
|---|
| 435 | IF (ALLOCATED(KxKwQp)) DEALLOCATE(KxKwQp) |
|---|
| 436 | IF (ALLOCATED(dd_AQ)) DEALLOCATE(dd_AQ) |
|---|
| 437 | IF (ALLOCATED(dd_BQ)) DEALLOCATE(dd_BQ) |
|---|
| 438 | IF (ALLOCATED(Kech_Up)) DEALLOCATE(Kech_Up) |
|---|
| 439 | IF (ALLOCATED(Kech_U_xp)) DEALLOCATE(Kech_U_xp) |
|---|
| 440 | IF (ALLOCATED(Kech_U_wp)) DEALLOCATE(Kech_U_wp) |
|---|
| 441 | IF (ALLOCATED(dd_KUp)) DEALLOCATE(dd_KUp) |
|---|
| 442 | IF (ALLOCATED(KxKwUp)) DEALLOCATE(KxKwUp) |
|---|
| 443 | IF (ALLOCATED(dd_AU)) DEALLOCATE(dd_AU) |
|---|
| 444 | IF (ALLOCATED(dd_BU)) DEALLOCATE(dd_BU) |
|---|
| 445 | IF (ALLOCATED(Kech_Vp)) DEALLOCATE(Kech_Vp) |
|---|
| 446 | IF (ALLOCATED(Kech_V_xp)) DEALLOCATE(Kech_V_xp) |
|---|
| 447 | IF (ALLOCATED(Kech_V_wp)) DEALLOCATE(Kech_V_wp) |
|---|
| 448 | IF (ALLOCATED(KxKwVp)) DEALLOCATE(KxKwVp) |
|---|
| 449 | IF (ALLOCATED(dd_KVp)) DEALLOCATE(dd_KVp) |
|---|
| 450 | IF (ALLOCATED(dd_AV)) DEALLOCATE(dd_AV) |
|---|
| 451 | IF (ALLOCATED(dd_BV)) DEALLOCATE(dd_BV) |
|---|
| 452 | |
|---|
| 453 | END SUBROUTINE wx_pbl_final |
|---|
| 454 | |
|---|
| 455 | END MODULE wx_pbl_mod |
|---|
| 456 | |
|---|
