source: LMDZ6/branches/LMDZ-COSP/libf/phylmd/wx_pbl_mod.F90 @ 3847

Last change on this file since 3847 was 3181, checked in by jyg, 7 years ago

bug fix: forgotten OMP THREADPRIVATE

File size: 19.4 KB
Line 
1MODULE 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
26CONTAINS
27!
28!****************************************************************************************
29!
30SUBROUTINE 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
133END SUBROUTINE wx_pbl_init
134
135SUBROUTINE 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
336END SUBROUTINE wx_pbl0_fuse
337
338SUBROUTINE 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
415END SUBROUTINE wx_pbl0_split
416
417SUBROUTINE 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
453END SUBROUTINE wx_pbl_final
454
455END MODULE wx_pbl_mod
456
Note: See TracBrowser for help on using the repository browser.