Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

cdrag_mod.F90

Last change on this file was 4721, checked in by Laurent Fairhead, 23 months ago
Needed for convergence LF
Property svn:executable set to ``*
File size: 25.1 KB

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

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

Download in other formats:

Original Format