[3817] | 1 | ! |
---|
[4725] | 2 | !$Id: cdrag_mod.F90 4725 2023-10-11 16:37:33Z jyg $ |
---|
| 3 | ! |
---|
| 4 | ! |
---|
[3817] | 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, & |
---|
[4722] | 20 | psol, pblh, tsurf, qsurf, z0m, z0h, & |
---|
[4478] | 21 | ri_in, iri_in, & |
---|
[4722] | 22 | cdm, cdh, zri, pref, prain, tsol , pat1) |
---|
[3817] | 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 |
---|
[4687] | 28 | USE lmdz_atke_turbulence_ini, ONLY : ric, cinf, cepsilon, pr_slope, pr_asym, pr_neut |
---|
[3817] | 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 |
---|
[4722] | 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) |
---|
[4478] | 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 |
---|
[4722] | 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 |
---|
[3817] | 96 | |
---|
[4722] | 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 |
---|
[3817] | 102 | |
---|
| 103 | |
---|
[4722] | 104 | |
---|
[3817] | 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 |
---|
[4722] | 110 | REAL, DIMENSION(klon), INTENT(INOUT) :: pref ! Pression au niveau zgeop/RG |
---|
[3817] | 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 |
---|
[4722] | 129 | INTEGER i, k |
---|
[3817] | 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 |
---|
[4478] | 136 | REAL, DIMENSION(klon) :: sm, prandtl ! Stability function from atke turbulence scheme |
---|
[4481] | 137 | REAL ri0, ri1, cn ! to have dimensionless term in sm and prandtl |
---|
[3817] | 138 | |
---|
[4722] | 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 | |
---|
[3817] | 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) |
---|
[4722] | 179 | LOGICAL, SAVE :: ok_cdrag_iter |
---|
| 180 | !$OMP THREADPRIVATE(ok_cdrag_iter) |
---|
[3817] | 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 | |
---|
[4481] | 214 | ! Consistent with atke scheme |
---|
[4722] | 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 |
---|
[4478] | 218 | |
---|
[4481] | 219 | |
---|
[3817] | 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 | !************************************************************************** |
---|
[4722] | 254 | IF (firstcall) THEN |
---|
[3817] | 255 | iflag_corr_sta=2 |
---|
| 256 | iflag_corr_insta=2 |
---|
[4722] | 257 | ok_cdrag_iter = .FALSE. |
---|
[3817] | 258 | |
---|
| 259 | CALL getin_p('iflag_corr_sta',iflag_corr_sta) |
---|
| 260 | CALL getin_p('iflag_corr_insta',iflag_corr_insta) |
---|
[4722] | 261 | CALL getin_p('ok_cdrag_iter',ok_cdrag_iter) |
---|
[3817] | 262 | |
---|
| 263 | firstcall = .FALSE. |
---|
| 264 | ENDIF |
---|
| 265 | |
---|
[4722] | 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 | |
---|
[3817] | 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)* & |
---|
[4722] | 285 | (1.+ RETV * max(q1(i),0.0)))) ! negative q1 set to zero |
---|
[3817] | 286 | ztsolv = tsurf(i) * (1.0+RETV*max(qsurf(i),0.0)) ! negative qsurf set to zero |
---|
[4722] | 287 | ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*q1(i))) & |
---|
[3817] | 288 | *(1.+RETV*max(q1(i),0.0)) ! negative q1 set to zero |
---|
[4722] | 289 | |
---|
| 290 | !------------------ Rajout (OT2018) -------------------- |
---|
| 291 | !-------------- ON DUPLIQUE POUR METTRE ITERATION SUR OCEAN ------------------------ |
---|
[4478] | 292 | IF (iri_in.EQ.1) THEN |
---|
| 293 | zri(i) = ri_in(i) |
---|
| 294 | ENDIF |
---|
[3817] | 295 | |
---|
[4722] | 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) |
---|
[3817] | 314 | |
---|
[4722] | 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) |
---|
[3817] | 330 | |
---|
[4722] | 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) |
---|
[3817] | 337 | |
---|
[4722] | 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) |
---|
[3817] | 352 | |
---|
[4722] | 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 | |
---|
[3817] | 378 | |
---|
[4722] | 379 | !----------------------- Rajout des itérations -------------- |
---|
| 380 | DO k=1,nit_bulk |
---|
[4481] | 381 | |
---|
[4722] | 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)))) |
---|
[4481] | 387 | |
---|
[4722] | 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 |
---|
[3817] | 425 | ! Calcul des drags |
---|
[4722] | 426 | cdmm(i)=cdmn(i)*FM(i) |
---|
| 427 | cdhh(i)=f_cdrag_ter*cdhn(i)*FH(i) |
---|
[3817] | 428 | ! Traitement particulier des cas oceaniques |
---|
| 429 | ! on applique Miller et al 1992 en l'absence de gustiness |
---|
[4722] | 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 |
---|
[3817] | 441 | |
---|
| 442 | !''''''''''''''' |
---|
| 443 | ! Cas stables : |
---|
| 444 | !''''''''''''''' |
---|
[4722] | 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 |
---|
[3817] | 483 | |
---|
[4722] | 484 | ! Calcul des drags |
---|
[3817] | 485 | |
---|
[4722] | 486 | cdmm(i)=cdmn(i)*FM(i) |
---|
| 487 | cdhh(i)=f_cdrag_ter*cdhn(i)*FH(i) |
---|
[4725] | 488 | |
---|
[4722] | 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 |
---|
[3817] | 493 | |
---|
[4722] | 494 | IF (nsrf.EQ.is_oce) THEN |
---|
| 495 | cdhh(i)=f_cdrag_oce*cdhn(i)*FH(i) |
---|
[4725] | 496 | cdmm(i)=MIN(cdmm(i),cdmmax) |
---|
| 497 | cdhh(i)=MIN(cdhh(i),cdhmax) |
---|
[4722] | 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) |
---|
[3817] | 504 | |
---|
[4722] | 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 |
---|
[3817] | 529 | |
---|
[4722] | 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)))) |
---|
[3817] | 535 | |
---|
| 536 | |
---|
[4722] | 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 |
---|
[3817] | 577 | ! Calcul des drags |
---|
[4722] | 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) |
---|
[3817] | 627 | END DO ! Fin de la boucle sur l'horizontal |
---|
[4725] | 628 | |
---|
[3817] | 629 | END SUBROUTINE cdrag |
---|
| 630 | |
---|
| 631 | END MODULE cdrag_mod |
---|