1 | ! |
---|
2 | !$Id: cdrag_mod.F90 4725 2023-10-11 16:37:33Z jyg $ |
---|
3 | ! |
---|
4 | ! |
---|
5 | MODULE cdrag_mod |
---|
6 | ! |
---|
7 | ! This module contains some procedures for calculation of the cdrag |
---|
8 | ! coefficients for turbulent diffusion at surface |
---|
9 | ! |
---|
10 | IMPLICIT NONE |
---|
11 | |
---|
12 | CONTAINS |
---|
13 | ! |
---|
14 | !**************************************************************************************** |
---|
15 | ! |
---|
16 | !r original routine svn3623 |
---|
17 | ! |
---|
18 | SUBROUTINE cdrag(knon, nsrf, & |
---|
19 | speed, t1, q1, zgeop1, & |
---|
20 | psol, pblh, tsurf, qsurf, z0m, z0h, & |
---|
21 | ri_in, iri_in, & |
---|
22 | cdm, cdh, zri, pref, prain, tsol , pat1) |
---|
23 | |
---|
24 | USE dimphy |
---|
25 | USE indice_sol_mod |
---|
26 | USE print_control_mod, ONLY: lunout, prt_level |
---|
27 | USE ioipsl_getin_p_mod, ONLY : getin_p |
---|
28 | USE lmdz_atke_turbulence_ini, ONLY : ric, cinf, cepsilon, pr_slope, pr_asym, pr_neut |
---|
29 | |
---|
30 | IMPLICIT NONE |
---|
31 | ! ================================================================= c |
---|
32 | ! |
---|
33 | ! Objet : calcul des cdrags pour le moment (pcfm) et |
---|
34 | ! les flux de chaleur sensible et latente (pcfh) d'apr??s |
---|
35 | ! Louis 1982, Louis 1979, King et al 2001 |
---|
36 | ! ou Zilitinkevich et al 2002 pour les cas stables, Louis 1979 |
---|
37 | ! et 1982 pour les cas instables |
---|
38 | ! |
---|
39 | ! Modified history: |
---|
40 | ! writting on the 20/05/2016 |
---|
41 | ! modified on the 13/12/2016 to be adapted to LMDZ6 |
---|
42 | ! |
---|
43 | ! References: |
---|
44 | ! Louis, J. F., 1979: A parametric model of vertical eddy fluxes in the |
---|
45 | ! atmosphere. Boundary-Layer Meteorology. 01/1979; 17(2):187-202. |
---|
46 | ! Louis, J. F., Tiedtke, M. and Geleyn, J. F., 1982: `A short history of the |
---|
47 | ! operational PBL parametrization at ECMWF'. Workshop on boundary layer |
---|
48 | ! parametrization, November 1981, ECMWF, Reading, England. |
---|
49 | ! Page: 19. Equations in Table 1. |
---|
50 | ! Mascart P, Noilhan J, Giordani H 1995.A MODIFIED PARAMETERIZATION OF FLUX-PROFILE RELATIONSHIPS |
---|
51 | ! IN THE SURFACE LAYER USING DIFFERENT ROUGHNESS LENGTH VALUES FOR HEAT AND MOMENTUM |
---|
52 | ! Boundary-Layer Meteorology 72: 331-344 |
---|
53 | ! Anton Beljaars. May 1992. The parametrization of the planetary boundary layer. |
---|
54 | ! European Centre for Medium-Range Weather Forecasts. |
---|
55 | ! Equations: 110-113. Page 40. |
---|
56 | ! Miller,M.J., A.C.M.Beljaars, T.N.Palmer. 1992. The sensitivity of the ECMWF |
---|
57 | ! model to the parameterization of evaporation from the tropical oceans. J. |
---|
58 | ! Climate, 5:418-434. |
---|
59 | ! King J.C, Connolley, W.M ad Derbyshire S.H. 2001, Sensitivity of Modelled Antarctic climate |
---|
60 | ! to surface and boundary-layer flux parametrizations |
---|
61 | ! QJRMS, 127, pp 779-794 |
---|
62 | ! |
---|
63 | ! ================================================================= c |
---|
64 | ! ================================================================= c |
---|
65 | ! On choisit le couple de fonctions de correction avec deux flags: |
---|
66 | ! Un pour les cas instables, un autre pour les cas stables |
---|
67 | ! |
---|
68 | ! iflag_corr_insta: |
---|
69 | ! 1: Louis 1979 avec les modifications de Mascart 1995 (z0/= z0h) |
---|
70 | ! 2: Louis 1982 |
---|
71 | ! 3: Laurent Li |
---|
72 | ! |
---|
73 | ! iflag_corr_sta: |
---|
74 | ! 1: Louis 1979 avec les modifications de Mascart 1995 (z0/= z0h) |
---|
75 | ! 2: Louis 1982 |
---|
76 | ! 3: Laurent Li |
---|
77 | ! 4: King 2001 (SHARP) |
---|
78 | ! 5: MO 1st order theory (allow collapse of turbulence) |
---|
79 | ! |
---|
80 | ! |
---|
81 | !***************************************************************** |
---|
82 | ! Parametres d'entree |
---|
83 | !***************************************************************** |
---|
84 | |
---|
85 | INTEGER, INTENT(IN) :: knon, nsrf ! nombre de points de grille sur l'horizontal + type de surface |
---|
86 | REAL, DIMENSION(klon), INTENT(IN) :: speed ! module du vent au 1er niveau du modele |
---|
87 | REAL, DIMENSION(klon), INTENT(IN) :: zgeop1 ! geopotentiel au 1er niveau du modele |
---|
88 | REAL, DIMENSION(klon), INTENT(IN) :: tsurf ! Surface temperature (K) |
---|
89 | REAL, DIMENSION(klon), INTENT(IN) :: qsurf ! Surface humidity (Kg/Kg) |
---|
90 | REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h ! Rugosity at surface (m) |
---|
91 | REAL, DIMENSION(klon), INTENT(IN) :: ri_in ! Input Richardson 1st layer for first guess calculations of screen var. |
---|
92 | INTEGER, INTENT(IN) :: iri_in! iflag to activate cdrag calculation using ri1 |
---|
93 | REAL, DIMENSION(klon), INTENT(IN) :: t1 ! Temperature au premier niveau (K) |
---|
94 | REAL, DIMENSION(klon), INTENT(IN) :: q1 ! humidite specifique au premier niveau (kg/kg) |
---|
95 | REAL, DIMENSION(klon), INTENT(IN) :: psol ! pression au sol |
---|
96 | |
---|
97 | !------------------ Rajout pour COARE (OT2018) -------------------- |
---|
98 | REAL, DIMENSION(klon), INTENT(INOUT) :: pblh !hauteur de CL |
---|
99 | REAL, DIMENSION(klon), INTENT(IN) :: prain !rapport au precipitation |
---|
100 | REAL, DIMENSION(klon), INTENT(IN) :: tsol !SST imposé sur la surface oceanique |
---|
101 | REAL, DIMENSION(klon), INTENT(IN) :: pat1 !pression premier lev |
---|
102 | |
---|
103 | |
---|
104 | |
---|
105 | ! Parametres de sortie |
---|
106 | !****************************************************************** |
---|
107 | REAL, DIMENSION(klon), INTENT(OUT) :: cdm ! Drag coefficient for momentum |
---|
108 | REAL, DIMENSION(klon), INTENT(OUT) :: cdh ! Drag coefficient for heat flux |
---|
109 | REAL, DIMENSION(klon), INTENT(OUT) :: zri ! Richardson number |
---|
110 | REAL, DIMENSION(klon), INTENT(INOUT) :: pref ! Pression au niveau zgeop/RG |
---|
111 | |
---|
112 | ! Variables Locales |
---|
113 | !****************************************************************** |
---|
114 | |
---|
115 | |
---|
116 | INCLUDE "YOMCST.h" |
---|
117 | INCLUDE "YOETHF.h" |
---|
118 | INCLUDE "clesphys.h" |
---|
119 | |
---|
120 | |
---|
121 | REAL, PARAMETER :: CKAP=0.40, CKAPT=0.42 |
---|
122 | REAL CEPDU2 |
---|
123 | REAL ALPHA |
---|
124 | REAL CB,CC,CD,C2,C3 |
---|
125 | REAL MU, CM, CH, B, CMstar, CHstar |
---|
126 | REAL PM, PH, BPRIME |
---|
127 | INTEGER ng_q1 ! Number of grids that q1 < 0.0 |
---|
128 | INTEGER ng_qsurf ! Number of grids that qsurf < 0.0 |
---|
129 | INTEGER i, k |
---|
130 | REAL zdu2, ztsolv |
---|
131 | REAL ztvd, zscf |
---|
132 | REAL zucf, zcr |
---|
133 | REAL, DIMENSION(klon) :: FM, FH ! stability functions |
---|
134 | REAL, DIMENSION(klon) :: cdmn, cdhn ! Drag coefficient in neutral conditions |
---|
135 | REAL zzzcd |
---|
136 | REAL, DIMENSION(klon) :: sm, prandtl ! Stability function from atke turbulence scheme |
---|
137 | REAL ri0, ri1, cn ! to have dimensionless term in sm and prandtl |
---|
138 | |
---|
139 | !------------------ Rajout (OT2018) -------------------- |
---|
140 | !------------------ Rajout pour les appelles BULK (OT) -------------------- |
---|
141 | REAL, DIMENSION(klon,2) :: rugos_itm |
---|
142 | REAL, DIMENSION(klon,2) :: rugos_ith |
---|
143 | REAL, PARAMETER :: tol_it_rugos=1.e-4 |
---|
144 | REAL, DIMENSION(3) :: coeffs |
---|
145 | LOGICAL :: mixte |
---|
146 | REAL :: z_0m |
---|
147 | REAL :: z_0h |
---|
148 | REAL, DIMENSION(klon) :: cdmm |
---|
149 | REAL, DIMENSION(klon) :: cdhh |
---|
150 | |
---|
151 | !------------------RAJOUT POUR ECUME ------------------- |
---|
152 | |
---|
153 | REAL, DIMENSION(klon) :: PQSAT |
---|
154 | REAL, DIMENSION(klon) :: PSFTH |
---|
155 | REAL, DIMENSION(klon) :: PFSTQ |
---|
156 | REAL, DIMENSION(klon) :: PUSTAR |
---|
157 | REAL, DIMENSION(klon) :: PCD ! Drag coefficient for momentum |
---|
158 | REAL, DIMENSION(klon) :: PCDN ! Drag coefficient for momentum |
---|
159 | REAL, DIMENSION(klon) :: PCH ! Drag coefficient for momentum |
---|
160 | REAL, DIMENSION(klon) :: PCE ! Drag coefficient for momentum |
---|
161 | REAL, DIMENSION(klon) :: PRI |
---|
162 | REAL, DIMENSION(klon) :: PRESA |
---|
163 | REAL, DIMENSION(klon) :: PSSS |
---|
164 | |
---|
165 | LOGICAL :: OPRECIP |
---|
166 | LOGICAL :: OPWEBB |
---|
167 | LOGICAL :: OPERTFLUX |
---|
168 | LOGICAL :: LPRECIP |
---|
169 | LOGICAL :: LPWG |
---|
170 | |
---|
171 | |
---|
172 | |
---|
173 | LOGICAL, SAVE :: firstcall = .TRUE. |
---|
174 | !$OMP THREADPRIVATE(firstcall) |
---|
175 | INTEGER, SAVE :: iflag_corr_sta |
---|
176 | !$OMP THREADPRIVATE(iflag_corr_sta) |
---|
177 | INTEGER, SAVE :: iflag_corr_insta |
---|
178 | !$OMP THREADPRIVATE(iflag_corr_insta) |
---|
179 | LOGICAL, SAVE :: ok_cdrag_iter |
---|
180 | !$OMP THREADPRIVATE(ok_cdrag_iter) |
---|
181 | |
---|
182 | !===================================================================c |
---|
183 | ! Valeurs numeriques des constantes |
---|
184 | !===================================================================c |
---|
185 | |
---|
186 | |
---|
187 | ! Minimum du carre du vent |
---|
188 | |
---|
189 | CEPDU2 = (0.1)**2 |
---|
190 | |
---|
191 | ! Louis 1982 |
---|
192 | |
---|
193 | CB=5.0 |
---|
194 | CC=5.0 |
---|
195 | CD=5.0 |
---|
196 | |
---|
197 | |
---|
198 | ! King 2001 |
---|
199 | |
---|
200 | C2=0.25 |
---|
201 | C3=0.0625 |
---|
202 | |
---|
203 | |
---|
204 | ! Louis 1979 |
---|
205 | |
---|
206 | BPRIME=4.7 |
---|
207 | B=9.4 |
---|
208 | |
---|
209 | |
---|
210 | !MO |
---|
211 | |
---|
212 | ALPHA=5.0 |
---|
213 | |
---|
214 | ! Consistent with atke scheme |
---|
215 | cn=(1./sqrt(cepsilon))**(2./3.) |
---|
216 | ri0=2./rpi*(cinf - cn)*ric/cn |
---|
217 | ri1=-2./rpi * (pr_asym - pr_neut)/pr_slope |
---|
218 | |
---|
219 | |
---|
220 | ! ================================================================= c |
---|
221 | ! Tests avant de commencer |
---|
222 | ! Fuxing WANG, 04/03/2015 |
---|
223 | ! To check if there are negative q1, qsurf values. |
---|
224 | !====================================================================c |
---|
225 | ng_q1 = 0 ! Initialization |
---|
226 | ng_qsurf = 0 ! Initialization |
---|
227 | DO i = 1, knon |
---|
228 | IF (q1(i).LT.0.0) ng_q1 = ng_q1 + 1 |
---|
229 | IF (qsurf(i).LT.0.0) ng_qsurf = ng_qsurf + 1 |
---|
230 | ENDDO |
---|
231 | IF (ng_q1.GT.0 .and. prt_level > 5) THEN |
---|
232 | WRITE(lunout,*)" *** Warning: Negative q1(humidity at 1st level) values in cdrag.F90 !" |
---|
233 | WRITE(lunout,*)" The total number of the grids is: ", ng_q1 |
---|
234 | WRITE(lunout,*)" The negative q1 is set to zero " |
---|
235 | ! abort_message="voir ci-dessus" |
---|
236 | ! CALL abort_physic(modname,abort_message,1) |
---|
237 | ENDIF |
---|
238 | IF (ng_qsurf.GT.0 .and. prt_level > 5) THEN |
---|
239 | WRITE(lunout,*)" *** Warning: Negative qsurf(humidity at surface) values in cdrag.F90 !" |
---|
240 | WRITE(lunout,*)" The total number of the grids is: ", ng_qsurf |
---|
241 | WRITE(lunout,*)" The negative qsurf is set to zero " |
---|
242 | ! abort_message="voir ci-dessus" |
---|
243 | ! CALL abort_physic(modname,abort_message,1) |
---|
244 | ENDIF |
---|
245 | |
---|
246 | |
---|
247 | |
---|
248 | !=============================================================================c |
---|
249 | ! Calcul du cdrag |
---|
250 | !=============================================================================c |
---|
251 | |
---|
252 | ! On choisit les fonctions de stabilite utilisees au premier appel |
---|
253 | !************************************************************************** |
---|
254 | IF (firstcall) THEN |
---|
255 | iflag_corr_sta=2 |
---|
256 | iflag_corr_insta=2 |
---|
257 | ok_cdrag_iter = .FALSE. |
---|
258 | |
---|
259 | CALL getin_p('iflag_corr_sta',iflag_corr_sta) |
---|
260 | CALL getin_p('iflag_corr_insta',iflag_corr_insta) |
---|
261 | CALL getin_p('ok_cdrag_iter',ok_cdrag_iter) |
---|
262 | |
---|
263 | firstcall = .FALSE. |
---|
264 | ENDIF |
---|
265 | |
---|
266 | !------------------ Rajout (OT2018) -------------------- |
---|
267 | !--------- Rajout pour itération sur rugosité ---------------- |
---|
268 | rugos_itm(:,2) = z0m |
---|
269 | rugos_itm(:,1) = 3.*tol_it_rugos*z0m |
---|
270 | |
---|
271 | rugos_ith(:,2) = z0h !cp nouveau rugos_it |
---|
272 | rugos_ith(:,1) = 3.*tol_it_rugos*z0h |
---|
273 | !-------------------------------------------------------------------- |
---|
274 | |
---|
275 | !xxxxxxxxxxxxxxxxxxxxxxx |
---|
276 | DO i = 1, knon ! Boucle sur l'horizontal |
---|
277 | !xxxxxxxxxxxxxxxxxxxxxxx |
---|
278 | |
---|
279 | |
---|
280 | ! calculs preliminaires: |
---|
281 | !*********************** |
---|
282 | |
---|
283 | zdu2 = MAX(CEPDU2, speed(i)**2) |
---|
284 | pref(i) = EXP(LOG(psol(i)) - zgeop1(i)/(RD*t1(i)* & |
---|
285 | (1.+ RETV * max(q1(i),0.0)))) ! negative q1 set to zero |
---|
286 | ztsolv = tsurf(i) * (1.0+RETV*max(qsurf(i),0.0)) ! negative qsurf set to zero |
---|
287 | ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*q1(i))) & |
---|
288 | *(1.+RETV*max(q1(i),0.0)) ! negative q1 set to zero |
---|
289 | |
---|
290 | !------------------ Rajout (OT2018) -------------------- |
---|
291 | !-------------- ON DUPLIQUE POUR METTRE ITERATION SUR OCEAN ------------------------ |
---|
292 | IF (iri_in.EQ.1) THEN |
---|
293 | zri(i) = ri_in(i) |
---|
294 | ENDIF |
---|
295 | |
---|
296 | IF (nsrf == is_oce) THEN |
---|
297 | |
---|
298 | !------------------ Pour Core 2 choix Core Pur ou Core Mixte -------------------- |
---|
299 | IF ((choix_bulk > 1 .AND. choix_bulk < 4) .AND. (nsrf .eq. is_oce)) THEN |
---|
300 | IF(choix_bulk .eq. 2) THEN |
---|
301 | mixte = .false. |
---|
302 | ELSE |
---|
303 | mixte = .true. |
---|
304 | ENDIF |
---|
305 | call clc_core_cp ( sqrt(zdu2),t1(i)-tsurf(i),q1(i)-qsurf(i),t1(i),q1(i),& |
---|
306 | zgeop1(i)/RG, zgeop1(i)/RG, zgeop1(i)/RG,& |
---|
307 | psol(i),nit_bulk,mixte,& |
---|
308 | coeffs,z_0m,z_0h) |
---|
309 | cdmm(i) = coeffs(1) |
---|
310 | cdhh(i) = coeffs(2) |
---|
311 | cdm(i)=cdmm(i) |
---|
312 | cdh(i)=cdhh(i) |
---|
313 | write(*,*) "clc_core cd ch",cdmm(i),cdhh(i) |
---|
314 | |
---|
315 | !------------------ Pour ECUME -------------------- |
---|
316 | ELSE IF ((choix_bulk .eq. 4) .and. (nsrf .eq. is_oce)) THEN |
---|
317 | OPRECIP = .false. |
---|
318 | OPWEBB = .false. |
---|
319 | OPERTFLUX = .false. |
---|
320 | IF (nsrf .eq. is_oce) THEN |
---|
321 | PSSS = 0.0 |
---|
322 | ENDIF |
---|
323 | call ini_csts |
---|
324 | call ecumev6_flux( z_0m,t1(i),tsurf(i),& |
---|
325 | q1(i),qsurf(i),sqrt(zdu2),zgeop1(i)/RG,PSSS,zgeop1(i)/RG,& |
---|
326 | psol(i),pat1(i), OPRECIP, OPWEBB,& |
---|
327 | PSFTH,PFSTQ,PUSTAR,PCD,PCDN,& |
---|
328 | PCH,PCE,PRI,PRESA,prain,& |
---|
329 | z_0h,OPERTFLUX,coeffs) |
---|
330 | |
---|
331 | cdmm(i) = coeffs(1) |
---|
332 | cdhh(i) = coeffs(2) |
---|
333 | cdm(i)=cdmm(i) |
---|
334 | cdh(i)=cdhh(i) |
---|
335 | |
---|
336 | write(*,*) "ecume cd ch",cdmm(i),cdhh(i) |
---|
337 | |
---|
338 | !------------------ Pour COARE CNRM -------------------- |
---|
339 | ELSE IF ((choix_bulk .eq. 5) .and. (nsrf .eq. is_oce)) THEN |
---|
340 | LPRECIP = .false. |
---|
341 | LPWG = .false. |
---|
342 | call ini_csts |
---|
343 | call coare30_flux_cnrm(z_0m,t1(i),tsurf(i), q1(i), & |
---|
344 | sqrt(zdu2),zgeop1(i)/RG,zgeop1(i)/RG,psol(i),qsurf(i),PQSAT, & |
---|
345 | PSFTH,PFSTQ,PUSTAR,PCD,PCDN,PCH,PCE,PRI, & |
---|
346 | PRESA,prain,pat1(i),z_0h, LPRECIP, LPWG, coeffs) |
---|
347 | cdmm(i) = coeffs(1) |
---|
348 | cdhh(i) = coeffs(2) |
---|
349 | cdm(i)=cdmm(i) |
---|
350 | cdh(i)=cdhh(i) |
---|
351 | write(*,*) "coare CNRM cd ch",cdmm(i),cdhh(i) |
---|
352 | |
---|
353 | !------------------ Pour COARE Maison -------------------- |
---|
354 | ELSE IF ((choix_bulk .eq. 1) .and. (nsrf .eq. is_oce)) THEN |
---|
355 | IF ( pblh(i) .eq. 0. ) THEN |
---|
356 | pblh(i) = 1500. |
---|
357 | ENDIF |
---|
358 | write(*,*) "debug size",size(coeffs) |
---|
359 | call coare_cp(sqrt(zdu2),t1(i)-tsurf(i),q1(i)-qsurf(i),& |
---|
360 | t1(i),q1(i),& |
---|
361 | zgeop1(i)/RG,zgeop1(i)/RG,zgeop1(i)/RG,& |
---|
362 | psol(i), pblh(i),& |
---|
363 | nit_bulk,& |
---|
364 | coeffs,z_0m,z_0h) |
---|
365 | cdmm(i) = coeffs(1) |
---|
366 | cdhh(i) = coeffs(3) |
---|
367 | cdm(i)=cdmm(i) |
---|
368 | cdh(i)=cdhh(i) |
---|
369 | write(*,*) "coare cd ch",cdmm(i),cdhh(i) |
---|
370 | ELSE |
---|
371 | !------------------ Pour La param LMDZ (ocean) -------------------- |
---|
372 | zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd) |
---|
373 | IF (iri_in.EQ.1) THEN |
---|
374 | zri(i) = ri_in(i) |
---|
375 | ENDIF |
---|
376 | ENDIF |
---|
377 | |
---|
378 | |
---|
379 | !----------------------- Rajout des itérations -------------- |
---|
380 | DO k=1,nit_bulk |
---|
381 | |
---|
382 | ! Coefficients CD neutres : k^2/ln(z/z0) et k^2/(ln(z/z0)*ln(z/z0h)): |
---|
383 | !******************************************************************** |
---|
384 | zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*rugos_itm(i,2))) |
---|
385 | cdmn(i) = zzzcd*zzzcd |
---|
386 | cdhn(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*rugos_ith(i,2)))) |
---|
387 | |
---|
388 | ! Calcul des fonctions de stabilite FMs, FHs, FMi, FHi : |
---|
389 | !******************************************************* |
---|
390 | IF (zri(i) .LT. 0.) THEN |
---|
391 | SELECT CASE (iflag_corr_insta) |
---|
392 | CASE (1) ! Louis 1979 + Mascart 1995 |
---|
393 | MU=LOG(MAX(z0m(i)/z0h(i),0.01)) |
---|
394 | CMstar=6.8741+2.6933*MU-0.3601*(MU**2)+0.0154*(MU**3) |
---|
395 | PM=0.5233-0.0815*MU+0.0135*(MU**2)-0.001*(MU**3) |
---|
396 | CHstar=3.2165+4.3431*MU+0.536*(MU**2)-0.0781*(MU**3) |
---|
397 | PH=0.5802-0.1571*MU+0.0327*(MU**2)-0.0026*(MU**3) |
---|
398 | CH=CHstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) & |
---|
399 | & * CKAPT/LOG(z0h(i)+zgeop1(i)/(RG*z0h(i))) & |
---|
400 | & * ((zgeop1(i)/(RG*z0h(i)))**PH) |
---|
401 | CM=CMstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) & |
---|
402 | & *CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) & |
---|
403 | & * ((zgeop1(i)/(RG*z0m(i)))**PM) |
---|
404 | FM(i)=1.-B*zri(i)/(1.+CM*SQRT(ABS(zri(i)))) |
---|
405 | FH(i)=1.-B*zri(i)/(1.+CH*SQRT(ABS(zri(i)))) |
---|
406 | CASE (2) ! Louis 1982 |
---|
407 | zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) & |
---|
408 | *(1.0+zgeop1(i)/(RG*z0m(i))))) |
---|
409 | FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min) |
---|
410 | FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min) |
---|
411 | CASE (3) ! Laurent Li |
---|
412 | FM(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min) |
---|
413 | FH(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min) |
---|
414 | CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023) |
---|
415 | sm(i) = 2./rpi * (cinf - cn) * atan(-zri(i)/ri0) + cn |
---|
416 | prandtl(i) = -2./rpi * (pr_asym - pr_neut) * atan(zri(i)/ri1) + pr_neut |
---|
417 | FM(i) = MAX((sm(i)**(3./2.) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1./2.)),f_ri_cd_min) |
---|
418 | FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min) |
---|
419 | CASE default ! Louis 1982 |
---|
420 | zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) & |
---|
421 | *(1.0+zgeop1(i)/(RG*z0m(i))))) |
---|
422 | FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min) |
---|
423 | FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min) |
---|
424 | END SELECT |
---|
425 | ! Calcul des drags |
---|
426 | cdmm(i)=cdmn(i)*FM(i) |
---|
427 | cdhh(i)=f_cdrag_ter*cdhn(i)*FH(i) |
---|
428 | ! Traitement particulier des cas oceaniques |
---|
429 | ! on applique Miller et al 1992 en l'absence de gustiness |
---|
430 | IF (nsrf == is_oce) THEN |
---|
431 | ! cdh(i)=f_cdrag_oce*cdhn(i)*FH(i) |
---|
432 | IF (iflag_gusts==0) THEN |
---|
433 | zcr = (0.0016/(cdmn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.) |
---|
434 | cdhh(i) =f_cdrag_oce* cdhn(i)*(1.0+zcr**1.25)**(1./1.25) |
---|
435 | ENDIF |
---|
436 | cdmm(i)=MIN(cdmm(i),cdmmax) |
---|
437 | cdhh(i)=MIN(cdhh(i),cdhmax) |
---|
438 | ! write(*,*) "LMDZ cd ch",cdmm(i),cdhh(i) |
---|
439 | END IF |
---|
440 | ELSE |
---|
441 | |
---|
442 | !''''''''''''''' |
---|
443 | ! Cas stables : |
---|
444 | !''''''''''''''' |
---|
445 | zri(i) = MIN(20.,zri(i)) |
---|
446 | SELECT CASE (iflag_corr_sta) |
---|
447 | CASE (1) ! Louis 1979 + Mascart 1995 |
---|
448 | FM(i)=MAX(1./((1+BPRIME*zri(i))**2),f_ri_cd_min) |
---|
449 | FH(i)=FM(i) |
---|
450 | CASE (2) ! Louis 1982 |
---|
451 | zscf = SQRT(1.+CD*ABS(zri(i))) |
---|
452 | FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min) |
---|
453 | FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min ) |
---|
454 | CASE (3) ! Laurent Li |
---|
455 | FM(i)=MAX(1.0 / (1.0+10.0*zri(i)*(1+8.0*zri(i))),f_ri_cd_min) |
---|
456 | FH(i)=FM(i) |
---|
457 | CASE (4) ! King 2001 |
---|
458 | IF (zri(i) .LT. C2/2.) THEN |
---|
459 | FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min) |
---|
460 | FH(i)= FM(i) |
---|
461 | ELSE |
---|
462 | FM(i)=MAX(C3*((C2/zri(i))**2),f_ri_cd_min) |
---|
463 | FH(i)= FM(i) |
---|
464 | ENDIF |
---|
465 | CASE (5) ! MO |
---|
466 | if (zri(i) .LT. 1./alpha) then |
---|
467 | FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min) |
---|
468 | FH(i)=FM(i) |
---|
469 | else |
---|
470 | FM(i)=MAX(1E-7,f_ri_cd_min) |
---|
471 | FH(i)=FM(i) |
---|
472 | endif |
---|
473 | CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023) |
---|
474 | sm(i) = MAX(0.,cn*(1.-zri(i)/ric)) |
---|
475 | prandtl(i) = pr_neut + zri(i) * pr_slope |
---|
476 | FM(i) = MAX((sm(i)**(3./2.) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1./2.)),f_ri_cd_min) |
---|
477 | FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min) |
---|
478 | CASE default ! Louis 1982 |
---|
479 | zscf = SQRT(1.+CD*ABS(zri(i))) |
---|
480 | FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min) |
---|
481 | FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min ) |
---|
482 | END SELECT |
---|
483 | |
---|
484 | ! Calcul des drags |
---|
485 | |
---|
486 | cdmm(i)=cdmn(i)*FM(i) |
---|
487 | cdhh(i)=f_cdrag_ter*cdhn(i)*FH(i) |
---|
488 | |
---|
489 | IF (choix_bulk == 0) THEN |
---|
490 | cdm(i)=cdmn(i)*FM(i) |
---|
491 | cdh(i)=f_cdrag_ter*cdhn(i)*FH(i) |
---|
492 | ENDIF |
---|
493 | |
---|
494 | IF (nsrf.EQ.is_oce) THEN |
---|
495 | cdhh(i)=f_cdrag_oce*cdhn(i)*FH(i) |
---|
496 | cdmm(i)=MIN(cdmm(i),cdmmax) |
---|
497 | cdhh(i)=MIN(cdhh(i),cdhmax) |
---|
498 | ENDIF |
---|
499 | IF (ok_cdrag_iter) THEN |
---|
500 | rugos_itm(i,1) = rugos_itm(i,2) |
---|
501 | rugos_ith(i,1) = rugos_ith(i,2) |
---|
502 | rugos_itm(i,2) = 0.018*cdmm(i) * (speed(i))/RG & |
---|
503 | + 0.11*14e-6 / SQRT(cdmm(i) * zdu2) |
---|
504 | |
---|
505 | !---------- Version SEPARATION DES Z0 ---------------------- |
---|
506 | IF (iflag_z0_oce==0) THEN |
---|
507 | rugos_ith(i,2) = rugos_itm(i,2) |
---|
508 | ELSE IF (iflag_z0_oce==1) THEN |
---|
509 | rugos_ith(i,2) = 0.40*14e-6 / SQRT(cdmm(i) * zdu2) |
---|
510 | ENDIF |
---|
511 | ENDIF |
---|
512 | ENDIF |
---|
513 | IF (ok_cdrag_iter) THEN |
---|
514 | rugos_itm(i,2) = MAX(1.5e-05,rugos_itm(i,2)) |
---|
515 | rugos_ith(i,2) = MAX(1.5e-05,rugos_ith(i,2)) |
---|
516 | ENDIF |
---|
517 | ENDDO |
---|
518 | IF (nsrf.EQ.is_oce) THEN |
---|
519 | cdm(i)=MIN(cdmm(i),cdmmax) |
---|
520 | cdh(i)=MIN(cdhh(i),cdhmax) |
---|
521 | ENDIF |
---|
522 | z0m = rugos_itm(:,2) |
---|
523 | z0h = rugos_ith(:,2) |
---|
524 | ELSE ! (nsrf == is_oce) |
---|
525 | zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd) |
---|
526 | IF (iri_in.EQ.1) THEN |
---|
527 | zri(i) = ri_in(i) |
---|
528 | ENDIF |
---|
529 | |
---|
530 | ! Coefficients CD neutres : k^2/ln(z/z0) et k^2/(ln(z/z0)*ln(z/z0h)): |
---|
531 | !******************************************************************** |
---|
532 | zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i))) |
---|
533 | cdmn(i) = zzzcd*zzzcd |
---|
534 | cdhn(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*z0h(i)))) |
---|
535 | |
---|
536 | |
---|
537 | ! Calcul des fonctions de stabilit?? FMs, FHs, FMi, FHi : |
---|
538 | !******************************************************* |
---|
539 | !'''''''''''''' |
---|
540 | ! Cas instables |
---|
541 | !'''''''''''''' |
---|
542 | IF (zri(i) .LT. 0.) THEN |
---|
543 | SELECT CASE (iflag_corr_insta) |
---|
544 | CASE (1) ! Louis 1979 + Mascart 1995 |
---|
545 | MU=LOG(MAX(z0m(i)/z0h(i),0.01)) |
---|
546 | CMstar=6.8741+2.6933*MU-0.3601*(MU**2)+0.0154*(MU**3) |
---|
547 | PM=0.5233-0.0815*MU+0.0135*(MU**2)-0.001*(MU**3) |
---|
548 | CHstar=3.2165+4.3431*MU+0.536*(MU**2)-0.0781*(MU**3) |
---|
549 | PH=0.5802-0.1571*MU+0.0327*(MU**2)-0.0026*(MU**3) |
---|
550 | CH=CHstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) & |
---|
551 | & * CKAPT/LOG(z0h(i)+zgeop1(i)/(RG*z0h(i))) & |
---|
552 | & * ((zgeop1(i)/(RG*z0h(i)))**PH) |
---|
553 | CM=CMstar*B*CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) & |
---|
554 | & *CKAP/LOG(z0m(i)+zgeop1(i)/(RG*z0m(i))) & |
---|
555 | & * ((zgeop1(i)/(RG*z0m(i)))**PM) |
---|
556 | FM(i)=1.-B*zri(i)/(1.+CM*SQRT(ABS(zri(i)))) |
---|
557 | FH(i)=1.-B*zri(i)/(1.+CH*SQRT(ABS(zri(i)))) |
---|
558 | CASE (2) ! Louis 1982 |
---|
559 | zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) & |
---|
560 | *(1.0+zgeop1(i)/(RG*z0m(i))))) |
---|
561 | FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min) |
---|
562 | FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min) |
---|
563 | CASE (3) ! Laurent Li |
---|
564 | FM(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min) |
---|
565 | FH(i) = MAX(SQRT(1.0-18.0*zri(i)),f_ri_cd_min) |
---|
566 | CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023) |
---|
567 | sm(i) = 2./rpi * (cinf - cn) * atan(-zri(i)/ri0) + cn |
---|
568 | prandtl(i) = -2./rpi * (pr_asym - pr_neut) * atan(zri(i)/ri1) + pr_neut |
---|
569 | FM(i) = MAX((sm(i)**(3./2.) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1./2.)),f_ri_cd_min) |
---|
570 | FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min) |
---|
571 | CASE default ! Louis 1982 |
---|
572 | zucf = 1./(1.+3.0*CB*CC*cdmn(i)*SQRT(ABS(zri(i)) & |
---|
573 | *(1.0+zgeop1(i)/(RG*z0m(i))))) |
---|
574 | FM(i) = AMAX1((1.-2.0*CB*zri(i)*zucf),f_ri_cd_min) |
---|
575 | FH(i) = AMAX1((1.-3.0*CB*zri(i)*zucf),f_ri_cd_min) |
---|
576 | END SELECT |
---|
577 | ! Calcul des drags |
---|
578 | cdm(i)=cdmn(i)*FM(i) |
---|
579 | cdh(i)=f_cdrag_ter*cdhn(i)*FH(i) |
---|
580 | ELSE |
---|
581 | !''''''''''''''' |
---|
582 | ! Cas stables : |
---|
583 | !''''''''''''''' |
---|
584 | zri(i) = MIN(20.,zri(i)) |
---|
585 | SELECT CASE (iflag_corr_sta) |
---|
586 | CASE (1) ! Louis 1979 + Mascart 1995 |
---|
587 | FM(i)=MAX(1./((1+BPRIME*zri(i))**2),f_ri_cd_min) |
---|
588 | FH(i)=FM(i) |
---|
589 | CASE (2) ! Louis 1982 |
---|
590 | zscf = SQRT(1.+CD*ABS(zri(i))) |
---|
591 | FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min) |
---|
592 | FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min ) |
---|
593 | CASE (3) ! Laurent Li |
---|
594 | FM(i)=MAX(1.0 / (1.0+10.0*zri(i)*(1+8.0*zri(i))),f_ri_cd_min) |
---|
595 | FH(i)=FM(i) |
---|
596 | CASE (4) ! King 2001 |
---|
597 | if (zri(i) .LT. C2/2.) then |
---|
598 | FM(i)=MAX((1.-zri(i)/C2)**2,f_ri_cd_min) |
---|
599 | FH(i)= FM(i) |
---|
600 | else |
---|
601 | FM(i)=MAX(C3*((C2/zri(i))**2),f_ri_cd_min) |
---|
602 | FH(i)= FM(i) |
---|
603 | endif |
---|
604 | CASE (5) ! MO |
---|
605 | if (zri(i) .LT. 1./alpha) then |
---|
606 | FM(i)=MAX((1.-alpha*zri(i))**2,f_ri_cd_min) |
---|
607 | FH(i)=FM(i) |
---|
608 | else |
---|
609 | FM(i)=MAX(1E-7,f_ri_cd_min) |
---|
610 | FH(i)=FM(i) |
---|
611 | endif |
---|
612 | CASE (6) ! Consistent with turbulence scheme (in stationary case) derived in atke (2023) |
---|
613 | sm(i) = MAX(0.,cn*(1.-zri(i)/ric)) |
---|
614 | prandtl(i) = pr_neut + zri(i) * pr_slope |
---|
615 | FM(i) = MAX((sm(i)**(3./2.) * sqrt(cepsilon) * (1 - zri(i) / prandtl(i))**(1./2.)),f_ri_cd_min) |
---|
616 | FH(i) = MAX((FM(i) / prandtl(i)), f_ri_cd_min) |
---|
617 | CASE default ! Louis 1982 |
---|
618 | zscf = SQRT(1.+CD*ABS(zri(i))) |
---|
619 | FM(i)= AMAX1(1. / (1.+2.*CB*zri(i)/zscf), f_ri_cd_min) |
---|
620 | FH(i)= AMAX1(1./ (1.+3.*CB*zri(i)*zscf), f_ri_cd_min ) |
---|
621 | END SELECT |
---|
622 | ! Calcul des drags |
---|
623 | cdm(i)=cdmn(i)*FM(i) |
---|
624 | cdh(i)=f_cdrag_ter*cdhn(i)*FH(i) |
---|
625 | ENDIF |
---|
626 | ENDIF ! fin du if (nsrf == is_oce) |
---|
627 | END DO ! Fin de la boucle sur l'horizontal |
---|
628 | |
---|
629 | END SUBROUTINE cdrag |
---|
630 | |
---|
631 | END MODULE cdrag_mod |
---|