source: LMDZ6/branches/Amaury_dev/libf/phylmd/wx_pbl_var_mod.F90 @ 5157

Last change on this file since 5157 was 5153, checked in by abarral, 7 weeks ago

Revert FCTTRE to INCLUDE to assess impact of inlining
File size: 26.4 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  USE dimphy
8  USE lmdz_abort_physic, ONLY: abort_physic
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(qsat0, dqsatdT0)
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
75  SUBROUTINE 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
302  END SUBROUTINE wx_pbl_init
303
304  SUBROUTINE 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          Kech_h_x_out, Kech_h_w_out, Kech_h_out  &
315          )
316
317    USE lmdz_print_control, ONLY: prt_level, lunout
318    USE indice_sol_mod, ONLY: is_oce
319    USE lmdz_clesphys
320    USE lmdz_yoethf
321
322    USE lmdz_yomcst
323
324    IMPLICIT NONE
325 INCLUDE "FCTTRE.h"
326
327    INTEGER, INTENT(IN) :: knon    ! number of grid cells
328    INTEGER, INTENT(IN) :: nsrf    ! surface type
329    REAL, INTENT(IN) :: dtime   ! time step size (s)
330    REAL, DIMENSION(knon, klev), INTENT(IN) :: ypplay  ! mid-layer pressure (Pa)
331    REAL, DIMENSION(knon, klev), INTENT(IN) :: ypaprs  ! pressure at layer interfaces (pa)
332    REAL, DIMENSION(knon), INTENT(IN) :: sigw ! cold pools fractional area
333    REAL, DIMENSION(knon), INTENT(IN) :: yt_s
334    REAL, DIMENSION(knon), INTENT(IN) :: ydeltat_s
335    REAL, DIMENSION(knon), INTENT(IN) :: ygustiness
336    REAL, DIMENSION(knon, klev), INTENT(IN) :: yt_x, yt_w, yq_x, yq_w
337    REAL, DIMENSION(knon, klev), INTENT(IN) :: yu_x, yu_w, yv_x, yv_w
338    REAL, DIMENSION(knon), INTENT(IN) :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
339    REAL, DIMENSION(knon), INTENT(IN) :: ycdragm_x, ycdragm_w
340    REAL, DIMENSION(knon), INTENT(IN) :: AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w
341    REAL, DIMENSION(knon), INTENT(IN) :: AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w
342    REAL, DIMENSION(knon), INTENT(IN) :: BcoefT_x, BcoefT_w, BcoefQ_x, BcoefQ_w
343    REAL, DIMENSION(knon), INTENT(IN) :: BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w
344
345    REAL, DIMENSION(knon), INTENT(OUT) :: Kech_h_x_out, Kech_h_w_out, Kech_h_out
346
347    ! Local variables
348    INTEGER :: j
349    REAL :: rho1
350    REAL :: mod_wind_x
351    REAL :: mod_wind_w
352    REAL :: dd_Kh
353    REAL :: dd_Kq
354    REAL :: dd_Km
355
356    REAL :: zdelta, zcvm5, zcor, qsat
357
358    REAL, DIMENSION(knon) :: sigx       ! fractional area of (x) region
359
360    !!!
361    !!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences
362
363    !  First computations
364    !  ------------------
365    eps_1 = 0.5
366    smallestreal = tiny(smallestreal)
367
368    sigx(1:knon) = 1. - sigw(1:knon)
369    ! Compute Cp, Lv, qsat, dqsat_dT.
370    L_v(1:knon) = RLvtt
371    Ts0(1:knon) = yt_s(1:knon)
372    dTs0(1:knon) = ydeltat_s(1:knon)
373    q1_0b(1:knon) = sigw(1:knon) * yq_w(1:knon, 1) + sigx(1:knon) * yq_x(1:knon, 1)
374
375    ! fqsat determination
376    ! -------------------
377    IF (nsrf == is_oce) THEN
378      fqsat = f_qsat_oce
379    ELSE
380      fqsat = 1.
381    ENDIF
382
383
384    !  Reference state
385    !  ---------------
386    DO j = 1, knon
387      zdelta = MAX(0., SIGN(1., RTT - Ts0(j)))
388      zcvm5 = R5LES * (1. - zdelta) + R5IES * zdelta
389      qsat = R2ES * FOEEW(Ts0(j), zdelta) / ypaprs(j, 1)
390      qsat = MIN(0.5, qsat)
391      zcor = 1. / (1. - RETV * qsat)
392      qsat0(j) = fqsat * qsat * zcor
393      dqsatdT0(j) = fqsat * FOEDE(Ts0(j), zdelta, zcvm5, qsat0(j), zcor)
394      C_p(j) = RCpd + qsat0(j) * (RCpv - RCpd)
395      C_p(j) = RCpd
396
397      !      print *,' AAAA wx_pbl0, C_p(j), qsat0(j), Ts0(j) : ', C_p(j), qsat0(j), Ts0(j)
398    ENDDO
399    DO j = 1, knon
400      Ts0_x(j) = Ts0(j) - sigw(j) * dTs0(j)
401      zdelta = MAX(0., SIGN(1., RTT - Ts0_x(j)))
402      zcvm5 = R5LES * (1. - zdelta) + R5IES * zdelta
403      !!      zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
404      qsat = R2ES * FOEEW(Ts0_x(j), zdelta) / ypaprs(j, 1)
405      qsat = MIN(0.5, qsat)
406      zcor = 1. / (1. - RETV * qsat)
407      qsat0_x(j) = fqsat * qsat * zcor
408      dqsatdT0_x(j) = fqsat * FOEDE(Ts0_x(j), zdelta, zcvm5, qsat0_x(j), zcor)
409      !!      dqsatdT0_x(j) = (RLvtt*(1.-zdelta)+RLSTT*zdelta)*qsat0_x(j)/(Rv*Ts0_x(j)*Ts0_x(j))
410    ENDDO
411    DO j = 1, knon
412      Ts0_w(j) = Ts0(j) + sigx(j) * dTs0(j)
413      zdelta = MAX(0., SIGN(1., RTT - Ts0_w(j)))
414      zcvm5 = R5LES * (1. - zdelta) + R5IES * zdelta
415      !!      zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
416      qsat = R2ES * FOEEW(Ts0_w(j), zdelta) / ypaprs(j, 1)
417      qsat = MIN(0.5, qsat)
418      zcor = 1. / (1. - RETV * qsat)
419      qsat0_w(j) = fqsat * qsat * zcor
420      dqsatdT0_w(j) = fqsat * FOEDE(Ts0_w(j), zdelta, zcvm5, qsat0_w(j), zcor)
421      !!      dqsatdT0_w(j) = (RLvtt*(1.-zdelta)+RLSTT*zdelta)*qsat0_w(j)/(Rv*Ts0_w(j)*Ts0_w(j))
422    ENDDO
423
424    QQ_x(1:knon) = 1. / dqsatdT0_x(1:knon)
425    QQ_w(1:knon) = 1. / dqsatdT0_w(1:knon)
426    QQ_b(1:knon) = sigw(1:knon) * QQ_w(1:knon) + sigx(1:knon) * QQ_x(1:knon)
427    dd_QQ(1:knon) = QQ_w(1:knon) - QQ_x(1:knon)
428
429    DO j = 1, knon
430
431      ! Exchange coefficients computation
432      ! ---------------------------------
433
434      ! Wind factor (Warning : this is not valid when using land_surf_orchidee)
435      mod_wind_x = min_wind_speed + SQRT(ygustiness(j) + yu_x(j, 1)**2 + yv_x(j, 1)**2)
436      mod_wind_w = min_wind_speed + SQRT(ygustiness(j) + yu_w(j, 1)**2 + yv_w(j, 1)**2)
437
438      !!         rho1 = ypplay(j,1)/(RD*yt(j,1))
439      rho1 = ypplay(j, 1) / (RD * (yt_x(j, 1) + sigw(j) * (yt_w(j, 1) - yt_x(j, 1))))
440
441      ! (w) and (x) Exchange coefficients
442      Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1
443      Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1
444      Kech_q_x(j) = ycdragq_x(j) * mod_wind_x * rho1
445      Kech_q_w(j) = ycdragq_w(j) * mod_wind_w * rho1
446      Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1
447      Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1
448      !!  Print *,'YYYYpbl0: ycdragh_x, ycdragq_x, mod_wind_x, rho1, Kech_q_x, Kech_h_x ', &
449      !!                     ycdragh_x(j), ycdragq_x(j), mod_wind_x, rho1, Kech_q_x(j), Kech_h_x(j)
450      !!  Print *,'YYYYpbl0: ycdragh_w, ycdragq_w, mod_wind_w, rho1, Kech_q_w, Kech_h_w ', &
451      !!                     ycdragh_w(j), ycdragq_w(j), mod_wind_w, rho1, Kech_q_w(j), Kech_h_w(j)
452
453      ! Merged exchange coefficients
454      dd_Kh = Kech_h_w(j) - Kech_h_x(j)
455      dd_Kq = Kech_q_w(j) - Kech_q_x(j)
456      dd_Km = Kech_m_w(j) - Kech_m_x(j)
457      IF (prt_level >=10) THEN
458        print *, ' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w
459        print *, ' rho1 ', rho1
460        print *, ' ycdragh_x(j),ycdragm_x(j) ', ycdragh_x(j), ycdragm_x(j)
461        print *, ' ycdragh_w(j),ycdragm_w(j) ', ycdragh_w(j), ycdragm_w(j)
462        print *, ' dd_Kh: ', dd_Kh
463      ENDIF
464
465      Kech_h(j) = Kech_h_x(j) + sigw(j) * dd_Kh
466      Kech_q(j) = Kech_q_x(j) + sigw(j) * dd_Kq
467      Kech_m(j) = Kech_m_x(j) + sigw(j) * dd_Km
468
469      Kech_h_x_out(j) = Kech_h_x(j)
470      Kech_h_w_out(j) = Kech_h_w(j)
471      Kech_h_out(j) = Kech_h(j)
472
473      ! Effective exchange coefficient computation
474      ! ------------------------------------------
475      Kech_T_px(j) = Kech_h_x(j) / (1. - BcoefT_x(j) * Kech_h_x(j) * dtime)
476      Kech_T_pw(j) = Kech_h_w(j) / (1. - BcoefT_w(j) * Kech_h_w(j) * dtime)
477
478      Kech_Q_px(j) = Kech_q_x(j) / (1. - BcoefQ_x(j) * Kech_q_x(j) * dtime)
479      Kech_Q_pw(j) = Kech_q_w(j) / (1. - BcoefQ_w(j) * Kech_q_w(j) * dtime)
480
481      Kech_U_px(j) = Kech_m_x(j) / (1. - BcoefU_x(j) * Kech_m_x(j) * dtime)
482      Kech_U_pw(j) = Kech_m_w(j) / (1. - BcoefU_w(j) * Kech_m_w(j) * dtime)
483
484      Kech_V_px(j) = Kech_m_x(j) / (1. - BcoefV_x(j) * Kech_m_x(j) * dtime)
485      Kech_V_pw(j) = Kech_m_w(j) / (1. - BcoefV_w(j) * Kech_m_w(j) * dtime)
486
487      dd_KTp(j) = Kech_T_pw(j) - Kech_T_px(j)
488      dd_KQp(j) = Kech_Q_pw(j) - Kech_Q_px(j)
489      dd_KUp(j) = Kech_U_pw(j) - Kech_U_px(j)
490      dd_KVp(j) = Kech_V_pw(j) - Kech_V_px(j)
491
492      Kech_Tp(j) = Kech_T_px(j) + sigw(j) * dd_KTp(j)
493      Kech_Qp(j) = Kech_Q_px(j) + sigw(j) * dd_KQp(j)
494      Kech_Up(j) = Kech_U_px(j) + sigw(j) * dd_KUp(j)
495      Kech_Vp(j) = Kech_V_px(j) + sigw(j) * dd_KVp(j)
496
497      ! Store AQ and BQ in the module variables
498      AQ_x(j) = AcoefQ_x(j)
499      AQ_w(j) = AcoefQ_w(j)
500      BQ_x(j) = BcoefQ_x(j)
501      BQ_w(j) = BcoefQ_w(j)
502
503      ! Calcul des differences w-x
504      dd_Cdragm(j) = ycdragm_w(j) - ycdragm_x(j)
505      dd_Cdragh(j) = ycdragh_w(j) - ycdragh_x(j)
506      dd_Cdragq(j) = ycdragq_w(j) - ycdragq_x(j)
507
508      dd_AT(j) = AcoefT_w(j) - AcoefT_x(j)
509      dd_AQ(j) = AcoefQ_w(j) - AcoefQ_x(j)
510      dd_AU(j) = AcoefU_w(j) - AcoefU_x(j)
511      dd_AV(j) = AcoefV_w(j) - AcoefV_x(j)
512      dd_BT(j) = BcoefT_w(j) - BcoefT_x(j)
513      dd_BQ(j) = BcoefQ_w(j) - BcoefQ_x(j)
514      dd_BU(j) = BcoefU_w(j) - BcoefU_x(j)
515      dd_BV(j) = BcoefV_w(j) - BcoefV_x(j)
516
517      KxKwTp(j) = Kech_T_px(j) * Kech_T_pw(j)
518      KxKwQp(j) = Kech_Q_px(j) * Kech_Q_pw(j)
519      KxKwUp(j) = Kech_U_px(j) * Kech_U_pw(j)
520      KxKwVp(j) = Kech_V_px(j) * Kech_V_pw(j)
521
522      IF (prt_level >=10) THEN
523        print *, 'Variables pour la fusion : Kech_T_px(j)', Kech_T_px(j)
524        print *, 'Variables pour la fusion : Kech_T_pw(j)', Kech_T_pw(j)
525        print *, 'Variables pour la fusion : Kech_Tp(j)', Kech_Tp(j)
526        print *, 'Variables pour la fusion : Kech_h(j)', Kech_h(j)
527      ENDIF
528
529    ENDDO  ! j = 1, knon
530
531  END SUBROUTINE wx_pbl_prelim_0
532
533  SUBROUTINE wx_pbl_prelim_beta(knon, dtime, &
534          sigw, beta, &
535          BcoefQ_x, BcoefQ_w &
536          )
537
538    USE lmdz_print_control, ONLY: prt_level, lunout
539    USE indice_sol_mod, ONLY: is_oce
540
541    INTEGER, INTENT(IN) :: knon    ! number of grid cells
542    REAL, INTENT(IN) :: dtime   ! time step size (s)
543    REAL, DIMENSION(knon), INTENT(IN) :: sigw ! cold pools fractional area
544    REAL, DIMENSION(knon), INTENT(IN) :: beta ! evaporation by potential evaporation
545    REAL, DIMENSION(knon), INTENT(IN) :: BcoefQ_x, BcoefQ_w
546
547    ! Local variables
548    INTEGER :: j
549
550    DO j = 1, knon
551
552      qsatsrf0_x(j) = beta(j) * qsat0_x(j)
553      qsatsrf0_w(j) = beta(j) * qsat0_w(j)
554      dqsatsrf0(j) = qsatsrf0_w(j) - qsatsrf0_x(j)
555
556      Kech_Q_sx(j) = Kech_q_x(j) / (1. - beta(j) * BcoefQ_x(j) * Kech_q_x(j) * dtime)
557      Kech_Q_sw(j) = Kech_q_w(j) / (1. - beta(j) * BcoefQ_w(j) * Kech_q_w(j) * dtime)
558
559      dd_KQs(j) = Kech_Q_sw(j) - Kech_Q_sx(j)
560
561      Kech_Qs(j) = Kech_Q_sx(j) + sigw(j) * dd_KQs(j)
562
563      KxKwQs(j) = Kech_Q_sx(j) * Kech_Q_sw(j)
564
565      !!  print *,'BBBBwx_prelim_beta : beta ', beta(j)
566
567    ENDDO ! j = 1, knon
568
569  END SUBROUTINE wx_pbl_prelim_beta
570
571  SUBROUTINE wx_pbl_final
572
573    !****************************************************************************************
574    ! Deallocate module variables
575
576    !****************************************************************************************
577
578    IF (ALLOCATED(C_p))           DEALLOCATE(C_p)
579    IF (ALLOCATED(L_v))           DEALLOCATE(L_v)
580    IF (ALLOCATED(Ts0))           DEALLOCATE(Ts0)
581    IF (ALLOCATED(dTs0))          DEALLOCATE(dTs0)
582    IF (ALLOCATED(Ts0_x))         DEALLOCATE(Ts0_x)
583    IF (ALLOCATED(Ts0_w))         DEALLOCATE(Ts0_w)
584    IF (ALLOCATED(qsat0))         DEALLOCATE(qsat0)
585    IF (ALLOCATED(dqsatdT0))      DEALLOCATE(dqsatdT0)
586    IF (ALLOCATED(qsat0_x))       DEALLOCATE(qsat0_x)
587    IF (ALLOCATED(dqsatdT0_x))    DEALLOCATE(dqsatdT0_x)
588    IF (ALLOCATED(qsat0_w))       DEALLOCATE(qsat0_w)
589    IF (ALLOCATED(dqsatdT0_w))    DEALLOCATE(dqsatdT0_w)
590    IF (ALLOCATED(q1_0b))         DEALLOCATE(q1_0b)
591    IF (ALLOCATED(QQ_b))          DEALLOCATE(QQ_b)
592    IF (ALLOCATED(dd_QQ))         DEALLOCATE(dd_QQ)
593    IF (ALLOCATED(QQ_x))          DEALLOCATE(QQ_x)
594    IF (ALLOCATED(QQ_w))          DEALLOCATE(QQ_w)
595    IF (ALLOCATED(qsatsrf0_x))    DEALLOCATE(qsatsrf0_x)
596    IF (ALLOCATED(qsatsrf0_w))    DEALLOCATE(qsatsrf0_w)
597    IF (ALLOCATED(dqsatsrf0))     DEALLOCATE(dqsatsrf0)
598    IF (ALLOCATED(dd_Cdragh))     DEALLOCATE(dd_Cdragh)
599    IF (ALLOCATED(dd_Cdragm))     DEALLOCATE(dd_Cdragm)
600    IF (ALLOCATED(dd_Cdragq))     DEALLOCATE(dd_Cdragq)
601    IF (ALLOCATED(Kech_h))        DEALLOCATE(Kech_h)
602    IF (ALLOCATED(Kech_h_x))      DEALLOCATE(Kech_h_x)
603    IF (ALLOCATED(Kech_h_w))      DEALLOCATE(Kech_h_w)
604    IF (ALLOCATED(Kech_q))        DEALLOCATE(Kech_q)
605    IF (ALLOCATED(Kech_q_x))      DEALLOCATE(Kech_q_x)
606    IF (ALLOCATED(Kech_q_w))      DEALLOCATE(Kech_q_w)
607    IF (ALLOCATED(Kech_m))        DEALLOCATE(Kech_m)
608    IF (ALLOCATED(Kech_m_x))      DEALLOCATE(Kech_m_x)
609    IF (ALLOCATED(Kech_m_w))      DEALLOCATE(Kech_m_w)
610    IF (ALLOCATED(Kech_Tp))       DEALLOCATE(Kech_Tp)
611    IF (ALLOCATED(Kech_T_px))     DEALLOCATE(Kech_T_px)
612    IF (ALLOCATED(Kech_T_pw))     DEALLOCATE(Kech_T_pw)
613    IF (ALLOCATED(dd_KTp))        DEALLOCATE(dd_KTp)
614    IF (ALLOCATED(KxKwTp))        DEALLOCATE(KxKwTp)
615    IF (ALLOCATED(dd_AT))         DEALLOCATE(dd_AT)
616    IF (ALLOCATED(dd_BT))         DEALLOCATE(dd_BT)
617    IF (ALLOCATED(Kech_Qp))       DEALLOCATE(Kech_Qp)
618    IF (ALLOCATED(Kech_Q_px))     DEALLOCATE(Kech_Q_px)
619    IF (ALLOCATED(Kech_Q_pw))     DEALLOCATE(Kech_Q_pw)
620    IF (ALLOCATED(dd_KQp))        DEALLOCATE(dd_KQp)
621    IF (ALLOCATED(KxKwQp))        DEALLOCATE(KxKwQp)
622    IF (ALLOCATED(Kech_Qs))       DEALLOCATE(Kech_Qs)
623    IF (ALLOCATED(Kech_Q_sx))     DEALLOCATE(Kech_Q_sx)
624    IF (ALLOCATED(Kech_Q_sw))     DEALLOCATE(Kech_Q_sw)
625    IF (ALLOCATED(dd_KQs))        DEALLOCATE(dd_KQs)
626    IF (ALLOCATED(KxKwQs))       DEALLOCATE(KxKwQs)
627    IF (ALLOCATED(AQ_x))          DEALLOCATE(AQ_x)
628    IF (ALLOCATED(AQ_w))          DEALLOCATE(AQ_w)
629    IF (ALLOCATED(BQ_x))          DEALLOCATE(BQ_x)
630    IF (ALLOCATED(BQ_w))          DEALLOCATE(BQ_w)
631    IF (ALLOCATED(dd_AQ))         DEALLOCATE(dd_AQ)
632    IF (ALLOCATED(dd_BQ))        DEALLOCATE(dd_BQ)
633    IF (ALLOCATED(Kech_Up))       DEALLOCATE(Kech_Up)
634    IF (ALLOCATED(Kech_U_px))     DEALLOCATE(Kech_U_px)
635    IF (ALLOCATED(Kech_U_pw))     DEALLOCATE(Kech_U_pw)
636    IF (ALLOCATED(dd_KUp))        DEALLOCATE(dd_KUp)
637    IF (ALLOCATED(KxKwUp))        DEALLOCATE(KxKwUp)
638    IF (ALLOCATED(dd_AU))         DEALLOCATE(dd_AU)
639    IF (ALLOCATED(dd_BU))         DEALLOCATE(dd_BU)
640    IF (ALLOCATED(Kech_Vp))       DEALLOCATE(Kech_Vp)
641    IF (ALLOCATED(Kech_V_px))     DEALLOCATE(Kech_V_px)
642    IF (ALLOCATED(Kech_V_pw))     DEALLOCATE(Kech_V_pw)
643    IF (ALLOCATED(dd_KVp))        DEALLOCATE(dd_KVp)
644    IF (ALLOCATED(KxKwVp))        DEALLOCATE(KxKwVp)
645    IF (ALLOCATED(dd_AV))         DEALLOCATE(dd_AV)
646    IF (ALLOCATED(dd_BV))         DEALLOCATE(dd_BV)
647
648  END SUBROUTINE wx_pbl_final
649
650END MODULE wx_pbl_var_mod
651
Note: See TracBrowser for help on using the repository browser.