Context Navigation

wx_pbl_mod.F90 @ 3774

Last change on this file since 3774 was 3181, checked in by jyg, 7 years ago
bug fix: forgotten OMP THREADPRIVATE
File size: 19.4 KB

Line
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)LambdaTLambdaTs &
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)LambdaQLambdaQs &
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)LambdaULambdaUs &
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)LambdaVLambdaVs &
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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format