source: LMDZ6/trunk/libf/phylmd/wx_pbl_var_mod.F90 @ 3888

Last change on this file since 3888 was 3888, checked in by jyg, 3 years ago

New provisional version of the splitting of the
diffusive boundary layer into inwake and offwake
PBLs. The splitting of the diffuse BL should NOT
be activated yet for general purpose simulations.

The splitting is activated by:
mod(iflag_pbl_split,10)=1 for the option with
fixed surface temperature and
mod(iflag_pbl_split,10)=2 for the option with
coupled surface temperature.

iflag_pbl_split=0 ==> no splittingat all.
iflag_pbl_split=10 ==> splitting of thermals.
iflag_pbl_split=11 ==> splitting of thermals and
of vertical diffusion (fixed surf. temp.).
iflag_pbl_split=12 ==> splitting of thermals and
of vertical diffusion (coupled surf. temp.).
File size: 26.5 KB
Line 
1MODULE wx_pbl_var_mod
2!
3! Split Planetary Boundary Layer variables
4!
5! This module manages the variables necessary for the splitting of the boundary layer
6!
7!
8  USE dimphy
9
10  IMPLICIT NONE
11
12  REAL, PROTECTED, SAVE                             :: eps_1, fqsat, smallestreal
13!$OMP THREADPRIVATE(eps_1, fqsat, smallestreal)
14!
15  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: C_p, L_v
16!$OMP THREADPRIVATE(C_p, L_v)
17  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Ts0, dTs0
18!$OMP THREADPRIVATE(Ts0, dTs0)
19  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Ts0_x, Ts0_w
20!$OMP THREADPRIVATE(Ts0_x, Ts0_w)
21  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: qsat0, dqsatdT0
22!$OMP THREADPRIVATE(qsat, dqsat_dT)
23  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: qsat0_x, dqsatdT0_x
24!$OMP THREADPRIVATE(qsat0_x, dqsatdT0_x)
25  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: qsat0_w, dqsatdT0_w
26!$OMP THREADPRIVATE(qsat0_w, dqsatdT0_w)
27  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: QQ_b, dd_QQ
28!$OMP THREADPRIVATE(QQ_b, dd_QQ)
29  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: QQ_x, QQ_w
30!$OMP THREADPRIVATE(QQ_x, QQ_w)
31  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: qsatsrf0_x, qsatsrf0_w
32!$OMP THREADPRIVATE(qsatsrf0_x, qsatsrf0_w)
33  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dqsatsrf0
34!$OMP THREADPRIVATE(dqsatsrf0)
35  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: q1_0b
36!$OMP THREADPRIVATE(q1_0b)
37  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_Cdragh, dd_Cdragm, dd_Cdragq
38!$OMP THREADPRIVATE(dd_Cdragh, dd_Cdragm, dd_Cdragq )
39  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Kech_h, Kech_h_x, Kech_h_w   ! Energy exchange coefficients
40!$OMP THREADPRIVATE(Kech_h, Kech_h_x, Kech_h_w)
41  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Kech_q, Kech_q_x, Kech_q_w   ! Moisture exchange coefficients
42!$OMP THREADPRIVATE(Kech_q, Kech_q_x, Kech_q_w)
43  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Kech_m, Kech_m_x, Kech_m_w   ! Momentum exchange coefficients
44!$OMP THREADPRIVATE(Kech_m, Kech_m_x, Kech_m_w)
45  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Kech_Tp, Kech_T_px, Kech_T_pw
46  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_KTp, KxKwTp
47!$OMP THREADPRIVATE(Kech_Tp, Kech_T_px, Kech_T_pw, dd_KTp, KxKwTp)
48  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_AT, dd_BT
49!$OMP THREADPRIVATE(dd_AT, dd_BT)
50  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Kech_Qp, Kech_Q_px, Kech_Q_pw
51  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_KQp, KxKwQp
52!$OMP THREADPRIVATE(Kech_Qp, Kech_Q_px, Kech_Q_pw, dd_KQp, KxKwQp)
53  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Kech_Qs, Kech_Q_sx, Kech_Q_sw
54  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_KQs, KxKwQs
55!$OMP THREADPRIVATE(Kech_Qs, Kech_Q_sx, Kech_Q_sw, dd_KQs, KxKwQs)
56  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_AQ, dd_BQ
57!$OMP THREADPRIVATE(dd_AQ, dd_BQ)
58  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: AQ_x, AQ_w, BQ_x, BQ_w
59!$OMP THREADPRIVATE(AQ_x, AQ_w, BQ_x, BQ_w)
60  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Kech_Up, Kech_U_px, Kech_U_pw
61  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_KUp, KxKwUp
62!$OMP THREADPRIVATE(Kech_Up, Kech_U_px, Kech_U_pw, dd_KUp, KxKwUp)
63  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_AU, dd_BU
64!$OMP THREADPRIVATE(dd_AU, dd_BU)
65  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: Kech_Vp, Kech_V_px, Kech_V_pw
66  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_KVp, KxKwVp
67!$OMP THREADPRIVATE(Kech_Vp, Kech_V_px, Kech_V_pw, dd_KVp, KxKwVp)
68  REAL, ALLOCATABLE, PROTECTED, DIMENSION(:), SAVE  :: dd_AV, dd_BV
69!$OMP THREADPRIVATE(dd_AV, dd_BV)
70
71CONTAINS
72!
73!****************************************************************************************
74!
75SUBROUTINE wx_pbl_init
76
77! Local variables
78!****************************************************************************************
79    INTEGER                       :: ierr
80 
81
82!****************************************************************************************
83! Allocate module variables
84!
85!****************************************************************************************   
86
87    ierr = 0
88
89    ALLOCATE(C_p(klon), stat=ierr)
90    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
91
92    ALLOCATE(L_v(klon), stat=ierr)
93    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
94
95    ALLOCATE(Ts0(klon), stat=ierr)
96    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
97
98    ALLOCATE(dTs0(klon), stat=ierr)
99    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
100
101    ALLOCATE(Ts0_x(klon), stat=ierr)
102    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
103
104    ALLOCATE(Ts0_w(klon), stat=ierr)
105    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
106
107    ALLOCATE(qsat0(klon), stat=ierr)
108    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
109
110    ALLOCATE(dqsatdT0(klon), stat=ierr)
111    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
112
113    ALLOCATE(qsat0_x(klon), stat=ierr)
114    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
115
116    ALLOCATE(dqsatdT0_x(klon), stat=ierr)
117    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
118
119    ALLOCATE(qsat0_w(klon), stat=ierr)
120    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
121
122    ALLOCATE(dqsatdT0_w(klon), stat=ierr)
123    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
124
125    ALLOCATE(q1_0b(klon), stat=ierr)
126    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
127
128    ALLOCATE(QQ_b(klon), stat=ierr)
129    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
130
131    ALLOCATE(dd_QQ(klon), stat=ierr)
132    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
133
134    ALLOCATE(QQ_x(klon), stat=ierr)
135    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
136
137    ALLOCATE(QQ_w(klon), stat=ierr)
138    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
139
140    ALLOCATE(qsatsrf0_x(klon), stat=ierr)
141    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
142
143    ALLOCATE(qsatsrf0_w(klon), stat=ierr)
144    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
145
146    ALLOCATE(dqsatsrf0(klon), stat=ierr)
147    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
148
149    ALLOCATE(dd_Cdragh(klon), stat=ierr)
150    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
151
152    ALLOCATE(dd_Cdragm(klon), stat=ierr)
153    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
154
155    ALLOCATE(dd_Cdragq(klon), stat=ierr)
156    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
157
158    ALLOCATE(Kech_h(klon), stat=ierr)
159    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
160
161    ALLOCATE(Kech_h_x(klon), stat=ierr)
162    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
163
164    ALLOCATE(Kech_h_w(klon), stat=ierr)
165    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
166
167    ALLOCATE(Kech_q(klon), stat=ierr)
168    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
169
170    ALLOCATE(Kech_q_x(klon), stat=ierr)
171    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
172
173    ALLOCATE(Kech_q_w(klon), stat=ierr)
174    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
175
176    ALLOCATE(Kech_m(klon), stat=ierr)
177    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
178
179    ALLOCATE(Kech_m_x(klon), stat=ierr)
180    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
181
182    ALLOCATE(Kech_m_w(klon), stat=ierr)
183    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
184
185    ALLOCATE(Kech_Tp(klon), stat=ierr)
186    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
187
188    ALLOCATE(Kech_T_px(klon), stat=ierr)
189    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
190
191    ALLOCATE(Kech_T_pw(klon), stat=ierr)
192    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
193
194    ALLOCATE(dd_KTp(klon), stat=ierr)
195    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
196
197    ALLOCATE(KxKwTp(klon), stat=ierr)
198    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
199
200    ALLOCATE(dd_AT(klon), stat=ierr)
201    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
202
203    ALLOCATE(dd_BT(klon), stat=ierr)
204    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
205
206!----------------------------------------------------------------------------
207    ALLOCATE(Kech_Qp(klon), stat=ierr)
208    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
209
210    ALLOCATE(Kech_Q_px(klon), stat=ierr)
211    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
212
213    ALLOCATE(Kech_Q_pw(klon), stat=ierr)
214    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
215
216    ALLOCATE(dd_KQp(klon), stat=ierr)
217    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
218
219    ALLOCATE(KxKwQp(klon), stat=ierr)
220    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
221
222    ALLOCATE(Kech_Qs(klon), stat=ierr)
223    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
224
225    ALLOCATE(Kech_Q_sx(klon), stat=ierr)
226    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
227
228    ALLOCATE(Kech_Q_sw(klon), stat=ierr)
229    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
230
231    ALLOCATE(dd_KQs(klon), stat=ierr)
232    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
233
234    ALLOCATE(KxKwQs(klon), stat=ierr)
235    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
236
237!!!!!!!!!!
238    ALLOCATE(AQ_x(klon), stat=ierr)
239    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
240
241    ALLOCATE(AQ_w(klon), stat=ierr)
242    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
243
244    ALLOCATE(BQ_x(klon), stat=ierr)
245    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
246
247    ALLOCATE(BQ_w(klon), stat=ierr)
248    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
249
250    ALLOCATE(dd_AQ(klon), stat=ierr)
251    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
252
253    ALLOCATE(dd_BQ(klon), stat=ierr)
254    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
255
256!----------------------------------------------------------------------------
257    ALLOCATE(Kech_Up(klon), stat=ierr)
258    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
259
260    ALLOCATE(Kech_U_px(klon), stat=ierr)
261    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
262
263    ALLOCATE(Kech_U_pw(klon), stat=ierr)
264    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
265
266    ALLOCATE(dd_KUp(klon), stat=ierr)
267    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
268
269    ALLOCATE(KxKwUp(klon), stat=ierr)
270    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
271
272    ALLOCATE(dd_AU(klon), stat=ierr)
273    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
274
275    ALLOCATE(dd_BU(klon), stat=ierr)
276    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
277
278!----------------------------------------------------------------------------
279    ALLOCATE(Kech_Vp(klon), stat=ierr)
280    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
281
282    ALLOCATE(Kech_V_px(klon), stat=ierr)
283    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
284
285    ALLOCATE(Kech_V_pw(klon), stat=ierr)
286    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
287
288    ALLOCATE(dd_KVp(klon), stat=ierr)
289    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
290
291    ALLOCATE(KxKwVp(klon), stat=ierr)
292    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
293
294    ALLOCATE(dd_AV(klon), stat=ierr)
295    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
296
297    ALLOCATE(dd_BV(klon), stat=ierr)
298    IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
299
300!----------------------------------------------------------------------------
301
302END SUBROUTINE wx_pbl_init
303
304SUBROUTINE wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, sigw,   &
305                                 yt_s, ydeltat_s, ygustiness, &
306                                 yt_x, yt_w, yq_x, yq_w, &
307                                 yu_x, yu_w, yv_x, yv_w, &
308                                 ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
309                                 ycdragm_x, ycdragm_w, &
310                                 AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w, &
311                                 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
312                                 BcoefT_x, BcoefT_w, BcoefQ_x, BcoefQ_w, &
313                                 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w  &
314                                 )
315!
316    USE print_control_mod, ONLY: prt_level,lunout
317    USE indice_sol_mod, ONLY: is_oce
318!
319    INCLUDE "YOMCST.h"
320    INCLUDE "FCTTRE.h"
321    INCLUDE "YOETHF.h"
322    INCLUDE "clesphys.h"
323!
324    INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
325    INTEGER,                      INTENT(IN)        :: nsrf    ! surface type
326    REAL,                         INTENT(IN)        :: dtime   ! time step size (s)
327    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypplay  ! mid-layer pressure (Pa)
328    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypaprs  ! pressure at layer interfaces (pa)
329    REAL, DIMENSION(knon),        INTENT(IN)        :: sigw ! cold pools fractional area
330    REAL, DIMENSION(knon),        INTENT(IN)        :: yt_s
331    REAL, DIMENSION(knon),        INTENT(IN)        :: ydeltat_s
332    REAL, DIMENSION(knon),        INTENT(IN)        :: ygustiness
333    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: yt_x, yt_w, yq_x, yq_w
334    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: yu_x, yu_w, yv_x, yv_w
335    REAL, DIMENSION(knon),        INTENT(IN)        :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
336    REAL, DIMENSION(knon),        INTENT(IN)        :: ycdragm_x, ycdragm_w
337    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w
338    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w
339    REAL, DIMENSION(knon),        INTENT(IN)        :: BcoefT_x, BcoefT_w, BcoefQ_x, BcoefQ_w
340    REAL, DIMENSION(knon),        INTENT(IN)        :: BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w
341!
342! Local variables
343    INTEGER                    :: j
344    REAL                       :: rho1
345    REAL                       :: mod_wind_x
346    REAL                       :: mod_wind_w   
347    REAL                       :: dd_Kh
348    REAL                       :: dd_Kq
349    REAL                       :: dd_Km
350!
351    REAL                       :: zdelta, zcvm5, zcor, qsat
352!
353    REAL, DIMENSION(knon)      :: sigx       ! fractional area of (x) region
354!
355!!!
356!!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences
357
358!
359!  First computations
360!  ------------------
361   eps_1 = 0.5
362   smallestreal=tiny(smallestreal)
363!
364   sigx(1:knon) = 1.-sigw(1:knon)
365! Compute Cp, Lv, qsat, dqsat_dT.
366   L_v(1:knon) = RLvtt
367   Ts0(1:knon) = yt_s(1:knon)
368   dTs0(1:knon) = ydeltat_s(1:knon)
369   q1_0b(1:knon) = sigw(1:knon)*yq_w(1:knon,1)+sigx(1:knon)*yq_x(1:knon,1)
370!
371! fqsat determination
372! -------------------
373   IF (nsrf == is_oce) THEN
374     fqsat = f_qsat_oce
375   ELSE
376     fqsat = 1.
377   ENDIF
378!
379!
380!  Reference state
381!  ---------------
382   DO j = 1, knon
383      zdelta = MAX(0.,SIGN(1.,RTT-Ts0(j)))
384      zcvm5 = R5LES*(1.-zdelta) + R5IES*zdelta
385      qsat = R2ES*FOEEW(Ts0(j),zdelta)/ypaprs(j,1)
386      qsat = MIN(0.5,qsat)
387      zcor = 1./(1.-RETV*qsat)
388      qsat0(j) = fqsat*qsat*zcor
389      dqsatdT0(j) = fqsat*FOEDE(Ts0(j),zdelta,zcvm5,qsat0(j),zcor)
390      C_p(j) = RCpd + qsat0(j)*(RCpv - RCpd)
391      C_p(j) = RCpd
392!
393!      print *,' AAAA wx_pbl0, C_p(j), qsat0(j), Ts0(j) : ', C_p(j), qsat0(j), Ts0(j)
394   ENDDO
395   DO j = 1, knon
396      Ts0_x(j) = Ts0(j) - sigw(j)*dTs0(j)
397      zdelta = MAX(0.,SIGN(1.,RTT-Ts0_x(j)))
398      zcvm5 = R5LES*(1.-zdelta) + R5IES*zdelta
399!!      zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
400      qsat = R2ES*FOEEW(Ts0_x(j),zdelta)/ypaprs(j,1)
401      qsat = MIN(0.5,qsat)
402      zcor = 1./(1.-RETV*qsat)
403      qsat0_x(j) = qsat*zcor
404      dqsatdT0_x(j) = FOEDE(Ts0_x(j),zdelta,zcvm5,qsat0_x(j),zcor)
405!!      dqsatdT0_x(j) = (RLvtt*(1.-zdelta)+RLSTT*zdelta)*qsat0_x(j)/(Rv*Ts0_x(j)*Ts0_x(j))
406   ENDDO
407   DO j = 1, knon
408      Ts0_w(j) = Ts0(j) + sigx(j)*dTs0(j)
409      zdelta = MAX(0.,SIGN(1.,RTT-Ts0_w(j)))
410      zcvm5 = R5LES*(1.-zdelta) + R5IES*zdelta
411!!      zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
412      qsat = R2ES*FOEEW(Ts0_w(j),zdelta)/ypaprs(j,1)
413      qsat = MIN(0.5,qsat)
414      zcor = 1./(1.-RETV*qsat)
415      qsat0_w(j) = qsat*zcor
416      dqsatdT0_w(j) = FOEDE(Ts0_w(j),zdelta,zcvm5,qsat0_w(j),zcor)
417!!      dqsatdT0_w(j) = (RLvtt*(1.-zdelta)+RLSTT*zdelta)*qsat0_w(j)/(Rv*Ts0_w(j)*Ts0_w(j))
418   ENDDO
419!
420   QQ_x(1:knon)  = 1./dqsatdT0_x(1:knon)
421   QQ_w(1:knon)  = 1./dqsatdT0_w(1:knon)
422   QQ_b(1:knon)  = sigw(1:knon)*QQ_w(1:knon) + sigx(1:knon)*QQ_x(1:knon)
423   dd_QQ(1:knon) = QQ_w(1:knon) - QQ_x(1:knon)
424!
425        DO j=1,knon
426!
427! Exchange coefficients computation
428! ---------------------------------
429!
430! Wind factor (Warning : this is not valid when using land_surf_orchidee)
431         mod_wind_x = min_wind_speed+SQRT(ygustiness(j)+yu_x(j,1)**2+yv_x(j,1)**2)
432         mod_wind_w = min_wind_speed+SQRT(ygustiness(j)+yu_w(j,1)**2+yv_w(j,1)**2)
433!
434!!         rho1 = ypplay(j,1)/(RD*yt(j,1))
435         rho1 = ypplay(j,1)/(RD*(yt_x(j,1) + sigw(j)*(yt_w(j,1)-yt_x(j,1))))
436!
437! (w) and (x) Exchange coefficients
438         Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1
439         Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1
440         Kech_q_x(j) = ycdragq_x(j) * mod_wind_x * rho1
441         Kech_q_w(j) = ycdragq_w(j) * mod_wind_w * rho1
442         Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1
443         Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1
444!!  Print *,'YYYYpbl0: ycdragh_x, ycdragq_x, mod_wind_x, rho1, Kech_q_x, Kech_h_x ', &
445!!                     ycdragh_x(j), ycdragq_x(j), mod_wind_x, rho1, Kech_q_x(j), Kech_h_x(j)
446!!  Print *,'YYYYpbl0: ycdragh_w, ycdragq_w, mod_wind_w, rho1, Kech_q_w, Kech_h_w ', &
447!!                     ycdragh_w(j), ycdragq_w(j), mod_wind_w, rho1, Kech_q_w(j), Kech_h_w(j)
448!
449! Merged exchange coefficients
450         dd_Kh = Kech_h_w(j) - Kech_h_x(j)
451         dd_Kq = Kech_q_w(j) - Kech_q_x(j)
452         dd_Km = Kech_m_w(j) - Kech_m_x(j)
453         IF (prt_level >=10) THEN
454          print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w
455          print *,' rho1 ',rho1
456          print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j)
457          print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j)
458          print *,' dd_Kh: ',dd_Kh
459         ENDIF
460!
461         Kech_h(j) = Kech_h_x(j) + sigw(j)*dd_Kh
462         Kech_q(j) = Kech_q_x(j) + sigw(j)*dd_Kq
463         Kech_m(j) = Kech_m_x(j) + sigw(j)*dd_Km
464!
465! Effective exchange coefficient computation
466! ------------------------------------------
467        Kech_T_px(j) = Kech_h_x(j)/(1.-BcoefT_x(j)*Kech_h_x(j)*dtime)
468        Kech_T_pw(j) = Kech_h_w(j)/(1.-BcoefT_w(j)*Kech_h_w(j)*dtime)
469!
470        Kech_Q_px(j) = Kech_q_x(j)/(1.-BcoefQ_x(j)*Kech_q_x(j)*dtime)
471        Kech_Q_pw(j) = Kech_q_w(j)/(1.-BcoefQ_w(j)*Kech_q_w(j)*dtime)
472!
473        Kech_U_px(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime)
474        Kech_U_pw(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime)
475!
476        Kech_V_px(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime)
477        Kech_V_pw(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime)
478!
479         dd_KTp(j) = Kech_T_pw(j) - Kech_T_px(j)
480         dd_KQp(j) = Kech_Q_pw(j) - Kech_Q_px(j)
481         dd_KUp(j) = Kech_U_pw(j) - Kech_U_px(j)
482         dd_KVp(j) = Kech_V_pw(j) - Kech_V_px(j)
483!
484        Kech_Tp(j) = Kech_T_px(j) + sigw(j)*dd_KTp(j)
485        Kech_Qp(j) = Kech_Q_px(j) + sigw(j)*dd_KQp(j)
486        Kech_Up(j) = Kech_U_px(j) + sigw(j)*dd_KUp(j)
487        Kech_Vp(j) = Kech_V_px(j) + sigw(j)*dd_KVp(j)
488!
489! Store AQ and BQ in the module variables
490       AQ_x(j) = AcoefQ_x(j)
491       AQ_w(j) = AcoefQ_w(j)
492       BQ_x(j) = BcoefQ_x(j)
493       BQ_w(j) = BcoefQ_w(j)
494!
495! Calcul des differences w-x
496       dd_Cdragm(j) = ycdragm_w(j) - ycdragm_x(j)
497       dd_Cdragh(j) = ycdragh_w(j) - ycdragh_x(j)
498       dd_Cdragq(j) = ycdragq_w(j) - ycdragq_x(j)
499!
500       dd_AT(j) = AcoefT_w(j) - AcoefT_x(j)
501       dd_AQ(j) = AcoefQ_w(j) - AcoefQ_x(j)
502       dd_AU(j) = AcoefU_w(j) - AcoefU_x(j)
503       dd_AV(j) = AcoefV_w(j) - AcoefV_x(j)
504       dd_BT(j) = BcoefT_w(j) - BcoefT_x(j)
505       dd_BQ(j) = BcoefQ_w(j) - BcoefQ_x(j)
506       dd_BU(j) = BcoefU_w(j) - BcoefU_x(j)
507       dd_BV(j) = BcoefV_w(j) - BcoefV_x(j)
508!
509       KxKwTp(j) = Kech_T_px(j)*Kech_T_pw(j)
510       KxKwQp(j) = Kech_Q_px(j)*Kech_Q_pw(j)
511       KxKwUp(j) = Kech_U_px(j)*Kech_U_pw(j)
512       KxKwVp(j) = Kech_V_px(j)*Kech_V_pw(j)
513!                                           
514!
515       IF (prt_level >=10) THEN
516          print *,'Variables pour la fusion : Kech_T_px(j)' ,Kech_T_px(j)
517          print *,'Variables pour la fusion : Kech_T_pw(j)' ,Kech_T_pw(j)
518          print *,'Variables pour la fusion : Kech_Tp(j)' ,Kech_Tp(j)
519          print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j)
520       ENDIF
521
522     ENDDO  ! j = 1, knon
523
524     RETURN
525
526END SUBROUTINE wx_pbl_prelim_0
527
528SUBROUTINE wx_pbl_prelim_beta(knon, dtime,  &
529                                 sigw, beta,       &
530                                 BcoefQ_x, BcoefQ_w &
531                                 )
532!
533    USE print_control_mod, ONLY: prt_level,lunout
534    USE indice_sol_mod, ONLY: is_oce
535!
536    INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
537    REAL,                         INTENT(IN)        :: dtime   ! time step size (s)
538    REAL, DIMENSION(knon),        INTENT(IN)        :: sigw ! cold pools fractional area
539    REAL, DIMENSION(knon),        INTENT(IN)        :: beta ! evaporation by potential evaporation
540    REAL, DIMENSION(knon),        INTENT(IN)        :: BcoefQ_x, BcoefQ_w
541!
542! Local variables
543    INTEGER                    :: j
544!
545   DO j = 1, knon
546!
547        qsatsrf0_x(j) = beta(j)*qsat0_x(j)
548        qsatsrf0_w(j) = beta(j)*qsat0_w(j)
549        dqsatsrf0(j)  = qsatsrf0_w(j) - qsatsrf0_x(j)
550!
551        Kech_Q_sx(j) = Kech_q_x(j)/(1.-beta(j)*BcoefQ_x(j)*Kech_q_x(j)*dtime)
552        Kech_Q_sw(j) = Kech_q_w(j)/(1.-beta(j)*BcoefQ_w(j)*Kech_q_w(j)*dtime)
553!
554        dd_KQs(j) = Kech_Q_sw(j) - Kech_Q_sx(j)
555!
556        Kech_Qs(j) = Kech_Q_sx(j) + sigw(j)*dd_KQs(j)
557!
558        KxKwQs(j) = Kech_Q_sx(j)*Kech_Q_sw(j)
559!
560!!  print *,'BBBBwx_prelim_beta : beta ', beta(j)
561!
562  ENDDO ! j = 1, knon
563
564  RETURN
565
566END SUBROUTINE wx_pbl_prelim_beta
567
568SUBROUTINE wx_pbl_final
569!
570!****************************************************************************************
571! Deallocate module variables
572!
573!****************************************************************************************   
574!
575    IF (ALLOCATED(C_p))           DEALLOCATE(C_p)
576    IF (ALLOCATED(L_v))           DEALLOCATE(L_v)
577    IF (ALLOCATED(Ts0))           DEALLOCATE(Ts0)
578    IF (ALLOCATED(dTs0))          DEALLOCATE(dTs0)
579    IF (ALLOCATED(Ts0_x))         DEALLOCATE(Ts0_x)
580    IF (ALLOCATED(Ts0_w))         DEALLOCATE(Ts0_w)
581    IF (ALLOCATED(qsat0))         DEALLOCATE(qsat0)
582    IF (ALLOCATED(dqsatdT0))      DEALLOCATE(dqsatdT0 )
583    IF (ALLOCATED(qsat0_x))       DEALLOCATE(qsat0_x)
584    IF (ALLOCATED(dqsatdT0_x))    DEALLOCATE(dqsatdT0_x )
585    IF (ALLOCATED(qsat0_w))       DEALLOCATE(qsat0_w)
586    IF (ALLOCATED(dqsatdT0_w))    DEALLOCATE(dqsatdT0_w )
587    IF (ALLOCATED(q1_0b))         DEALLOCATE(q1_0b)
588    IF (ALLOCATED(QQ_b))          DEALLOCATE(QQ_b)
589    IF (ALLOCATED(dd_QQ))         DEALLOCATE(dd_QQ)
590    IF (ALLOCATED(QQ_x))          DEALLOCATE(QQ_x)
591    IF (ALLOCATED(QQ_w))          DEALLOCATE(QQ_w)
592    IF (ALLOCATED(qsatsrf0_x))    DEALLOCATE(qsatsrf0_x)
593    IF (ALLOCATED(qsatsrf0_w))    DEALLOCATE(qsatsrf0_w)
594    IF (ALLOCATED(dqsatsrf0))     DEALLOCATE(dqsatsrf0)
595    IF (ALLOCATED(dd_Cdragh))     DEALLOCATE(dd_Cdragh)
596    IF (ALLOCATED(dd_Cdragm))     DEALLOCATE(dd_Cdragm)
597    IF (ALLOCATED(dd_Cdragq))     DEALLOCATE(dd_Cdragq)
598    IF (ALLOCATED(Kech_h))        DEALLOCATE(Kech_h)
599    IF (ALLOCATED(Kech_h_x))      DEALLOCATE(Kech_h_x)
600    IF (ALLOCATED(Kech_h_w))      DEALLOCATE(Kech_h_w)
601    IF (ALLOCATED(Kech_q))        DEALLOCATE(Kech_q)
602    IF (ALLOCATED(Kech_q_x))      DEALLOCATE(Kech_q_x)
603    IF (ALLOCATED(Kech_q_w))      DEALLOCATE(Kech_q_w)
604    IF (ALLOCATED(Kech_m))        DEALLOCATE(Kech_m)
605    IF (ALLOCATED(Kech_m_x))      DEALLOCATE(Kech_m_x)
606    IF (ALLOCATED(Kech_m_w))      DEALLOCATE(Kech_m_w)
607    IF (ALLOCATED(Kech_Tp))       DEALLOCATE(Kech_Tp)
608    IF (ALLOCATED(Kech_T_px))     DEALLOCATE(Kech_T_px)
609    IF (ALLOCATED(Kech_T_pw))     DEALLOCATE(Kech_T_pw)
610    IF (ALLOCATED(dd_KTp))        DEALLOCATE(dd_KTp)
611    IF (ALLOCATED(KxKwTp))        DEALLOCATE(KxKwTp)
612    IF (ALLOCATED(dd_AT))         DEALLOCATE(dd_AT)
613    IF (ALLOCATED(dd_BT))         DEALLOCATE(dd_BT)
614    IF (ALLOCATED(Kech_Qp))       DEALLOCATE(Kech_Qp)
615    IF (ALLOCATED(Kech_Q_px))     DEALLOCATE(Kech_Q_px)
616    IF (ALLOCATED(Kech_Q_pw))     DEALLOCATE(Kech_Q_pw)
617    IF (ALLOCATED(dd_KQp))        DEALLOCATE(dd_KQp)
618    IF (ALLOCATED(KxKwQp))        DEALLOCATE(KxKwQp)
619    IF (ALLOCATED(Kech_Qs))       DEALLOCATE(Kech_Qs)
620    IF (ALLOCATED(Kech_Q_sx))     DEALLOCATE(Kech_Q_sx)
621    IF (ALLOCATED(Kech_Q_sw))     DEALLOCATE(Kech_Q_sw)
622    IF (ALLOCATED(dd_KQs))        DEALLOCATE(dd_KQs)
623    IF (ALLOCATED(KxKwQs ))       DEALLOCATE(KxKwQs )
624    IF (ALLOCATED(AQ_x))          DEALLOCATE(AQ_x)
625    IF (ALLOCATED(AQ_w))          DEALLOCATE(AQ_w)
626    IF (ALLOCATED(BQ_x))          DEALLOCATE(BQ_x)
627    IF (ALLOCATED(BQ_w))          DEALLOCATE(BQ_w)
628    IF (ALLOCATED(dd_AQ))         DEALLOCATE(dd_AQ)
629    IF (ALLOCATED(dd_BQ ))        DEALLOCATE(dd_BQ )
630    IF (ALLOCATED(Kech_Up))       DEALLOCATE(Kech_Up)
631    IF (ALLOCATED(Kech_U_px))     DEALLOCATE(Kech_U_px)
632    IF (ALLOCATED(Kech_U_pw))     DEALLOCATE(Kech_U_pw)
633    IF (ALLOCATED(dd_KUp))        DEALLOCATE(dd_KUp)
634    IF (ALLOCATED(KxKwUp))        DEALLOCATE(KxKwUp)
635    IF (ALLOCATED(dd_AU))         DEALLOCATE(dd_AU)
636    IF (ALLOCATED(dd_BU))         DEALLOCATE(dd_BU)
637    IF (ALLOCATED(Kech_Vp))       DEALLOCATE(Kech_Vp)
638    IF (ALLOCATED(Kech_V_px))     DEALLOCATE(Kech_V_px)
639    IF (ALLOCATED(Kech_V_pw))     DEALLOCATE(Kech_V_pw)
640    IF (ALLOCATED(dd_KVp))        DEALLOCATE(dd_KVp)
641    IF (ALLOCATED(KxKwVp))        DEALLOCATE(KxKwVp)
642    IF (ALLOCATED(dd_AV))         DEALLOCATE(dd_AV)
643    IF (ALLOCATED(dd_BV))         DEALLOCATE(dd_BV)
644
645END SUBROUTINE wx_pbl_final
646
647END MODULE wx_pbl_var_mod
648
Note: See TracBrowser for help on using the repository browser.