Context Navigation

cdrag_mod.f90 @ 5274

Last change on this file since 5274 was 5274, checked in by abarral, 9 hours ago
Replace yomcst.h by existing module
Property svn:executable set to ``* Property svn:keywords set to `Id`
File size: 26.5 KB

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

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

Download in other formats:

Original Format