Context Navigation

cdrag_mod.f90 @ 5876

Last change on this file since 5876 was 5876, checked in by yann meurdesoif, 12 hours ago

GPU port of cdrag + call_atke + coef_diff_turb

Property svn:executable set to *
Property svn:keywords set to Id

File size: 26.1 KB

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

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

Download in other formats:

Original Format